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
3e6c662a
Commit
3e6c662a
authored
Oct 13, 2020
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[FIX] SemiGroup instance of ListType
parent
e86fc566
Changes
2
Show whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
15 additions
and
15 deletions
+15
-15
Social.hs
src/Gargantext/Core/Text/List/Social.hs
+12
-12
Main.hs
src/Gargantext/Core/Types/Main.hs
+3
-3
No files found.
src/Gargantext/Core/Text/List/Social.hs
View file @
3e6c662a
...
@@ -44,9 +44,9 @@ flowSocialList :: ( RepoCmdM env err m
...
@@ -44,9 +44,9 @@ flowSocialList :: ( RepoCmdM env err m
->
m
(
Map
ListType
(
Set
Text
))
->
m
(
Map
ListType
(
Set
Text
))
flowSocialList
user
nt
ngrams'
=
do
flowSocialList
user
nt
ngrams'
=
do
privateLists
<-
flowSocialListByMode
Private
user
nt
ngrams'
privateLists
<-
flowSocialListByMode
Private
user
nt
ngrams'
printDebug
"* privateLists *:
\n
"
privateLists
--
printDebug "* privateLists *: \n" privateLists
sharedLists
<-
flowSocialListByMode
Shared
user
nt
(
termsByList
CandidateTerm
privateLists
)
sharedLists
<-
flowSocialListByMode
Shared
user
nt
(
termsByList
CandidateTerm
privateLists
)
printDebug
"* socialLists *:
\n
"
sharedLists
--
printDebug "* socialLists *: \n" sharedLists
-- TODO publicMapList
-- TODO publicMapList
pure
$
Map
.
fromList
[
(
MapTerm
,
termsByList
MapTerm
privateLists
pure
$
Map
.
fromList
[
(
MapTerm
,
termsByList
MapTerm
privateLists
...
@@ -81,7 +81,7 @@ flowSocialListByMode mode user nt ngrams' = do
...
@@ -81,7 +81,7 @@ flowSocialListByMode mode user nt ngrams' = do
[]
->
pure
$
Map
.
fromList
[(
Nothing
,
ngrams'
)]
[]
->
pure
$
Map
.
fromList
[(
Nothing
,
ngrams'
)]
_
->
do
_
->
do
counts
<-
countFilterList
ngrams'
nt
listIds
Map
.
empty
counts
<-
countFilterList
ngrams'
nt
listIds
Map
.
empty
printDebug
"flowSocialListByMode counts"
counts
--
printDebug "flowSocialListByMode counts" counts
pure
$
toSocialList
counts
ngrams'
pure
$
toSocialList
counts
ngrams'
---------------------------------------------------------------------------
---------------------------------------------------------------------------
...
@@ -124,7 +124,7 @@ countFilterList' :: RepoCmdM env err m
...
@@ -124,7 +124,7 @@ countFilterList' :: RepoCmdM env err m
->
m
(
Map
Text
(
Map
ListType
Int
))
->
m
(
Map
Text
(
Map
ListType
Int
))
countFilterList'
st
nt
ls
input
=
do
countFilterList'
st
nt
ls
input
=
do
ml
<-
toMapTextListType
<$>
getListNgrams
ls
nt
ml
<-
toMapTextListType
<$>
getListNgrams
ls
nt
printDebug
"countFilterList'"
ml
--
printDebug "countFilterList'" ml
pure
$
Set
.
foldl'
(
\
m
t
->
countList
t
ml
m
)
input
st
pure
$
Set
.
foldl'
(
\
m
t
->
countList
t
ml
m
)
input
st
---------------------------------------------------------------------------
---------------------------------------------------------------------------
...
@@ -135,13 +135,6 @@ toMapTextListType m = Map.fromListWith (<>)
...
@@ -135,13 +135,6 @@ toMapTextListType m = Map.fromListWith (<>)
$
(
map
(
toList
m
))
$
(
map
(
toList
m
))
$
Map
.
toList
m
$
Map
.
toList
m
listOf
::
Map
Text
NgramsRepoElement
->
NgramsRepoElement
->
ListType
listOf
m
ng
=
case
_nre_parent
ng
of
Nothing
->
_nre_list
ng
Just
p
->
case
Map
.
lookup
(
unNgramsTerm
p
)
m
of
Nothing
->
CandidateTerm
-- Should Not happen
Just
ng'
->
listOf
m
ng'
toList
::
Map
Text
NgramsRepoElement
->
(
Text
,
NgramsRepoElement
)
->
[(
Text
,
ListType
)]
toList
::
Map
Text
NgramsRepoElement
->
(
Text
,
NgramsRepoElement
)
->
[(
Text
,
ListType
)]
toList
m
(
t
,
nre
@
(
NgramsRepoElement
_
_
_
_
(
MSet
children
)))
=
toList
m
(
t
,
nre
@
(
NgramsRepoElement
_
_
_
_
(
MSet
children
)))
=
List
.
zip
terms
(
List
.
cycle
[
lt'
])
List
.
zip
terms
(
List
.
cycle
[
lt'
])
...
@@ -152,6 +145,13 @@ toList m (t, nre@(NgramsRepoElement _ _ _ _ (MSet children))) =
...
@@ -152,6 +145,13 @@ toList m (t, nre@(NgramsRepoElement _ _ _ _ (MSet children))) =
<>
(
map
unNgramsTerm
$
Map
.
keys
children
)
<>
(
map
unNgramsTerm
$
Map
.
keys
children
)
lt'
=
listOf
m
nre
lt'
=
listOf
m
nre
listOf
::
Map
Text
NgramsRepoElement
->
NgramsRepoElement
->
ListType
listOf
m
ng
=
case
_nre_parent
ng
of
Nothing
->
_nre_list
ng
Just
p
->
case
Map
.
lookup
(
unNgramsTerm
p
)
m
of
Just
ng'
->
listOf
m
ng'
Nothing
->
CandidateTerm
-- Should Not happen
---------------------------------------------------------------------------
---------------------------------------------------------------------------
countList
::
Text
countList
::
Text
->
Map
Text
ListType
->
Map
Text
ListType
...
@@ -177,7 +177,7 @@ findListsId mode u = do
...
@@ -177,7 +177,7 @@ findListsId mode u = do
r
<-
getRootId
u
r
<-
getRootId
u
ns
<-
map
_dt_nodeId
<$>
filter
(
\
n
->
_dt_typeId
n
==
nodeTypeId
NodeList
)
ns
<-
map
_dt_nodeId
<$>
filter
(
\
n
->
_dt_typeId
n
==
nodeTypeId
NodeList
)
<$>
findNodes'
mode
r
<$>
findNodes'
mode
r
printDebug
"findListsIds"
ns
--
printDebug "findListsIds" ns
pure
ns
pure
ns
commonNodes
::
[
NodeType
]
commonNodes
::
[
NodeType
]
...
...
src/Gargantext/Core/Types/Main.hs
View file @
3e6c662a
...
@@ -63,9 +63,9 @@ instance Semigroup ListType
...
@@ -63,9 +63,9 @@ instance Semigroup ListType
where
where
MapTerm
<>
_
=
MapTerm
MapTerm
<>
_
=
MapTerm
_
<>
MapTerm
=
MapTerm
_
<>
MapTerm
=
MapTerm
CandidateTerm
<>
_
=
Candidate
Term
StopTerm
<>
CandidateTerm
=
Stop
Term
_
<>
CandidateTerm
=
Candidate
Term
CandidateTerm
<>
StopTerm
=
Stop
Term
StopTerm
<>
StopTerm
=
Stop
Term
_
<>
_
=
Candidate
Term
instance
FromHttpApiData
ListType
where
instance
FromHttpApiData
ListType
where
...
...
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