Add test for searchInCorpus

bin/gargantext-init/Main.hs

@@ -73,7 +73,7 @@ main = do
       pure (masterUserId, masterRootId, masterCorpusId, masterListId)
 
   withDevEnv iniPath $ \env -> do
-    _ <- runCmdDev env (initFirstTriggers secret :: Cmd GargError [Int64])
+    _ <- runCmdDev env (initFirstTriggers secret :: DBCmd GargError [Int64])
     _ <- runCmdDev env createUsers
     x <- runCmdDev env initMaster
     _ <- runCmdDev env mkRoots

gargantext.cabal

@@ -86,6 +86,7 @@ library
       Gargantext.Core.Text.Terms
       Gargantext.Core.Text.Terms.Eleve
       Gargantext.Core.Text.Terms.Mono
+      Gargantext.Core.Text.Terms.Mono.Stem.En
       Gargantext.Core.Text.Terms.Multi
       Gargantext.Core.Text.Terms.Multi.Lang.En
       Gargantext.Core.Text.Terms.Multi.Lang.Fr
@@ -113,6 +114,7 @@ library
       Gargantext.Core.Viz.Types
       Gargantext.Database.Action.Flow
       Gargantext.Database.Action.Flow.Types
+      Gargantext.Database.Action.Search
       Gargantext.Database.Action.User
       Gargantext.Database.Action.User.New
       Gargantext.Database.Admin.Config
@@ -253,7 +255,6 @@ library
       Gargantext.Core.Text.Samples.PL
       Gargantext.Core.Text.Samples.ZH
       Gargantext.Core.Text.Terms.Mono.Stem
-      Gargantext.Core.Text.Terms.Mono.Stem.En
       Gargantext.Core.Text.Terms.Mono.Token
       Gargantext.Core.Text.Terms.Mono.Token.En
       Gargantext.Core.Text.Terms.Multi.Group
@@ -291,7 +292,6 @@ library
       Gargantext.Database.Action.Metrics.NgramsByContext
       Gargantext.Database.Action.Metrics.TFICF
       Gargantext.Database.Action.Node
-      Gargantext.Database.Action.Search
       Gargantext.Database.Action.Share
       Gargantext.Database.Action.TSQuery
       Gargantext.Database.Admin.Access

src/Gargantext/Database/Action/Flow.hs

@@ -324,7 +324,7 @@ addDocumentsToHyperCorpus ncs mb_hyper la corpusId docs = do
   pure ids
 
 ------------------------------------------------------------------------
