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
bb2042f3
Commit
bb2042f3
authored
Mar 07, 2019
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[FLOW] Clean / factor.
parent
173ac7db
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
17 additions
and
11 deletions
+17
-11
Tools.hs
src/Gargantext/API/Ngrams/Tools.hs
+11
-6
Node.hs
src/Gargantext/API/Node.hs
+1
-1
Flow.hs
src/Gargantext/Database/Flow.hs
+5
-4
No files found.
src/Gargantext/API/Ngrams/Tools.hs
View file @
bb2042f3
...
@@ -33,9 +33,10 @@ import qualified Data.Set as Set
...
@@ -33,9 +33,10 @@ import qualified Data.Set as Set
type
RootTerm
=
Text
type
RootTerm
=
Text
getListNgrams
::
RepoCmdM
env
err
m
getListNgrams
::
RepoCmdM
env
err
m
=>
[
ListId
]
->
NgramsType
=>
[
ListId
]
->
NgramsType
->
m
(
Map
Text
(
ListType
,
(
Maybe
Text
))
)
->
m
(
Map
Text
NgramsRepoElement
)
getListNgrams
nodeIds
ngramsType
=
do
getListNgrams
nodeIds
ngramsType
=
do
v
<-
view
repoVar
v
<-
view
repoVar
repo
<-
liftIO
$
readMVar
v
repo
<-
liftIO
$
readMVar
v
...
@@ -46,12 +47,16 @@ getListNgrams nodeIds ngramsType = do
...
@@ -46,12 +47,16 @@ getListNgrams nodeIds ngramsType = do
ngrams
=
Map
.
unionsWith
mergeNgramsElement
ngrams
=
Map
.
unionsWith
mergeNgramsElement
[
ngramsMap
^.
at
nodeId
.
_Just
|
nodeId
<-
nodeIds
]
[
ngramsMap
^.
at
nodeId
.
_Just
|
nodeId
<-
nodeIds
]
mapTermListRoot
=
Map
.
fromList
pure
ngrams
[(
t
,
(
_nre_list
nre
,
_nre_root
nre
))
|
(
t
,
nre
)
<-
Map
.
toList
ngrams
]
pure
mapTermListRoot
mapTermListRoot
::
RepoCmdM
env
err
m
=>
[
ListId
]
->
NgramsType
->
m
(
Map
Text
(
ListType
,
(
Maybe
Text
)))
mapTermListRoot
nodeIds
ngramsType
=
do
ngrams
<-
getListNgrams
nodeIds
ngramsType
pure
$
Map
.
fromList
[(
t
,
(
_nre_list
nre
,
_nre_root
nre
))
|
(
t
,
nre
)
<-
Map
.
toList
ngrams
]
filterListWithRoot
::
ListType
->
Map
Text
(
ListType
,
Maybe
Text
)
filterListWithRoot
::
ListType
->
Map
Text
(
ListType
,
Maybe
Text
)
...
...
src/Gargantext/API/Node.hs
View file @
bb2042f3
...
@@ -284,7 +284,7 @@ graphAPI nId = do
...
@@ -284,7 +284,7 @@ graphAPI nId = do
let
cId
=
maybe
(
panic
"no parentId"
)
identity
$
_node_parentId
nodeGraph
let
cId
=
maybe
(
panic
"no parentId"
)
identity
$
_node_parentId
nodeGraph
lId
<-
defaultList
cId
lId
<-
defaultList
cId
ngs
<-
filterListWithRoot
GraphTerm
<$>
getListNgrams
[
lId
]
NgramsTerms
ngs
<-
filterListWithRoot
GraphTerm
<$>
mapTermListRoot
[
lId
]
NgramsTerms
myCooc
<-
Map
.
filter
(
>
1
)
<$>
getCoocByNgrams
myCooc
<-
Map
.
filter
(
>
1
)
<$>
getCoocByNgrams
<$>
groupNodesByNgrams
ngs
<$>
groupNodesByNgrams
ngs
...
...
src/Gargantext/Database/Flow.hs
View file @
bb2042f3
...
@@ -299,11 +299,12 @@ mapNodeIdNgrams = DM.unionsWith (DM.unionWith (DM.unionWith (+))) . fmap f
...
@@ -299,11 +299,12 @@ mapNodeIdNgrams = DM.unionsWith (DM.unionWith (DM.unionWith (+))) . fmap f
nId
=
documentId
$
documentWithId
d
nId
=
documentId
$
documentWithId
d
------------------------------------------------------------------------
------------------------------------------------------------------------
flowListBase
::
FlowCmdM
env
err
m
listInsert
::
FlowCmdM
env
err
m
=>
ListId
->
Map
NgramsType
[
NgramsElement
]
=>
ListId
->
Map
NgramsType
[
NgramsElement
]
->
m
()
->
m
()
flowListBase
lId
ngs
=
do
listInsert
lId
ngs
=
mapM_
(
\
(
typeList
,
ngElmts
)
mapM_
(
\
(
typeList
,
ngElmts
)
->
putListNgrams
lId
typeList
ngElmts
)
$
toList
ngs
->
putListNgrams
lId
typeList
ngElmts
)
$
toList
ngs
flowList
::
FlowCmdM
env
err
m
=>
UserId
->
CorpusId
flowList
::
FlowCmdM
env
err
m
=>
UserId
->
CorpusId
->
Map
NgramsType
[
NgramsElement
]
->
Map
NgramsType
[
NgramsElement
]
...
@@ -311,7 +312,7 @@ flowList :: FlowCmdM env err m => UserId -> CorpusId
...
@@ -311,7 +312,7 @@ flowList :: FlowCmdM env err m => UserId -> CorpusId
flowList
uId
cId
ngs
=
do
flowList
uId
cId
ngs
=
do
lId
<-
getOrMkList
cId
uId
lId
<-
getOrMkList
cId
uId
printDebug
"listId flowList"
lId
printDebug
"listId flowList"
lId
flowListBase
lId
ngs
listInsert
lId
ngs
pure
lId
pure
lId
...
...
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