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
eef6a43a
Commit
eef6a43a
authored
Oct 29, 2020
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[REFACT] SocialList main
parent
a3148efb
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
52 additions
and
45 deletions
+52
-45
Social.hs
src/Gargantext/Core/Text/List/Social.hs
+52
-45
No files found.
src/Gargantext/Core/Text/List/Social.hs
View file @
eef6a43a
...
@@ -47,63 +47,52 @@ flowSocialList :: ( RepoCmdM env err m
...
@@ -47,63 +47,52 @@ flowSocialList :: ( RepoCmdM env err m
=>
User
->
NgramsType
->
Set
Text
=>
User
->
NgramsType
->
Set
Text
->
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'
-- Here preference to privateLists (discutable: let user choice)
privateListIds
<-
findListsId
Private
user
privateLists
<-
flowSocialListByMode
privateListIds
nt
ngrams'
-- printDebug "* privateLists *: \n" privateLists
-- printDebug "* privateLists *: \n" privateLists
-- here preference to privateLists (discutable)
sharedLists
<-
flowSocialListByMode
Shared
user
nt
(
termsByList
CandidateTerm
privateLists
)
sharedListIds
<-
findListsId
Shared
user
sharedLists
<-
flowSocialListByMode
sharedListIds
nt
(
termsByList
CandidateTerm
privateLists
)
-- printDebug "* sharedLists *: \n" sharedLists
-- printDebug "* sharedLists *: \n" sharedLists
-- TODO publicMapList
-- TODO publicMapList:
-- Note: if both produce 3 identic repetition => refactor mode
-- publicListIds <- findListsId Public user
-- publicLists <- flowSocialListByMode' publicListIds nt (termsByList CandidateTerm privateLists)
let
result
=
unions
[
Map
.
mapKeys
(
fromMaybe
CandidateTerm
)
privateLists
let
result
=
unions
[
Map
.
mapKeys
(
fromMaybe
CandidateTerm
)
privateLists
,
Map
.
mapKeys
(
fromMaybe
CandidateTerm
)
sharedLists
,
Map
.
mapKeys
(
fromMaybe
CandidateTerm
)
sharedLists
-- , Map.mapKeys (fromMaybe CandidateTerm) publicLists
]
]
-- printDebug "* socialLists *: results \n" result
-- printDebug "* socialLists *: results \n" result
pure
result
pure
result
------------------------------------------------------------------------
------------------------------------------------------------------------
unions
::
(
Ord
a
,
Semigroup
a
,
Semigroup
b
,
Ord
b
)
flowSocialListByMode
::
(
RepoCmdM
env
err
m
=>
[
Map
a
(
Set
b
)]
->
Map
a
(
Set
b
)
,
CmdM
env
err
m
unions
=
invertBack
.
Map
.
unionsWith
(
<>
)
.
map
invertForw
,
HasNodeError
err
,
HasTreeError
err
)
=>
[
NodeId
]
->
NgramsType
->
Set
Text
->
m
(
Map
(
Maybe
ListType
)
(
Set
Text
))
flowSocialListByMode
[]
nt
ngrams'
=
pure
$
Map
.
fromList
[(
Nothing
,
ngrams'
)]
flowSocialListByMode
listIds
nt
ngrams'
=
do
counts
<-
countFilterList
ngrams'
nt
listIds
Map
.
empty
let
r
=
toSocialList
counts
ngrams'
pure
r
invertForw
::
(
Ord
b
,
Semigroup
a
)
=>
Map
a
(
Set
b
)
->
Map
b
a
invertForw
=
Map
.
unionsWith
(
<>
)
.
(
map
(
\
(
k
,
sets
)
->
Map
.
fromSet
(
\
_
->
k
)
sets
))
.
Map
.
toList
invertBack
::
(
Ord
a
,
Ord
b
)
=>
Map
b
a
->
Map
a
(
Set
b
)
invertBack
=
Map
.
fromListWith
(
<>
)
.
(
map
(
\
(
b
,
a
)
->
(
a
,
Set
.
singleton
b
)))
.
Map
.
toList
unions_test
::
Map
ListType
(
Set
Text
)
unions_test
=
unions
[
m1
,
m2
]
where
m1
=
Map
.
fromList
[
(
StopTerm
,
Set
.
singleton
"Candidate"
)]
m2
=
Map
.
fromList
[
(
CandidateTerm
,
Set
.
singleton
"Candidate"
)
,
(
MapTerm
,
Set
.
singleton
"Candidate"
)
]
------------------------------------------------------------------------
flowSocialListByMode
::
(
RepoCmdM
env
err
m
,
CmdM
env
err
m
,
HasNodeError
err
,
HasTreeError
err
)
=>
NodeMode
->
User
->
NgramsType
->
Set
Text
->
m
(
Map
(
Maybe
ListType
)
(
Set
Text
))
flowSocialListByMode
mode
user
nt
ngrams'
=
do
listIds
<-
findListsId
mode
user
case
listIds
of
[]
->
pure
$
Map
.
fromList
[(
Nothing
,
ngrams'
)]
_
->
do
counts
<-
countFilterList
ngrams'
nt
listIds
Map
.
empty
-- printDebug "flowSocialListByMode counts" counts
let
r
=
toSocialList
counts
ngrams'
-- printDebug "flowSocialListByMode r" r
pure
r
------------------------------------------------------------------------
------------------------------------------------------------------------
-- TODO: maybe use social groups too
-- TODO: maybe use social groups too
-- | TODO what if equality ?
-- choice depends on Ord instance of ListType
-- for now : data ListType = StopTerm | CandidateTerm | MapTerm
-- means MapTerm > CandidateTerm > StopTerm in case of equality of counts
-- (we minimize errors on MapTerms if doubt)
toSocialList
::
Map
Text
(
Map
ListType
Int
)
toSocialList
::
Map
Text
(
Map
ListType
Int
)
->
Set
Text
->
Set
Text
->
Map
(
Maybe
ListType
)
(
Set
Text
)
->
Map
(
Maybe
ListType
)
(
Set
Text
)
...
@@ -111,11 +100,6 @@ toSocialList m = Map.fromListWith (<>)
...
@@ -111,11 +100,6 @@ toSocialList m = Map.fromListWith (<>)
.
Set
.
toList
.
Set
.
toList
.
Set
.
map
(
toSocialList1
m
)
.
Set
.
map
(
toSocialList1
m
)
-- | TODO what if equality ?
-- choice depends on Ord instance of ListType
-- for now : data ListType = StopTerm | CandidateTerm | MapTerm
-- means MapTerm > CandidateTerm > StopTerm in case of equality of counts
-- (we minimize errors on MapTerms if doubt)
toSocialList1
::
Map
Text
(
Map
ListType
Int
)
toSocialList1
::
Map
Text
(
Map
ListType
Int
)
->
Text
->
Text
->
(
Maybe
ListType
,
Set
Text
)
->
(
Maybe
ListType
,
Set
Text
)
...
@@ -135,3 +119,26 @@ toSocialList1_testIsTrue = result == (Just MapTerm, Set.singleton token)
...
@@ -135,3 +119,26 @@ toSocialList1_testIsTrue = result == (Just MapTerm, Set.singleton token)
,
(
StopTerm
,
3
)
,
(
StopTerm
,
3
)
]
]
------------------------------------------------------------------------
-- | Tools
unions
::
(
Ord
a
,
Semigroup
a
,
Semigroup
b
,
Ord
b
)
=>
[
Map
a
(
Set
b
)]
->
Map
a
(
Set
b
)
unions
=
invertBack
.
Map
.
unionsWith
(
<>
)
.
map
invertForw
invertForw
::
(
Ord
b
,
Semigroup
a
)
=>
Map
a
(
Set
b
)
->
Map
b
a
invertForw
=
Map
.
unionsWith
(
<>
)
.
(
map
(
\
(
k
,
sets
)
->
Map
.
fromSet
(
\
_
->
k
)
sets
))
.
Map
.
toList
invertBack
::
(
Ord
a
,
Ord
b
)
=>
Map
b
a
->
Map
a
(
Set
b
)
invertBack
=
Map
.
fromListWith
(
<>
)
.
(
map
(
\
(
b
,
a
)
->
(
a
,
Set
.
singleton
b
)))
.
Map
.
toList
unions_test
::
Map
ListType
(
Set
Text
)
unions_test
=
unions
[
m1
,
m2
]
where
m1
=
Map
.
fromList
[
(
StopTerm
,
Set
.
singleton
"Candidate"
)]
m2
=
Map
.
fromList
[
(
CandidateTerm
,
Set
.
singleton
"Candidate"
)
,
(
MapTerm
,
Set
.
singleton
"Candidate"
)
]
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