[FIX] Order 1 and Order 2, node size ok.
[gargantext.git] / src / Gargantext / Database / Action / Search.hs
index 9271ff7a2b865158d35918f2608f78afb6454a9c..81d4ea53bff01d0dd8b722da63cb4722b1c11c2a 100644 (file)
@@ -14,19 +14,13 @@ module Gargantext.Database.Action.Search where
 
 import Control.Arrow (returnA)
 import Control.Lens ((^.))
-import Data.Aeson
-import Data.List (intersperse)
 import Data.Maybe
-import Data.String (IsString(..))
-import Data.Text (Text, words, unpack, intercalate)
+import Data.Text (Text, unpack, intercalate)
 import Data.Time (UTCTime)
-import Database.PostgreSQL.Simple (Query)
-import Database.PostgreSQL.Simple.ToField
+import Gargantext.Core
 import Gargantext.Core.Types
-import Gargantext.Database.Admin.Config (nodeTypeId)
 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument(..), HyperdataContact(..))
-import Gargantext.Database.Admin.Types.Node (NodeType(..))
-import Gargantext.Database.Prelude (Cmd, runPGSQuery, runOpaQuery, runCountOpaQuery)
+import Gargantext.Database.Prelude (Cmd, runOpaQuery, runCountOpaQuery)
 import Gargantext.Database.Query.Facet
 import Gargantext.Database.Query.Filter
 import Gargantext.Database.Query.Join (leftJoin5)
@@ -34,28 +28,30 @@ import Gargantext.Database.Query.Table.Node
 import Gargantext.Database.Query.Table.NodeNode
 import Gargantext.Database.Schema.Node
 import Gargantext.Prelude
-import Gargantext.Text.Terms.Mono.Stem.En (stemIt)
+import Gargantext.Core.Text.Terms.Mono.Stem.En (stemIt)
 import Opaleye hiding (Query, Order)
 import Data.Profunctor.Product (p4)
 import qualified Opaleye as O hiding (Order)
 
 ------------------------------------------------------------------------
-searchDocInDatabase :: ParentId
-                 -> Text
-                 -> Cmd err [(NodeId, HyperdataDocument)]
-searchDocInDatabase p t = runOpaQuery (queryDocInDatabase p t)
+searchDocInDatabase :: HasDBid NodeType
+                    => ParentId
+                    -> Text
+                    -> Cmd err [(NodeId, HyperdataDocument)]
+searchDocInDatabase _p t = runOpaQuery (queryDocInDatabase t)
   where
     -- | Global search query where ParentId is Master Node Corpus Id 
-    queryDocInDatabase :: ParentId -> Text -> O.Query (Column PGInt4, Column PGJsonb)
-    queryDocInDatabase q = proc () -> do
+    queryDocInDatabase :: Text -> O.Query (Column PGInt4, Column PGJsonb)
+    queryDocInDatabase q = proc () -> do
         row <- queryNodeSearchTable -< ()
         restrict -< (_ns_search row)    @@ (pgTSQuery (unpack q))
-        restrict -< (_ns_typename row) .== (pgInt4 $ nodeTypeId NodeDocument)
+        restrict -< (_ns_typename row) .== (sqlInt4 $ toDBid NodeDocument)
         returnA  -< (_ns_id row, _ns_hyperdata row)
 
 ------------------------------------------------------------------------
 -- | todo add limit and offset and order
-searchInCorpus :: CorpusId
+searchInCorpus :: HasDBid NodeType
+               => CorpusId
                -> IsTrash
                -> [Text]
                -> Maybe Offset
@@ -68,7 +64,8 @@ searchInCorpus cId t q o l order = runOpaQuery
                                  $ intercalate " | "
                                  $ map stemIt q
 
-searchCountInCorpus :: CorpusId
+searchCountInCorpus :: HasDBid NodeType
+                    => CorpusId
                     -> IsTrash
                     -> [Text]
                     -> Cmd err Int
@@ -77,7 +74,8 @@ searchCountInCorpus cId t q = runCountOpaQuery
                             $ intercalate " | "
                             $ map stemIt q
 
-queryInCorpus :: CorpusId
+queryInCorpus :: HasDBid NodeType
+              => CorpusId
               -> IsTrash
               -> Text
               -> O.Query FacetDocRead
@@ -85,16 +83,18 @@ queryInCorpus cId t q = proc () -> do
   (n, nn) <- joinInCorpus -< ()
   restrict -< (nn^.nn_node1_id) .== (toNullable $ pgNodeId cId)
   restrict -< if t
-                 then (nn^.nn_category) .== (toNullable $ pgInt4 0)
-                 else (nn^.nn_category) .>= (toNullable $ pgInt4 1)
+                 then (nn^.nn_category) .== (toNullable $ sqlInt4 0)
+                 else (nn^.nn_category) .>= (toNullable $ sqlInt4 1)
   restrict -< (n ^. ns_search)           @@ (pgTSQuery (unpack q))
-  restrict -< (n ^. ns_typename )       .== (pgInt4 $ nodeTypeId NodeDocument)
-  returnA  -< FacetDoc (n^.ns_id       )
-                       (n^.ns_date     )
-                       (n^.ns_name     )
-                       (n^.ns_hyperdata)
-                       (nn^.nn_category)
-                       (nn^.nn_score   )
+  restrict -< (n ^. ns_typename )       .== (sqlInt4 $ toDBid NodeDocument)
+  returnA  -< FacetDoc { facetDoc_id = n^.ns_id
+                       , facetDoc_created = n^.ns_date
+                       , facetDoc_title = n^.ns_name
+                       , facetDoc_hyperdata = n^.ns_hyperdata
+                       , facetDoc_category = nn^.nn_category
+                       , facetDoc_ngramCount = nn^.nn_score
+                       , facetDoc_score = nn^.nn_score
+                       }
 
 joinInCorpus :: O.Query (NodeSearchRead, NodeNodeReadNull)
 joinInCorpus = leftJoin queryNodeSearchTable queryNodeNodeTable cond
