Eleve...
[gargantext.git] / src / Gargantext / Database / TextSearch.hs
index 2f9f075ff2e141dcd8a1125d0a28214832e7aec0..c66c354d73d7a219396357da5fbee9a8f5e129ed 100644 (file)
@@ -11,15 +11,18 @@ Portability : POSIX
 {-# LANGUAGE Arrows            #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes        #-}
 
 module Gargantext.Database.TextSearch where
 
 import Data.Aeson
-import Data.List (intersperse)
+import Data.Map.Strict hiding (map, drop, take)
+import Data.Maybe
+import Data.List (intersperse, take, drop)
 import Data.String (IsString(..))
 import Data.Text (Text, words, unpack, intercalate)
 import Data.Time (UTCTime)
-import Database.PostgreSQL.Simple -- (Query, Connection)
+import Database.PostgreSQL.Simple (Query)
 import Database.PostgreSQL.Simple.ToField
 import Gargantext.Database.Config (nodeTypeId)
 import Gargantext.Database.Types.Node (NodeType(..))
@@ -28,9 +31,10 @@ import Gargantext.Prelude
 import Gargantext.Database.Facet
 import Gargantext.Database.Schema.Node
 import Gargantext.Database.Schema.Ngrams
-import Gargantext.Database.Schema.NodeNode
+import Gargantext.Database.Schema.NodeNode hiding (joinInCorpus)
 import Gargantext.Database.Schema.NodeNgram
 import Gargantext.Database.Queries.Join (leftJoin6)
+import Gargantext.Database.Utils (Cmd, runPGSQuery, runOpaQuery)
 import Gargantext.Text.Terms.Mono.Stem.En (stemIt)
 import Gargantext.Core.Types
 import Control.Arrow (returnA)
@@ -39,8 +43,8 @@ import Opaleye hiding (Query, Order)
 
 
 ------------------------------------------------------------------------
-searchInDatabase :: Connection -> ParentId -> Text -> IO [(NodeId, HyperdataDocument)]
-searchInDatabase c p t = runQuery c (queryInDatabase p t)
+searchInDatabase :: ParentId -> Text -> Cmd err [(NodeId, HyperdataDocument)]
+searchInDatabase p t = runOpaQuery (queryInDatabase p t)
 
 -- | Global search query where ParentId is Master Node Corpus Id 
 queryInDatabase :: ParentId -> Text -> O.Query (Column PGInt4, Column PGJsonb)
@@ -52,15 +56,16 @@ queryInDatabase _ q = proc () -> do
 
 ------------------------------------------------------------------------
 -- | todo add limit and offset and order
-searchInCorpus :: Connection -> CorpusId -> [Text] -> Maybe Offset -> Maybe Limit -> Maybe OrderBy -> IO [FacetDoc]
-searchInCorpus c cId q o l order = runQuery c (filterWith o l order $ queryInCorpus cId q')
+searchInCorpus :: CorpusId -> [Text] -> Maybe Offset -> Maybe Limit -> Maybe OrderBy -> Cmd err [FacetDoc]
+searchInCorpus cId q o l order = runOpaQuery (filterWith o l order $ queryInCorpus cId q')
   where
-    q' = intercalate " || " $ map stemIt q
+    q' = intercalate " | " $ map stemIt q
 
 queryInCorpus :: CorpusId -> Text -> O.Query FacetDocRead
 queryInCorpus cId q = proc () -> do
   (n, nn) <- joinInCorpus -< ()
-  restrict -< ( nodeNode_node1_id nn) .== (toNullable $ pgInt4 cId)
+  restrict -< ( nn_node1_id nn) .== (toNullable $ pgNodeId cId)
+  restrict -< ( nn_delete nn)   .== (toNullable $ pgBool False)
   restrict -< (_ns_search n)           @@ (pgTSQuery (unpack q))
   restrict -< (_ns_typename n)        .== (pgInt4 $ nodeTypeId NodeDocument)
   returnA  -< FacetDoc (_ns_id n) (_ns_date n) (_ns_name n) (_ns_hyperdata n) (pgBool True) (pgInt4 1)
@@ -69,18 +74,28 @@ joinInCorpus :: O.Query (NodeSearchRead, NodeNodeReadNull)
 joinInCorpus = leftJoin queryNodeSearchTable queryNodeNodeTable cond
   where
     cond :: (NodeSearchRead, NodeNodeRead) -> Column PGBool
-    cond (n, nn) = nodeNode_node2_id nn .== _ns_id n
+    cond (n, nn) = nn_node2_id nn .== _ns_id n
 
 ------------------------------------------------------------------------
 type AuthorName = Text
 
-searchInCorpusWithContacts :: Connection -> CorpusId -> [Text] -> Maybe Offset -> Maybe Limit -> Maybe OrderBy -> IO [FacetPaired Int UTCTime HyperdataDocument Int [Pair Int Text]]
-searchInCorpusWithContacts = undefined
+-- | TODO Optim: Offset and Limit in the Query
+searchInCorpusWithContacts :: CorpusId -> [Text] -> Maybe Offset -> Maybe Limit -> Maybe OrderBy -> Cmd err [FacetPaired Int UTCTime HyperdataDocument Int [Pair Int Text]]
+searchInCorpusWithContacts cId q o l order = take (maybe 5 identity l) <$> drop (maybe 0 identity o)
+  <$> map (\((i,u,h,s), ps) -> FacetPaired i u h s (catMaybes ps))
+  <$> toList <$> fromListWith (<>)
+  <$> map (\(FacetPaired i u h s p) -> ((i,u,h,s), [maybePair p]))
+  <$> searchInCorpusWithContacts' cId q o l order
+  where
+    maybePair (Pair Nothing Nothing) = Nothing
+    maybePair (Pair _ Nothing) = Nothing
+    maybePair (Pair Nothing _) = Nothing
+    maybePair (Pair (Just p_id) (Just p_label)) = Just $ Pair p_id p_label
 
-searchInCorpusWithContacts' :: Connection -> CorpusId -> [Text] -> Maybe Offset -> Maybe Limit -> Maybe OrderBy -> IO [(FacetPaired Int UTCTime HyperdataDocument Int (Pair (Maybe Int) (Maybe Text)))]
-searchInCorpusWithContacts' c cId q o l order = runQuery c $ queryInCorpusWithContacts cId q' o l order
+searchInCorpusWithContacts' :: CorpusId -> [Text] -> Maybe Offset -> Maybe Limit -> Maybe OrderBy -> Cmd err [(FacetPaired Int UTCTime HyperdataDocument Int (Pair (Maybe Int) (Maybe Text)))]
+searchInCorpusWithContacts' cId q o l order = runOpaQuery $ queryInCorpusWithContacts cId q' o l order
   where
-    q' = intercalate " || " $ map stemIt q
+    q' = intercalate " | " $ map stemIt q
 
 
 
@@ -89,8 +104,8 @@ queryInCorpusWithContacts cId q _ _ _ = proc () -> do
   (docs, (corpusDoc, (docNgrams, (ngrams', (_, contacts))))) <- joinInCorpusWithContacts -< ()
   restrict -< (_ns_search docs)              @@ (pgTSQuery  $ unpack q  )
   restrict -< (_ns_typename docs)           .== (pgInt4 $ nodeTypeId NodeDocument)
-  restrict -< (nodeNode_node1_id corpusDoc) .== (toNullable $ pgInt4 cId)
-  restrict -< (nodeNgram_type docNgrams)    .== (toNullable $ pgInt4 $ ngramsTypeId Authors)
+  restrict -< (nn_node1_id corpusDoc) .== (toNullable $ pgNodeId cId)
+  restrict -< (nng_listType docNgrams)      .== (toNullable $ pgNgramsType Authors)
   restrict -< (_node_typename contacts)     .== (toNullable $ pgInt4 $ nodeTypeId NodeContact)
   -- let contact_id    = ifThenElse (isNull $ _node_id contacts) (toNullable $ pgInt4 0) (_node_id contacts)
   returnA  -< FacetPaired (_ns_id docs) (_ns_date docs) (_ns_hyperdata docs) (pgInt4 0) (Pair (_node_id contacts) (ngrams_terms ngrams'))
@@ -99,37 +114,20 @@ joinInCorpusWithContacts :: O.Query (NodeSearchRead, (NodeNodeReadNull, (NodeNgr
 joinInCorpusWithContacts = leftJoin6 queryNodeTable queryNodeNgramTable queryNgramsTable queryNodeNgramTable queryNodeNodeTable queryNodeSearchTable cond12 cond23 cond34 cond45 cond56
     where
          cond12 :: (NodeNgramRead, NodeRead) -> Column PGBool
-         cond12 (ng3, n2) = _node_id n2 .== nodeNgram_node_id ng3
+         cond12 (ng3, n2) = _node_id n2 .== nng_node_id ng3
 ---------
          cond23 :: (NgramsRead, (NodeNgramRead, NodeReadNull)) -> Column PGBool
-         cond23 (ng2, (nng2, _)) = nodeNgram_ngrams_id nng2 .== ngrams_id ng2
+         cond23 (ng2, (nng2, _)) = nng_ngrams_id nng2 .== ngrams_id ng2
          
          cond34 :: (NodeNgramRead, (NgramsRead, (NodeNgramReadNull, NodeReadNull))) -> Column PGBool
-         cond34 (nng, (ng, (_,_))) = ngrams_id ng .== nodeNgram_ngrams_id nng
+         cond34 (nng, (ng, (_,_))) = ngrams_id ng .== nng_ngrams_id nng
          
          cond45 :: (NodeNodeRead, (NodeNgramRead, (NgramsReadNull, (NodeNgramReadNull, NodeReadNull)))) -> Column PGBool
-         cond45 (nn, (nng, (_,(_,_)))) = nodeNgram_node_id nng .== nodeNode_node2_id nn
+         cond45 (nn, (nng, (_,(_,_)))) = nng_node_id nng .== nn_node2_id nn
          
          cond56 :: (NodeSearchRead, (NodeNodeRead, (NodeNgramReadNull, (NgramsReadNull, (NodeNgramReadNull, NodeReadNull))))) -> Column PGBool
-         cond56 (n, (nn, (_,(_,(_,_))))) = _ns_id n .== nodeNode_node2_id nn
-
+         cond56 (n, (nn, (_,(_,(_,_))))) = _ns_id n .== nn_node2_id nn
 
-{-
-queryGraphCorpusAuthors' :: O.Query (NodeSearchRead, (NodeNodeReadNull, (NodeNgramReadNull, NgramsReadNull)))
-queryGraphCorpusAuthors' = leftJoin4 queryNgramsTable queryNodeNgramTable queryNodeNodeTable queryNodeSearchTable cond12 cond23 cond34
-    where
-         cond23 :: (NgramsRead, (NodeNgramRead, NodeReadNull)) -> Column PGBool
-         cond23 (ng2, (nng2, _)) = nodeNgram_ngrams_id nng2 .== ngrams_id ng2
-         
-         cond34 :: (NodeNgramRead, (NgramsRead, (NodeNgramReadNull, NodeReadNull))) -> Column PGBool
-         cond34 (nng, (ng, (_,_))) = ngrams_id ng .== nodeNgram_ngrams_id nng
-         
-         cond45 :: (NodeNodeRead, (NodeNgramRead, (NgramsReadNull, (NodeNgramReadNull, NodeReadNull)))) -> Column PGBool
-         cond45 (nn, (nng, (_,(_,_)))) = nodeNgram_node_id nng .== nodeNode_node2_id nn
-         
-         cond56 :: (NodeSearchRead, (NodeNodeRead, (NodeNgramReadNull, (NgramsReadNull, (NodeNgramReadNull, NodeReadNull))))) -> Column PGBool
-         cond56 (n, (nn, (_,(_,(_,_))))) = _ns_id n .== nodeNode_node2_id nn
--}
 
 
 
@@ -184,13 +182,12 @@ textSearchQuery = "SELECT n.id, n.hyperdata->'publication_year'     \
 -- | Text Search Function for Master Corpus
 -- TODO : text search for user corpus
 -- Example:
--- textSearchTest :: ParentId -> TSQuery -> Cmd [(Int, Value, Value, Value, Value, Maybe Int)]
--- textSearchTest pId q = mkCmd $ \c -> textSearch c q pId 5 0 Asc
-textSearch :: Connection 
-           -> TSQuery -> ParentId
+-- 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
-           -> IO [(Int,Value,Value,Value, Value, Maybe Int)]
-textSearch conn q p l o ord = query conn textSearchQuery (q,p,p,typeId,ord,o,l)
+           -> 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