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
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
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
Christian Merten
haskell-gargantext
Commits
d556ab83
Commit
d556ab83
authored
Mar 20, 2019
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[OPTIM] Flow reduced to master flow + insert users for empty database in gargantext-import.
parent
232db569
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
21 additions
and
23 deletions
+21
-23
Main.hs
bin/gargantext-import/Main.hs
+8
-6
Flow.hs
src/Gargantext/Database/Flow.hs
+13
-17
No files found.
bin/gargantext-import/Main.hs
View file @
d556ab83
...
...
@@ -26,7 +26,7 @@ import Gargantext.Database.Flow (FlowCmdM, flowCorpus'')
import
Gargantext.Text.Parsers
(
FileFormat
(
CsvHalFormat
))
import
Gargantext.Database.Utils
(
Cmd
,
)
import
Gargantext.Database.Types.Node
(
CorpusId
)
--import Gargantext.Database.Schema.User (insertUsers, gargantuaUser, simpleUser
)
import
Gargantext.Database.Schema.User
(
insertUsersDemo
)
import
Gargantext.Text.Terms
(
TermType
(
..
))
import
Gargantext.Core
(
Lang
(
..
))
import
Gargantext.API.Node
()
-- instances
...
...
@@ -40,15 +40,16 @@ main :: IO ()
main
=
do
[
user
,
iniPath
,
name
,
corpusPath
]
<-
getArgs
{-let createUsers :: Cmd ServantErr Int64
createUsers = insertUsers [gargantuaUser,simpleUser]
--{-
let
createUsers
::
Cmd
ServantErr
Int64
createUsers
=
insertUsersDemo
{-
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
]
cmdCorpus
=
do
docs
<-
liftIO
(
splitEvery
1000
<$>
take
5
000
<$>
readFile
corpusPath
::
IO
[[
GrandDebatReference
]])
docs
<-
liftIO
(
splitEvery
3
000
<$>
readFile
corpusPath
::
IO
[[
GrandDebatReference
]])
ids
<-
flowCorpus''
(
Text
.
pack
user
)
(
Text
.
pack
name
)
(
Mono
FR
)
docs
pure
ids
...
...
@@ -56,6 +57,7 @@ main = do
env
<-
newDevEnvWith
iniPath
-- Better if we keep only one call to runCmdDev.
_
<-
runCmdDev
env
createUsers
_
<-
runCmdDev
env
cmdCorpus
pure
()
...
...
src/Gargantext/Database/Flow.hs
View file @
d556ab83
...
...
@@ -58,7 +58,7 @@ import Gargantext.Database.Types.Node -- (HyperdataDocument(..), NodeType(..), N
import
Gargantext.Database.Utils
(
Cmd
,
CmdM
)
import
Gargantext.Ext.IMT
(
toSchoolName
)
import
Gargantext.Prelude
import
Gargantext.Text.List
--
import Gargantext.Text.List
import
Gargantext.Text.Parsers
(
parseDocs
,
FileFormat
)
import
Gargantext.Text.Terms
(
TermType
(
..
))
import
Gargantext.Text.Terms
(
extractTerms
)
...
...
@@ -99,33 +99,29 @@ flowCorpusSearchInDatabase :: FlowCmdM env ServantErr m
flowCorpusSearchInDatabase
u
q
=
do
(
_masterUserId
,
_masterRootId
,
cId
)
<-
getOrMkRootWithCorpus
userMaster
""
ids
<-
map
fst
<$>
searchInDatabase
cId
(
stemIt
q
)
flowCorpusUser
u
q
[
ids
]
flowCorpusUser
u
q
ids
flowCorpusMaster
::
FlowCmdM
env
ServantErr
m
=>
TermType
Lang
->
[
HyperdataDocument
]
->
m
[[
NodeId
]]
flowCorpusMaster
la
hd
=
do
-- Master Flow
let
docs
=
map
addUniqIdsDoc
hd
-- TODO uniformize language of corpus
ids
<-
mapM
(
insertMasterDocs
la
)
$
splitEvery
10000
docs
pure
ids
-- TODO uniformize language of corpus
flowCorpusMaster
::
FlowCmdM
env
ServantErr
m
=>
TermType
Lang
->
[
HyperdataDocument
]
->
m
[
NodeId
]
flowCorpusMaster
la
hd
=
(
insertMasterDocs
la
)
$
(
map
addUniqIdsDoc
)
hd
flowCorpusUser
::
FlowCmdM
env
ServantErr
m
=>
Username
->
CorpusName
->
[
[
NodeId
]
]
->
m
CorpusId
flowCorpusUser
::
FlowCmdM
env
ServantErr
m
=>
Username
->
CorpusName
->
[
NodeId
]
->
m
CorpusId
flowCorpusUser
userName
corpusName
ids
=
do
-- User Flow
(
userId
,
_rootId
,
userCorpusId
)
<-
getOrMkRootWithCorpus
userName
corpusName
(
_
userId
,
_rootId
,
userCorpusId
)
<-
getOrMkRootWithCorpus
userName
corpusName
-- TODO: check if present already, ignore
_
<-
Doc
.
add
userCorpusId
$
concat
ids
_
<-
Doc
.
add
userCorpusId
ids
-- User List Flow
(
_masterUserId
,
_masterRootId
,
masterCorpusId
)
<-
getOrMkRootWithCorpus
userMaster
""
ngs
<-
buildNgramsLists
userCorpusId
masterCorpusId
userListId
<-
flowList
userId
userCorpusId
ngs
printDebug
"userListId"
userListId
--
(_masterUserId, _masterRootId, masterCorpusId) <- getOrMkRootWithCorpus userMaster ""
--
ngs <- buildNgramsLists userCorpusId masterCorpusId
--
userListId <- flowList userId userCorpusId ngs
--
printDebug "userListId" userListId
-- User Graph Flow
_
<-
mkGraph
userCorpusId
userId
--
_
<-
mkGraph
userCorpusId
userId
-- User Dashboard Flow
-- _ <- mkDashboard userCorpusId userId
...
...
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