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
5705c4d3
Commit
5705c4d3
authored
Jan 07, 2020
by
Nicolas Pouillard
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[NGRAMS-TABLE] Refactoring to make more explicit the repo access
parent
7f6848cd
Changes
4
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
32 additions
and
27 deletions
+32
-27
Tools.hs
src/Gargantext/API/Ngrams/Tools.hs
+25
-21
Metrics.hs
src/Gargantext/Database/Metrics.hs
+2
-2
Chart.hs
src/Gargantext/Viz/Chart.hs
+3
-3
API.hs
src/Gargantext/Viz/Graph/API.hs
+2
-1
No files found.
src/Gargantext/API/Ngrams/Tools.hs
View file @
5705c4d3
...
...
@@ -33,24 +33,28 @@ import qualified Data.Set as Set
type
RootTerm
=
Text
-- TODO-ACCESS: We want to do the security check before entering here.
-- Add a static capability parameter would be nice.
-- Ideally this is the access to `repoVar` which needs to
-- be properly guarded.
getListNgrams
::
RepoCmdM
env
err
m
=>
[
ListId
]
->
NgramsType
->
m
(
Map
Text
NgramsRepoElement
)
getListNgrams
nodeIds
ngramsType
=
do
v
<-
view
repoVar
repo
<-
liftIO
$
readMVar
v
let
getRepo
::
RepoCmdM
env
err
m
=>
m
NgramsRepo
getRepo
=
do
v
<-
view
repoVar
liftIO
$
readMVar
v
listNgramsFromRepo
::
[
ListId
]
->
NgramsType
->
NgramsRepo
->
Map
Text
NgramsRepoElement
listNgramsFromRepo
nodeIds
ngramsType
repo
=
ngrams
where
ngramsMap
=
repo
^.
r_state
.
at
ngramsType
.
_Just
ngrams
=
Map
.
unionsWith
mergeNgramsElement
[
ngramsMap
^.
at
nodeId
.
_Just
|
nodeId
<-
nodeIds
]
pure
ngrams
-- TODO-ACCESS: We want to do the security check before entering here.
-- Add a static capability parameter would be nice.
-- Ideally this is the access to `repoVar` which needs to
-- be properly guarded.
getListNgrams
::
RepoCmdM
env
err
m
=>
[
ListId
]
->
NgramsType
->
m
(
Map
Text
NgramsRepoElement
)
getListNgrams
nodeIds
ngramsType
=
listNgramsFromRepo
nodeIds
ngramsType
<$>
getRepo
getTermsWith
::
(
RepoCmdM
env
err
m
,
Ord
a
)
=>
(
Text
->
a
)
->
[
ListId
]
...
...
@@ -61,19 +65,19 @@ getTermsWith f ls ngt lt = Map.fromListWith (<>)
<$>
Map
.
toList
<$>
Map
.
filter
(
\
f'
->
(
fst
f'
)
==
lt
)
<$>
mapTermListRoot
ls
ngt
<$>
getRepo
where
toTreeWith
f''
(
t
,
(
_lt
,
maybeRoot
))
=
case
maybeRoot
of
Nothing
->
(
f''
t
,
[]
)
Just
r
->
(
f''
r
,
map
f''
[
t
])
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
]
mapTermListRoot
::
[
ListId
]
->
NgramsType
->
NgramsRepo
->
Map
Text
(
ListType
,
(
Maybe
Text
))
mapTermListRoot
nodeIds
ngramsType
repo
=
Map
.
fromList
[
(
t
,
(
_nre_list
nre
,
_nre_root
nre
))
|
(
t
,
nre
)
<-
Map
.
toList
ngrams
]
where
ngrams
=
listNgramsFromRepo
nodeIds
ngramsType
repo
filterListWithRoot
::
ListType
->
Map
Text
(
ListType
,
Maybe
Text
)
->
Map
Text
(
Maybe
RootTerm
)
...
...
src/Gargantext/Database/Metrics.hs
View file @
5705c4d3
...
...
@@ -21,7 +21,7 @@ module Gargantext.Database.Metrics
import
Data.Map
(
Map
)
import
Data.Text
(
Text
)
import
Gargantext.API.Ngrams
(
TabType
(
..
),
ngramsTypeFromTabType
)
import
Gargantext.API.Ngrams.Tools
(
filterListWithRoot
,
groupNodesByNgrams
,
Diagonal
(
..
),
getCoocByNgrams
,
mapTermListRoot
,
RootTerm
)
import
Gargantext.API.Ngrams.Tools
(
filterListWithRoot
,
groupNodesByNgrams
,
Diagonal
(
..
),
getCoocByNgrams
,
mapTermListRoot
,
RootTerm
,
getRepo
)
import
Gargantext.Core.Types
(
ListType
(
..
),
Limit
,
NodeType
(
..
))
import
Gargantext.Database.Flow
(
FlowCmdM
)
import
Gargantext.Database.Metrics.NgramsByNode
(
getNodesByNgramsOnlyUser
{-, getTficfWith-}
)
...
...
@@ -76,7 +76,7 @@ getNgrams cId maybeListId tabType = do
Nothing
->
defaultList
cId
Just
lId'
->
pure
lId'
lists
<-
mapTermListRoot
[
lId
]
(
ngramsTypeFromTabType
tabType
)
lists
<-
mapTermListRoot
[
lId
]
(
ngramsTypeFromTabType
tabType
)
<$>
getRepo
let
maybeSyn
=
Map
.
unions
$
map
(
\
t
->
filterListWithRoot
t
lists
)
[
GraphTerm
,
StopTerm
,
CandidateTerm
]
pure
(
lists
,
maybeSyn
)
...
...
src/Gargantext/Viz/Chart.hs
View file @
5705c4d3
...
...
@@ -72,7 +72,7 @@ pieData :: FlowCmdM env err m
pieData
cId
nt
lt
=
do
ls'
<-
selectNodesWithUsername
NodeList
userMaster
ls
<-
map
(
_node_id
)
<$>
getListsWithParentId
cId
ts
<-
mapTermListRoot
ls
nt
ts
<-
mapTermListRoot
ls
nt
<$>
getRepo
let
dico
=
filterListWithRoot
lt
ts
terms
=
catMaybes
$
List
.
concat
$
map
(
\
(
a
,
b
)
->
[
Just
a
,
b
])
$
Map
.
toList
dico
...
...
@@ -94,7 +94,7 @@ treeData :: FlowCmdM env err m
treeData
cId
nt
lt
=
do
ls'
<-
selectNodesWithUsername
NodeList
userMaster
ls
<-
map
(
_node_id
)
<$>
getListsWithParentId
cId
ts
<-
mapTermListRoot
ls
nt
ts
<-
mapTermListRoot
ls
nt
<$>
getRepo
let
dico
=
filterListWithRoot
lt
ts
...
...
@@ -112,7 +112,7 @@ treeData' :: FlowCmdM env ServerError m
treeData'
cId
nt
lt
=
do
ls'
<-
selectNodesWithUsername
NodeList
userMaster
ls
<-
map
(
_node_id
)
<$>
getListsWithParentId
cId
ts
<-
mapTermListRoot
ls
nt
ts
<-
mapTermListRoot
ls
nt
<$>
getRepo
let
dico
=
filterListWithRoot
lt
ts
...
...
src/Gargantext/Viz/Graph/API.hs
View file @
5705c4d3
...
...
@@ -75,7 +75,8 @@ getGraph nId = do
-- (map (\n -> LegendField n "#FFFFFF" (pack $ show n)) [1..10])
lIds
<-
selectNodesWithUsername
NodeList
userMaster
ngs
<-
filterListWithRoot
GraphTerm
<$>
mapTermListRoot
[
lId
]
NgramsTerms
repo
<-
getRepo
let
ngs
=
filterListWithRoot
GraphTerm
$
mapTermListRoot
[
lId
]
NgramsTerms
repo
myCooc
<-
Map
.
filter
(
>
1
)
<$>
getCoocByNgrams
(
Diagonal
False
)
<$>
groupNodesByNgrams
ngs
...
...
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