[refactor] addDocumentsToHyperCorpus can use HasNLPServer instance

All calls were basically:

nlpServer <- view (nlpServerGet lang)
addDocumentsToHyperCorpus nlpServer ...
parent 7fad2fc3
......@@ -23,7 +23,7 @@ import Data.Tuple.Select (sel1, sel2, sel3)
import Gargantext.Core (Lang(..))
import Gargantext.Core.Config (GargConfig(..), hasConfig)
import Gargantext.Core.Config.Types (FramesConfig(..))
import Gargantext.Core.NLP (HasNLPServer, nlpServerGet)
import Gargantext.Core.NLP (HasNLPServer)
import Gargantext.Core.NodeStory.Types ( HasNodeStory )
import Gargantext.Core.Text.Corpus.Query qualified as Query
import Gargantext.Core.Text.Terms (TermType(..))
......@@ -126,7 +126,6 @@ insertSearxResponse :: ( MonadBase IO m
-> m ()
insertSearxResponse _ _ _ _ (Left _) = pure ()
insertSearxResponse user cId listId l (Right (SearxResponse { _srs_results })) = do
server <- view (nlpServerGet l)
-- docs :: [Either Text HyperdataDocument]
let docs = hyperdataDocumentFromSearxResult l <$> _srs_results
--printDebug "[triggerSearxSearch] docs" docs
......@@ -141,7 +140,7 @@ insertSearxResponse user cId listId l (Right (SearxResponse { _srs_results })) =
-}
--_ <- flowDataText user (DataNew [docs']) (Multi l) cId Nothing logStatus
let mCorpus = Nothing :: Maybe HyperdataCorpus
void $ addDocumentsToHyperCorpus server mCorpus (Multi l) cId docs'
void $ addDocumentsToHyperCorpus mCorpus (Multi l) cId docs'
_ <- buildSocialList l user cId listId mCorpus Nothing
......
......@@ -27,7 +27,7 @@ import Gargantext.API.Prelude ( GargM )
import Gargantext.API.Routes.Named.Document qualified as Named
import Gargantext.API.Worker (serveWorkerAPI)
import Gargantext.Core (Lang(..))
import Gargantext.Core.NLP (nlpServerGet, HasNLPServer)
import Gargantext.Core.NLP (HasNLPServer)
import Gargantext.Core.NodeStory.Types (HasNodeStoryEnv, HasNodeArchiveStoryImmediateSaver)
import Gargantext.Core.Text.Corpus.Parsers.Date (mDateSplit)
import Gargantext.Core.Text.Terms (TermType(..))
......@@ -99,8 +99,7 @@ documentUpload nId doc = do
, _hd_institutes_tree = Nothing }
let lang = EN
ncs <- view $ nlpServerGet lang
addDocumentsToHyperCorpus ncs (Nothing :: Maybe HyperdataCorpus) (Multi lang) cId [hd]
addDocumentsToHyperCorpus (Nothing :: Maybe HyperdataCorpus) (Multi lang) cId [hd]
-- | Imports the documents contained into this 'DocumentExport' into this (local) version
-- of the running node.
......@@ -122,9 +121,8 @@ remoteImportDocuments :: ( HasNodeError err
-> m [NodeId]
remoteImportDocuments loggedInUser corpusId nodeId WorkSplit{..} documents = do
let la = Multi EN
nlpServerConfig <- view $ nlpServerGet (_tt_lang la)
$(logLocM) INFO $ "Importing " <> T.pack (show _ws_current) <> "/" <> T.pack (show _ws_total) <> " documents for corpus node " <> T.pack (show nodeId)
docs <- addDocumentsToHyperCorpus nlpServerConfig (Nothing :: Maybe HyperdataCorpus) la corpusId (map (_node_hyperdata . _d_document) documents)
docs <- addDocumentsToHyperCorpus (Nothing :: Maybe HyperdataCorpus) la corpusId (map (_node_hyperdata . _d_document) documents)
_versioned <- commitCorpus corpusId (RootId $ _auth_node_id loggedInUser)
$(logLocM) INFO $ "Done importing " <> T.pack (show _ws_current) <> "/" <> T.pack (show _ws_total) <> " documents for corpus node " <> T.pack (show nodeId)
pure docs
......@@ -274,10 +274,9 @@ flow :: forall env err m a c.
flow c mkCorpusUser la mfslw (count, docsC) jobHandle = do
(_userId, userCorpusId, listId) <- createNodes mkCorpusUser c
-- TODO if public insertMasterDocs else insertUserDocs
nlpServer <- view $ nlpServerGet (_tt_lang la)
runConduit $ zipSources (yieldMany ([1..] :: [Int])) docsC
.| CList.chunksOf 5
.| mapM_C (addDocumentsWithProgress nlpServer userCorpusId)
.| mapM_C (addDocumentsWithProgress userCorpusId)
.| sinkNull
let u = userFromMkCorpusUser mkCorpusUser
......@@ -286,10 +285,10 @@ flow c mkCorpusUser la mfslw (count, docsC) jobHandle = do
flowCorpusUser (la ^. tt_lang) u userCorpusId listId c mfslw
where
addDocumentsWithProgress :: NLPServerConfig -> CorpusId -> [(Int, a)] -> m ()
addDocumentsWithProgress nlpServer userCorpusId docsChunk = do
addDocumentsWithProgress :: CorpusId -> [(Int, a)] -> m ()
addDocumentsWithProgress userCorpusId docsChunk = do
$(logLocM) DEBUG $ T.pack $ "calling insertDoc, ([idx], mLength) = " <> show (fst <$> docsChunk, count)
docs <- addDocumentsToHyperCorpus nlpServer c la userCorpusId (map snd docsChunk)
docs <- addDocumentsToHyperCorpus c la userCorpusId (map snd docsChunk)
markProgress (length docs) jobHandle
......@@ -297,17 +296,18 @@ flow c mkCorpusUser la mfslw (count, docsC) jobHandle = do
-- the given documents to the corpus. Returns the Ids of the inserted documents.
addDocumentsToHyperCorpus :: ( IsDBCmd env err m
, HasNodeError err
, HasNLPServer env
, FlowCorpus document
, MkCorpus corpus
)
=> NLPServerConfig
-> Maybe corpus
=> Maybe corpus
-> TermType Lang
-> CorpusId
-> [document]
-> m [DocId]
addDocumentsToHyperCorpus ncs mb_hyper la corpusId docs = do
ids <- insertMasterDocs ncs mb_hyper la docs
addDocumentsToHyperCorpus mb_hyper la corpusId docs = do
nlpServer <- view $ nlpServerGet (_tt_lang la)
ids <- insertMasterDocs nlpServer mb_hyper la docs
void $ Doc.add corpusId (map nodeId2ContextId ids)
pure ids
......
......@@ -3,7 +3,6 @@
module Test.API.Export (tests) where
import Control.Lens (view)
import Data.ByteString.Lazy qualified as BSL
import Data.Version (showVersion)
import Database.SQLite.Simple qualified as S
......@@ -11,7 +10,6 @@ import Database.SQLite.Simple qualified as S
import Gargantext.API.Node.Corpus.Export.Types (CorpusSQLite(..), CorpusSQLiteData(..))
import Gargantext.API.Node.Corpus.Export.Utils (withTempSQLiteDir, mkCorpusSQLiteData)
import Gargantext.Core (Lang(EN))
import Gargantext.Core.NLP (nlpServerGet)
import Gargantext.Core.Text.Terms (TermType(Multi))
import Gargantext.Core.Types (unNodeId)
import Gargantext.Core.Types.Individu
......@@ -55,8 +53,7 @@ tests = sequential $ around withTestDBAndPort $ beforeWith dbEnvSetup $ do
let docs = [ exampleDocument_01, exampleDocument_02 ]
let lang = EN
nlpServer <- view (nlpServerGet lang)
_ <- addDocumentsToHyperCorpus nlpServer (Just $ corpus ^. node_hyperdata) (Multi lang) corpusId docs
_ <- addDocumentsToHyperCorpus (Just $ corpus ^. node_hyperdata) (Multi lang) corpusId docs
(CorpusSQLiteData { .. }) <- mkCorpusSQLiteData corpusId Nothing
......
......@@ -12,15 +12,11 @@ Portability : POSIX
module Test.Database.Operations.DocumentSearch where
-- import Gargantext.API.Node.Update (updateDocs)
-- import Network.URI (parseURI)
import Control.Lens (view)
import Control.Monad.Reader
import Data.Aeson.QQ.Simple
import Data.Aeson.Types
import Data.Text qualified as T
import Gargantext.Core
import Gargantext.Core.NLP (nlpServerGet)
import Gargantext.Core.Text.Corpus.Query qualified as API
import Gargantext.Core.Text.Terms.Mono.Stem
import Gargantext.Core.Types.Individu
......@@ -122,9 +118,7 @@ addCorpusDocuments env = flip runReaderT env $ runTestMonad $ do
let lang = EN
let docs = [exampleDocument_01, exampleDocument_02, exampleDocument_03, exampleDocument_04]
server <- view (nlpServerGet lang)
_ <- addDocumentsToHyperCorpus server
(Just $ _node_hyperdata $ corpus)
_ <- addDocumentsToHyperCorpus (Just $ _node_hyperdata $ corpus)
(Multi lang)
corpusId
docs
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment