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
Julien Moutinho
haskell-gargantext
Commits
800f255f
Commit
800f255f
authored
Nov 10, 2022
by
Przemyslaw Kaminski
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[ngrams] some more fixes and refactorings
parent
df4a810f
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
35 additions
and
27 deletions
+35
-27
Ngrams.hs
src/Gargantext/API/Ngrams.hs
+35
-27
No files found.
src/Gargantext/API/Ngrams.hs
View file @
800f255f
...
@@ -83,7 +83,7 @@ module Gargantext.API.Ngrams
...
@@ -83,7 +83,7 @@ module Gargantext.API.Ngrams
where
where
import
Control.Concurrent
import
Control.Concurrent
import
Control.Lens
((
.~
),
view
,
(
^.
),
(
^..
),
(
+~
),
(
%~
),
(
.~
),
sumOf
,
at
,
_Just
,
Each
(
..
),
(
%%~
),
mapped
,
ifolded
,
withIndex
)
import
Control.Lens
((
.~
),
view
,
(
^.
),
(
^..
),
(
+~
),
(
%~
),
(
.~
),
sumOf
,
at
,
_Just
,
Each
(
..
),
(
%%~
),
mapped
,
ifolded
,
withIndex
,
over
)
import
Control.Monad.Reader
import
Control.Monad.Reader
import
Data.Aeson
hiding
((
.=
))
import
Data.Aeson
hiding
((
.=
))
import
Data.Either
(
Either
(
..
))
import
Data.Either
(
Either
(
..
))
...
@@ -535,6 +535,11 @@ getTableNgrams _nType nId tabType listId limit_ offset
...
@@ -535,6 +535,11 @@ getTableNgrams _nType nId tabType listId limit_ offset
minSize'
=
maybe
(
const
True
)
(
<=
)
minSize
minSize'
=
maybe
(
const
True
)
(
<=
)
minSize
maxSize'
=
maybe
(
const
True
)
(
>=
)
maxSize
maxSize'
=
maybe
(
const
True
)
(
>=
)
maxSize
rootOf
tableMap
ne
=
maybe
ne
(
\
r
->
fromMaybe
(
panic
"getTableNgrams: invalid root"
)
(
tableMap
^.
at
r
)
)
(
ne
^.
ne_root
)
selected_node
n
=
minSize'
s
selected_node
n
=
minSize'
s
&&
maxSize'
s
&&
maxSize'
s
&&
searchQuery
(
n
^.
ne_ngrams
)
&&
searchQuery
(
n
^.
ne_ngrams
)
...
@@ -553,30 +558,32 @@ getTableNgrams _nType nId tabType listId limit_ offset
...
@@ -553,30 +558,32 @@ getTableNgrams _nType nId tabType listId limit_ offset
---------------------------------------
---------------------------------------
filteredNodes
::
Map
NgramsTerm
NgramsElement
->
[
NgramsElement
]
filteredNodes
::
Map
NgramsTerm
NgramsElement
->
[
NgramsElement
]
filteredNodes
tableMap
=
rootOf
<$>
list
&
filter
selected_node
filteredNodes
tableMap
=
roots
<>
inners
-- rootOf <$> list & filter selected_node
where
where
rootOf
ne
=
maybe
ne
(
\
r
->
fromMaybe
(
panic
"getTableNgrams: invalid root"
)
(
tableMap
^.
at
r
)
)
(
ne
^.
ne_root
)
list
=
tableMap
^..
each
list
=
tableMap
^..
each
selected_nodes
=
list
&
filter
selected_node
roots
=
rootOf
tableMap
<$>
selected_nodes
rootSet
=
Set
.
fromList
(
_ne_ngrams
<$>
roots
)
inners
=
list
&
filter
(
selected_inner
rootSet
)
---------------------------------------
---------------------------------------
selectAndPaginate
::
Map
NgramsTerm
NgramsElement
->
[
NgramsElement
]
-- selectAndPaginate :: Map NgramsTerm NgramsElement -> [NgramsElement]
selectAndPaginate
tableMap
=
roots
<>
inners
-- selectAndPaginate tableMap = roots <> inners
where
-- where
list
=
tableMap
^..
each
-- list = tableMap ^.. each
rootOf
ne
=
maybe
ne
(
\
r
->
fromMaybe
(
panic
"getTableNgrams: invalid root"
)
-- selected_nodes = list & take limit_
(
tableMap
^.
at
r
)
-- . drop offset'
)
-- . filter selected_node
(
ne
^.
ne_root
)
-- . sortOnOrder orderBy
selected_nodes
=
list
&
take
limit_
-- roots = rootOf tableMap <$> selected_nodes
.
drop
offset'
-- rootsSet = Set.fromList (_ne_ngrams <$> roots)
.
filter
selected_node
-- inners = list & filter (selected_inner rootsSet)
.
sortOnOrder
orderBy
roots
=
rootOf
<$>
selected_nodes
paginate
::
[
NgramsElement
]
->
[
NgramsElement
]
rootsSet
=
Set
.
fromList
(
_ne_ngrams
<$>
roots
)
paginate
=
take
limit_
inners
=
list
&
filter
(
selected_inner
rootsSet
)
.
drop
offset'
.
sortOnOrder
orderBy
---------------------------------------
---------------------------------------
...
@@ -590,16 +597,17 @@ getTableNgrams _nType nId tabType listId limit_ offset
...
@@ -590,16 +597,17 @@ getTableNgrams _nType nId tabType listId limit_ offset
tableMap2
<-
getNgramsTable'
nId
listId
ngramsType
orderBy
tableMap2
<-
getNgramsTable'
nId
listId
ngramsType
orderBy
-- TODO Refactor: `fltr` and `tableMap3` use very similar functions
fltr
<-
tableMap2
&
v_data
%%~
fmap
NgramsTable
let
fmapScores
=
fmap
NgramsTable
.
(
setNgramsTableScores
nId
listId
ngramsType
(
not
scoresNeeded
))
.
(
setNgramsTableScores
nId
listId
ngramsType
(
not
scoresNeeded
))
.
filteredNodes
printDebug
"[getNgramsTable] fltr"
fltr
fltr
<-
tableMap2
&
v_data
%%~
fmapScores
.
filteredNodes
let
fltrCount
=
length
$
fltr
^.
v_data
.
_NgramsTable
let
fltrCount
=
length
$
fltr
^.
v_data
.
_NgramsTable
t2
<-
getTime
t2
<-
getTime
tableMap3
<-
tableMap2
&
v_data
%%~
fmapScores
.
selectAndPaginate
--tableMap3 <- tableMap2 & v_data %%~ fmapScores . selectAndPaginate :: m (Versioned NgramsTable)
--let tableMap3 = fltr & v_data . _NgramsTable . each %%~ selectAndPaginate' :: Versioned NgramsTable
let
tableMap3
=
over
(
v_data
.
_NgramsTable
)
paginate
fltr
t3
<-
getTime
t3
<-
getTime
liftBase
$
do
liftBase
$
do
hprint
stderr
hprint
stderr
...
...
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