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
145
Issues
145
List
Board
Labels
Milestones
Merge Requests
6
Merge Requests
6
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
9813fc11
Commit
9813fc11
authored
Dec 14, 2020
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Plain Diff
Merge branch 'dev-merge' into dev
parents
69c6ee20
13d7bad7
Changes
18
Expand all
Hide whitespace changes
Inline
Side-by-side
Showing
18 changed files
with
252 additions
and
210 deletions
+252
-210
package.yaml
package.yaml
+1
-0
Metrics.hs
src/Gargantext/API/Metrics.hs
+13
-12
Tools.hs
src/Gargantext/API/Ngrams/Tools.hs
+64
-44
Types.hs
src/Gargantext/API/Ngrams/Types.hs
+5
-1
Export.hs
src/Gargantext/API/Node/Corpus/Export.hs
+2
-1
List.hs
src/Gargantext/Core/Text/List.hs
+5
-5
Metrics.hs
src/Gargantext/Core/Text/Metrics.hs
+4
-3
Chart.hs
src/Gargantext/Core/Viz/Chart.hs
+7
-5
API.hs
src/Gargantext/Core/Viz/Graph/API.hs
+1
-1
Types.hs
src/Gargantext/Core/Viz/Types.hs
+6
-4
Pairing.hs
src/Gargantext/Database/Action/Flow/Pairing.hs
+40
-39
Metrics.hs
src/Gargantext/Database/Action/Metrics.hs
+7
-6
Lists.hs
src/Gargantext/Database/Action/Metrics/Lists.hs
+1
-1
NgramsByNode.hs
src/Gargantext/Database/Action/Metrics/NgramsByNode.hs
+62
-57
TFICF.hs
src/Gargantext/Database/Action/Metrics/TFICF.hs
+14
-16
List.hs
src/Gargantext/Database/Admin/Types/Hyperdata/List.hs
+12
-10
Metrics.hs
src/Gargantext/Database/Admin/Types/Metrics.hs
+6
-4
Node.hs
src/Gargantext/Database/Admin/Types/Node.hs
+2
-1
No files found.
package.yaml
View file @
9813fc11
...
...
@@ -150,6 +150,7 @@ library:
-
full-text-search
-
fullstop
-
graphviz
-
hashable
-
haskell-igraph
-
hlcm
-
hsparql
...
...
src/Gargantext/API/Metrics.hs
View file @
9813fc11
...
...
@@ -19,7 +19,8 @@ module Gargantext.API.Metrics
where
import
Control.Lens
import
qualified
Data.Map
as
Map
import
Data.HashMap.Strict
(
HashMap
)
import
qualified
Data.HashMap.Strict
as
HM
import
Data.Text
(
Text
)
import
Data.Time
(
UTCTime
)
import
Servant
...
...
@@ -78,7 +79,7 @@ getScatter cId maybeListId tabType _maybeLimit = do
Nothing
->
defaultList
cId
node
<-
getNodeWith
listId
(
Proxy
::
Proxy
HyperdataList
)
let
HyperdataList
{
_hl_scatter
=
scatterMap
}
=
node
^.
node_hyperdata
mChart
=
Map
.
lookup
tabType
scatterMap
mChart
=
HM
.
lookup
tabType
scatterMap
chart
<-
case
mChart
of
Just
chart
->
pure
chart
...
...
@@ -111,9 +112,9 @@ updateScatter' cId maybeListId tabType maybeLimit = do
(
ngs'
,
scores
)
<-
Metrics
.
getMetrics
cId
maybeListId
tabType
maybeLimit
let
metrics
=
map
(
\
(
Scored
t
s1
s2
)
->
Metric
t
s1
s2
(
listType
t
ngs'
))
$
map
normalizeLocal
scores
listType
t
m
=
maybe
(
panic
errorMsg
)
fst
$
Map
.
lookup
t
m
metrics
=
f
map
(
\
(
Scored
t
s1
s2
)
->
Metric
t
s1
s2
(
listType
t
ngs'
))
$
f
map
normalizeLocal
scores
listType
t
m
=
maybe
(
panic
errorMsg
)
fst
$
HM
.
lookup
t
m
errorMsg
=
"API.Node.metrics: key absent"
listId
<-
case
maybeListId
of
...
...
@@ -122,7 +123,7 @@ updateScatter' cId maybeListId tabType maybeLimit = do
node
<-
getNodeWith
listId
(
Proxy
::
Proxy
HyperdataList
)
let
hl
=
node
^.
node_hyperdata
scatterMap
=
hl
^.
hl_scatter
_
<-
updateHyperdata
listId
$
hl
{
_hl_scatter
=
Map
.
insert
tabType
(
Metrics
metrics
)
scatterMap
}
_
<-
updateHyperdata
listId
$
hl
{
_hl_scatter
=
HM
.
insert
tabType
(
Metrics
metrics
)
scatterMap
}
pure
$
Metrics
metrics
...
...
@@ -172,7 +173,7 @@ getChart cId _start _end maybeListId tabType = do
Nothing
->
defaultList
cId
node
<-
getNodeWith
listId
(
Proxy
::
Proxy
HyperdataList
)
let
chartMap
=
node
^.
node_hyperdata
^.
hl_chart
mChart
=
Map
.
lookup
tabType
chartMap
mChart
=
HM
.
lookup
tabType
chartMap
chart
<-
case
mChart
of
Just
chart
->
pure
chart
...
...
@@ -209,7 +210,7 @@ updateChart' cId maybeListId tabType _maybeLimit = do
let
hl
=
node
^.
node_hyperdata
chartMap
=
hl
^.
hl_chart
h
<-
histoData
cId
_
<-
updateHyperdata
listId
$
hl
{
_hl_chart
=
Map
.
insert
tabType
(
ChartMetrics
h
)
chartMap
}
_
<-
updateHyperdata
listId
$
hl
{
_hl_chart
=
HM
.
insert
tabType
(
ChartMetrics
h
)
chartMap
}
pure
$
ChartMetrics
h
...
...
@@ -258,7 +259,7 @@ getPie cId _start _end maybeListId tabType = do
Nothing
->
defaultList
cId
node
<-
getNodeWith
listId
(
Proxy
::
Proxy
HyperdataList
)
let
pieMap
=
node
^.
node_hyperdata
^.
hl_pie
mChart
=
Map
.
lookup
tabType
pieMap
mChart
=
HM
.
lookup
tabType
pieMap
chart
<-
case
mChart
of
Just
chart
->
pure
chart
...
...
@@ -296,7 +297,7 @@ updatePie' cId maybeListId tabType _maybeLimit = do
pieMap
=
hl
^.
hl_pie
p
<-
chartData
cId
(
ngramsTypeFromTabType
tabType
)
MapTerm
_
<-
updateHyperdata
listId
$
hl
{
_hl_pie
=
Map
.
insert
tabType
(
ChartMetrics
p
)
pieMap
}
_
<-
updateHyperdata
listId
$
hl
{
_hl_pie
=
HM
.
insert
tabType
(
ChartMetrics
p
)
pieMap
}
pure
$
ChartMetrics
p
...
...
@@ -349,7 +350,7 @@ getTree cId _start _end maybeListId tabType listType = do
node
<-
getNodeWith
listId
(
Proxy
::
Proxy
HyperdataList
)
let
treeMap
=
node
^.
node_hyperdata
^.
hl_tree
mChart
=
Map
.
lookup
tabType
treeMap
mChart
=
HM
.
lookup
tabType
treeMap
chart
<-
case
mChart
of
Just
chart
->
pure
chart
...
...
@@ -387,7 +388,7 @@ updateTree' cId maybeListId tabType listType = do
let
hl
=
node
^.
node_hyperdata
treeMap
=
hl
^.
hl_tree
t
<-
treeData
cId
(
ngramsTypeFromTabType
tabType
)
listType
_
<-
updateHyperdata
listId
$
hl
{
_hl_tree
=
Map
.
insert
tabType
(
ChartMetrics
t
)
treeMap
}
_
<-
updateHyperdata
listId
$
hl
{
_hl_tree
=
HM
.
insert
tabType
(
ChartMetrics
t
)
treeMap
}
pure
$
ChartMetrics
t
...
...
src/Gargantext/API/Ngrams/Tools.hs
View file @
9813fc11
...
...
@@ -9,13 +9,18 @@ Portability : POSIX
-}
{-# LANGUAGE TypeFamilies #-}
module
Gargantext.API.Ngrams.Tools
where
import
Control.Concurrent
import
Control.Lens
(
_Just
,
(
^.
),
at
,
view
)
import
Control.Lens
(
_Just
,
(
^.
),
at
,
view
,
At
,
Index
,
IxValue
)
import
Control.Monad.Reader
import
Data.Hashable
(
Hashable
)
import
Data.HashMap.Strict
(
HashMap
)
import
qualified
Data.HashMap.Strict
as
HM
import
Gargantext.Data.HashMap.Strict.Utils
as
HM
import
Data.Map.Strict
(
Map
)
import
qualified
Data.Map.Strict
as
Map
import
qualified
Data.Set
as
Set
...
...
@@ -31,7 +36,7 @@ import Gargantext.Prelude
mergeNgramsElement
::
NgramsRepoElement
->
NgramsRepoElement
->
NgramsRepoElement
mergeNgramsElement
_neOld
neNew
=
neNew
type
RootTerm
=
Text
type
RootTerm
=
NgramsTerm
getRepo
::
RepoCmdM
env
err
m
=>
m
NgramsRepo
getRepo
=
do
...
...
@@ -39,8 +44,8 @@ getRepo = do
liftBase
$
readMVar
v
listNgramsFromRepo
::
[
ListId
]
->
NgramsType
->
NgramsRepo
->
Map
Text
NgramsRepoElement
listNgramsFromRepo
nodeIds
ngramsType
repo
=
Map
.
mapKeys
unNgramsTerm
ngrams
->
NgramsRepo
->
Map
NgramsTerm
NgramsRepoElement
listNgramsFromRepo
nodeIds
ngramsType
repo
=
ngrams
where
ngramsMap
=
repo
^.
r_state
.
at
ngramsType
.
_Just
...
...
@@ -55,73 +60,88 @@ listNgramsFromRepo nodeIds ngramsType repo = Map.mapKeys unNgramsTerm ngrams
-- be properly guarded.
getListNgrams
::
RepoCmdM
env
err
m
=>
[
ListId
]
->
NgramsType
->
m
(
Map
Text
NgramsRepoElement
)
->
m
(
Map
NgramsTerm
NgramsRepoElement
)
getListNgrams
nodeIds
ngramsType
=
listNgramsFromRepo
nodeIds
ngramsType
<$>
getRepo
getTermsWith
::
(
RepoCmdM
env
err
m
,
Ord
a
)
=>
(
Text
->
a
)
->
[
ListId
]
getTermsWith
::
(
RepoCmdM
env
err
m
,
Eq
a
,
Hashable
a
)
=>
(
NgramsTerm
->
a
)
->
[
ListId
]
->
NgramsType
->
ListType
->
m
(
Map
a
[
a
])
getTermsWith
f
ls
ngt
lt
=
Map
.
fromListWith
(
<>
)
<$>
map
(
toTreeWith
f
)
->
m
(
Hash
Map
a
[
a
])
getTermsWith
f
ls
ngt
lt
=
HM
.
fromListWith
(
<>
)
<$>
map
toTreeWith
<$>
Map
.
toList
<$>
Map
.
filter
(
\
f'
->
(
fst
f'
)
==
lt
)
<$>
Map
.
filter
(
\
f'
->
fst
f'
==
lt
)
<$>
mapTermListRoot
ls
ngt
<$>
getRepo
where
toTreeWith
f''
(
t
,
(
_lt
,
maybeRoot
))
=
case
maybeRoot
of
Nothing
->
(
f
''
t
,
[]
)
Just
r
->
(
f
''
r
,
map
f''
[
t
])
toTreeWith
(
t
,
(
_lt
,
maybeRoot
))
=
case
maybeRoot
of
Nothing
->
(
f
t
,
[]
)
Just
r
->
(
f
r
,
[
f
t
])
mapTermListRoot
::
[
ListId
]
->
NgramsType
->
NgramsRepo
->
Map
Text
(
ListType
,
(
Maybe
Text
)
)
->
Map
NgramsTerm
(
ListType
,
Maybe
NgramsTerm
)
mapTermListRoot
nodeIds
ngramsType
repo
=
Map
.
fromList
[
(
t
,
(
_nre_list
nre
,
unNgramsTerm
<$>
_nre_root
nre
))
|
(
t
,
nre
)
<-
Map
.
toList
ngrams
]
where
ngrams
=
listNgramsFromRepo
nodeIds
ngramsType
repo
(
\
nre
->
(
_nre_list
nre
,
_nre_root
nre
))
<$>
listNgramsFromRepo
nodeIds
ngramsType
repo
filterListWithRootHashMap
::
ListType
->
HashMap
NgramsTerm
(
ListType
,
Maybe
NgramsTerm
)
->
HashMap
NgramsTerm
(
Maybe
RootTerm
)
filterListWithRootHashMap
lt
m
=
snd
<$>
HM
.
filter
isMapTerm
m
where
isMapTerm
(
l
,
maybeRoot
)
=
case
maybeRoot
of
Nothing
->
l
==
lt
Just
r
->
case
HM
.
lookup
r
m
of
Nothing
->
panic
$
"Garg.API.Ngrams.Tools: filterWithRoot, unknown key: "
<>
unNgramsTerm
r
Just
(
l'
,
_
)
->
l'
==
lt
filterListWithRoot
::
ListType
->
Map
Text
(
ListType
,
Maybe
Text
)
->
Map
Text
(
Maybe
RootTerm
)
filterListWithRoot
lt
m
=
Map
.
fromList
$
map
(
\
(
t
,(
_
,
r
))
->
(
t
,
r
))
$
filter
isMapTerm
(
Map
.
toList
m
)
->
Map
NgramsTerm
(
ListType
,
Maybe
NgramsTerm
)
->
Map
NgramsTerm
(
Maybe
RootTerm
)
filterListWithRoot
lt
m
=
snd
<$>
Map
.
filter
isMapTerm
m
where
isMapTerm
(
_t
,(
l
,
maybeRoot
)
)
=
case
maybeRoot
of
isMapTerm
(
l
,
maybeRoot
)
=
case
maybeRoot
of
Nothing
->
l
==
lt
Just
r
->
case
Map
.
lookup
r
m
of
Nothing
->
panic
$
"Garg.API.Ngrams.Tools: filterWithRoot, unknown key: "
<>
r
Nothing
->
panic
$
"Garg.API.Ngrams.Tools: filterWithRoot, unknown key: "
<>
unNgramsTerm
r
Just
(
l'
,
_
)
->
l'
==
lt
groupNodesByNgrams
::
Map
Text
(
Maybe
RootTerm
)
->
Map
Text
(
Set
NodeId
)
->
Map
Text
(
Set
NodeId
)
groupNodesByNgrams
syn
occs
=
Map
.
fromListWith
(
<>
)
occs'
groupNodesByNgrams
::
(
At
root_map
,
Index
root_map
~
NgramsTerm
,
IxValue
root_map
~
Maybe
RootTerm
)
=>
root_map
->
HashMap
NgramsTerm
(
Set
NodeId
)
->
HashMap
NgramsTerm
(
Set
NodeId
)
groupNodesByNgrams
syn
occs
=
HM
.
fromListWith
(
<>
)
occs'
where
occs'
=
map
toSyn
(
Map
.
toList
occs
)
toSyn
(
t
,
ns
)
=
case
Map
.
lookup
t
syn
of
Nothing
->
panic
$
"[Garg.API.Ngrams.Tools.groupNodesByNgrams] unknown key: "
<>
t
occs'
=
map
toSyn
(
HM
.
toList
occs
)
toSyn
(
t
,
ns
)
=
case
syn
^.
at
t
of
Nothing
->
panic
$
"[Garg.API.Ngrams.Tools.groupNodesByNgrams] unknown key: "
<>
unNgramsTerm
t
Just
r
->
case
r
of
Nothing
->
(
t
,
ns
)
Just
r'
->
(
r'
,
ns
)
data
Diagonal
=
Diagonal
Bool
getCoocByNgrams
::
Diagonal
->
Map
Text
(
Set
NodeId
)
->
Map
(
Text
,
Text
)
Int
getCoocByNgrams
::
Diagonal
->
HashMap
Text
(
Set
NodeId
)
->
Hash
Map
(
Text
,
Text
)
Int
getCoocByNgrams
=
getCoocByNgrams'
identity
getCoocByNgrams'
::
(
Ord
a
,
Ord
c
)
=>
(
b
->
Set
c
)
->
Diagonal
->
Map
a
b
->
Map
(
a
,
a
)
Int
getCoocByNgrams'
::
(
Hashable
a
,
Ord
a
,
Ord
c
)
=>
(
b
->
Set
c
)
->
Diagonal
->
HashMap
a
b
->
Hash
Map
(
a
,
a
)
Int
getCoocByNgrams'
f
(
Diagonal
diag
)
m
=
Map
.
fromList
[(
(
t1
,
t2
)
,
maybe
0
Set
.
size
$
Set
.
intersection
<$>
(
fmap
f
$
Map
.
lookup
t1
m
)
<*>
(
fmap
f
$
Map
.
lookup
t2
m
)
)
|
(
t1
,
t2
)
<-
case
diag
of
True
->
[
(
x
,
y
)
|
x
<-
Map
.
keys
m
,
y
<-
Map
.
keys
m
,
x
<=
y
]
False
->
listToCombi
identity
(
Map
.
keys
m
)
]
HM
.
fromList
[(
(
t1
,
t2
)
,
maybe
0
Set
.
size
$
Set
.
intersection
<$>
(
fmap
f
$
HM
.
lookup
t1
m
)
<*>
(
fmap
f
$
HM
.
lookup
t2
m
)
)
|
(
t1
,
t2
)
<-
if
diag
then
[
(
x
,
y
)
|
x
<-
ks
,
y
<-
ks
,
x
<=
y
]
-- TODO if we keep a Data.Map here it might be
-- more efficient to enumerate all the y <= x.
else
listToCombi
identity
ks
]
where
ks
=
HM
.
keys
m
\ No newline at end of file
src/Gargantext/API/Ngrams/Types.hs
View file @
9813fc11
...
...
@@ -19,6 +19,7 @@ import Data.Aeson hiding ((.=))
import
Data.Aeson.TH
(
deriveJSON
)
import
Data.Either
(
Either
(
..
))
import
Data.Foldable
import
Data.Hashable
(
Hashable
)
import
qualified
Data.HashMap.Strict.InsOrd
as
InsOrdHashMap
import
qualified
Data.List
as
List
import
Data.Map.Strict
(
Map
)
...
...
@@ -60,6 +61,9 @@ data TabType = Docs | Trash | MoreFav | MoreTrash
|
Contacts
deriving
(
Bounded
,
Enum
,
Eq
,
Generic
,
Ord
,
Show
)
instance
Hashable
TabType
instance
FromHttpApiData
TabType
where
parseUrlPiece
"Docs"
=
pure
Docs
...
...
@@ -120,7 +124,7 @@ instance (ToJSONKey a, ToSchema a) => ToSchema (MSet a) where
------------------------------------------------------------------------
newtype
NgramsTerm
=
NgramsTerm
{
unNgramsTerm
::
Text
}
deriving
(
Ord
,
Eq
,
Show
,
Generic
,
ToJSONKey
,
ToJSON
,
FromJSON
,
Semigroup
,
Arbitrary
,
Serialise
,
ToSchema
)
deriving
(
Ord
,
Eq
,
Show
,
Generic
,
ToJSONKey
,
ToJSON
,
FromJSON
,
Semigroup
,
Arbitrary
,
Serialise
,
ToSchema
,
Hashable
)
instance
FromJSONKey
NgramsTerm
where
fromJSONKey
=
FromJSONKeyTextParser
$
\
t
->
pure
$
NgramsTerm
$
strip
t
...
...
src/Gargantext/API/Node/Corpus/Export.hs
View file @
9813fc11
...
...
@@ -17,6 +17,7 @@ module Gargantext.API.Node.Corpus.Export
where
import
Data.HashMap.Strict
(
HashMap
)
import
Data.Map
(
Map
)
import
Data.Maybe
(
fromMaybe
)
import
Data.Set
(
Set
)
...
...
@@ -76,7 +77,7 @@ getNodeNgrams :: HasNodeError err
->
Maybe
ListId
->
NgramsType
->
NgramsRepo
->
Cmd
err
(
Map
NodeId
(
Set
Text
))
->
Cmd
err
(
Hash
Map
NodeId
(
Set
Text
))
getNodeNgrams
cId
lId'
nt
repo
=
do
lId
<-
case
lId'
of
Nothing
->
defaultList
cId
...
...
src/Gargantext/Core/Text/List.hs
View file @
9813fc11
...
...
@@ -188,19 +188,19 @@ buildNgramsTermsList user uCid mCid groupParams (nt, _mapListSize)= do
selectedTerms
let
groupedTreeScores_SetNodeId
::
Map
Text
(
GroupedTreeScores
(
Set
NodeId
))
groupedTreeScores_SetNodeId
::
Hash
Map
Text
(
GroupedTreeScores
(
Set
NodeId
))
groupedTreeScores_SetNodeId
=
setScoresWithMap
mapTextDocIds
(
groupedMonoHead
<>
groupedMultHead
)
-- | Coocurrences computation
--, t1 >= t2 -- permute byAxis diag -- since matrix symmetric
let
mapCooc
=
Map
.
filter
(
>
2
)
$
Map
.
fromList
[
((
t1
,
t2
),
Set
.
size
$
Set
.
intersection
s1
s2
)
let
mapCooc
=
HM
.
filter
(
>
2
)
$
HM
.
fromList
[
((
t1
,
t2
),
Set
.
size
$
Set
.
intersection
s1
s2
)
|
(
t1
,
s1
)
<-
mapStemNodeIds
,
(
t2
,
s2
)
<-
mapStemNodeIds
]
where
mapStemNodeIds
=
Map
.
toList
$
Map
.
map
viewScores
mapStemNodeIds
=
HM
.
toList
$
HM
.
map
viewScores
$
groupedTreeScores_SetNodeId
let
-- computing scores
...
...
src/Gargantext/Core/Text/Metrics.hs
View file @
9813fc11
...
...
@@ -30,19 +30,20 @@ import qualified Data.Array.Accelerate as DAA
import
qualified
Data.Array.Accelerate.Interpreter
as
DAA
import
qualified
Data.Map
as
Map
import
qualified
Data.Vector
as
V
import
qualified
Data.Vector.Storable
as
Vec
type
MapListSize
=
Int
type
InclusionSize
=
Int
scored
::
Ord
t
=>
Map
(
t
,
t
)
Int
->
[
Scored
t
]
scored
::
Ord
t
=>
Map
(
t
,
t
)
Int
->
V
.
Vector
(
Scored
t
)
scored
=
map2scored
.
(
pcaReduceTo
(
Dimension
2
))
.
scored2map
where
scored2map
::
Ord
t
=>
Map
(
t
,
t
)
Int
->
Map
t
(
Vec
.
Vector
Double
)
scored2map
m
=
Map
.
fromList
$
map
(
\
(
Scored
t
i
s
)
->
(
t
,
Vec
.
fromList
[
i
,
s
]))
$
scored'
m
map2scored
::
Ord
t
=>
Map
t
(
Vec
.
Vector
Double
)
->
[
Scored
t
]
map2scored
=
map
(
\
(
t
,
ds
)
->
Scored
t
(
Vec
.
head
ds
)
(
Vec
.
last
ds
))
.
Map
.
toList
map2scored
::
Ord
t
=>
Map
t
(
Vec
.
Vector
Double
)
->
V
.
Vector
(
Scored
t
)
map2scored
=
V
.
map
(
\
(
t
,
ds
)
->
Scored
t
(
Vec
.
head
ds
)
(
Vec
.
last
ds
))
.
V
.
fromList
.
Map
.
toList
-- TODO change type with (x,y)
data
Scored
ts
=
Scored
...
...
src/Gargantext/Core/Viz/Chart.hs
View file @
9813fc11
...
...
@@ -14,11 +14,12 @@ Portability : POSIX
module
Gargantext.Core.Viz.Chart
where
import
Data.List
(
unzip
,
sortOn
)
import
Data.List
(
sortOn
)
import
Data.Map
(
toList
)
import
qualified
Data.List
as
List
import
qualified
Data.Map
as
Map
import
Data.Maybe
(
catMaybes
)
import
qualified
Data.Vector
as
V
import
Gargantext.Core.Types.Main
import
Gargantext.Database.Admin.Config
...
...
@@ -42,8 +43,9 @@ import Gargantext.Core.Viz.Types
histoData
::
CorpusId
->
Cmd
err
Histo
histoData
cId
=
do
dates
<-
selectDocsDates
cId
let
(
ls
,
css
)
=
unzip
$
sortOn
fst
let
(
ls
,
css
)
=
V
.
unzip
$
V
.
fromList
$
sortOn
fst
-- TODO Vector.sortOn
$
toList
$
occurrencesWith
identity
dates
pure
(
Histo
ls
css
)
...
...
@@ -65,8 +67,8 @@ chartData cId nt lt = do
(
_total
,
mapTerms
)
<-
countNodesByNgramsWith
(
group
dico
)
<$>
getNodesByNgramsOnlyUser
cId
(
ls'
<>
ls
)
nt
terms
let
(
dates
,
count
)
=
unzip
$
map
(
\
(
t
,(
d
,
_
))
->
(
t
,
d
))
$
Map
.
toList
mapTerms
pure
(
Histo
dates
(
map
round
count
))
let
(
dates
,
count
)
=
V
.
unzip
$
fmap
(
\
(
t
,(
d
,
_
))
->
(
t
,
d
))
$
V
.
fromList
$
Map
.
toList
mapTerms
pure
(
Histo
(
dates
)
(
round
<$>
count
))
treeData
::
FlowCmdM
env
err
m
...
...
src/Gargantext/Core/Viz/Graph/API.hs
View file @
9813fc11
...
...
@@ -150,7 +150,7 @@ computeGraph cId d nt repo = do
let
ngs
=
filterListWithRoot
MapTerm
$
mapTermListRoot
[
lId
]
nt
repo
-- TODO split diagonal
myCooc
<-
Map
.
filter
(
>
1
)
myCooc
<-
HM
.
filter
(
>
1
)
<$>
getCoocByNgrams
(
Diagonal
True
)
<$>
groupNodesByNgrams
ngs
<$>
getNodesByNgramsOnlyUser
cId
(
lIds
<>
[
lId
])
nt
(
Map
.
keys
ngs
)
...
...
src/Gargantext/Core/Viz/Types.hs
View file @
9813fc11
...
...
@@ -9,6 +9,8 @@ module Gargantext.Core.Viz.Types where
import
Data.Aeson.TH
(
deriveJSON
)
import
Data.Swagger
import
Data.Vector
(
Vector
)
import
qualified
Data.Vector
as
V
import
Protolude
import
Test.QuickCheck
(
elements
)
import
Test.QuickCheck.Arbitrary
(
Arbitrary
,
arbitrary
)
...
...
@@ -23,8 +25,8 @@ data Chart = ChartHisto | ChartScatter | ChartPie
deriving
(
Generic
)
-- TODO use UTCTime
data
Histo
=
Histo
{
histo_dates
::
!
[
Text
]
,
histo_count
::
!
[
Int
]
data
Histo
=
Histo
{
histo_dates
::
!
(
Vector
Text
)
,
histo_count
::
!
(
Vector
Int
)
}
deriving
(
Show
,
Generic
)
...
...
@@ -32,7 +34,7 @@ instance ToSchema Histo where
declareNamedSchema
=
genericDeclareNamedSchema
(
unPrefixSwagger
"histo_"
)
instance
Arbitrary
Histo
where
arbitrary
=
elements
[
Histo
[
"2012"
]
[
1
]
,
Histo
[
"2013"
]
[
1
]
arbitrary
=
elements
[
Histo
(
V
.
singleton
"2012"
)
(
V
.
singleton
1
)
,
Histo
(
V
.
singleton
"2013"
)
(
V
.
singleton
1
)
]
deriveJSON
(
unPrefix
"histo_"
)
''
H
isto
src/Gargantext/Database/Action/Flow/Pairing.hs
View file @
9813fc11
...
...
@@ -17,13 +17,14 @@ module Gargantext.Database.Action.Flow.Pairing
where
import
Control.Lens
(
_Just
,
(
^.
))
import
Data.Map
(
Map
,
fromList
,
fromListWith
)
import
Data.HashMap.Strict
(
HashMap
)
import
qualified
Data.HashMap.Strict
as
HM
import
Data.Maybe
(
catMaybes
,
fromMaybe
)
import
Data.Set
(
Set
)
import
Data.Text
(
Text
)
import
Gargantext.API.Ngrams.Tools
import
Gargantext.API.Ngrams.Types
(
NgramsTerm
(
..
))
import
Gargantext.API.Prelude
(
GargNoServer
)
import
Gargantext.Core.Types
(
TableResult
(
..
)
,
Term
)
import
Gargantext.Core.Types
(
TableResult
(
..
))
import
Gargantext.Core.Types.Main
import
Gargantext.Database
import
Gargantext.Database.Action.Metrics.NgramsByNode
(
getNodesByNgramsOnlyUser
)
...
...
@@ -79,7 +80,7 @@ dataPairing :: AnnuaireId
->
(
CorpusId
,
ListId
,
NgramsType
)
->
(
ContactName
->
Projected
)
->
(
DocAuthor
->
Projected
)
->
GargNoServer
(
Map
ContactId
(
Set
DocId
))
->
GargNoServer
(
Hash
Map
ContactId
(
Set
DocId
))
dataPairing
aId
(
cId
,
lId
,
ngt
)
fc
fa
=
do
mc
<-
getNgramsContactId
aId
md
<-
getNgramsDocId
cId
lId
ngt
...
...
@@ -87,14 +88,14 @@ dataPairing aId (cId, lId, ngt) fc fa = do
printDebug
"ngramsContactId"
mc
printDebug
"ngramsDocId"
md
let
from
=
projectionFrom
(
Set
.
fromList
$
Map
.
keys
mc
)
fc
to
=
projectionTo
(
Set
.
fromList
$
Map
.
keys
md
)
fa
from
=
projectionFrom
(
Set
.
fromList
$
HM
.
keys
mc
)
fc
to
=
projectionTo
(
Set
.
fromList
$
HM
.
keys
md
)
fa
pure
$
fusion
mc
$
align
from
to
md
prepareInsert
::
Map
ContactId
(
Set
DocId
)
->
[
NodeNode
]
prepareInsert
::
Hash
Map
ContactId
(
Set
DocId
)
->
[
NodeNode
]
prepareInsert
m
=
map
(
\
(
n1
,
n2
)
->
NodeNode
n1
n2
Nothing
Nothing
)
$
List
.
concat
$
map
(
\
(
contactId
,
setDocIds
)
...
...
@@ -102,21 +103,21 @@ prepareInsert m = map (\(n1,n2) -> NodeNode n1 n2 Nothing Nothing)
->
(
contactId
,
setDocId
)
)
$
Set
.
toList
setDocIds
)
$
Map
.
toList
m
$
HM
.
toList
m
------------------------------------------------------------------------
type
ContactName
=
Text
type
DocAuthor
=
Text
type
Projected
=
Text
type
ContactName
=
NgramsTerm
type
DocAuthor
=
NgramsTerm
type
Projected
=
NgramsTerm
projectionFrom
::
Set
ContactName
->
(
ContactName
->
Projected
)
->
Map
ContactName
Projected
projectionFrom
ss
f
=
fromList
$
map
(
\
s
->
(
s
,
f
s
))
(
Set
.
toList
ss
)
projectionFrom
::
Set
ContactName
->
(
ContactName
->
Projected
)
->
Hash
Map
ContactName
Projected
projectionFrom
ss
f
=
HM
.
fromList
$
map
(
\
s
->
(
s
,
f
s
))
(
Set
.
toList
ss
)
-- use HS.toMap
projectionTo
::
Set
DocAuthor
->
(
DocAuthor
->
Projected
)
->
Map
Projected
(
Set
DocAuthor
)
projectionTo
ss
f
=
fromListWith
(
<>
)
$
map
(
\
s
->
(
f
s
,
Set
.
singleton
s
))
(
Set
.
toList
ss
)
projectionTo
::
Set
DocAuthor
->
(
DocAuthor
->
Projected
)
->
Hash
Map
Projected
(
Set
DocAuthor
)
projectionTo
ss
f
=
HM
.
fromListWith
(
<>
)
$
map
(
\
s
->
(
f
s
,
Set
.
singleton
s
))
(
Set
.
toList
ss
)
-- use HS.toMap
------------------------------------------------------------------------
takeName
::
Term
->
Term
takeName
texte
=
DT
.
toLower
texte'
takeName
::
NgramsTerm
->
Ngrams
Term
takeName
(
NgramsTerm
texte
)
=
NgramsTerm
$
DT
.
toLower
texte'
where
texte'
=
maybe
texte
(
\
x
->
if
DT
.
length
x
>
3
then
x
else
texte
)
(
lastName'
texte
)
...
...
@@ -124,51 +125,51 @@ takeName texte = DT.toLower texte'
------------------------------------------------------------------------
align
::
Map
ContactName
Projected
->
Map
Projected
(
Set
DocAuthor
)
->
Map
DocAuthor
(
Set
DocId
)
->
Map
ContactName
(
Set
DocId
)
align
mc
ma
md
=
fromListWith
(
<>
)
align
::
Hash
Map
ContactName
Projected
->
Hash
Map
Projected
(
Set
DocAuthor
)
->
Hash
Map
DocAuthor
(
Set
DocId
)
->
Hash
Map
ContactName
(
Set
DocId
)
align
mc
ma
md
=
HM
.
fromListWith
(
<>
)
$
map
(
\
c
->
(
c
,
getProjection
md
$
testProjection
c
mc
ma
))
$
Map
.
keys
mc
$
HM
.
keys
mc
where
getProjection
::
Map
DocAuthor
(
Set
DocId
)
->
Set
DocAuthor
->
Set
DocId
getProjection
::
Hash
Map
DocAuthor
(
Set
DocId
)
->
Set
DocAuthor
->
Set
DocId
getProjection
ma'
sa'
=
if
Set
.
null
sa'
then
Set
.
empty
else
Set
.
unions
$
sets
ma'
sa'
where
sets
ma''
sa''
=
Set
.
map
(
\
s
->
lookup
s
ma''
)
sa''
lookup
s'
ma''
=
fromMaybe
Set
.
empty
(
Map
.
lookup
s'
ma''
)
lookup
s'
ma''
=
fromMaybe
Set
.
empty
(
HM
.
lookup
s'
ma''
)
testProjection
::
ContactName
->
Map
ContactName
Projected
->
Map
Projected
(
Set
DocAuthor
)
->
Hash
Map
ContactName
Projected
->
Hash
Map
Projected
(
Set
DocAuthor
)
->
Set
DocAuthor
testProjection
cn'
mc'
ma'
=
case
Map
.
lookup
cn'
mc'
of
testProjection
cn'
mc'
ma'
=
case
HM
.
lookup
cn'
mc'
of
Nothing
->
Set
.
empty
Just
c
->
case
Map
.
lookup
c
ma'
of
Just
c
->
case
HM
.
lookup
c
ma'
of
Nothing
->
Set
.
empty
Just
a
->
a
fusion
::
Map
ContactName
(
Set
ContactId
)
->
Map
ContactName
(
Set
DocId
)
->
Map
ContactId
(
Set
DocId
)
fusion
mc
md
=
Map
.
fromListWith
(
<>
)
fusion
::
Hash
Map
ContactName
(
Set
ContactId
)
->
Hash
Map
ContactName
(
Set
DocId
)
->
Hash
Map
ContactId
(
Set
DocId
)
fusion
mc
md
=
HM
.
fromListWith
(
<>
)
$
catMaybes
$
[
(,)
<$>
Just
cId
<*>
Map
.
lookup
cn
md
|
(
cn
,
setContactId
)
<-
Map
.
toList
mc
$
[
(,)
<$>
Just
cId
<*>
HM
.
lookup
cn
md
|
(
cn
,
setContactId
)
<-
HM
.
toList
mc
,
cId
<-
Set
.
toList
setContactId
]
------------------------------------------------------------------------
getNgramsContactId
::
AnnuaireId
->
Cmd
err
(
Map
ContactName
(
Set
NodeId
))
->
Cmd
err
(
Hash
Map
ContactName
(
Set
NodeId
))
getNgramsContactId
aId
=
do
contacts
<-
getAllContacts
aId
pure
$
fromListWith
(
<>
)
pure
$
HM
.
fromListWith
(
<>
)
$
catMaybes
$
map
(
\
contact
->
(,)
<$>
contact
^.
(
node_hyperdata
.
hc_who
.
_Just
.
cw_lastName
)
$
map
(
\
contact
->
(,)
<$>
(
NgramsTerm
<$>
contact
^.
(
node_hyperdata
.
hc_who
.
_Just
.
cw_lastName
)
)
<*>
Just
(
Set
.
singleton
(
contact
^.
node_id
))
)
(
tr_docs
contacts
)
...
...
@@ -176,7 +177,7 @@ getNgramsContactId aId = do
getNgramsDocId
::
CorpusId
->
ListId
->
NgramsType
->
GargNoServer
(
Map
DocAuthor
(
Set
NodeId
))
->
GargNoServer
(
Hash
Map
DocAuthor
(
Set
NodeId
))
getNgramsDocId
cId
lId
nt
=
do
repo
<-
getRepo
lIds
<-
selectNodesWithUsername
NodeList
userMaster
...
...
src/Gargantext/Database/Action/Metrics.hs
View file @
9813fc11
...
...
@@ -18,6 +18,7 @@ module Gargantext.Database.Action.Metrics
import
Data.Map
(
Map
)
import
qualified
Data.Map
as
Map
import
Data.Text
(
Text
)
import
Data.Vector
(
Vector
)
import
Gargantext.API.Ngrams.Types
(
TabType
(
..
),
ngramsTypeFromTabType
)
import
Gargantext.API.Ngrams.Tools
(
filterListWithRoot
,
groupNodesByNgrams
,
Diagonal
(
..
),
getCoocByNgrams
,
mapTermListRoot
,
RootTerm
,
getRepo
)
...
...
@@ -33,7 +34,7 @@ import Gargantext.Core.Text.Metrics (scored, Scored(..), {-localMetrics, toScore
getMetrics
::
FlowCmdM
env
err
m
=>
CorpusId
->
Maybe
ListId
->
TabType
->
Maybe
Limit
->
m
(
Map
Text
(
ListType
,
Maybe
Text
),
[
Scored
Text
]
)
->
m
(
Map
Text
(
ListType
,
Maybe
Text
),
Vector
(
Scored
Text
)
)
getMetrics
cId
maybeListId
tabType
maybeLimit
=
do
(
ngs
,
_
,
myCooc
)
<-
getNgramsCooc
cId
maybeListId
tabType
maybeLimit
pure
(
ngs
,
scored
myCooc
)
...
...
@@ -43,7 +44,7 @@ getNgramsCooc :: (FlowCmdM env err m)
=>
CorpusId
->
Maybe
ListId
->
TabType
->
Maybe
Limit
->
m
(
Map
Text
(
ListType
,
Maybe
Text
)
,
Map
Text
(
Maybe
RootTerm
)
,
Map
(
Text
,
Text
)
Int
,
Hash
Map
(
Text
,
Text
)
Int
)
getNgramsCooc
cId
maybeListId
tabType
maybeLimit
=
do
(
ngs'
,
ngs
)
<-
getNgrams
cId
maybeListId
tabType
...
...
@@ -55,10 +56,10 @@ getNgramsCooc cId maybeListId tabType maybeLimit = do
lId
<-
defaultList
cId
lIds
<-
selectNodesWithUsername
NodeList
userMaster
myCooc
<-
Map
.
filter
(
>
1
)
<$>
getCoocByNgrams
(
Diagonal
True
)
<$>
groupNodesByNgrams
ngs
<$>
getNodesByNgramsOnlyUser
cId
(
lIds
<>
[
lId
])
(
ngramsTypeFromTabType
tabType
)
(
take'
maybeLimit
$
Map
.
keys
ngs
)
myCooc
<-
HM
.
filter
(
>
1
)
<$>
getCoocByNgrams
(
Diagonal
True
)
<$>
groupNodesByNgrams
ngs
<$>
getNodesByNgramsOnlyUser
cId
(
lIds
<>
[
lId
])
(
ngramsTypeFromTabType
tabType
)
(
take'
maybeLimit
$
Map
.
keys
ngs
)
pure
$
(
ngs'
,
ngs
,
myCooc
)
...
...
src/Gargantext/Database/Action/Metrics/Lists.hs
View file @
9813fc11
...
...
@@ -56,5 +56,5 @@ getMetrics' cId maybeListId tabType maybeLimit = do
{-
_ <- Learn.grid 100 110 metrics' metrics'
--}
pure
$
Map
.
fromListWith
(
<>
)
metrics
pure
$
Map
.
fromListWith
(
<>
)
$
Vec
.
toList
metrics
src/Gargantext/Database/Action/Metrics/NgramsByNode.hs
View file @
9813fc11
This diff is collapsed.
Click to expand it.
src/Gargantext/Database/Action/Metrics/TFICF.hs
View file @
9813fc11
...
...
@@ -16,7 +16,8 @@ module Gargantext.Database.Action.Metrics.TFICF
-- import Debug.Trace (trace)
-- import Gargantext.Core (Lang(..))
import
Data.Map.Strict
(
Map
,
toList
,
fromList
)
import
Data.HashMap.Strict
(
HashMap
)
import
qualified
Data.HashMap.Strict
as
HM
import
Data.Maybe
(
fromMaybe
)
import
Data.Text
(
Text
)
import
Gargantext.Core.Text.Metrics.TFICF
...
...
@@ -25,31 +26,28 @@ import Gargantext.Database.Admin.Types.Node -- (ListId, CorpusId, NodeId)
import
Gargantext.Database.Prelude
(
Cmd
)
import
Gargantext.Database.Query.Table.NodeNode
(
selectCountDocs
)
import
Gargantext.Database.Schema.Ngrams
(
NgramsType
(
..
))
import
Gargantext.API.Ngrams.Types
import
Gargantext.Prelude
import
qualified
Data.Map.Strict
as
Map
import
qualified
Data.Set
as
Set
getTficf
::
UserCorpusId
->
MasterCorpusId
->
NgramsType
->
Cmd
err
(
Map
Text
Double
)
->
Cmd
err
(
HashMap
NgramsTerm
Double
)
getTficf
cId
mId
nt
=
do
mapTextDoubleLocal
<-
Map
.
filter
(
>
1
)
<$>
Map
.
map
(
fromIntegral
.
Set
.
size
)
mapTextDoubleLocal
<-
HM
.
filter
(
>
1
)
<$>
HM
.
map
(
fromIntegral
.
Set
.
size
)
<$>
getNodesByNgramsUser
cId
nt
mapTextDoubleGlobal
<-
Map
.
map
fromIntegral
<$>
getOccByNgramsOnlyFast
mId
nt
(
Map
.
keys
mapTextDoubleLocal
)
mapTextDoubleGlobal
<-
HM
.
map
fromIntegral
<$>
getOccByNgramsOnlyFast
mId
nt
(
HM
.
keys
mapTextDoubleLocal
)
countLocal
<-
selectCountDocs
cId
countGlobal
<-
selectCountDocs
mId
pure
$
fromList
[
(
t
,
tficf
(
TficfInfra
(
Count
n
)
(
Total
$
fromIntegral
countLocal
))
(
TficfSupra
(
Count
$
fromMaybe
0
$
Map
.
lookup
t
mapTextDoubleGlobal
)
(
Total
$
fromIntegral
countGlobal
))
)
|
(
t
,
n
)
<-
toList
mapTextDoubleLocal
]
pure
$
HM
.
mapWithKey
(
\
t
n
->
tficf
(
TficfInfra
(
Count
n
)
(
Total
$
fromIntegral
countLocal
))
(
TficfSupra
(
Count
$
fromMaybe
0
$
HM
.
lookup
t
mapTextDoubleGlobal
)
(
Total
$
fromIntegral
countGlobal
))
)
mapTextDoubleLocal
\ No newline at end of file
src/Gargantext/Database/Admin/Types/Hyperdata/List.hs
View file @
9813fc11
...
...
@@ -21,8 +21,10 @@ Portability : POSIX
module
Gargantext.Database.Admin.Types.Hyperdata.List
where
import
Data.Map
(
Map
)
import
qualified
Data.Map
as
Map
import
Data.Vector
(
Vector
)
--import qualified Data.Vector as V
import
Data.HashMap.Strict
(
HashMap
)
import
qualified
Data.HashMap.Strict
as
HM
import
Control.Applicative
import
Gargantext.Prelude
...
...
@@ -34,11 +36,11 @@ import Gargantext.Database.Admin.Types.Metrics (ChartMetrics(..), Metrics)
------------------------------------------------------------------------
data
HyperdataList
=
HyperdataList
{
_hl_chart
::
!
(
Map
TabType
(
ChartMetrics
Histo
))
HyperdataList
{
_hl_chart
::
!
(
Hash
Map
TabType
(
ChartMetrics
Histo
))
,
_hl_list
::
!
(
Maybe
Text
)
,
_hl_pie
::
!
(
Map
TabType
(
ChartMetrics
Histo
))
,
_hl_scatter
::
!
(
Map
TabType
Metrics
)
,
_hl_tree
::
!
(
Map
TabType
(
ChartMetrics
[
NgramsTree
]
))
,
_hl_pie
::
!
(
Hash
Map
TabType
(
ChartMetrics
Histo
))
,
_hl_scatter
::
!
(
Hash
Map
TabType
Metrics
)
,
_hl_tree
::
!
(
HashMap
TabType
(
ChartMetrics
(
Vector
NgramsTree
)
))
}
deriving
(
Show
,
Generic
)
-- HyperdataList { _hl_chart :: !(Maybe (ChartMetrics Histo))
-- , _hl_list :: !(Maybe Text)
...
...
@@ -49,11 +51,11 @@ data HyperdataList =
defaultHyperdataList
::
HyperdataList
defaultHyperdataList
=
HyperdataList
{
_hl_chart
=
Map
.
empty
HyperdataList
{
_hl_chart
=
HM
.
empty
,
_hl_list
=
Nothing
,
_hl_pie
=
Map
.
empty
,
_hl_scatter
=
Map
.
empty
,
_hl_tree
=
Map
.
empty
,
_hl_pie
=
HM
.
empty
,
_hl_scatter
=
HM
.
empty
,
_hl_tree
=
HM
.
empty
}
------------------------------------------------------------------------
...
...
src/Gargantext/Database/Admin/Types/Metrics.hs
View file @
9813fc11
...
...
@@ -5,6 +5,8 @@ module Gargantext.Database.Admin.Types.Metrics where
import
Data.Aeson.TH
(
deriveJSON
)
import
Data.Swagger
import
Data.Vector
(
Vector
)
import
qualified
Data.Vector
as
V
import
Protolude
import
Test.QuickCheck.Arbitrary
...
...
@@ -13,15 +15,15 @@ import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger, wellNamedSchema)
----------------------------------------------------------------------------
data
Metrics
=
Metrics
{
metrics_data
::
[
Metric
]
}
newtype
Metrics
=
Metrics
{
metrics_data
::
Vector
Metric
}
deriving
(
Generic
,
Show
)
instance
ToSchema
Metrics
where
declareNamedSchema
=
genericDeclareNamedSchema
(
unPrefixSwagger
"metrics_"
)
instance
Arbitrary
Metrics
where
arbitrary
=
Metrics
<$>
arbitrary
arbitrary
=
(
Metrics
.
V
.
fromList
)
<$>
arbitrary
data
Metric
=
Metric
{
m_label
::
!
Text
...
...
@@ -43,7 +45,7 @@ deriveJSON (unPrefix "metrics_") ''Metrics
deriveJSON
(
unPrefix
"m_"
)
''
M
etric
data
ChartMetrics
a
=
ChartMetrics
{
chartMetrics_data
::
a
}
newtype
ChartMetrics
a
=
ChartMetrics
{
chartMetrics_data
::
a
}
deriving
(
Generic
,
Show
)
instance
(
Typeable
a
,
ToSchema
a
)
=>
ToSchema
(
ChartMetrics
a
)
where
...
...
src/Gargantext/Database/Admin/Types/Node.hs
View file @
9813fc11
...
...
@@ -24,6 +24,7 @@ import Control.Monad (mzero)
import
Data.Aeson
import
Data.Aeson.TH
(
deriveJSON
)
import
Data.Either
import
Data.Hashable
(
Hashable
)
import
Data.Swagger
import
Data.Text
(
Text
,
unpack
)
import
Data.Time
(
UTCTime
)
...
...
@@ -130,7 +131,7 @@ pgNodeId = O.pgInt4 . id2int
------------------------------------------------------------------------
newtype
NodeId
=
NodeId
Int
deriving
(
Show
,
Read
,
Generic
,
Num
,
Eq
,
Ord
,
Enum
,
ToJSONKey
,
FromJSONKey
,
ToJSON
,
FromJSON
)
deriving
(
Show
,
Read
,
Generic
,
Num
,
Eq
,
Ord
,
Enum
,
ToJSONKey
,
FromJSONKey
,
ToJSON
,
FromJSON
,
Hashable
)
unNodeId
::
NodeId
->
Int
unNodeId
(
NodeId
n
)
=
n
...
...
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