Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
haskell-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
163
Issues
163
List
Board
Labels
Milestones
Merge Requests
9
Merge Requests
9
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
gargantext
haskell-gargantext
Commits
3229f682
Commit
3229f682
authored
Mar 07, 2019
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[FLOW] adding flow with search in database.
parent
b605fa3d
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
26 additions
and
8 deletions
+26
-8
Main.hs
bin/gargantext-import/Main.hs
+1
-1
Flow.hs
src/Gargantext/Database/Flow.hs
+20
-2
Flow.hs
src/Gargantext/Text/Flow.hs
+5
-5
No files found.
bin/gargantext-import/Main.hs
View file @
3229f682
...
@@ -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
...
...
src/Gargantext/Database/Flow.hs
View file @
3229f682
...
@@ -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
...
...
src/Gargantext/Text/Flow.hs
View file @
3229f682
...
@@ -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
myCooc
3
--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
myCooc
3
--printDebug "myCooc4 size" $ M.size myCooc4
--printDebug "myCooc4 size" $ M.size myCooc4
--printDebug "myCooc4" myCooc4
--printDebug "myCooc4" myCooc4
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment