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
1e9e4ffd
Commit
1e9e4ffd
authored
Dec 15, 2020
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[CLEAN] fix warnings
parent
5cf6f5da
Pipeline
#1304
failed with stage
Changes
4
Pipelines
1
Show whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
2 additions
and
173 deletions
+2
-173
List.hs
src/Gargantext/Core/Text/List.hs
+1
-1
Group.hs
src/Gargantext/Core/Text/List/Group.hs
+1
-4
WithStem.hs
src/Gargantext/Core/Text/List/Group/WithStem.hs
+0
-167
Social.hs
src/Gargantext/Core/Text/List/Social.hs
+0
-1
No files found.
src/Gargantext/Core/Text/List.hs
View file @
1e9e4ffd
...
...
@@ -89,7 +89,7 @@ buildNgramsOthersList ::( HasNodeError err
->
GroupParams
->
(
NgramsType
,
MapListSize
)
->
m
(
Map
NgramsType
[
NgramsElement
])
buildNgramsOthersList
user
uCid
groupParams
(
nt
,
MapListSize
mapListSize
)
=
do
buildNgramsOthersList
user
uCid
_
groupParams
(
nt
,
MapListSize
mapListSize
)
=
do
allTerms
::
Map
Text
(
Set
NodeId
)
<-
getNodesByNgramsUser
uCid
nt
-- | PrivateFirst for first developments since Public NodeMode is not implemented yet
...
...
src/Gargantext/Core/Text/List/Group.hs
View file @
1e9e4ffd
...
...
@@ -25,13 +25,12 @@ import Data.Monoid (Monoid, mempty)
import
Data.Text
(
Text
)
import
Gargantext.Core.Text.List.Social.Prelude
import
Gargantext.Core.Text.List.Group.Prelude
import
Gargantext.Core.Text.List.Group.WithStem
import
Gargantext.Core.Text.List.Group.WithScores
import
Gargantext.Prelude
import
qualified
Data.Map
as
Map
------------------------------------------------------------------------
toGroupedTree
::
(
Ord
a
,
Monoid
a
,
GroupWithStem
a
)
toGroupedTree
::
(
Ord
a
,
Monoid
a
)
=>
FlowCont
Text
FlowListScores
->
Map
Text
a
->
FlowCont
Text
(
GroupedTreeScores
a
)
...
...
@@ -66,6 +65,4 @@ setScoresWith f = Map.mapWithKey (\k v -> v { _gts'_score = f k
$
view
gts'_children
v
}
)
------------------------------------------------------------------------
src/Gargantext/Core/Text/List/Group/WithStem.hs
View file @
1e9e4ffd
...
...
@@ -17,10 +17,8 @@ Portability : POSIX
module
Gargantext.Core.Text.List.Group.WithStem
where
import
Control.Lens
(
view
,
over
)
import
Data.Map
(
Map
)
import
Data.Maybe
(
catMaybes
)
import
Data.Monoid
(
mempty
)
import
Data.Set
(
Set
)
import
Data.Text
(
Text
)
import
Gargantext.API.Ngrams.Types
...
...
@@ -29,7 +27,6 @@ import Gargantext.Core.Text.List.Group.Prelude
import
Gargantext.Core.Text.List.Social.Prelude
import
Gargantext.Core.Text.List.Social.Patch
import
Gargantext.Core.Text.Terms.Mono.Stem
(
stem
)
import
Gargantext.Database.Admin.Types.Node
(
NodeId
)
import
Gargantext.Prelude
import
qualified
Data.List
as
List
import
qualified
Data.Map
as
Map
...
...
@@ -113,167 +110,3 @@ toNgramsPatch children = NgramsPatch children' Patch.Keep
$
PatchMap
.
fromList
$
List
.
zip
children
(
List
.
cycle
[
addPatch
])
------------------------------------------------------------------------
-- 8< - 8< - 8< - 8< - 8< - 8< - 8< - 8< - 8< - 8< - 8< - 8< - 8< - 8< --
-- TODO remove below
------------------------------------------------------------------------
class
GroupWithStem
a
where
groupWithStem'
::
GroupParams
->
FlowCont
Text
(
GroupedTreeScores
a
)
->
FlowCont
Text
(
GroupedTreeScores
a
)
-- TODO factorize groupWithStem_*
instance
GroupWithStem
(
Set
NodeId
)
where
groupWithStem'
=
groupWithStem_SetNodeId
instance
GroupWithStem
Double
where
groupWithStem'
=
groupWithStem_Double
groupWithStem_SetNodeId
::
GroupParams
->
FlowCont
Text
(
GroupedTreeScores
(
Set
NodeId
))
->
FlowCont
Text
(
GroupedTreeScores
(
Set
NodeId
))
groupWithStem_SetNodeId
g
flc
|
g
==
GroupIdentity
=
FlowCont
(
(
<>
)
(
view
flc_scores
flc
)
(
view
flc_cont
flc
)
)
mempty
|
otherwise
=
mergeWith
(
groupWith
g
)
flc
groupWithStem_Double
::
GroupParams
->
FlowCont
Text
(
GroupedTreeScores
Double
)
->
FlowCont
Text
(
GroupedTreeScores
Double
)
groupWithStem_Double
g
flc
|
g
==
GroupIdentity
=
FlowCont
(
(
<>
)
(
view
flc_scores
flc
)
(
view
flc_cont
flc
)
)
mempty
|
otherwise
=
mergeWith_Double
(
groupWith
g
)
flc
-- | MergeWith : with stem, we always have an answer
-- if Maybe lems then we should add it to continuation
mergeWith
::
(
Text
->
Text
)
->
FlowCont
Text
(
GroupedTreeScores
(
Set
NodeId
))
->
FlowCont
Text
(
GroupedTreeScores
(
Set
NodeId
))
mergeWith
fun
flc
=
FlowCont
scores
mempty
where
scores
::
Map
Text
(
GroupedTreeScores
(
Set
NodeId
))
scores
=
foldl'
(
alter
(
mapStems
scores'
))
scores'
cont'
where
scores'
=
view
flc_scores
flc
cont'
=
Map
.
toList
$
view
flc_cont
flc
-- TODO insert at the right place in group hierarchy
-- adding as child of the parent for now
alter
::
Map
Stem
Text
->
Map
Text
(
GroupedTreeScores
(
Set
NodeId
))
->
(
Text
,
GroupedTreeScores
(
Set
NodeId
))
->
Map
Text
(
GroupedTreeScores
(
Set
NodeId
))
alter
st
target
(
t
,
g
)
=
case
Map
.
lookup
t
st
of
Nothing
->
Map
.
alter
(
alter'
(
t
,
g
))
t
target
Just
t'
->
Map
.
alter
(
alter'
(
t
,
g
))
t'
target
alter'
(
_t
,
g
)
Nothing
=
Just
g
alter'
(
t
,
g
)
(
Just
g'
)
=
Just
$
over
gts'_children
(
Map
.
union
(
Map
.
singleton
t
g
))
g'
mapStems
::
Map
Text
(
GroupedTreeScores
(
Set
NodeId
))
->
Map
Stem
Text
mapStems
=
(
Map
.
fromListWith
(
<>
))
.
List
.
concat
.
(
map
mapStem
)
.
Map
.
toList
mapStem
::
(
Text
,
GroupedTreeScores
(
Set
NodeId
))
->
[(
Stem
,
Text
)]
mapStem
(
s
,
g
)
=
parent
:
children
where
parent
=
(
fun
s
,
s
)
children
=
List
.
concat
$
map
mapStem
(
Map
.
toList
$
view
gts'_children
g
)
-- | MergeWith : with stem, we always have an answer
-- if Maybe lems then we should add it to continuation
mergeWith_Double
::
(
Text
->
Text
)
->
FlowCont
Text
(
GroupedTreeScores
Double
)
->
FlowCont
Text
(
GroupedTreeScores
Double
)
mergeWith_Double
fun
flc
=
FlowCont
scores
mempty
where
scores
::
Map
Text
(
GroupedTreeScores
Double
)
scores
=
foldl'
(
alter
(
mapStems
scores'
))
scores'
cont'
where
scores'
=
view
flc_scores
flc
cont'
=
Map
.
toList
$
view
flc_cont
flc
-- TODO insert at the right place in group hierarchy
-- adding as child of the parent for now
alter
::
Map
Stem
Text
->
Map
Text
(
GroupedTreeScores
Double
)
->
(
Text
,
GroupedTreeScores
Double
)
->
Map
Text
(
GroupedTreeScores
Double
)
alter
st
target
(
t
,
g
)
=
case
Map
.
lookup
t
st
of
Nothing
->
Map
.
alter
(
alter'
(
t
,
g
))
t
target
Just
t'
->
Map
.
alter
(
alter'
(
t
,
g
))
t'
target
alter'
(
_t
,
g
)
Nothing
=
Just
g
alter'
(
t
,
g
)
(
Just
g'
)
=
Just
$
over
gts'_children
(
Map
.
union
(
Map
.
singleton
t
g
))
g'
mapStems
::
Map
Text
(
GroupedTreeScores
Double
)
->
Map
Stem
Text
mapStems
=
(
Map
.
fromListWith
(
<>
))
.
List
.
concat
.
(
map
mapStem
)
.
Map
.
toList
mapStem
::
(
Text
,
GroupedTreeScores
Double
)
->
[(
Stem
,
Text
)]
mapStem
(
s
,
g
)
=
parent
:
children
where
parent
=
(
fun
s
,
s
)
children
=
List
.
concat
$
map
mapStem
(
Map
.
toList
$
view
gts'_children
g
)
{-
-- | TODO fixme
mergeWith_a :: (Text -> Text)
-> FlowCont Text (GroupedTreeScores a)
-> FlowCont Text (GroupedTreeScores a)
mergeWith_a fun flc = FlowCont scores mempty
where
scores :: Map Text (GroupedTreeScores a)
scores = foldl' (alter (mapStems scores')) scores' cont'
where
scores' = view flc_scores flc
cont' = Map.toList $ _flc_cont flc
-- TODO insert at the right place in group hierarchy
-- adding as child of the parent for now
alter :: Map Stem Text
-> Map Text (GroupedTreeScores a)
-> (Text, GroupedTreeScores a)
-> Map Text (GroupedTreeScores a)
alter st target (t,g) = case Map.lookup t st of
Nothing -> Map.alter (alter' (t,g)) t target
Just t' -> Map.alter (alter' (t,g)) t' target
alter' (_t,g) Nothing = Just g
alter' ( t,g) (Just g') = Just $ over gts'_children
( Map.union (Map.singleton t g))
g'
mapStems :: Map Text (GroupedTreeScores a)
-> Map Stem Text
mapStems = (Map.fromListWith (<>)) . List.concat . (map mapStem) . Map.toList
mapStem :: (Text, GroupedTreeScores a)
-> [(Stem, Text)]
mapStem (s,g) = parent : children
where
parent = (fun s, s)
children = List.concat $ map mapStem (Map.toList $ view gts'_children g)
-}
src/Gargantext/Core/Text/List/Social.hs
View file @
1e9e4ffd
...
...
@@ -20,7 +20,6 @@ import Gargantext.Core.Text.List.Social.Find
import
Gargantext.Core.Text.List.Social.History
import
Gargantext.Core.Text.List.Social.Patch
import
Gargantext.Core.Text.List.Social.Prelude
import
Gargantext.Core.Text.List.Social.Scores
import
Gargantext.Core.Types.Individu
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Prelude
...
...
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