Commit 3229f682 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[FLOW] adding flow with search in database.

parent b605fa3d
...@@ -40,7 +40,7 @@ main = do ...@@ -40,7 +40,7 @@ main = do
-} -}
let cmdCorpus :: forall m. FlowCmdM DevEnv ServantErr m => m CorpusId let cmdCorpus :: forall m. FlowCmdM DevEnv ServantErr m => m CorpusId
cmdCorpus = flowCorpus (cs user) CsvHalFormat corpusPath (cs name) cmdCorpus = flowCorpus (cs user) (cs name) CsvHalFormat corpusPath
-- cmd = {-createUsers >>-} cmdCorpus -- cmd = {-createUsers >>-} cmdCorpus
......
...@@ -46,6 +46,7 @@ import Gargantext.Core (Lang(..)) ...@@ -46,6 +46,7 @@ import Gargantext.Core (Lang(..))
import Gargantext.Core.Types (NodePoly(..), Terms(..)) import Gargantext.Core.Types (NodePoly(..), Terms(..))
import Gargantext.Core.Types.Individu (Username) import Gargantext.Core.Types.Individu (Username)
import Gargantext.Core.Types.Main import Gargantext.Core.Types.Main
import Gargantext.Database.TextSearch (searchInDatabase)
import Gargantext.Database.Config (userMaster, corpusMasterName) import Gargantext.Database.Config (userMaster, corpusMasterName)
import Gargantext.Database.Flow.Utils (insertToNodeNgrams) import Gargantext.Database.Flow.Utils (insertToNodeNgrams)
import Gargantext.Database.Node.Document.Insert -- (insertDocuments, ReturnId(..), addUniqIdsDoc, addUniqIdsContact, ToDbData(..)) import Gargantext.Database.Node.Document.Insert -- (insertDocuments, ReturnId(..), addUniqIdsDoc, addUniqIdsContact, ToDbData(..))
...@@ -61,6 +62,7 @@ import Gargantext.Text.List ...@@ -61,6 +62,7 @@ import Gargantext.Text.List
import Gargantext.Text.Parsers (parseDocs, FileFormat) import Gargantext.Text.Parsers (parseDocs, FileFormat)
import Gargantext.Text.Terms (TermType(..)) import Gargantext.Text.Terms (TermType(..))
import Gargantext.Text.Terms (extractTerms) import Gargantext.Text.Terms (extractTerms)
import Gargantext.Text.Terms.Mono.Stem.En (stemIt)
import Servant (ServantErr) import Servant (ServantErr)
import System.FilePath (FilePath) import System.FilePath (FilePath)
import qualified Data.Map as DM import qualified Data.Map as DM
...@@ -76,8 +78,20 @@ type FlowCmdM env err m = ...@@ -76,8 +78,20 @@ type FlowCmdM env err m =
flowCorpus :: FlowCmdM env ServantErr m flowCorpus :: FlowCmdM env ServantErr m
=> Username -> FileFormat -> FilePath -> CorpusName -> m CorpusId => Username -> CorpusName -> FileFormat -> FilePath -> m CorpusId
flowCorpus userName ff fp corpusName = do flowCorpus u cn ff fp = do
ids <- flowCorpusMaster ff fp
flowCorpusUser u cn ids
flowCorpusSearchInDatabase :: FlowCmdM env ServantErr m
=> Username -> CorpusName -> Text -> m CorpusId
flowCorpusSearchInDatabase u cn q = do
ids <- chunkAlong 10000 10000 <$> map fst <$> searchInDatabase 2 (stemIt q)
flowCorpusUser u cn ids
flowCorpusMaster :: FlowCmdM env ServantErr m => FileFormat -> FilePath -> m [[NodeId]]
flowCorpusMaster ff fp = do
-- Master Flow -- Master Flow
docs <- map addUniqIdsDoc <$> liftIO (parseDocs ff fp) docs <- map addUniqIdsDoc <$> liftIO (parseDocs ff fp)
...@@ -90,7 +104,11 @@ flowCorpus userName ff fp corpusName = do ...@@ -90,7 +104,11 @@ flowCorpus userName ff fp corpusName = do
-- TODO: chunkAlongNoRest or chunkAlongWithRest -- TODO: chunkAlongNoRest or chunkAlongWithRest
-- default behavior: NoRest -- default behavior: NoRest
ids <- mapM insertMasterDocs $ chunkAlong 10000 10000 docs ids <- mapM insertMasterDocs $ chunkAlong 10000 10000 docs
pure ids
flowCorpusUser :: FlowCmdM env ServantErr m => Username -> CorpusName -> [[NodeId]] -> m CorpusId
flowCorpusUser userName corpusName ids = do
-- User Flow -- User Flow
(userId, _rootId, userCorpusId) <- getOrMkRootWithCorpus userName corpusName (userId, _rootId, userCorpusId) <- getOrMkRootWithCorpus userName corpusName
-- TODO: check if present already, ignore -- TODO: check if present already, ignore
......
...@@ -36,7 +36,7 @@ import Gargantext.Core.Types (CorpusId) ...@@ -36,7 +36,7 @@ import Gargantext.Core.Types (CorpusId)
--import Gargantext.Database.Types.Node --import Gargantext.Database.Types.Node
import Gargantext.Prelude import Gargantext.Prelude
--import Gargantext.Text.Context (splitBy, SplitContext(Sentences)) --import Gargantext.Text.Context (splitBy, SplitContext(Sentences))
--import Gargantext.Text.Metrics (filterCooc, FilterConfig(..), Clusters(..), SampleBins(..), DefaultValue(..), MapListSize(..), InclusionSize(..)) import Gargantext.Text.Metrics (filterCooc, FilterConfig(..), Clusters(..), SampleBins(..), DefaultValue(..), MapListSize(..), InclusionSize(..))
--import Gargantext.Text.Metrics.Count (coocOn) --import Gargantext.Text.Metrics.Count (coocOn)
--import Gargantext.Text.Parsers.CSV --import Gargantext.Text.Parsers.CSV
--import Gargantext.Text.Terms (TermType, extractTerms) --import Gargantext.Text.Terms (TermType, extractTerms)
...@@ -120,21 +120,21 @@ cooc2graph :: (Map (Text, Text) Int) -> IO Graph ...@@ -120,21 +120,21 @@ cooc2graph :: (Map (Text, Text) Int) -> IO Graph
cooc2graph myCooc = do cooc2graph myCooc = do
--printDebug "myCooc" myCooc --printDebug "myCooc" myCooc
-- Filtering terms with inclusion/Exclusion and Specificity/Genericity scores -- Filtering terms with inclusion/Exclusion and Specificity/Genericity scores
{- let myCooc3 = filterCooc ( FilterConfig (MapListSize 350 ) let myCooc3 = filterCooc ( FilterConfig (MapListSize 350 )
(InclusionSize 500 ) (InclusionSize 500 )
(SampleBins 10 ) (SampleBins 10 )
(Clusters 3 ) (Clusters 3 )
(DefaultValue 0 ) (DefaultValue 0 )
) myCooc ) myCooc
-} --printDebug "myCooc3 size" $ M.size myCooc3 --printDebug "myCooc3 size" $ M.size myCooc3
--printDebug "myCooc3" myCooc3 --printDebug "myCooc3" myCooc3
-- Cooc -> Matrix -- Cooc -> Matrix
let (ti, _) = createIndices myCooc let (ti, _) = createIndices myCooc3
--printDebug "ti size" $ M.size ti --printDebug "ti size" $ M.size ti
--printDebug "ti" ti --printDebug "ti" ti
let myCooc4 = toIndex ti myCooc let myCooc4 = toIndex ti myCooc3
--printDebug "myCooc4 size" $ M.size myCooc4 --printDebug "myCooc4 size" $ M.size myCooc4
--printDebug "myCooc4" myCooc4 --printDebug "myCooc4" myCooc4
......
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