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
195
Issues
195
List
Board
Labels
Milestones
Merge Requests
12
Merge Requests
12
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
2dae3522
Commit
2dae3522
authored
Nov 09, 2020
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[FEAT] SocialList refactoring
parent
4a5e83c1
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
15 additions
and
10 deletions
+15
-10
List.hs
src/Gargantext/Core/Text/List.hs
+3
-1
Social.hs
src/Gargantext/Core/Text/List/Social.hs
+12
-9
No files found.
src/Gargantext/Core/Text/List.hs
View file @
2dae3522
...
@@ -29,7 +29,7 @@ import qualified Data.Text as Text
...
@@ -29,7 +29,7 @@ import qualified Data.Text as Text
-- import Gargantext.API.Ngrams.Tools (getCoocByNgrams', Diagonal(..))
-- import Gargantext.API.Ngrams.Tools (getCoocByNgrams', Diagonal(..))
import
Gargantext.API.Ngrams.Types
(
NgramsElement
,
mkNgramsElement
,
NgramsTerm
(
..
),
RootParent
(
..
),
mSetFromList
)
import
Gargantext.API.Ngrams.Types
(
NgramsElement
,
mkNgramsElement
,
NgramsTerm
(
..
),
RootParent
(
..
),
mSetFromList
)
import
Gargantext.API.Ngrams.Types
(
RepoCmdM
)
import
Gargantext.API.Ngrams.Types
(
RepoCmdM
)
import
Gargantext.Core.Text.List.Social
(
flowSocialList
,
invertForw
)
import
Gargantext.Core.Text.List.Social
(
flowSocialList
,
flowSocialList'
,
FlowSocialListPriority
(
..
),
invertForw
)
import
Gargantext.Core.Text.Metrics
(
scored'
,
Scored
(
..
),
normalizeGlobal
,
normalizeLocal
)
import
Gargantext.Core.Text.Metrics
(
scored'
,
Scored
(
..
),
normalizeGlobal
,
normalizeLocal
)
import
Gargantext.Core.Text.Group
import
Gargantext.Core.Text.Group
import
Gargantext.Core.Types
(
ListType
(
..
),
MasterCorpusId
,
UserCorpusId
)
import
Gargantext.Core.Types
(
ListType
(
..
),
MasterCorpusId
,
UserCorpusId
)
...
@@ -88,6 +88,8 @@ buildNgramsOthersList user uCid groupIt (nt, MapListSize mapListSize) = do
...
@@ -88,6 +88,8 @@ buildNgramsOthersList user uCid groupIt (nt, MapListSize mapListSize) = do
$
ngs
$
ngs
socialLists
<-
flowSocialList
user
nt
(
Set
.
fromList
$
Map
.
keys
ngs
)
socialLists
<-
flowSocialList
user
nt
(
Set
.
fromList
$
Map
.
keys
ngs
)
-- PrivateFirst for first development since Public is not implemented yet
socialLists'
<-
flowSocialList'
PrivateFirst
user
nt
(
Set
.
fromList
$
Map
.
keys
ngs
)
let
let
groupedWithList
=
map
(
addListType
(
invertForw
socialLists
))
grouped
groupedWithList
=
map
(
addListType
(
invertForw
socialLists
))
grouped
...
...
src/Gargantext/Core/Text/List/Social.hs
View file @
2dae3522
...
@@ -63,6 +63,7 @@ flowSocialList user nt ngrams' = do
...
@@ -63,6 +63,7 @@ flowSocialList user nt ngrams' = do
-- printDebug "* socialLists *: results \n" result
-- printDebug "* socialLists *: results \n" result
pure
result
pure
result
------------------------------------------------------------------------
------------------------------------------------------------------------
------------------------------------------------------------------------
-- | FlowSocialListPriority
-- | FlowSocialListPriority
-- Sociological assumption: either private or others (public) first
-- Sociological assumption: either private or others (public) first
...
@@ -73,6 +74,7 @@ flowSocialListPriority :: FlowSocialListPriority -> [NodeMode]
...
@@ -73,6 +74,7 @@ flowSocialListPriority :: FlowSocialListPriority -> [NodeMode]
flowSocialListPriority
PrivateFirst
=
[
Private
,
Shared
{-, Public -}
]
flowSocialListPriority
PrivateFirst
=
[
Private
,
Shared
{-, Public -}
]
flowSocialListPriority
OthersFirst
=
reverse
$
flowSocialListPriority
PrivateFirst
flowSocialListPriority
OthersFirst
=
reverse
$
flowSocialListPriority
PrivateFirst
------------------------------------------------------------------------
flowSocialList'
::
(
RepoCmdM
env
err
m
flowSocialList'
::
(
RepoCmdM
env
err
m
,
CmdM
env
err
m
,
CmdM
env
err
m
,
HasNodeError
err
,
HasNodeError
err
...
@@ -82,7 +84,7 @@ flowSocialList' :: ( RepoCmdM env err m
...
@@ -82,7 +84,7 @@ flowSocialList' :: ( RepoCmdM env err m
->
User
->
NgramsType
->
Set
Text
->
User
->
NgramsType
->
Set
Text
->
m
(
Map
Text
FlowListScores
)
->
m
(
Map
Text
FlowListScores
)
flowSocialList'
flowPriority
user
nt
ngrams'
=
flowSocialList'
flowPriority
user
nt
ngrams'
=
parentUnionsExcl
<$>
mapM
(
\
m
->
flowSocialListByMode'
user
m
nt
ngrams'
)
parentUnionsExcl
<$>
mapM
(
flowSocialListByMode'
user
nt
ngrams'
)
(
flowSocialListPriority
flowPriority
)
(
flowSocialListPriority
flowPriority
)
...
@@ -106,11 +108,11 @@ flowSocialListByMode' :: ( RepoCmdM env err m
...
@@ -106,11 +108,11 @@ flowSocialListByMode' :: ( RepoCmdM env err m
,
HasNodeError
err
,
HasNodeError
err
,
HasTreeError
err
,
HasTreeError
err
)
)
=>
User
->
N
odeMode
->
NgramsType
->
Set
Text
=>
User
->
N
gramsType
->
Set
Text
->
NodeMode
->
m
(
Map
Text
FlowListScores
)
->
m
(
Map
Text
FlowListScores
)
flowSocialListByMode'
user
mode
nt
st
=
do
flowSocialListByMode'
user
nt
st
mode
=
listIds
<-
findListsId
user
mode
findListsId
user
mode
flowSocialListByModeWith
listIds
nt
st
>>=
flowSocialListByModeWith
nt
st
flowSocialListByModeWith
::
(
RepoCmdM
env
err
m
flowSocialListByModeWith
::
(
RepoCmdM
env
err
m
...
@@ -118,11 +120,12 @@ flowSocialListByModeWith :: ( RepoCmdM env err m
...
@@ -118,11 +120,12 @@ flowSocialListByModeWith :: ( RepoCmdM env err m
,
HasNodeError
err
,
HasNodeError
err
,
HasTreeError
err
,
HasTreeError
err
)
)
=>
[
NodeId
]
->
NgramsType
->
Set
Text
=>
NgramsType
->
Set
Text
->
[
NodeId
]
->
m
(
Map
Text
FlowListScores
)
->
m
(
Map
Text
FlowListScores
)
flowSocialListByModeWith
ns
nt
st
=
do
flowSocialListByModeWith
nt
st
ns
=
ngramsRepos
<-
mapM
(
\
l
->
getListNgrams
[
l
]
nt
)
ns
mapM
(
\
l
->
getListNgrams
[
l
]
nt
)
ns
pure
$
toFlowListScores
(
keepAllParents
nt
)
st
Map
.
empty
ngramsRepos
>>=
pure
.
toFlowListScores
(
keepAllParents
nt
)
st
Map
.
empty
-- | We keep the parents for all ngrams but terms
-- | We keep the parents for all ngrams but terms
...
...
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