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
200
Issues
200
List
Board
Labels
Milestones
Merge Requests
12
Merge Requests
12
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
740badb8
Commit
740badb8
authored
Mar 20, 2019
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[BIN] import adding limit.
parent
d2e8a845
Pipeline
#293
failed with stage
Changes
2
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
20 additions
and
14 deletions
+20
-14
Main.hs
bin/gargantext-import/Main.hs
+18
-10
NgramsByNode.hs
src/Gargantext/Database/Metrics/NgramsByNode.hs
+2
-4
No files found.
bin/gargantext-import/Main.hs
View file @
740badb8
...
@@ -19,6 +19,7 @@ Import a corpus binary.
...
@@ -19,6 +19,7 @@ Import a corpus binary.
module
Main
where
module
Main
where
import
Prelude
(
read
)
import
Control.Exception
(
finally
)
import
Control.Exception
(
finally
)
import
Servant
(
ServantErr
)
import
Servant
(
ServantErr
)
import
Gargantext.Prelude
import
Gargantext.Prelude
...
@@ -38,31 +39,38 @@ import Control.Monad.IO.Class (liftIO)
...
@@ -38,31 +39,38 @@ import Control.Monad.IO.Class (liftIO)
main
::
IO
()
main
::
IO
()
main
=
do
main
=
do
[
user
,
iniPath
,
name
,
corpusPath
,
users
]
<-
getArgs
[
user
Create
,
user
,
name
,
iniPath
,
limit
,
corpusPath
]
<-
getArgs
--{-
--{-
let
createUsers
::
Cmd
ServantErr
Int64
let
createUsers
::
Cmd
ServantErr
Int64
createUsers
=
insertUsersDemo
createUsers
=
insertUsersDemo
{-
{-
let c
md
Corpus :: forall m. FlowCmdM DevEnv ServantErr m => m CorpusId
let c
sv
Corpus :: forall m. FlowCmdM DevEnv ServantErr m => m CorpusId
c
mdCorpus = flowCorpus (cs user) (cs name) (Mono
EN) CsvHalFormat corpusPath
c
svCorpus = flowCorpus (cs user) (cs name) (Multi
EN) CsvHalFormat corpusPath
--}
--}
let
cmd
Corpus
::
forall
m
.
FlowCmdM
DevEnv
ServantErr
m
=>
m
CorpusId
let
debat
Corpus
::
forall
m
.
FlowCmdM
DevEnv
ServantErr
m
=>
m
CorpusId
cmd
Corpus
=
do
debat
Corpus
=
do
docs
<-
liftIO
(
splitEvery
500
docs
<-
liftIO
(
splitEvery
500
<$>
take
10000
<$>
take
(
read
limit
::
Int
)
<$>
readFile
corpusPath
<$>
readFile
corpusPath
::
IO
[[
GrandDebatReference
]]
::
IO
[[
GrandDebatReference
]]
)
)
flowCorpus
(
Text
.
pack
user
)
(
Text
.
pack
name
)
(
Multi
FR
)
docs
flowCorpus
(
Text
.
pack
user
)
(
Text
.
pack
name
)
(
Multi
FR
)
docs
-- cmd = {-createUsers >>-} cmdCorpus
env
<-
newDevEnvWith
iniPath
env
<-
newDevEnvWith
iniPath
-- Better if we keep only one call to runCmdDev.
-- Better if we keep only one call to runCmdDev.
_
<-
if
user
s
==
"0
"
_
<-
if
user
Create
==
"true
"
then
runCmdDev
env
createUsers
then
runCmdDev
env
createUsers
else
pure
1
else
pure
0
--(cs "false")
_
<-
runCmdDev
env
cmdCorpus
_
<-
runCmdDev
env
debatCorpus
{-
_ <- if corpusType == "csv"
then runCmdDev env csvCorpus
else if corpusType == "debat"
then runCmdDev env debatCorpus
else panic "corpusType unknown: try \"csv\" or \"debat\""
-}
pure
()
pure
()
src/Gargantext/Database/Metrics/NgramsByNode.hs
View file @
740badb8
...
@@ -171,8 +171,6 @@ queryNgramsOnlyByNodeUser = [sql|
...
@@ -171,8 +171,6 @@ queryNgramsOnlyByNodeUser = [sql|
GROUP BY nng.node_id, ng.terms
GROUP BY nng.node_id, ng.terms
|]
|]
------------------------------------------------------------------------
------------------------------------------------------------------------
-- | TODO filter by language, database, any social field
-- | TODO filter by language, database, any social field
getNodesByNgramsMaster
::
UserCorpusId
->
MasterCorpusId
->
Cmd
err
(
Map
Text
(
Set
NodeId
))
getNodesByNgramsMaster
::
UserCorpusId
->
MasterCorpusId
->
Cmd
err
(
Map
Text
(
Set
NodeId
))
...
@@ -183,10 +181,10 @@ selectNgramsByNodeMaster :: UserCorpusId -> MasterCorpusId -> Cmd err [(NodeId,
...
@@ -183,10 +181,10 @@ selectNgramsByNodeMaster :: UserCorpusId -> MasterCorpusId -> Cmd err [(NodeId,
selectNgramsByNodeMaster
ucId
mcId
=
runPGSQuery
selectNgramsByNodeMaster
ucId
mcId
=
runPGSQuery
queryNgramsByNodeMaster
queryNgramsByNodeMaster
(
ucId
(
ucId
,
nodeTypeId
NodeDocument
,
nodeTypeId
NodeDocument
,
ngramsTypeId
NgramsTerms
,
ngramsTypeId
NgramsTerms
,
mcId
,
mcId
,
nodeTypeId
NodeDocument
,
nodeTypeId
NodeDocument
,
ngramsTypeId
NgramsTerms
,
ngramsTypeId
NgramsTerms
)
)
...
...
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