@@ -104,7 +104,8 @@ joinInCorpus = leftJoin queryNodeSearchTable queryNodeNodeTable cond
 
 ------------------------------------------------------------------------
 searchInCorpusWithContacts
-  :: CorpusId
+  :: HasDBid NodeType
+  => CorpusId
   -> AnnuaireId
   -> [Text]
   -> Maybe Offset
@@ -120,7 +121,8 @@ searchInCorpusWithContacts cId aId q o l _order =
               $ map stemIt q
 
 selectContactViaDoc
-  :: CorpusId
+  :: HasDBid NodeType
+  => CorpusId
   -> AnnuaireId
   -> Text
   -> QueryArr ()
@@ -132,32 +134,27 @@ selectContactViaDoc
 selectContactViaDoc cId aId q = proc () -> do
   (doc, (corpus_doc, (_contact_doc, (annuaire_contact, contact)))) <- queryContactViaDoc -< ()
   restrict -< (doc^.ns_search)           @@ (pgTSQuery  $ unpack q  )
-  restrict -< (doc^.ns_typename)        .== (pgInt4 $ nodeTypeId NodeDocument)
+  restrict -< (doc^.ns_typename)        .== (sqlInt4 $ toDBid NodeDocument)
   restrict -< (corpus_doc^.nn_node1_id)  .== (toNullable $ pgNodeId cId)
   restrict -< (annuaire_contact^.nn_node1_id) .== (toNullable $ pgNodeId aId)
-  restrict -< (contact^.node_typename)        .== (toNullable $ pgInt4 $ nodeTypeId NodeContact)
+  restrict -< (contact^.node_typename)        .== (toNullable $ sqlInt4 $ toDBid NodeContact)
   returnA  -< ( contact^.node_id
               , contact^.node_date
               , contact^.node_hyperdata
-              , toNullable $ pgInt4 1
+              , toNullable $ sqlInt4 1
               )
 
-selectGroup :: NodeId
-      -> NodeId
-      -> Text
-     -> Select FacetPairedReadNull
+selectGroup :: HasDBid NodeType
+            => NodeId
+            -> NodeId
+            -> Text
+            -> Select FacetPairedReadNull
 selectGroup cId aId q = proc () -> do
   (a, b, c, d) <- aggregate (p4 (groupBy, groupBy, groupBy, O.sum))
                             (selectContactViaDoc cId aId q) -< ()
   returnA -< FacetPaired a b c d
 
 
-
-
-
-
-
-
 queryContactViaDoc :: O.Query ( NodeSearchRead
                               , ( NodeNodeReadNull
                                 , ( NodeNodeReadNull
@@ -212,65 +209,3 @@ queryContactViaDoc =
 
 
 ------------------------------------------------------------------------
-
-newtype TSQuery = UnsafeTSQuery [Text]
-
--- | TODO [""] -> panic "error"
-toTSQuery :: [Text] -> TSQuery
-toTSQuery txt = UnsafeTSQuery $ map stemIt txt
-
-
-instance IsString TSQuery
-  where
-    fromString = UnsafeTSQuery . words . cs
-
-
-instance ToField TSQuery
-  where
-    toField (UnsafeTSQuery xs)
-      = Many  $ intersperse (Plain " && ")
-              $ map (\q -> Many [ Plain "plainto_tsquery("
-                                , Escape (cs q)
-                                , Plain ")"
-                                ]
-                    ) xs
-
-data Order    = Asc | Desc
-
-instance ToField Order
-  where
-    toField Asc  = Plain "ASC"
-    toField Desc = Plain "DESC"
-
--- TODO
--- FIX fav
--- ADD ngrams count
--- TESTS
-textSearchQuery :: Query
-textSearchQuery = "SELECT n.id, n.hyperdata->'publication_year'     \
-\                   , n.hyperdata->'title'                          \
-\                   , n.hyperdata->'source'                         \
-\                   , n.hyperdata->'authors'                        \
-\                   , COALESCE(nn.score,null)                       \
-\                      FROM nodes n                                 \
-\            LEFT JOIN nodes_nodes nn  ON nn.node2_id = n.id        \
-\              WHERE                                                \
-\                n.search @@ (?::tsquery)                           \
-\                AND (n.parent_id = ? OR nn.node1_id = ?)           \
-\                AND n.typename  = ?                                \
-\                ORDER BY n.hyperdata -> 'publication_date' ?       \
-\            offset ? limit ?;"
-
--- | Text Search Function for Master Corpus
--- TODO : text search for user corpus
--- Example:
--- textSearchTest :: ParentId -> TSQuery -> Cmd err [(Int, Value, Value, Value, Value, Maybe Int)]
--- textSearchTest pId q = textSearch q pId 5 0 Asc
-textSearch :: TSQuery -> ParentId
-           -> Limit -> Offset -> Order
-           -> Cmd err [(Int,Value,Value,Value, Value, Maybe Int)]
-textSearch q p l o ord = runPGSQuery textSearchQuery (q,p,p,typeId,ord,o,l)
-  where
-    typeId = nodeTypeId NodeDocument
-
-