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
160
Issues
160
List
Board
Labels
Milestones
Merge Requests
8
Merge Requests
8
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
38ebe154
Commit
38ebe154
authored
Mar 20, 2019
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[FLOW] only one corpus for the user (again).
parent
ec9906ef
Pipeline
#291
failed with stage
Changes
2
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
14 additions
and
14 deletions
+14
-14
Main.hs
bin/gargantext-import/Main.hs
+3
-3
Flow.hs
src/Gargantext/Database/Flow.hs
+11
-11
No files found.
bin/gargantext-import/Main.hs
View file @
38ebe154
...
...
@@ -22,7 +22,7 @@ module Main where
import
Control.Exception
(
finally
)
import
Servant
(
ServantErr
)
import
Gargantext.Prelude
import
Gargantext.Database.Flow
(
FlowCmdM
,
flowCorpus
''
)
import
Gargantext.Database.Flow
(
FlowCmdM
,
flowCorpus
)
import
Gargantext.Text.Parsers
(
FileFormat
(
CsvHalFormat
))
import
Gargantext.Database.Utils
(
Cmd
,
)
import
Gargantext.Database.Types.Node
(
CorpusId
)
...
...
@@ -47,10 +47,10 @@ main = do
let cmdCorpus :: forall m. FlowCmdM DevEnv ServantErr m => m CorpusId
cmdCorpus = flowCorpus (cs user) (cs name) (Mono EN) CsvHalFormat corpusPath
--}
let
cmdCorpus
::
forall
m
.
FlowCmdM
DevEnv
ServantErr
m
=>
m
[
CorpusId
]
let
cmdCorpus
::
forall
m
.
FlowCmdM
DevEnv
ServantErr
m
=>
m
CorpusId
cmdCorpus
=
do
docs
<-
liftIO
(
splitEvery
500
<$>
readFile
corpusPath
::
IO
[[
GrandDebatReference
]])
ids
<-
flowCorpus
''
(
Text
.
pack
user
)
(
Text
.
pack
name
)
(
Mono
FR
)
docs
ids
<-
flowCorpus
(
Text
.
pack
user
)
(
Text
.
pack
name
)
(
Mono
FR
)
docs
pure
ids
-- cmd = {-createUsers >>-} cmdCorpus
...
...
src/Gargantext/Database/Flow.hs
View file @
38ebe154
...
...
@@ -59,12 +59,12 @@ import Gargantext.Database.Utils (Cmd, CmdM)
import
Gargantext.Ext.IMT
(
toSchoolName
)
import
Gargantext.Prelude
--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
(
extractTerms
)
import
Gargantext.Text.Terms.Mono.Stem.En
(
stemIt
)
import
Servant
(
ServantErr
)
import
System.FilePath
(
FilePath
)
--
import System.FilePath (FilePath)
import
qualified
Data.Map
as
DM
import
qualified
Data.Text
as
Text
import
qualified
Gargantext.Database.Node.Document.Add
as
Doc
(
add
)
...
...
@@ -76,21 +76,21 @@ type FlowCmdM env err m =
,
HasRepoVar
env
)
{-
flowCorpus :: FlowCmdM env ServantErr m
=> Username -> CorpusName -> TermType Lang -> FileFormat -> FilePath -> m CorpusId
flowCorpus
u
cn
la
ff
fp
=
liftIO
(
parseDocs
ff
fp
)
>>=
\
docs
->
flowCorpus'
u
cn
la
docs
flowCorpus u cn la ff fp =
undefined --
liftIO (parseDocs ff fp) >>= \docs -> flowCorpus' u cn la docs
--{-
flowCorpus''
::
(
FlowCmdM
env
ServantErr
m
,
ToHyperdataDocument
a
)
flowCorpus''' :: (FlowCmdM env ServantErr m, ToHyperdataDocument a)
=> Username -> CorpusName -> TermType Lang -> [[a]] -> m [CorpusId]
flowCorpus''
u
cn
la
docs
=
mapM
(
\
doc
->
flowCorpus'
u
cn
la
doc
)
docs
flowCorpus''
'
u cn la docs = mapM (\doc -> flowCorpus' u cn la doc) docs
--}
flowCorpus
'
::
(
FlowCmdM
env
ServantErr
m
,
ToHyperdataDocument
a
)
=>
Username
->
CorpusName
->
TermType
Lang
->
[
a
]
->
m
CorpusId
flowCorpus
'
u
cn
la
docs
=
do
ids
<-
flowCorpusMaster
la
(
map
toHyperdataDocument
docs
)
flowCorpusUser
u
cn
ids
flowCorpus
::
(
FlowCmdM
env
ServantErr
m
,
ToHyperdataDocument
a
)
=>
Username
->
CorpusName
->
TermType
Lang
->
[
[
a
]
]
->
m
CorpusId
flowCorpus
u
cn
la
docs
=
do
ids
<-
mapM
(
\
doc
->
flowCorpusMaster
la
(
map
toHyperdataDocument
doc
))
docs
flowCorpusUser
u
cn
$
concat
ids
-- TODO query with complex query
...
...
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