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
acbb8703
Commit
acbb8703
authored
Nov 23, 2020
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[FlowList] All instances for GroupedText Int (to be removed)
parent
acad4d47
Changes
2
Show whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
67 additions
and
34 deletions
+67
-34
List.hs
src/Gargantext/Core/Text/List.hs
+7
-25
Prelude.hs
src/Gargantext/Core/Text/List/Group/Prelude.hs
+60
-9
No files found.
src/Gargantext/Core/Text/List.hs
View file @
acbb8703
...
@@ -18,11 +18,11 @@ module Gargantext.Core.Text.List
...
@@ -18,11 +18,11 @@ module Gargantext.Core.Text.List
import
Control.Lens
((
^.
),
set
,
view
,
over
)
import
Control.Lens
((
^.
),
set
,
view
,
over
)
import
Data.Map
(
Map
)
import
Data.Map
(
Map
)
import
Data.Maybe
(
fromMaybe
,
catMaybes
)
import
Data.Maybe
(
catMaybes
)
import
Data.Ord
(
Down
(
..
))
import
Data.Ord
(
Down
(
..
))
import
Data.Set
(
Set
)
import
Data.Set
(
Set
)
import
Data.Text
(
Text
)
import
Data.Text
(
Text
)
import
Gargantext.API.Ngrams.Types
(
NgramsElement
,
mkNgramsElement
,
NgramsTerm
(
..
),
RootParent
(
..
),
mSetFromList
)
import
Gargantext.API.Ngrams.Types
(
NgramsElement
)
import
Gargantext.API.Ngrams.Types
(
RepoCmdM
)
import
Gargantext.API.Ngrams.Types
(
RepoCmdM
)
import
Gargantext.Core.Text.List.Group
import
Gargantext.Core.Text.List.Group
import
Gargantext.Core.Text.List.Group.Prelude
import
Gargantext.Core.Text.List.Group.Prelude
...
@@ -112,15 +112,13 @@ buildNgramsOthersList user uCid groupIt (nt, MapListSize mapListSize) = do
...
@@ -112,15 +112,13 @@ buildNgramsOthersList user uCid groupIt (nt, MapListSize mapListSize) = do
listSize
=
mapListSize
-
(
List
.
length
mapTerms
)
listSize
=
mapListSize
-
(
List
.
length
mapTerms
)
(
mapTerms'
,
candiTerms
)
=
List
.
splitAt
listSize
(
mapTerms'
,
candiTerms
)
=
List
.
splitAt
listSize
$
List
.
sortOn
(
Down
.
_gt_s
core
)
$
List
.
sortOn
(
Down
.
viewS
core
)
$
Map
.
elems
tailTerms'
$
Map
.
elems
tailTerms'
pure
$
Map
.
fromList
[(
nt
,
(
List
.
concat
$
map
toNgramsElement
stopTerms
)
pure
$
Map
.
fromList
[(
nt
,
(
toNgramsElement
stopTerms
)
<>
(
List
.
concat
$
map
toNgramsElement
mapTerms
)
<>
(
toNgramsElement
mapTerms
)
<>
(
List
.
concat
$
map
toNgramsElement
<>
(
toNgramsElement
$
setListType
(
Just
MapTerm
)
mapTerms'
)
$
map
(
setListType
(
Just
MapTerm
))
mapTerms'
)
<>
(
toNgramsElement
$
setListType
(
Just
CandidateTerm
)
candiTerms
)
<>
(
List
.
concat
$
map
toNgramsElement
$
map
(
setListType
(
Just
CandidateTerm
))
candiTerms
)
)]
)]
...
@@ -290,22 +288,6 @@ buildNgramsTermsList user uCid mCid groupParams = do
...
@@ -290,22 +288,6 @@ buildNgramsTermsList user uCid mCid groupParams = do
toNgramsElement
::
GroupedText
a
->
[
NgramsElement
]
toNgramsElement
(
GroupedText
listType
label
_
setNgrams
_
_
_
)
=
[
parentElem
]
<>
childrenElems
where
parent
=
label
children
=
Set
.
toList
setNgrams
parentElem
=
mkNgramsElement
(
NgramsTerm
parent
)
(
fromMaybe
CandidateTerm
listType
)
Nothing
(
mSetFromList
(
NgramsTerm
<$>
children
))
childrenElems
=
map
(
\
t
->
mkNgramsElement
t
(
fromMaybe
CandidateTerm
$
listType
)
(
Just
$
RootParent
(
NgramsTerm
parent
)
(
NgramsTerm
parent
))
(
mSetFromList
[]
)
)
(
NgramsTerm
<$>
children
)
toGargList
::
Maybe
ListType
->
b
->
(
Maybe
ListType
,
b
)
toGargList
::
Maybe
ListType
->
b
->
(
Maybe
ListType
,
b
)
toGargList
l
n
=
(
l
,
n
)
toGargList
l
n
=
(
l
,
n
)
...
...
src/Gargantext/Core/Text/List/Group/Prelude.hs
View file @
acbb8703
...
@@ -10,6 +10,9 @@ Portability : POSIX
...
@@ -10,6 +10,9 @@ Portability : POSIX
-}
-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE InstanceSigs #-}
module
Gargantext.Core.Text.List.Group.Prelude
module
Gargantext.Core.Text.List.Group.Prelude
where
where
...
@@ -19,13 +22,15 @@ import Data.Monoid
...
@@ -19,13 +22,15 @@ import Data.Monoid
import
Data.Semigroup
import
Data.Semigroup
import
Data.Set
(
Set
)
import
Data.Set
(
Set
)
import
Data.Text
(
Text
)
import
Data.Text
(
Text
)
import
Data.Maybe
(
fromMaybe
)
import
Data.Map
(
Map
)
import
Data.Map
(
Map
)
import
Gargantext.Core.Types
(
ListType
(
..
))
import
Gargantext.Core.Types
(
ListType
(
..
))
import
Gargantext.Database.Admin.Types.Node
(
NodeId
)
import
Gargantext.Database.Admin.Types.Node
(
NodeId
)
import
Gargantext.API.Ngrams.Types
(
NgramsElement
,
mkNgramsElement
,
NgramsTerm
(
..
),
RootParent
(
..
),
mSetFromList
)
import
Gargantext.Prelude
import
Gargantext.Prelude
import
qualified
Data.Set
as
Set
import
qualified
Data.Set
as
Set
import
qualified
Data.Map
as
Map
import
qualified
Data.Map
as
Map
import
qualified
Data.List
as
List
------------------------------------------------------------------------
------------------------------------------------------------------------
-- | Group With Scores Main Types
-- | Group With Scores Main Types
-- Tree of GroupedTextScores
-- Tree of GroupedTextScores
...
@@ -57,20 +62,34 @@ class ViewListType a where
...
@@ -57,20 +62,34 @@ class ViewListType a where
class
SetListType
a
where
class
SetListType
a
where
setListType
::
Maybe
ListType
->
a
->
a
setListType
::
Maybe
ListType
->
a
->
a
class
ViewScore
a
b
where
class
Ord
b
=>
ViewScore
a
b
|
a
->
b
where
viewScore
::
a
->
b
viewScore
::
a
->
b
class
ToNgramsElement
a
where
toNgramsElement
::
a
->
[
NgramsElement
]
---------------------------------------------
instance
ViewListType
(
GroupedTreeScores
a
)
where
instance
ViewListType
(
GroupedTreeScores
a
)
where
viewListType
=
view
gts'_listType
viewListType
=
view
gts'_listType
instance
SetListType
(
GroupedTreeScores
a
)
where
instance
SetListType
(
GroupedTreeScores
a
)
where
setListType
=
set
gts'_listType
setListType
=
set
gts'_listType
{-
instance
ViewScore
(
GroupedTreeScores
(
Set
NodeId
))
Int
where
instance ViewScore (GroupedTreeScores a) b where
viewScore
=
Set
.
size
.
(
view
gts'_score
)
viewScore = view gts'_score
-}
instance
ToNgramsElement
(
Map
Text
(
GroupedTreeScores
(
Set
NodeId
)))
where
toNgramsElement
=
undefined
-- 8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--
-- 8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--
...
@@ -90,7 +109,7 @@ instance Monoid GroupedWithListScores where
...
@@ -90,7 +109,7 @@ instance Monoid GroupedWithListScores where
mempty
=
GroupedWithListScores
Nothing
Set
.
empty
mempty
=
GroupedWithListScores
Nothing
Set
.
empty
makeLenses
''
G
roupedWithListScores
makeLenses
''
G
roupedWithListScores
-- 8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--
------------------------------------------------------------------------
------------------------------------------------------------------------
------------------------------------------------------------------------
------------------------------------------------------------------------
...
@@ -115,6 +134,9 @@ instance ViewListType (GroupedText a) where
...
@@ -115,6 +134,9 @@ instance ViewListType (GroupedText a) where
instance
SetListType
(
GroupedText
a
)
where
instance
SetListType
(
GroupedText
a
)
where
setListType
=
set
gt_listType
setListType
=
set
gt_listType
instance
Ord
a
=>
ViewScore
(
GroupedText
a
)
a
where
viewScore
=
(
view
gt_score
)
{-
{-
instance Show score => Show (GroupedText score) where
instance Show score => Show (GroupedText score) where
show (GroupedText lt l s _ _ _ _) = show l <> " : " <> show lt <> " : " <> show s
show (GroupedText lt l s _ _ _ _) = show l <> " : " <> show lt <> " : " <> show s
...
@@ -140,3 +162,32 @@ instance Ord a => Semigroup (GroupedText a) where
...
@@ -140,3 +162,32 @@ instance Ord a => Semigroup (GroupedText a) where
gr
=
Set
.
union
group1
group2
gr
=
Set
.
union
group1
group2
nodes
=
Set
.
union
nodes1
nodes2
nodes
=
Set
.
union
nodes1
nodes2
instance
SetListType
[
GroupedText
Int
]
where
setListType
lt
=
map
(
setListType
lt
)
instance
ToNgramsElement
(
Map
Stem
(
GroupedText
Int
))
where
toNgramsElement
=
List
.
concat
.
(
map
toNgramsElement
)
.
Map
.
elems
instance
ToNgramsElement
[
GroupedText
a
]
where
toNgramsElement
=
List
.
concat
.
(
map
toNgramsElement
)
instance
ToNgramsElement
(
GroupedText
a
)
where
toNgramsElement
::
GroupedText
a
->
[
NgramsElement
]
toNgramsElement
(
GroupedText
listType
label
_
setNgrams
_
_
_
)
=
[
parentElem
]
<>
childrenElems
where
parent
=
label
children
=
Set
.
toList
setNgrams
parentElem
=
mkNgramsElement
(
NgramsTerm
parent
)
(
fromMaybe
CandidateTerm
listType
)
Nothing
(
mSetFromList
(
NgramsTerm
<$>
children
))
childrenElems
=
map
(
\
t
->
mkNgramsElement
t
(
fromMaybe
CandidateTerm
$
listType
)
(
Just
$
RootParent
(
NgramsTerm
parent
)
(
NgramsTerm
parent
))
(
mSetFromList
[]
)
)
(
NgramsTerm
<$>
children
)
-- 8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--
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