[VERSION] +1 to 0.0.2.6
[gargantext.git] / src / Gargantext / Database / Action / Search.hs
index b1fab4fc962c239a754a2bf987da3de2d7fbd246..f51f6f04e1e82c504b322f7eb202946dc6348974 100644 (file)
@@ -15,37 +15,34 @@ module Gargantext.Database.Action.Search where
 import Control.Arrow (returnA)
 import Control.Lens ((^.))
 import Data.Aeson
-import Data.List (intersperse, take, drop)
-import Data.Map.Strict hiding (map, drop, take)
+import Data.List (intersperse)
 import Data.Maybe
 import Data.String (IsString(..))
 import Data.Text (Text, words, unpack, intercalate)
 import Data.Time (UTCTime)
 import Database.PostgreSQL.Simple (Query)
 import Database.PostgreSQL.Simple.ToField
-import Opaleye hiding (Query, Order)
-import qualified Opaleye as O hiding (Order)
-
+import Gargantext.Core
 import Gargantext.Core.Types
-import Gargantext.Database.Query.Filter
-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.Query.Facet
-import Gargantext.Database.Query.Join (leftJoin6, leftJoin5)
+import Gargantext.Database.Query.Filter
+import Gargantext.Database.Query.Join (leftJoin5)
 import Gargantext.Database.Query.Table.Node
 import Gargantext.Database.Query.Table.NodeNode
-import Gargantext.Database.Query.Table.NodeNodeNgrams
-import Gargantext.Database.Query.Table.Ngrams
-import Gargantext.Database.Prelude (Cmd, runPGSQuery, runOpaQuery, runCountOpaQuery)
 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 :: HasDBid NodeType
+                    => ParentId
+                    -> Text
+                    -> Cmd err [(NodeId, HyperdataDocument)]
 searchDocInDatabase p t = runOpaQuery (queryDocInDatabase p t)
   where
     -- | Global search query where ParentId is Master Node Corpus Id 
@@ -53,12 +50,13 @@ searchDocInDatabase p t = runOpaQuery (queryDocInDatabase p t)
     queryDocInDatabase _ q = proc () -> do
         row <- queryNodeSearchTable -< ()
         restrict -< (_ns_search row)    @@ (pgTSQuery (unpack q))
-        restrict -< (_ns_typename row) .== (pgInt4 $ nodeTypeId NodeDocument)
+        restrict -< (_ns_typename row) .== (pgInt4 $ 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
@@ -71,7 +69,8 @@ searchInCorpus cId t q o l order = runOpaQuery
                                  $ intercalate " | "
                                  $ map stemIt q
 
-searchCountInCorpus :: CorpusId
+searchCountInCorpus :: HasDBid NodeType
+                    => CorpusId
                     -> IsTrash
                     -> [Text]
                     -> Cmd err Int
@@ -80,7 +79,8 @@ searchCountInCorpus cId t q = runCountOpaQuery
                             $ intercalate " | "
                             $ map stemIt q
 
-queryInCorpus :: CorpusId
+queryInCorpus :: HasDBid NodeType
+              => CorpusId
               -> IsTrash
               -> Text
               -> O.Query FacetDocRead
@@ -91,13 +91,14 @@ queryInCorpus cId t q = proc () -> do
                  then (nn^.nn_category) .== (toNullable $ pgInt4 0)
                  else (nn^.nn_category) .>= (toNullable $ pgInt4 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 )       .== (pgInt4 $ toDBid NodeDocument)
+  returnA  -< FacetDoc (n^.ns_id        )
+                       (n^.ns_date      )
+                       (n^.ns_name      )
+                       (n^.ns_hyperdata )
+                       (nn^.nn_category )
+                       (nn^.nn_score    )
+                       (nn^.nn_score    )
 
 joinInCorpus :: O.Query (NodeSearchRead, NodeNodeReadNull)
 joinInCorpus = leftJoin queryNodeSearchTable queryNodeNodeTable cond
@@ -107,7 +108,8 @@ joinInCorpus = leftJoin queryNodeSearchTable queryNodeNodeTable cond
 
 ------------------------------------------------------------------------
 searchInCorpusWithContacts
-  :: CorpusId
+  :: HasDBid NodeType
+  => CorpusId
   -> AnnuaireId
   -> [Text]
   -> Maybe Offset
@@ -117,29 +119,44 @@ searchInCorpusWithContacts
 searchInCorpusWithContacts cId aId q o l _order =
   runOpaQuery $ limit'   l
               $ offset'  o
-              -- $ orderBy ( o l order
-              $ selectContactViaDoc cId aId
+              $ orderBy ( desc _fp_score)
+              $ selectGroup cId aId
               $ intercalate " | "
               $ map stemIt q
 
-
 selectContactViaDoc
-  :: CorpusId
+  :: HasDBid NodeType
+  => CorpusId
   -> AnnuaireId
   -> Text
-  -> O.Query FacetPairedReadNull
+  -> QueryArr ()
+              ( Column (Nullable PGInt4)
+              , Column (Nullable PGTimestamptz)
+              , Column (Nullable PGJsonb)
+              , Column (Nullable PGInt4)
+              )
 selectContactViaDoc cId aId q = proc () -> do
-  (doc, (corpus_doc, (contact_doc, (annuaire_contact, contact)))) <- queryContactViaDoc -< ()
+  (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)        .== (pgInt4 $ 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)
-  returnA  -< FacetPaired (contact^.node_id)
-                          (contact^.node_date)
-                          (contact^.node_hyperdata)
-                          (toNullable $ pgInt4 0)
-
+  restrict -< (contact^.node_typename)        .== (toNullable $ pgInt4 $ toDBid NodeContact)
+  returnA  -< ( contact^.node_id
+              , contact^.node_date
+              , contact^.node_hyperdata
+              , toNullable $ pgInt4 1
+              )
+
+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
@@ -250,11 +267,12 @@ textSearchQuery = "SELECT n.id, n.hyperdata->'publication_year'     \
 -- 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
+textSearch :: HasDBid NodeType
+           => 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
+    typeId = toDBid NodeDocument