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
158
Issues
158
List
Board
Labels
Milestones
Merge Requests
11
Merge Requests
11
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
154e210b
Commit
154e210b
authored
Nov 24, 2020
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[BUG] Flow continuation <> bugs persists (cont should be empty)
parent
494199af
Changes
4
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
14 additions
and
12 deletions
+14
-12
WithScores.hs
src/Gargantext/Core/Text/List/Group/WithScores.hs
+6
-6
WithStem.hs
src/Gargantext/Core/Text/List/Group/WithStem.hs
+2
-2
Prelude.hs
src/Gargantext/Core/Text/List/Social/Prelude.hs
+3
-1
Scores.hs
src/Gargantext/Core/Text/List/Social/Scores.hs
+3
-3
No files found.
src/Gargantext/Core/Text/List/Group/WithScores.hs
View file @
154e210b
...
...
@@ -70,18 +70,18 @@ fromScores'' f' (t, fs) = ( maybeParent
toGroupedTree
::
Map
(
Maybe
Parent
)
(
Map
Text
(
GroupedTreeScores
(
Set
NodeId
)))
->
Map
Parent
(
GroupedTreeScores
(
Set
NodeId
))
toGroupedTree
m
=
case
Map
.
lookup
Nothing
m
of
Nothing
->
Map
.
empty
Nothing
->
m
empty
Just
m'
->
toGroupedTree'
m
m'
toGroupedTree'
::
Map
(
Maybe
Parent
)
(
Map
Text
(
GroupedTreeScores
(
Set
NodeId
)))
->
(
Map
Text
(
GroupedTreeScores
(
Set
NodeId
)))
->
Map
Parent
(
GroupedTreeScores
(
Set
NodeId
))
toGroupedTree'
m
notEmpty
|
notEmpty
==
Map
.
empty
=
Map
.
empty
|
notEmpty
==
mempty
=
m
empty
|
otherwise
=
Map
.
mapWithKey
(
addGroup
m
)
notEmpty
where
addGroup
m'
k
v
=
over
gts'_children
(
(
toGroupedTree'
m'
)
.
(
Map
.
union
(
fromMaybe
Map
.
empty
.
(
Map
.
union
(
fromMaybe
m
empty
$
Map
.
lookup
(
Just
k
)
m'
)
)
...
...
@@ -136,21 +136,21 @@ addIfNotExist :: Map Text FlowListScores
->
Map
Text
(
Set
NodeId
)
->
Map
Text
(
GroupedTextScores
(
Set
NodeId
))
addIfNotExist
mapSocialScores
mapScores
=
foldl'
(
addIfNotExist'
mapSocialScores
)
Map
.
empty
$
Map
.
toList
mapScores
foldl'
(
addIfNotExist'
mapSocialScores
)
m
empty
$
Map
.
toList
mapScores
where
addIfNotExist'
mss
m
(
t
,
ns
)
=
case
Map
.
lookup
t
mss
of
Nothing
->
Map
.
alter
(
add
ns
)
t
m
_
->
m
add
ns'
Nothing
=
Just
$
GroupedTextScores
Nothing
ns'
Set
.
empty
add
ns'
Nothing
=
Just
$
GroupedTextScores
Nothing
ns'
m
empty
add
_
_
=
Nothing
-- should not be present
------------------------------------------------------------------------
------------------------------------------------------------------------
fromGroupedScores
::
Map
Parent
GroupedWithListScores
->
Map
Parent
(
GroupedTextScores
(
Set
NodeId
))
fromGroupedScores
=
Map
.
map
(
\
(
GroupedWithListScores
l
c
)
->
GroupedTextScores
l
Set
.
empty
c
)
fromGroupedScores
=
Map
.
map
(
\
(
GroupedWithListScores
l
c
)
->
GroupedTextScores
l
m
empty
c
)
------------------------------------------------------------------------
fromListScores
::
Map
Text
FlowListScores
->
Map
Parent
GroupedWithListScores
...
...
src/Gargantext/Core/Text/List/Group/WithStem.hs
View file @
154e210b
...
...
@@ -59,7 +59,7 @@ groupWithStem' g flc
|
g
==
GroupIdentity
=
FlowCont
(
(
<>
)
(
view
flc_scores
flc
)
(
view
flc_cont
flc
)
)
Map
.
empty
)
m
empty
|
otherwise
=
mergeWith
(
groupWith
g
)
flc
-- | MergeWith : with stem, we always have an answer
...
...
@@ -67,7 +67,7 @@ groupWithStem' g flc
mergeWith
::
(
Text
->
Text
)
->
FlowCont
Text
(
GroupedTreeScores
(
Set
NodeId
))
->
FlowCont
Text
(
GroupedTreeScores
(
Set
NodeId
))
mergeWith
fun
flc
=
FlowCont
scores
Map
.
empty
mergeWith
fun
flc
=
FlowCont
scores
m
empty
where
scores
::
Map
Text
(
GroupedTreeScores
(
Set
NodeId
))
...
...
src/Gargantext/Core/Text/List/Social/Prelude.hs
View file @
154e210b
...
...
@@ -49,7 +49,9 @@ instance (Eq a, Ord a, Eq b) => Semigroup (FlowCont a b) where
=
FlowCont
m
s
where
m
=
Map
.
union
m1
m2
s
=
Map
.
intersection
s1
s2
s
|
s1
==
mempty
=
s2
|
s2
==
mempty
=
s1
|
otherwise
=
Map
.
intersection
s1
s2
makeLenses
''
F
lowCont
...
...
src/Gargantext/Core/Text/List/Social/Scores.hs
View file @
154e210b
...
...
@@ -72,7 +72,7 @@ addList :: ListType
->
Maybe
FlowListScores
->
Maybe
FlowListScores
addList
l
Nothing
=
Just
$
set
fls_listType
(
addListScore
l
Map
.
empty
)
mempty
Just
$
set
fls_listType
(
addListScore
l
m
empty
)
mempty
addList
l
(
Just
fls
)
=
Just
$
over
fls_listType
(
addListScore
l
)
fls
...
...
@@ -101,9 +101,9 @@ addParent :: KeepAllParents -> NgramsRepoElement -> Set Text
->
Maybe
FlowListScores
addParent
k
nre
ss
Nothing
=
Just
$
FlowListScores
Map
.
empty
mapParent
Just
$
FlowListScores
m
empty
mapParent
where
mapParent
=
addParentScore
k
(
view
nre_parent
nre
)
ss
Map
.
empty
mapParent
=
addParentScore
k
(
view
nre_parent
nre
)
ss
m
empty
addParent
k
nre
ss
(
Just
fls
{-(FlowListScores mapList mapParent)-}
)
=
Just
$
over
fls_parents
(
addParentScore
k
(
view
nre_parent
nre
)
ss
)
fls
...
...
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