Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
H
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
Przemyslaw Kaminski
haskell-gargantext
Commits
373f1d39
Commit
373f1d39
authored
Oct 18, 2018
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[DBFLOW] subflow
parent
a11db080
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
31 additions
and
11 deletions
+31
-11
Flow.hs
src/Gargantext/Database/Flow.hs
+29
-11
User.hs
src/Gargantext/Database/User.hs
+2
-0
No files found.
src/Gargantext/Database/Flow.hs
View file @
373f1d39
...
...
@@ -38,31 +38,44 @@ import Gargantext.Core.Types (NodePoly(..))
import
Gargantext.Prelude
import
Gargantext.Database.Bashql
(
runCmd'
,
del
)
import
Gargantext.Database.Node
(
Cmd
(
..
),
getRoot
,
mkRoot
,
mkCorpus
,
defaultCorpus
)
import
Gargantext.Database.User
(
getUser
,
UserLight
(
..
))
import
Gargantext.Database.User
(
getUser
,
UserLight
(
..
)
,
Username
)
import
Gargantext.Database.Node.Document.Import
(
insertDocuments
)
import
Gargantext.Text.Parsers
(
parseDocs
,
FileFormat
(
WOS
))
--flow :: FilePath -> IO ()
flow
fp
=
do
masterUser
<-
runCmd'
(
getUser
"gargantua"
)
type
UserId
=
Int
type
RootId
=
Int
type
CorpusId
=
Int
subFlow
::
Username
->
IO
(
UserId
,
RootId
,
CorpusId
)
subFlow
username
=
do
maybeUserId
<-
runCmd'
(
getUser
username
)
let
masterUserId
=
case
masterUser
of
let
userId
=
case
maybeUserId
of
Nothing
->
panic
"Error: User does not exist (yet)"
-- mk NodeUser gargantua_id "Node Gargantua"
Just
user
->
userLight_id
user
rootId'
<-
map
_node_id
<$>
runCmd'
(
getRoot
masterU
serId
)
rootId'
<-
map
_node_id
<$>
runCmd'
(
getRoot
u
serId
)
rootId''
<-
case
rootId'
of
[]
->
runCmd'
(
mkRoot
masterU
serId
)
[]
->
runCmd'
(
mkRoot
u
serId
)
un
->
case
length
un
>=
2
of
True
->
panic
"Error: more than 1 userNode / user"
False
->
pure
rootId'
let
rootId
=
maybe
(
panic
"error rootId"
)
identity
(
head
rootId''
)
printDebug
"Root ID : "
rootId
corpusId'
<-
runCmd'
$
mkCorpus
(
Just
"Corpus WOS"
)
Nothing
rootId
masterUserId
corpusId'
<-
runCmd'
$
mkCorpus
(
Just
"Corpus WOS"
)
Nothing
rootId
userId
let
corpusId
=
maybe
(
panic
"error corpusId"
)
identity
(
head
corpusId'
)
printDebug
"Corpus ID : "
corpusId
printDebug
"(username, userId, rootId, corpusId"
(
username
,
userId
,
rootId
,
corpusId
)
pure
(
userId
,
rootId
,
corpusId
)
-- flow :: FilePath -> IO ()
flow
fp
=
do
(
masterUserId
,
_
,
corpusId
)
<-
subFlow
"gargantua"
docs
<-
parseDocs
WOS
fp
ids
<-
runCmd'
$
insertDocuments
masterUserId
corpusId
docs
...
...
@@ -71,8 +84,13 @@ flow fp = do
idsRepeat
<-
runCmd'
$
insertDocuments
masterUserId
corpusId
docs
printDebug
"Docs IDs : "
idsRepeat
(
userId
,
rootId
,
corpusId2
)
<-
subFlow
"alexandre"
runCmd'
(
del
[
corpusId
])
{-
--folderId <- mk Folder parentId (Name "Data") (Descr "All corpora DATA here")
folderId <- mk Folder rootId "Data"
...
...
src/Gargantext/Database/User.hs
View file @
373f1d39
...
...
@@ -142,3 +142,5 @@ type Username = Text
getUser
::
Username
->
Cmd
(
Maybe
UserLight
)
getUser
u
=
mkCmd
$
\
c
->
userLightWithUsername
u
<$>
runCmd
c
usersLight
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