Add addDocumentsToHyperCorpus function

This commit refactors the codebase to add a new function called
`addDocumentsToHyperCorpus` which generalises the common pattern of
calling `insertMasterDocs` and later adding the documents via the DB
`Doc` functions.

It also "lowers" some functions to run into a plain `DBCmd`.

src/Gargantext/API/Node/Corpus/Searx.hs

@@ -16,7 +16,7 @@ import Gargantext.Core.Text.List.Group.WithStem ({-StopSize(..),-} GroupParams(.
 import Gargantext.Core.Text.Terms (TermType(..))
 import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Core.Utils.Prefix (unPrefix)
-import Gargantext.Database.Action.Flow (insertMasterDocs) --, DataText(..))
+import Gargantext.Database.Action.Flow (addDocumentsToHyperCorpus) --, DataText(..))
 import Gargantext.Database.Action.Flow.List (flowList_DbRepo)
 import Gargantext.Database.Action.Flow.Types (FlowCmdM)
 import Gargantext.Database.Action.User (getUserId)
@@ -33,13 +33,12 @@ import Gargantext.Prelude.Config
 import Gargantext.Utils.Jobs (JobHandle, MonadJobStatus(..))
 import Network.HTTP.Client
 import Network.HTTP.Client.TLS
-import Protolude (catMaybes, encodeUtf8, rightToMaybe, Text)
+import Protolude (catMaybes, encodeUtf8, rightToMaybe, Text, void)
 import qualified Data.Aeson as Aeson
 import qualified Data.HashMap.Strict as HashMap
 import qualified Data.Text as T
 import qualified Data.Text as Text
 import qualified Gargantext.Core.Text.Corpus.API as API
-import qualified Gargantext.Database.Query.Table.Node.Document.Add  as Doc  (add)
 import qualified Prelude
 
 langToSearx :: Lang -> Text