-createNodes :: ( FlowCmdM env err m
+createNodes :: ( DbCmd' env err m, HasNodeError err
                , MkCorpus c
                )
             => User

src/Gargantext/Database/Action/Search.hs

@@ -11,7 +11,13 @@ Portability : POSIX
 {-# LANGUAGE Arrows            #-}
 {-# LANGUAGE LambdaCase         #-}
 
-module Gargantext.Database.Action.Search where
+module Gargantext.Database.Action.Search (
+    searchInCorpus
+  , searchInCorpusWithContacts
+  , searchCountInCorpus
+  , searchInCorpusWithNgrams
+  , searchDocInDatabase
+  ) where
 
 import Control.Arrow (returnA)
 import Control.Lens ((^.), view)
@@ -25,7 +31,7 @@ import Gargantext.Core
 import Gargantext.Core.Types
 import Gargantext.Core.Types.Query (IsTrash, Limit, Offset)
 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument(..), HyperdataContact(..))
-import Gargantext.Database.Prelude (Cmd, runOpaQuery, runCountOpaQuery)
+import Gargantext.Database.Prelude (runOpaQuery, runCountOpaQuery, DBCmd)
 import Gargantext.Database.Query.Facet
 import Gargantext.Database.Query.Filter
 import Gargantext.Database.Query.Table.Node
@@ -48,7 +54,7 @@ import qualified Opaleye as O hiding (Order)
 searchDocInDatabase :: HasDBid NodeType
                     => ParentId
                     -> Text
-                    -> Cmd err [(NodeId, HyperdataDocument)]
+                    -> DBCmd err [(NodeId, HyperdataDocument)]
 searchDocInDatabase p t = runOpaQuery (queryDocInDatabase p t)
   where
     -- | Global search query where ParentId is Master Node Corpus Id
@@ -71,7 +77,7 @@ searchInCorpusWithNgrams :: HasDBid NodeType
                -> Maybe Offset
                -> Maybe Limit
                -> Maybe OrderBy
-               -> Cmd err [FacetDoc]
+               -> DBCmd err [FacetDoc]
 searchInCorpusWithNgrams _cId _lId _t _ngt _q _o _l _order = undefined
 
 -- | Compute TF-IDF for all 'ngramIds' in given 'CorpusId'. In this
@@ -79,11 +85,11 @@ searchInCorpusWithNgrams _cId _lId _t _ngt _q _o _l _order = undefined
 -- ratio of "number of times our terms appear in given document" and
 -- "number of all terms in document" and return a sorted list of
 -- document ids
-tfidfAll :: (HasDBid NodeType, HasNodeError err) => CorpusId -> [Int] -> Cmd err [Int]
-tfidfAll cId ngramIds = do
+_tfidfAll :: (HasDBid NodeType, HasNodeError err) => CorpusId -> [Int] -> DBCmd err [Int]
+_tfidfAll cId ngramIds = do
   let ngramIdsSet = Set.fromList ngramIds
   lId <- defaultList cId
-  docsWithNgrams <- runOpaQuery (queryListWithNgrams lId ngramIds) :: Cmd err [(Int, Int, Int)]
+  docsWithNgrams <- runOpaQuery (_queryListWithNgrams lId ngramIds) :: DBCmd err [(Int, Int, Int)]
   -- NOTE The query returned docs with ANY ngramIds. We need to further
   -- restrict to ALL ngramIds.
   let docsNgramsM =
@@ -111,8 +117,8 @@ tfidfAll cId ngramIds = do
 
 -- | Query for searching the 'context_node_ngrams' table so that we
 -- find docs with ANY given 'ngramIds'.
-queryListWithNgrams :: ListId -> [Int] -> Select (Column SqlInt4, Column SqlInt4, Column SqlInt4)
-queryListWithNgrams lId ngramIds = proc () -> do
+_queryListWithNgrams :: ListId -> [Int] -> Select (Column SqlInt4, Column SqlInt4, Column SqlInt4)
+_queryListWithNgrams lId ngramIds = proc () -> do
   row <- queryContextNodeNgramsTable -< ()
   restrict -< (_cnng_node_id row) .== (pgNodeId lId)
   restrict -< in_ (sqlInt4 <$> ngramIds) (_cnng_ngrams_id row)
@@ -137,7 +143,7 @@ searchInCorpus :: HasDBid NodeType
                -> Maybe Offset
                -> Maybe Limit
                -> Maybe OrderBy
-               -> Cmd err [FacetDoc]
+               -> DBCmd err [FacetDoc]
 searchInCorpus cId t q o l order = runOpaQuery
                                  $ filterWith o l order
                                  $ queryInCorpus cId t
@@ -148,7 +154,7 @@ searchCountInCorpus :: HasDBid NodeType
                     => CorpusId
                     -> IsTrash
                     -> [Text]
-                    -> Cmd err Int
+                    -> DBCmd err Int
 searchCountInCorpus cId t q = runCountOpaQuery
                             $ queryInCorpus cId t
                             $ intercalate " | "
@@ -189,7 +195,7 @@ searchInCorpusWithContacts
   -> Maybe Offset
   -> Maybe Limit
   -> Maybe OrderBy
-  -> Cmd err [FacetPaired Int UTCTime HyperdataContact Int]
+  -> DBCmd err [FacetPaired Int UTCTime HyperdataContact Int]
 searchInCorpusWithContacts cId aId q o l _order =
   runOpaQuery $ limit'   l
               $ offset'  o

src/Gargantext/Database/Admin/Trigger/ContextNodeNgrams.hs

@@ -20,11 +20,12 @@ import Database.PostgreSQL.Simple.SqlQQ (sql)
 import Gargantext.Core
 -- import Gargantext.Core.Types.Main (ListType(CandidateTerm))
 import Gargantext.Database.Admin.Types.Node -- (ListId, CorpusId, NodeId)
-import Gargantext.Database.Prelude (Cmd, execPGSQuery)
+-- (ListId, CorpusId, NodeId)
+import Gargantext.Database.Prelude (execPGSQuery, DBCmd)
 import Gargantext.Prelude
 import qualified Database.PostgreSQL.Simple as DPS
 
-triggerCountInsert :: HasDBid NodeType => Cmd err Int64
+triggerCountInsert :: HasDBid NodeType => DBCmd err Int64
 triggerCountInsert = execPGSQuery query (toDBid NodeDocument, toDBid NodeList)
   where
     query :: DPS.Query
@@ -60,7 +61,7 @@ triggerCountInsert = execPGSQuery query (toDBid NodeDocument, toDBid NodeList)
           EXECUTE PROCEDURE set_ngrams_global_count();
    |]
 
-triggerCountInsert2 :: HasDBid NodeType => Cmd err Int64
+triggerCountInsert2 :: HasDBid NodeType => DBCmd err Int64
 triggerCountInsert2 = execPGSQuery query ( toDBid NodeCorpus
                                          , toDBid NodeDocument
                                          , toDBid NodeList

src/Gargantext/Database/Admin/Trigger/Contexts.hs

@@ -20,12 +20,13 @@ import Data.Text (Text)
 import Database.PostgreSQL.Simple.SqlQQ (sql)
 import Gargantext.Core (HasDBid(..))
 import Gargantext.Database.Admin.Types.Node -- (ListId, CorpusId, NodeId)
-import Gargantext.Database.Prelude (Cmd, execPGSQuery)
+-- (ListId, CorpusId, NodeId)
+import Gargantext.Database.Prelude (execPGSQuery, DBCmd)
 import Gargantext.Prelude
 import qualified Database.PostgreSQL.Simple as DPS
 
 
-triggerSearchUpdate :: HasDBid NodeType => Cmd err Int64
+triggerSearchUpdate :: HasDBid NodeType => DBCmd err Int64
 triggerSearchUpdate = execPGSQuery query ( toDBid NodeDocument
                                          , toDBid NodeDocument
                                          , toDBid NodeContact
@@ -69,7 +70,7 @@ triggerSearchUpdate = execPGSQuery query ( toDBid NodeDocument
 
 type Secret = Text
 
-triggerUpdateHash :: HasDBid NodeType => Secret -> Cmd err Int64
+triggerUpdateHash :: HasDBid NodeType => Secret -> DBCmd err Int64
 triggerUpdateHash secret = execPGSQuery query ( toDBid NodeDocument
                                               , toDBid NodeContact
                                               , secret

src/Gargantext/Database/Admin/Trigger/Init.hs

@@ -20,16 +20,17 @@ import Data.Text (Text)
 import Gargantext.Database.Admin.Trigger.ContextNodeNgrams (triggerCountInsert, triggerCountInsert2)
 import Gargantext.Database.Admin.Trigger.Contexts (triggerSearchUpdate, triggerUpdateHash)
 import Gargantext.Database.Admin.Trigger.NodesContexts ({-triggerDeleteCount,-} triggerInsertCount, triggerUpdateAdd, triggerUpdateDel, MasterListId) -- , triggerCoocInsert)
-import Gargantext.Database.Prelude (Cmd)
+-- , triggerCoocInsert)
+import Gargantext.Database.Prelude (DBCmd)
 import Gargantext.Prelude
 
 ------------------------------------------------------------------------
-initFirstTriggers :: Text -> Cmd err [Int64]
+initFirstTriggers :: Text -> DBCmd err [Int64]
 initFirstTriggers secret = do
   t0  <- triggerUpdateHash secret
   pure [t0]
 
-initLastTriggers :: MasterListId -> Cmd err [Int64]
+initLastTriggers :: MasterListId -> DBCmd err [Int64]
 initLastTriggers lId = do
   t0  <- triggerSearchUpdate
   t1 <- triggerCountInsert

src/Gargantext/Database/Admin/Trigger/NodesContexts.hs

@@ -20,13 +20,14 @@ import Database.PostgreSQL.Simple.SqlQQ (sql)
 import Gargantext.Core
 import Gargantext.Database.Admin.Config
 import Gargantext.Database.Admin.Types.Node -- (ListId, CorpusId, NodeId)
-import Gargantext.Database.Prelude (Cmd, execPGSQuery)
+-- (ListId, CorpusId, NodeId)
+import Gargantext.Database.Prelude (execPGSQuery, DBCmd)
 import Gargantext.Prelude
 import qualified Database.PostgreSQL.Simple as DPS
 
 type MasterListId = ListId
 
-triggerInsertCount :: MasterListId -> Cmd err Int64
+triggerInsertCount :: MasterListId -> DBCmd err Int64
 triggerInsertCount lId = execPGSQuery query (lId, nodeTypeId NodeList)
   where
     query :: DPS.Query
@@ -62,7 +63,7 @@ triggerInsertCount lId = execPGSQuery query (lId, nodeTypeId NodeList)
   |]
 
 
-triggerUpdateAdd :: MasterListId -> Cmd err Int64
+triggerUpdateAdd :: MasterListId -> DBCmd err Int64
 triggerUpdateAdd lId = execPGSQuery query (lId, nodeTypeId NodeList)
   where
     query :: DPS.Query
@@ -102,7 +103,7 @@ triggerUpdateAdd lId = execPGSQuery query (lId, nodeTypeId NodeList)
   |]
 
 
-triggerUpdateDel :: MasterListId -> Cmd err Int64
+triggerUpdateDel :: MasterListId -> DBCmd err Int64
 triggerUpdateDel lId = execPGSQuery query (lId, nodeTypeId NodeList)
   where
     query :: DPS.Query
@@ -144,7 +145,7 @@ triggerUpdateDel lId = execPGSQuery query (lId, nodeTypeId NodeList)
 
 
 
-triggerDeleteCount :: MasterListId -> Cmd err Int64
+triggerDeleteCount :: MasterListId -> DBCmd err Int64
 triggerDeleteCount lId = execPGSQuery query (lId, toDBid NodeList)
   where
     query :: DPS.Query

src/Gargantext/Database/Prelude.hs

@@ -138,7 +138,7 @@ runOpaQuery :: Default FromFields fields haskells
             -> DBCmd err [haskells]
 runOpaQuery q = mkCmd $ \c -> runSelect c q
 
-runCountOpaQuery :: Select a -> Cmd err Int
+runCountOpaQuery :: Select a -> DBCmd err Int
 runCountOpaQuery q = do
   counts <- mkCmd $ \c -> runSelect c $ countRows q
   -- countRows is guaranteed to return a list with exactly one row so DL.head is safe here
@@ -189,7 +189,7 @@ runPGSQuery_ q = mkCmd $ \conn -> catch (PGS.query_ conn q) printError
       hPutStrLn stderr (fromQuery q)
       throw (SomeException e)
 
-execPGSQuery :: PGS.ToRow a => PGS.Query -> a -> Cmd err Int64
+execPGSQuery :: PGS.ToRow a => PGS.Query -> a -> DBCmd err Int64
 execPGSQuery q a = mkCmd $ \conn -> PGS.execute conn q a
 
 ------------------------------------------------------------------------

src/Gargantext/Database/Query/Table/Node.hs

@@ -171,7 +171,7 @@ getClosestParentIdByType' nId nType = do
 getChildrenByType :: HasDBid NodeType
                   => NodeId
                   -> NodeType
-                  -> Cmd err [NodeId]
+                  -> DBCmd err [NodeId]
 getChildrenByType nId nType = do
   result <- runPGSQuery query (PGS.Only nId)
   children_lst <- mapM (\(id, _) -> getChildrenByType id nType) result
@@ -275,7 +275,7 @@ insertDefaultNode :: HasDBid NodeType
 insertDefaultNode nt p u = insertNode nt Nothing Nothing p u
 
 insertDefaultNodeIfNotExists :: HasDBid NodeType
-                             => NodeType -> ParentId -> UserId -> Cmd err [NodeId]
+                             => NodeType -> ParentId -> UserId -> DBCmd err [NodeId]
 insertDefaultNodeIfNotExists nt p u = do
   children <- getChildrenByType p nt
   case children of
@@ -406,7 +406,7 @@ getOrMkList pId uId =
       mkList' pId' uId' = maybe (nodeError MkNode) pure . headMay =<< insertDefaultNode NodeList pId' uId'
 
 -- | TODO remove defaultList
-defaultList :: (HasNodeError err, HasDBid NodeType) => CorpusId -> Cmd err ListId
+defaultList :: (HasNodeError err, HasDBid NodeType) => CorpusId -> DBCmd err ListId
 defaultList cId =
   maybe (nodeError (NoListFound cId)) (pure . view node_id) . headMay =<< getListsWithParentId cId
 

test/Database/Operations.hs

@@ -22,7 +22,7 @@ import Gargantext.Database.Action.User
 import Gargantext.Database.Action.User.New
 import Gargantext.Database.Admin.Types.Hyperdata.Corpus
 import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Query.Table.Node (mk, getCorporaWithParentId)
+import Gargantext.Database.Query.Table.Node (mk, getCorporaWithParentId, getOrMkList)
 import Gargantext.Database.Query.Tree.Root (getRootId)
 import Gargantext.Database.Schema.Node (NodePoly(..))
 import Gargantext.Prelude
@@ -44,6 +44,9 @@ import Test.Hspec
 import Test.QuickCheck.Monadic
 import Test.Tasty.HUnit hiding (assert)
 import Test.Tasty.QuickCheck
+import Gargantext.Database.Admin.Trigger.Init
+import Gargantext.Database.Action.Flow
+import Gargantext.Database.Admin.Config (userMaster, corpusMasterName)
 
 -- | Keeps a log of usernames we have already generated, so that our
 -- roundtrip tests won't fail.
@@ -110,6 +113,8 @@ withTestDB = bracket setup teardown
 
 tests :: Spec
 tests = sequential $ aroundAll withTestDB $ describe "Database" $ do
+  describe "Prelude" $ do
+    it "setup DB triggers" setupEnvironment
   describe "Read/Writes" $ do
     describe "User creation" $ do
       it "Simple write/read" writeRead01
@@ -119,6 +124,9 @@ tests = sequential $ aroundAll withTestDB $ describe "Database" $ do
       it "Simple write/read" corpusReadWrite01
       it "Can add language to Corpus" corpusAddLanguage
       it "Can add documents to a Corpus" corpusAddDocuments
+    describe "Corpus search" $ do
+      it "Can stem query terms" stemmingTest
+      it "Can perform a simple search inside documents" corpusSearch01
 
 data ExpectedActual a =
     Expected a
@@ -130,6 +138,16 @@ instance Eq a => Eq (ExpectedActual a) where
   (Actual a)   == (Expected b) = a == b
   _ == _ = False
 
+setupEnvironment :: TestEnv -> IO ()
+setupEnvironment env = flip runReaderT env $ runTestMonad $ do
+  void $ initFirstTriggers "secret_key"
+  void $ new_user $ mkNewUser (userMaster <> "@cnrs.com") (GargPassword "secret_key")
+  (masterUserId, _masterRootId, masterCorpusId)
+              <- getOrMk_RootWithCorpus (UserName userMaster)
+                                        (Left corpusMasterName)
+                                        (Nothing :: Maybe HyperdataCorpus)
+  masterListId <- getOrMkList masterCorpusId masterUserId
+  void $ initLastTriggers masterListId
 
 writeRead01 :: TestEnv -> Assertion
 writeRead01 env = do
@@ -140,14 +158,14 @@ writeRead01 env = do
     uid1 <- new_user nur1
     uid2 <- new_user nur2
 
-    liftBase $ uid1 `shouldBe` 1
-    liftBase $ uid2 `shouldBe` 2
+    liftBase $ uid1 `shouldBe` 2
+    liftBase $ uid2 `shouldBe` 3
 
     -- Getting the users by username returns the expected IDs
     uid1' <- getUserId (UserName "alfredo")
     uid2' <- getUserId (UserName "paul")
-    liftBase $ uid1' `shouldBe` 1
-    liftBase $ uid2' `shouldBe` 2
+    liftBase $ uid1' `shouldBe` 2
+    liftBase $ uid2' `shouldBe` 3
 
 mkUserDup :: TestEnv -> Assertion
 mkUserDup env = do
@@ -184,7 +202,7 @@ corpusReadWrite01 env = do
     uid      <- getUserId (UserName "alfredo")
     parentId <- getRootId (UserName "alfredo")
     [corpusId] <- mk (Just "Test_Corpus") (Nothing :: Maybe HyperdataCorpus) parentId uid
-    liftIO $ corpusId `shouldBe` NodeId 409
+    liftIO $ corpusId `shouldBe` NodeId 416
     -- Retrieve the corpus by Id
     [corpus] <- getCorporaWithParentId parentId
     liftIO $ corpusId `shouldBe` (_node_id corpus)

test/Database/Operations/DocumentSearch.hs

@@ -11,24 +11,25 @@ import Data.Maybe
 import Gargantext.Core
 import Gargantext.Core.Types.Individu
 import Gargantext.Database.Action.Flow
-import Gargantext.Database.Action.User
-import Gargantext.Database.Action.User.New
-import Gargantext.Database.Admin.Types.Hyperdata.Corpus
+import Gargantext.Database.Action.Search
 import Gargantext.Database.Admin.Types.Hyperdata.Document
 import Gargantext.Database.Query.Table.Node
 import Gargantext.Database.Query.Tree.Root
 import Gargantext.Database.Schema.Node (NodePoly(..))
 import Network.URI (parseURI)
 
-import Test.Tasty.HUnit
 import Database.Operations.Types
+import Test.Hspec.Expectations
+import Test.Tasty.HUnit
+import Gargantext.Core.Text.Terms.Mono.Stem.En
+import Gargantext.Database.Admin.Config (userMaster)
 
 
 exampleDocument_01 :: HyperdataDocument
 exampleDocument_01 = either error id $ parseEither parseJSON $ [aesonQQ|
   { "doi":"sdfds"
   , "publication_day":6
-  , "language_iso2":"en"
+  , "language_iso2":"EN"
   , "publication_minute":0
   , "publication_month":7
   , "language_iso3":"eng"
@@ -49,7 +50,7 @@ exampleDocument_02 :: HyperdataDocument
 exampleDocument_02 = either error id $ parseEither parseJSON $ [aesonQQ|
   { "doi":"sdfds"
   , "publication_day":6
-  , "language_iso2":"en"
+  , "language_iso2":"EN"
   , "publication_minute":0
   , "publication_month":7
   , "language_iso3":"eng"
@@ -74,19 +75,33 @@ nlpServerConfig =
 corpusAddDocuments :: TestEnv -> Assertion
 corpusAddDocuments env = do
   flip runReaderT env $ runTestMonad $ do
-
     -- NOTE(adn) We need to create user 'gargantua'(!!) in order
     -- for 'addDocumentsToHyperCorpus' to work.
-    let nur = mkNewUser "gargantua@foo.com" (GargPassword "my_secret")
-    void $ new_user nur
-    uid      <- getUserId (UserName "alfredo")
+    parentId <- getRootId (UserName userMaster)
+    [corpus] <- getCorporaWithParentId parentId
+    let corpusId = _node_id corpus
+
+    ids <- addDocumentsToHyperCorpus nlpServerConfig
+                                     (Just $ _node_hyperdata $ corpus)
+                                     (Multi EN)
+                                     corpusId
+                                     [exampleDocument_01, exampleDocument_02]
+    liftIO $ length ids `shouldBe` 2
+
+stemmingTest :: TestEnv -> Assertion
+stemmingTest _env = do
+  stemIt "Ajeje"    `shouldBe` "Ajeje"
+  stemIt "PyPlasm:" `shouldBe` "PyPlasm:"
+
+corpusSearch01 :: TestEnv -> Assertion
+corpusSearch01 env = do
+  flip runReaderT env $ runTestMonad $ do
+
     parentId <- getRootId (UserName "gargantua")
-    void $ mk (Just "Test_Corpus") (Nothing :: Maybe HyperdataCorpus) parentId uid
     [corpus] <- getCorporaWithParentId parentId
 
-    _ids <- addDocumentsToHyperCorpus nlpServerConfig
-                                      (Just $ _node_hyperdata $ corpus)
-                                      (Multi EN)
-                                      (_node_id corpus)
-                                      [exampleDocument_01]
-    pure ()
+    results1 <- searchInCorpus (_node_id corpus) False ["mineral"] Nothing Nothing Nothing
+    results2 <- searchInCorpus (_node_id corpus) False ["computational"] Nothing Nothing Nothing
+
+    liftIO $ length results1 `shouldBe` 1
+    liftIO $ length results2 `shouldBe` 1