@@ -133,8 +132,7 @@ insertSearxResponse user cId listId l (Right (SearxResponse { _srs_results })) =
     -}
   --_ <- flowDataText user (DataNew [docs']) (Multi l) cId Nothing logStatus
   let mCorpus = Nothing :: Maybe HyperdataCorpus
-  ids <- insertMasterDocs mCorpus (Multi l) docs'
-  _ <- Doc.add cId ids
+  void $ addDocumentsToHyperCorpus server mCorpus (Multi l) cId docs'
   (_masterUserId, _masterRootId, masterCorpusId)
     <- getOrMk_RootWithCorpus (UserName userMaster) (Left "") mCorpus
   let gp = GroupWithPosTag l server HashMap.empty

src/Gargantext/API/Node/DocumentUpload.hs

@@ -20,14 +20,13 @@ import Gargantext.Core.Text.Corpus.Parsers.Date (dateSplit)
 import Gargantext.Core.Utils.Prefix (unCapitalize, dropPrefix)
 import Gargantext.Database.Action.Flow.Types
 import Gargantext.Core.Text.Terms (TermType(..))
-import Gargantext.Database.Action.Flow (insertMasterDocs)
+import Gargantext.Database.Action.Flow (addDocumentsToHyperCorpus)
 import Gargantext.Database.Admin.Types.Hyperdata.Document (HyperdataDocument(..))
-import qualified Gargantext.Database.Query.Table.Node.Document.Add  as Doc  (add)
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Query.Table.Node (getClosestParentIdByType')
 import Gargantext.Prelude
-import Gargantext.Database.Admin.Types.Hyperdata.Corpus (HyperdataCorpus(..))
 import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
+import Gargantext.Core.NLP (nlpServerGet)
 
 
 data DocumentUpload = DocumentUpload
@@ -117,6 +116,6 @@ documentUpload nId doc = do
                              , _hd_publication_second = Nothing
                              , _hd_language_iso2 = Just $ view du_language doc }
 
-  docIds <- insertMasterDocs (Nothing :: Maybe HyperdataCorpus) (Multi EN) [hd]
-  _ <- Doc.add cId docIds
-  pure docIds
+  let lang = EN
+  ncs <- view $ nlpServerGet lang
+  addDocumentsToHyperCorpus ncs Nothing (Multi lang) cId [hd]

src/Gargantext/Core/Text/Terms.hs

@@ -56,7 +56,7 @@ import Gargantext.Core.Text.Terms.Mono.Stem (stem)
 import Gargantext.Core.Text.Terms.Mono.Token.En (tokenize)
 import Gargantext.Core.Text.Terms.Multi (multiterms)
 import Gargantext.Core.Types
-import Gargantext.Database.Prelude (Cmd)
+import Gargantext.Database.Prelude (DBCmd)
 import Gargantext.Database.Query.Table.Ngrams (insertNgrams)
 import Gargantext.Database.Query.Table.NgramsPostag (NgramsPostag(..), insertNgramsPostag, np_form, np_lem)
 import Gargantext.Database.Schema.Ngrams (Ngrams(..), NgramsType(..), ngramsTerms, text2ngrams, NgramsId)
@@ -121,9 +121,10 @@ instance Hashable ExtractedNgrams
 class ExtractNgramsT h
   where
     extractNgramsT :: HasText h
-                   => TermType Lang
+                   => NLPServerConfig
+                   -> TermType Lang
                    -> h
-                   -> Cmd err (HashMap ExtractedNgrams (Map NgramsType Int, TermsCount))
+                   -> DBCmd err (HashMap ExtractedNgrams (Map NgramsType Int, TermsCount))
 ------------------------------------------------------------------------
 enrichedTerms :: Lang -> PosTagAlgo -> POS -> Terms -> NgramsPostag
 enrichedTerms l pa po (Terms ng1 ng2) =
@@ -148,7 +149,7 @@ extracted2ngrams (SimpleNgrams   ng) = ng
 extracted2ngrams (EnrichedNgrams ng) = view np_form ng
 
 ---------------------------
-insertExtractedNgrams :: [ ExtractedNgrams ] -> Cmd err (HashMap Text NgramsId)
+insertExtractedNgrams :: [ ExtractedNgrams ] -> DBCmd err (HashMap Text NgramsId)
 insertExtractedNgrams ngs = do
   let (s, e) = List.partition isSimpleNgrams ngs
   m1 <- insertNgrams       (map unSimpleNgrams   s)

src/Gargantext/Database/Action/Flow.hs

@@ -38,6 +38,7 @@ module Gargantext.Database.Action.Flow -- (flowDatabase, ngrams2list)
   , flowAnnuaire
   , insertMasterDocs
   , saveDocNgramsWith
+  , addDocumentsToHyperCorpus
 
   , reIndexWith
   , docNgrams
@@ -73,7 +74,7 @@ import Data.Tuple.Extra (first, second)
 import GHC.Generics (Generic)
 import GHC.Num (fromInteger)
 import Gargantext.API.Ngrams.Tools (getTermsWith)
-import Gargantext.Core (Lang(..), PosTagAlgo(..))
+import Gargantext.Core (Lang(..), PosTagAlgo(..), NLPServerConfig)
 import Gargantext.Core (withDefaultLanguage)
 import Gargantext.Core.Ext.IMTUser (readFile_Annuaire)
 import Gargantext.Core.Flow.Types
@@ -299,11 +300,26 @@ flow c u cn la mfslw (mLength, docsC) jobHandle = do
     insertDocs' :: [(Integer, a)] -> m [NodeId]
     insertDocs' [] = pure []
     insertDocs' docs = do
+      ncs <- view $ nlpServerGet (_tt_lang la)
       $(logLocM) DEBUG $ T.pack $ "calling insertDoc, ([idx], mLength) = " <> show (fst <$> docs, mLength)
-      ids <- insertMasterDocs c la (snd <$> docs)
+      ids <- insertMasterDocs ncs c la (snd <$> docs)
       markProgress (length docs) jobHandle
       pure ids
 
+-- | Given a list of corpus documents and a 'NodeId' identifying the 'CorpusId', adds
+-- the given documents to the corpus. Returns the Ids of the inserted documents.
+addDocumentsToHyperCorpus :: (DbCmd' env err m, HasNodeError err)
+                          => NLPServerConfig
+                          -> Maybe HyperdataCorpus
+                          -> TermType Lang
+                          -> CorpusId
+                          -> [HyperdataDocument]
+                          -> m [DocId]
+addDocumentsToHyperCorpus ncs mb_hyper la corpusId docs = do
+  ids <- insertMasterDocs ncs mb_hyper la docs
+  void $ Doc.add corpusId ids
+  pure ids
+
 ------------------------------------------------------------------------
 createNodes :: ( FlowCmdM env err m
                , MkCorpus c
@@ -371,15 +387,17 @@ flowCorpusUser l user userCorpusId listId ctype mfslw = do
   pure userCorpusId
 
 
-insertMasterDocs :: ( FlowCmdM env err m
+insertMasterDocs :: ( DbCmd' env err m
+                    , HasNodeError err
                     , FlowCorpus a
                     , MkCorpus   c
                     )
-                 => Maybe c
+                 => NLPServerConfig
+                 -> Maybe c
                  -> TermType Lang
                  -> [a]
                  -> m [DocId]
-insertMasterDocs c lang hs  =  do
+insertMasterDocs ncs c lang hs  =  do
   (masterUserId, _, masterCorpusId) <- getOrMk_RootWithCorpus (UserName userMaster) (Left corpusMasterName) c
   (ids', documentsWithId) <- insertDocs masterUserId masterCorpusId (map (toNode masterUserId Nothing) hs )
   _ <- Doc.add masterCorpusId ids'
@@ -392,7 +410,7 @@ insertMasterDocs c lang hs  =  do
   mapNgramsDocs' :: HashMap ExtractedNgrams (Map NgramsType (Map NodeId (Int, TermsCount)))
                 <- mapNodeIdNgrams
                 <$> documentIdWithNgrams
-                      (extractNgramsT $ withLang lang documentsWithId)
+                      (extractNgramsT ncs $ withLang lang documentsWithId)
                       documentsWithId
 
   lId      <- getOrMkList masterCorpusId masterUserId
@@ -402,7 +420,7 @@ insertMasterDocs c lang hs  =  do
   -- _cooc <- insertDefaultNode NodeListCooc lId masterUserId
   pure ids'
 
-saveDocNgramsWith :: (FlowCmdM env err m)
+saveDocNgramsWith :: (DbCmd' env err m)
                   => ListId
                   -> HashMap ExtractedNgrams (Map NgramsType (Map NodeId (Int, TermsCount)))
                   -> m ()
@@ -438,9 +456,10 @@ saveDocNgramsWith lId mapNgramsDocs' = do
 
 ------------------------------------------------------------------------
 -- TODO Type NodeDocumentUnicised
-insertDocs :: ( FlowCmdM env err m
+insertDocs :: ( DbCmd' env err m
               -- , FlowCorpus a
               , FlowInsertDB a
+              , HasNodeError err
               )
               => UserId
               -> CorpusId
@@ -486,9 +505,9 @@ mergeData rs = catMaybes . map toDocumentWithId . Map.toList
 ------------------------------------------------------------------------
 documentIdWithNgrams :: HasNodeError err
                      => (a
-                     -> Cmd err (HashMap b (Map NgramsType Int, TermsCount)))
+                     -> DBCmd err (HashMap b (Map NgramsType Int, TermsCount)))
                      -> [Indexed NodeId a]
-                     -> Cmd err [DocumentIdWithNgrams a b]
+                     -> DBCmd err [DocumentIdWithNgrams a b]
 documentIdWithNgrams f = traverse toDocumentIdWithNgrams
   where
     toDocumentIdWithNgrams d = do
@@ -519,10 +538,10 @@ mapNodeIdNgrams = HashMap.unionsWith (Map.unionWith (Map.unionWith addTuples)) .
 ------------------------------------------------------------------------
 instance ExtractNgramsT HyperdataContact
   where
-    extractNgramsT l hc = HashMap.mapKeys (cleanExtractedNgrams 255) <$> extract l hc
+    extractNgramsT _ncs l hc = HashMap.mapKeys (cleanExtractedNgrams 255) <$> extract l hc
       where
         extract :: TermType Lang -> HyperdataContact
-                -> Cmd err (HashMap ExtractedNgrams (Map NgramsType Int, TermsCount))
+                -> DBCmd err (HashMap ExtractedNgrams (Map NgramsType Int, TermsCount))
         extract _l hc' = do
           let authors = map text2ngrams
                       $ maybe ["Nothing"] (\a -> [a])
@@ -533,15 +552,15 @@ instance ExtractNgramsT HyperdataContact
 
 instance ExtractNgramsT HyperdataDocument
   where
-    extractNgramsT :: TermType Lang
+    extractNgramsT :: NLPServerConfig
+                   -> TermType Lang
                    -> HyperdataDocument
-                   -> Cmd err (HashMap ExtractedNgrams (Map NgramsType Int, TermsCount))
-    extractNgramsT lang hd = HashMap.mapKeys (cleanExtractedNgrams 255) <$> extractNgramsT' lang hd
+                   -> DBCmd err (HashMap ExtractedNgrams (Map NgramsType Int, TermsCount))
+    extractNgramsT ncs lang hd = HashMap.mapKeys (cleanExtractedNgrams 255) <$> extractNgramsT' hd
       where
-        extractNgramsT' :: TermType Lang
-                        -> HyperdataDocument
-                       -> Cmd err (HashMap ExtractedNgrams (Map NgramsType Int, TermsCount))
-        extractNgramsT' lang' doc = do
+        extractNgramsT' :: HyperdataDocument
+                        -> DBCmd err (HashMap ExtractedNgrams (Map NgramsType Int, TermsCount))
+        extractNgramsT' doc = do
           let source    = text2ngrams
                         $ maybe "Nothing" identity
                         $ _hd_source doc
@@ -554,11 +573,9 @@ instance ExtractNgramsT HyperdataDocument
                          $ maybe ["Nothing"] (splitOn Authors (doc^. hd_bdd))
                          $ _hd_authors doc
 
-          ncs <- view (nlpServerGet $ lang' ^. tt_lang)
-
-          termsWithCounts' <- map (\(t, cnt) -> (enrichedTerms (lang' ^. tt_lang) CoreNLP NP t, cnt))
+          termsWithCounts' <- map (\(t, cnt) -> (enrichedTerms (lang ^. tt_lang) CoreNLP NP t, cnt))
                               <$> concat
-                              <$> liftBase (extractTerms ncs lang' $ hasText doc)
+                              <$> liftBase (extractTerms ncs lang $ hasText doc)
 
           pure $ HashMap.fromList
                $  [(SimpleNgrams source, (Map.singleton Sources     1, 1))                    ]
@@ -568,7 +585,7 @@ instance ExtractNgramsT HyperdataDocument
 
 instance (ExtractNgramsT a, HasText a) => ExtractNgramsT (Node a)
   where
-    extractNgramsT l (Node { _node_hyperdata = h }) = extractNgramsT l h
+    extractNgramsT ncs l (Node { _node_hyperdata = h }) = extractNgramsT ncs l h
 
 instance HasText a => HasText (Node a)
   where
@@ -592,9 +609,11 @@ extractInsert :: FlowCmdM env err m
               => [Node HyperdataDocument] -> m ()
 extractInsert docs = do
   let documentsWithId = map (\doc -> Indexed (doc ^. node_id) doc) docs
+  let lang = EN
+  ncs <- view $ nlpServerGet lang
   mapNgramsDocs' <- mapNodeIdNgrams
                 <$> documentIdWithNgrams
-                    (extractNgramsT $ withLang (Multi EN) documentsWithId)
+                    (extractNgramsT ncs $ withLang (Multi lang) documentsWithId)
                     documentsWithId
   _ <- insertExtractedNgrams $ HashMap.keys mapNgramsDocs'
   pure ()

src/Gargantext/Database/Action/Flow/Utils.hs

@@ -17,7 +17,7 @@ import Data.Map.Strict (Map)
 import Data.HashMap.Strict (HashMap)
 import Gargantext.Core.Types (TermsCount)
 import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Prelude (Cmd)
+import Gargantext.Database.Prelude (DBCmd)
 import Gargantext.Database.Query.Table.ContextNodeNgrams
 import Gargantext.Database.Schema.Ngrams
 import Gargantext.Database.Types
@@ -35,7 +35,7 @@ data DocumentIdWithNgrams a b =
 
 insertDocNgrams :: ListId
                 -> HashMap (Indexed NgramsId Ngrams) (Map NgramsType (Map DocId (Int, TermsCount)))
-                -> Cmd err Int
+                -> DBCmd err Int
 insertDocNgrams lId m = do
   -- printDebug "[insertDocNgrams] ns" ns
   insertContextNodeNgrams ns

src/Gargantext/Database/Prelude.hs

@@ -151,7 +151,7 @@ formatPGSQuery q a = mkCmd $ \conn -> PGS.formatQuery conn q a
 runPGSQuery' :: (PGS.ToRow a, PGS.FromRow b) => PGS.Query -> a -> Cmd err [b]
 runPGSQuery' q a = mkCmd $ \conn -> PGS.query conn q a
 
-runPGSQuery :: ( CmdM env err m
+runPGSQuery :: ( DbCmd' env err m
                , PGS.FromRow r, PGS.ToRow q
                )
                => PGS.Query -> q -> m [r]

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

@@ -23,7 +23,7 @@ module Gargantext.Database.Query.Table.ContextNodeNgrams
   where
 
 import Gargantext.Database.Admin.Types.Node (pgNodeId, pgContextId)
-import Gargantext.Database.Prelude (Cmd, mkCmd)
+import Gargantext.Database.Prelude (mkCmd, DBCmd)
 import Gargantext.Database.Schema.Ngrams (pgNgramsTypeId)
 import Gargantext.Database.Schema.ContextNodeNgrams
 import Gargantext.Database.Schema.Prelude
@@ -34,7 +34,7 @@ queryContextNodeNgramsTable :: Query ContextNodeNgramsRead
 queryContextNodeNgramsTable = selectTable contextNodeNgramsTable
 
 -- | Insert utils
-insertContextNodeNgrams :: [ContextNodeNgrams] -> Cmd err Int
+insertContextNodeNgrams :: [ContextNodeNgrams] -> DBCmd err Int
 insertContextNodeNgrams = insertContextNodeNgramsW
                      . map (\(ContextNodeNgrams c n ng nt w dc) ->
                               ContextNodeNgrams (pgContextId c)
@@ -45,7 +45,7 @@ insertContextNodeNgrams = insertContextNodeNgramsW
                                                 (sqlInt4 dc)
                             )
 
-insertContextNodeNgramsW :: [ContextNodeNgramsWrite] -> Cmd err Int
+insertContextNodeNgramsW :: [ContextNodeNgramsWrite] -> DBCmd err Int
 insertContextNodeNgramsW nnnw =
   mkCmd $ \c -> fromIntegral <$> runInsert_ c insertNothing
     where

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

@@ -25,7 +25,7 @@ module Gargantext.Database.Query.Table.ContextNodeNgrams2
 import Gargantext.Database.Schema.Prelude
 import Gargantext.Database.Schema.ContextNodeNgrams2
 import Gargantext.Database.Admin.Types.Node (pgNodeId)
-import Gargantext.Database.Prelude (Cmd, mkCmd)
+import Gargantext.Database.Prelude (mkCmd, DBCmd)
 import Prelude
 
 
@@ -33,7 +33,7 @@ queryContextNodeNgrams2Table :: Query ContextNodeNgrams2Read
 queryContextNodeNgrams2Table = selectTable contextNodeNgrams2Table
 
 -- | Insert utils
-insertContextNodeNgrams2 :: [ContextNodeNgrams2] -> Cmd err Int
+insertContextNodeNgrams2 :: [ContextNodeNgrams2] -> DBCmd err Int
 insertContextNodeNgrams2 = insertContextNodeNgrams2W
                      . map (\(ContextNodeNgrams2 n1 n2 w) ->
                               ContextNodeNgrams2 (pgNodeId n1)
@@ -41,7 +41,7 @@ insertContextNodeNgrams2 = insertContextNodeNgrams2W
                                                  (sqlDouble w)
                            )
 
-insertContextNodeNgrams2W :: [ContextNodeNgrams2Write] -> Cmd err Int
+insertContextNodeNgrams2W :: [ContextNodeNgrams2Write] -> DBCmd err Int
 insertContextNodeNgrams2W nnnw =
   mkCmd $ \c -> fromIntegral <$> runInsert_ c insertNothing
     where

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

@@ -28,7 +28,7 @@ import Data.HashMap.Strict (HashMap)
 import Data.Map.Strict (Map)
 import Data.Text (Text)
 import Gargantext.Core.Types
-import Gargantext.Database.Prelude (runOpaQuery, Cmd, formatPGSQuery, runPGSQuery)
+import Gargantext.Database.Prelude (runOpaQuery, Cmd, formatPGSQuery, runPGSQuery, DBCmd)
 import Gargantext.Database.Query.Join (leftJoin3)
 import Gargantext.Database.Query.Table.ContextNodeNgrams2
 import Gargantext.Database.Query.Table.NodeNgrams (queryNodeNgramsTable)
@@ -73,14 +73,14 @@ _dbGetNgramsDb = runOpaQuery queryNgramsTable
 
 
 -- TODO-ACCESS: access must not be checked here but when insertNgrams is called.
-insertNgrams :: [Ngrams] -> Cmd err (HashMap Text NgramsId)
+insertNgrams :: [Ngrams] -> DBCmd err (HashMap Text NgramsId)
 insertNgrams ns =
   if List.null ns
      then pure HashMap.empty
      else HashMap.fromList <$> map (\(Indexed i t) -> (t, i)) <$> (insertNgrams' ns)
 
 -- TODO-ACCESS: access must not be checked here but when insertNgrams' is called.
-insertNgrams' :: [Ngrams] -> Cmd err [Indexed Int Text]
+insertNgrams' :: [Ngrams] -> DBCmd err [Indexed Int Text]
 insertNgrams' ns = runPGSQuery queryInsertNgrams (PGS.Only $ Values fields ns)
   where
     fields = map (\t -> QualifiedIdentifier Nothing t) ["text", "int4"]

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

@@ -24,7 +24,7 @@ import Data.Hashable (Hashable)
 import Data.Text (Text)
 import Gargantext.Core
 import Gargantext.Core.Types
-import Gargantext.Database.Prelude (Cmd, runPGSQuery, runPGSQuery_)
+import Gargantext.Database.Prelude (Cmd, runPGSQuery, runPGSQuery_, DBCmd)
 import Gargantext.Database.Schema.Ngrams
 import Gargantext.Database.Schema.Prelude
 import Gargantext.Database.Query.Table.Ngrams
@@ -65,7 +65,7 @@ toInsert (NgramsPostag l a p form lem) =
   , view ngramsSize  lem
   )
 
-insertNgramsPostag :: [NgramsPostag] -> Cmd err (HashMap Text NgramsId)
+insertNgramsPostag :: [NgramsPostag] -> DBCmd err (HashMap Text NgramsId)
 insertNgramsPostag xs =
   if List.null xs
      then pure HashMap.empty
@@ -86,7 +86,7 @@ insertNgramsPostag xs =
        pure $ HashMap.union ns' nps'
 
 
-insertNgramsPostag' :: [NgramsPostagInsert] -> Cmd err [Indexed Text Int]
+insertNgramsPostag' :: [NgramsPostagInsert] -> DBCmd err [Indexed Text Int]
 insertNgramsPostag' ns = runPGSQuery queryInsertNgramsPostag (PGS.Only $ Values fields ns)
   where
 

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

@@ -399,7 +399,7 @@ instance MkCorpus HyperdataAnnuaire
 getOrMkList :: (HasNodeError err, HasDBid NodeType)
             => ParentId
             -> UserId
-            -> Cmd err ListId
+            -> DBCmd err ListId
 getOrMkList pId uId =
   maybe (mkList' pId uId) (pure . view node_id) . headMay =<< getListsWithParentId pId
     where
@@ -413,5 +413,5 @@ defaultList cId =
 defaultListMaybe :: (HasNodeError err, HasDBid NodeType) => CorpusId -> Cmd err (Maybe NodeId)
 defaultListMaybe cId = headMay <$> map (view node_id ) <$> getListsWithParentId cId
 
-getListsWithParentId :: HasDBid NodeType => NodeId -> Cmd err [Node HyperdataList]
+getListsWithParentId :: HasDBid NodeType => NodeId -> DBCmd err [Node HyperdataList]
 getListsWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeList)

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

@@ -28,12 +28,12 @@ import Database.PostgreSQL.Simple.ToRow (ToRow(..))
 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
 import GHC.Generics (Generic)
 import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Prelude (Cmd, runPGSQuery, formatPGSQuery)
+import Gargantext.Database.Prelude (Cmd, runPGSQuery, formatPGSQuery, DBCmd)
 import Gargantext.Prelude
 
 ---------------------------------------------------------------------------
 
-add :: CorpusId -> [ContextId] -> Cmd err [Only Int]
+add :: CorpusId -> [ContextId] -> DBCmd err [Only Int]
 add pId ns = runPGSQuery queryAdd (Only $ Values fields inputData)
   where
     fields    = map (\t-> QualifiedIdentifier Nothing t) inputSqlTypes

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

@@ -73,7 +73,7 @@ import GHC.Generics (Generic)
 import Gargantext.Core (HasDBid(toDBid))
 import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Prelude (Cmd, runPGSQuery{-, formatPGSQuery-})
+import Gargantext.Database.Prelude (runPGSQuery, DBCmd{-, formatPGSQuery-})
 import Gargantext.Database.Schema.Node (NodePoly(..))
 import qualified Gargantext.Defaults as Defaults
 import Gargantext.Prelude
@@ -93,7 +93,7 @@ import Database.PostgreSQL.Simple (formatQuery)
 -- ParentId : folder ID which is parent of the inserted documents
 -- Administrator of the database has to create a uniq index as following SQL command:
 -- `create unique index on contexts table (typename, parent_id, (hyperdata ->> 'uniqId'));`
-insertDb :: (InsertDb a, HasDBid NodeType) => UserId -> Maybe ParentId -> [a] -> Cmd err [ReturnId]
+insertDb :: (InsertDb a, HasDBid NodeType) => UserId -> Maybe ParentId -> [a] -> DBCmd err [ReturnId]
 insertDb u p = runPGSQuery queryInsert . Only . Values fields . map (insertDb' u p)
       where
         fields    = map (\t-> QualifiedIdentifier Nothing t) inputSqlTypes

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

@@ -67,7 +67,7 @@ listInsertDb :: Show a => ListId
              -> (ListId -> a -> [NodeNgramsW])
              -> a
              -- -> Cmd err [Returning]
-             -> Cmd err (Map NgramsType (Map Text Int))
+             -> DBCmd err (Map NgramsType (Map Text Int))
 listInsertDb l f ngs = Map.map Map.fromList
                     <$> Map.fromListWith (<>)
                     <$> List.map (\(Returning t tx id) -> (fromJust t, [(tx, id)]))
@@ -75,7 +75,7 @@ listInsertDb l f ngs = Map.map Map.fromList
                     <$> insertNodeNgrams (f l ngs)
 
 -- TODO optimize with size of ngrams
-insertNodeNgrams :: [NodeNgramsW] -> Cmd err [Returning]
+insertNodeNgrams :: [NodeNgramsW] -> DBCmd err [Returning]
 insertNodeNgrams nns = runPGSQuery query (PGS.Only $ Values fields nns')
   where
     fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","text","int4"

test/Database/Operations.hs

@@ -182,6 +182,7 @@ tests = sequential $ aroundAll withTestDB $ describe "Database" $ do
     describe "Corpus creation" $ do
       it "Simple write/read" corpusReadWrite01
       it "Can add language to Corpus" corpusAddLanguage
+      it "Can add documents to a Corpus" corpusAddDocuments
 
 data ExpectedActual a =
     Expected a
@@ -240,6 +241,7 @@ prop_userCreationRoundtrip env = monadicIO $ do
   ur' <- runEnv env (getUserId (UserName $ _nu_username nur))
   run (Expected uid `shouldBe` Actual ur')
 
+-- | We test that we can create and later read-back a 'Corpus'.
 corpusReadWrite01 :: TestEnv -> Assertion
 corpusReadWrite01 env = do
   flip runReaderT env $ runTestMonad $ do
@@ -251,6 +253,7 @@ corpusReadWrite01 env = do
     [corpus] <- getCorporaWithParentId parentId
     liftIO $ corpusId `shouldBe` (_node_id corpus)
 
+-- | We test that we can update the existing language for a 'Corpus'.
 corpusAddLanguage :: TestEnv -> Assertion
 corpusAddLanguage env = do
   flip runReaderT env $ runTestMonad $ do
@@ -260,3 +263,10 @@ corpusAddLanguage env = do
     addLanguageToCorpus (_node_id corpus) IT
     [corpus'] <- getCorporaWithParentId parentId
     liftIO $ (_hc_lang . _node_hyperdata $ corpus') `shouldBe` Just IT
+
+corpusAddDocuments :: TestEnv -> Assertion
+corpusAddDocuments env = do
+  flip runReaderT env $ runTestMonad $ do
+    parentId <- getRootId (UserName "alfredo")
+    [_corpus] <- getCorporaWithParentId parentId
+    pure ()