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
Christian Merten
haskell-gargantext
Commits
e1418b58
Commit
e1418b58
authored
Jun 19, 2023
by
Alfredo Di Napoli
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Initial work on the GraphData for Phylio GraphData
parent
48c99bb3
Changes
4
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
405 additions
and
25 deletions
+405
-25
gargantext.cabal
gargantext.cabal
+1
-1
package.yaml
package.yaml
+1
-0
JSON.hs
src-test/Offline/JSON.hs
+8
-2
Phylo.hs
src/Gargantext/Core/Types/Phylo.hs
+395
-22
No files found.
gargantext.cabal
View file @
e1418b58
...
@@ -81,6 +81,7 @@ library
...
@@ -81,6 +81,7 @@ library
Gargantext.Core.Types.Individu
Gargantext.Core.Types.Individu
Gargantext.Core.Types.Main
Gargantext.Core.Types.Main
Gargantext.Core.Types.Query
Gargantext.Core.Types.Query
Gargantext.Core.Types.Phylo
Gargantext.Core.Utils
Gargantext.Core.Utils
Gargantext.Core.Utils.Prefix
Gargantext.Core.Utils.Prefix
Gargantext.Core.Viz.Graph
Gargantext.Core.Viz.Graph
...
@@ -235,7 +236,6 @@ library
...
@@ -235,7 +236,6 @@ library
Gargantext.Core.Text.Terms.Multi.PosTagging
Gargantext.Core.Text.Terms.Multi.PosTagging
Gargantext.Core.Text.Terms.Multi.PosTagging.Types
Gargantext.Core.Text.Terms.Multi.PosTagging.Types
Gargantext.Core.Text.Upload
Gargantext.Core.Text.Upload
Gargantext.Core.Types.Phylo
Gargantext.Core.Types.Search
Gargantext.Core.Types.Search
Gargantext.Core.Utils.DateUtils
Gargantext.Core.Utils.DateUtils
Gargantext.Core.Viz
Gargantext.Core.Viz
...
...
package.yaml
View file @
e1418b58
...
@@ -109,6 +109,7 @@ library:
...
@@ -109,6 +109,7 @@ library:
-
Gargantext.Core.Types.Individu
-
Gargantext.Core.Types.Individu
-
Gargantext.Core.Types.Main
-
Gargantext.Core.Types.Main
-
Gargantext.Core.Types.Query
-
Gargantext.Core.Types.Query
-
Gargantext.Core.Types.Phylo
-
Gargantext.Core.Utils
-
Gargantext.Core.Utils
-
Gargantext.Core.Utils.Prefix
-
Gargantext.Core.Utils.Prefix
-
Gargantext.Core.Viz.Graph
-
Gargantext.Core.Viz.Graph
...
...
src-test/Offline/JSON.hs
View file @
e1418b58
...
@@ -9,6 +9,7 @@ import Data.Aeson
...
@@ -9,6 +9,7 @@ import Data.Aeson
import
Data.Either
import
Data.Either
import
Gargantext.API.Node.Corpus.New
import
Gargantext.API.Node.Corpus.New
import
Gargantext.API.Node.Corpus.Types
import
Gargantext.API.Node.Corpus.Types
import
Gargantext.Core.Types.Phylo
import
Gargantext.Core.Viz.Phylo.API
import
Gargantext.Core.Viz.Phylo.API
import
Prelude
import
Prelude
import
Test.Tasty
import
Test.Tasty
...
@@ -18,7 +19,8 @@ import Text.RawString.QQ
...
@@ -18,7 +19,8 @@ import Text.RawString.QQ
import
qualified
Data.ByteString.Lazy.Char8
as
C8
import
qualified
Data.ByteString.Lazy.Char8
as
C8
jsonRoundtrip
::
(
Show
a
,
FromJSON
a
,
ToJSON
a
,
Eq
a
)
=>
a
->
Property
jsonRoundtrip
::
(
Show
a
,
FromJSON
a
,
ToJSON
a
,
Eq
a
)
=>
a
->
Property
jsonRoundtrip
a
=
eitherDecode
(
encode
a
)
===
Right
a
jsonRoundtrip
a
=
counterexample
(
"Parsed JSON: "
<>
C8
.
unpack
(
encode
a
))
$
eitherDecode
(
encode
a
)
===
Right
a
tests
::
TestTree
tests
::
TestTree
tests
=
testGroup
"JSON"
[
tests
=
testGroup
"JSON"
[
...
@@ -26,7 +28,11 @@ tests = testGroup "JSON" [
...
@@ -26,7 +28,11 @@ tests = testGroup "JSON" [
,
testProperty
"WithQuery roundtrips"
(
jsonRoundtrip
@
WithQuery
)
,
testProperty
"WithQuery roundtrips"
(
jsonRoundtrip
@
WithQuery
)
,
testCase
"WithQuery frontend compliance"
testWithQueryFrontend
,
testCase
"WithQuery frontend compliance"
testWithQueryFrontend
,
testGroup
"Phylo"
[
,
testGroup
"Phylo"
[
testProperty
"PhyloData"
(
jsonRoundtrip
@
PhyloData
)
testProperty
"PeriodToNode"
(
jsonRoundtrip
@
PeriodToNodeData
)
,
testProperty
"GraphData"
(
jsonRoundtrip
@
GraphData
)
,
testProperty
"GraphDataData"
(
jsonRoundtrip
@
GraphDataData
)
,
testProperty
"ObjectData"
(
jsonRoundtrip
@
ObjectData
)
,
testProperty
"PhyloData"
(
jsonRoundtrip
@
PhyloData
)
]
]
]
]
...
...
src/Gargantext/Core/Types/Phylo.hs
View file @
e1418b58
...
@@ -28,8 +28,10 @@ module Gargantext.Core.Types.Phylo where
...
@@ -28,8 +28,10 @@ module Gargantext.Core.Types.Phylo where
import
Control.Monad.Fail
(
fail
)
import
Control.Monad.Fail
(
fail
)
import
Control.Lens
(
makeLenses
)
import
Control.Lens
(
makeLenses
)
import
Control.Applicative
((
<|>
))
import
Data.Aeson
import
Data.Aeson
import
Data.Aeson.Types
import
Data.Aeson.TH
(
deriveJSON
)
import
Data.Aeson.TH
(
deriveJSON
)
import
Data.Monoid
import
Data.Monoid
import
Data.Swagger
import
Data.Swagger
...
@@ -38,6 +40,7 @@ import Data.Time.Clock.POSIX (POSIXTime)
...
@@ -38,6 +40,7 @@ import Data.Time.Clock.POSIX (POSIXTime)
import
qualified
Data.Text
as
T
import
qualified
Data.Text
as
T
import
Test.QuickCheck
import
Test.QuickCheck
import
Test.QuickCheck.Instances.Text
()
import
Test.QuickCheck.Instances.Text
()
import
Prelude
(
Either
(
..
))
import
GHC.Generics
(
Generic
)
import
GHC.Generics
(
Generic
)
...
@@ -114,12 +117,319 @@ data GraphData =
...
@@ -114,12 +117,319 @@ data GraphData =
,
_gd_edges
::
[
EdgeData
]
,
_gd_edges
::
[
EdgeData
]
,
_gd_objects
::
[
ObjectData
]
,
_gd_objects
::
[
ObjectData
]
,
_gd_strict
::
Bool
,
_gd_strict
::
Bool
,
_gd_data
::
GraphDataData
}
deriving
(
Show
,
Eq
,
Generic
)
}
deriving
(
Show
,
Eq
,
Generic
)
data
GraphDataData
=
GraphDataData
{
_gdd_bb
::
Text
,
_gdd_color
::
Text
,
_gdd_fontsize
::
Text
,
_gdd_label
::
Text
,
_gdd_labelloc
::
Text
,
_gdd_lheight
::
Text
,
_gdd_lp
::
Text
,
_gdd_lwidth
::
Text
,
_gdd_name
::
Text
,
_gdd_nodesep
::
Text
,
_gdd_overlap
::
Text
,
_gdd_phyloBranches
::
Text
,
_gdd_phyloDocs
::
Text
,
_gdd_phyloFoundations
::
Text
,
_gdd_phyloGroups
::
Text
,
_gdd_phyloPeriods
::
Text
,
_gdd_phyloSources
::
Text
,
_gdd_phyloTerms
::
Text
,
_gdd_phyloTimeScale
::
Text
,
_gdd_rank
::
Text
,
_gdd_ranksep
::
Text
,
_gdd_ratio
::
Text
,
_gdd_splines
::
Text
,
_gdd_style
::
Text
}
deriving
(
Show
,
Eq
,
Generic
)
instance
ToJSON
GraphDataData
where
toJSON
GraphDataData
{
..
}
=
object
[
"bb"
.=
_gdd_bb
,
"color"
.=
_gdd_color
,
"fontsize"
.=
_gdd_fontsize
,
"label"
.=
_gdd_label
,
"labelloc"
.=
_gdd_labelloc
,
"lheight"
.=
_gdd_lheight
,
"lp"
.=
_gdd_lp
,
"lwidth"
.=
_gdd_lwidth
,
"name"
.=
_gdd_name
,
"nodesep"
.=
_gdd_nodesep
,
"overlap"
.=
_gdd_overlap
,
"phyloBranches"
.=
_gdd_phyloBranches
,
"phyloDocs"
.=
_gdd_phyloDocs
,
"phyloFoundations"
.=
_gdd_phyloFoundations
,
"phyloGroups"
.=
_gdd_phyloGroups
,
"phyloPeriods"
.=
_gdd_phyloPeriods
,
"phyloSources"
.=
_gdd_phyloSources
,
"phyloTerms"
.=
_gdd_phyloTerms
,
"phyloTimeScale"
.=
_gdd_phyloTimeScale
,
"rank"
.=
_gdd_rank
,
"ranksep"
.=
_gdd_ranksep
,
"ratio"
.=
_gdd_ratio
,
"splines"
.=
_gdd_splines
,
"style"
.=
_gdd_style
]
instance
FromJSON
GraphDataData
where
parseJSON
=
withObject
"GraphDataData"
$
\
o
->
do
_gdd_bb
<-
o
.:
"bb"
_gdd_color
<-
o
.:
"color"
_gdd_fontsize
<-
o
.:
"fontsize"
_gdd_label
<-
o
.:
"label"
_gdd_labelloc
<-
o
.:
"labelloc"
_gdd_lheight
<-
o
.:
"lheight"
_gdd_lp
<-
o
.:
"lp"
_gdd_lwidth
<-
o
.:
"lwidth"
_gdd_name
<-
o
.:
"name"
_gdd_nodesep
<-
o
.:
"nodesep"
_gdd_overlap
<-
o
.:
"overlap"
_gdd_phyloBranches
<-
o
.:
"phyloBranches"
_gdd_phyloDocs
<-
o
.:
"phyloDocs"
_gdd_phyloFoundations
<-
o
.:
"phyloFoundations"
_gdd_phyloGroups
<-
o
.:
"phyloGroups"
_gdd_phyloPeriods
<-
o
.:
"phyloPeriods"
_gdd_phyloSources
<-
o
.:
"phyloSources"
_gdd_phyloTerms
<-
o
.:
"phyloTerms"
_gdd_phyloTimeScale
<-
o
.:
"phyloTimeScale"
_gdd_rank
<-
o
.:
"rank"
_gdd_ranksep
<-
o
.:
"ranksep"
_gdd_ratio
<-
o
.:
"ratio"
_gdd_splines
<-
o
.:
"splines"
_gdd_style
<-
o
.:
"style"
pure
$
GraphDataData
{
..
}
-- temp placeholder.
-- temp placeholder.
newtype
ObjectData
=
ObjectData
{
_ObjectData
::
Value
}
data
ObjectData
=
deriving
stock
(
Show
,
Eq
,
Generic
)
GroupToNode
!
GvId
!
NodeCommonData
!
GroupToNodeData
deriving
newtype
(
FromJSON
,
ToJSON
)
|
BranchToNode
!
GvId
!
NodeCommonData
!
BranchToNodeData
|
PeriodToNode
!
GvId
!
NodeCommonData
!
PeriodToNodeData
|
Layer
!
GvId
!
GraphDataData
!
LayerData
deriving
(
Show
,
Eq
,
Generic
)
instance
ToJSON
ObjectData
where
toJSON
=
\
case
GroupToNode
gvid
commonData
nodeTypeData
->
mkObject
gvid
(
Left
commonData
)
nodeTypeData
BranchToNode
gvid
commonData
nodeTypeData
->
mkObject
gvid
(
Left
commonData
)
nodeTypeData
PeriodToNode
gvid
commonData
nodeTypeData
->
mkObject
gvid
(
Left
commonData
)
nodeTypeData
Layer
gvid
graphData
nodeTypeData
->
mkObject
gvid
(
Right
graphData
)
nodeTypeData
instance
FromJSON
ObjectData
where
parseJSON
=
withObject
"ObjectData"
$
\
o
->
do
_gvid
<-
o
.:
"_gvid"
-- try to parse the graph data first. If we succeed, then we are dealing with
-- the 'Layer', otherwise we the rest, but for the rest we can avoid re-parsing
-- the 'NodeCommonData' every time.
case
parseMaybe
@
_
@
GraphDataData
parseJSON
(
Object
o
)
of
Nothing
->
do
commonData
<-
parseJSON
(
Object
o
)
((
GroupToNode
<$>
pure
_gvid
<*>
pure
commonData
<*>
parseJSON
(
Object
o
))
<|>
(
BranchToNode
<$>
pure
_gvid
<*>
pure
commonData
<*>
parseJSON
(
Object
o
))
<|>
(
PeriodToNode
<$>
pure
_gvid
<*>
pure
commonData
<*>
parseJSON
(
Object
o
)))
Just
gd
->
Layer
<$>
pure
_gvid
<*>
pure
gd
<*>
parseJSON
(
Object
o
)
mkObject
::
ToJSON
a
=>
GvId
->
Either
NodeCommonData
GraphDataData
->
a
->
Value
mkObject
gvid
commonData
objectTypeData
=
let
commonDataJSON
=
either
toJSON
toJSON
commonData
objectTypeDataJSON
=
toJSON
objectTypeData
header
=
object
$
[
"_gvid"
.=
toJSON
gvid
]
in
case
(
commonDataJSON
,
objectTypeDataJSON
,
header
)
of
(
Object
hdr
,
Object
cdJSON
,
Object
etDataJSON
)
->
Object
$
hdr
<>
cdJSON
<>
etDataJSON
_
->
panic
"[Gargantext.Core.Types.Phylo.mkObject] impossible: commonData, header or objectTypeDataJSON didn't convert back to JSON Object."
data
GroupToNodeData
=
GroupToNodeData
{
_gtn_bId
::
Text
,
_gtn_branchId
::
Text
,
_gtn_fontname
::
Text
,
_gtn_foundation
::
Text
,
_gtn_frequence
::
Text
,
_gtn_from
::
Text
,
_gtn_lbl
::
Text
,
_gtn_penwidth
::
Text
,
_gtn_role
::
Text
,
_gtn_seaLvl
::
Maybe
Text
,
_gtn_source
::
Text
,
_gtn_strFrom
::
Maybe
Text
,
_gtn_strTo
::
Maybe
Text
,
_gtn_support
::
Text
,
_gtn_to
::
Text
,
_gtn_weight
::
Text
}
deriving
(
Show
,
Eq
,
Generic
)
instance
ToJSON
GroupToNodeData
where
toJSON
GroupToNodeData
{
..
}
=
object
[
"bId"
.=
_gtn_bId
,
"branchId"
.=
_gtn_branchId
,
"fontname"
.=
_gtn_fontname
,
"foundation"
.=
_gtn_foundation
,
"frequence"
.=
_gtn_frequence
,
"from"
.=
_gtn_from
,
"lbl"
.=
_gtn_lbl
,
"penwidth"
.=
_gtn_penwidth
,
"role"
.=
_gtn_role
,
"seaLvl"
.=
_gtn_seaLvl
,
"source"
.=
_gtn_source
,
"strFrom"
.=
_gtn_strFrom
,
"strTo"
.=
_gtn_strTo
,
"support"
.=
_gtn_support
,
"to"
.=
_gtn_to
,
"weight"
.=
_gtn_weight
]
instance
FromJSON
GroupToNodeData
where
parseJSON
=
withObject
"GroupToNodeData"
$
\
o
->
do
_gtn_bId
<-
o
.:
"bId"
_gtn_branchId
<-
o
.:
"branchId"
_gtn_fontname
<-
o
.:
"fontname"
_gtn_foundation
<-
o
.:
"foundation"
_gtn_frequence
<-
o
.:
"frequence"
_gtn_from
<-
o
.:
"from"
_gtn_lbl
<-
o
.:
"lbl"
_gtn_penwidth
<-
o
.:
"penwidth"
_gtn_role
<-
o
.:
"role"
_gtn_seaLvl
<-
o
.:?
"seaLvl"
_gtn_source
<-
o
.:
"source"
_gtn_strFrom
<-
o
.:?
"strFrom"
_gtn_strTo
<-
o
.:?
"strTo"
_gtn_support
<-
o
.:
"support"
_gtn_to
<-
o
.:
"to"
_gtn_weight
<-
o
.:
"weight"
pure
$
GroupToNodeData
{
..
}
data
BranchToNodeData
=
BranchToNodeData
{
_btn_age
::
Text
,
_btn_bId
::
Text
,
_btn_birth
::
Text
,
_btn_branchId
::
Text
,
_btn_branch_x
::
Text
,
_btn_branch_y
::
Text
,
_btn_fillcolor
::
Text
,
_btn_fontname
::
Text
,
_btn_fontsize
::
Text
,
_btn_size
::
Text
,
_btn_style
::
Text
}
deriving
(
Show
,
Eq
,
Generic
)
instance
ToJSON
BranchToNodeData
where
toJSON
BranchToNodeData
{
..
}
=
object
[
"age"
.=
_btn_age
,
"bId"
.=
_btn_bId
,
"birth"
.=
_btn_birth
,
"branchId"
.=
_btn_branchId
,
"branch_x"
.=
_btn_branch_x
,
"branch_y"
.=
_btn_branch_y
,
"fillcolor"
.=
_btn_fillcolor
,
"fontname"
.=
_btn_fontname
,
"fontsize"
.=
_btn_fontsize
,
"size"
.=
_btn_size
,
"style"
.=
_btn_style
]
instance
FromJSON
BranchToNodeData
where
parseJSON
=
withObject
"BranchToNodeData"
$
\
o
->
do
_btn_age
<-
o
.:
"age"
_btn_bId
<-
o
.:
"bId"
_btn_birth
<-
o
.:
"birth"
_btn_branchId
<-
o
.:
"branchId"
_btn_branch_x
<-
o
.:
"branch_x"
_btn_branch_y
<-
o
.:
"branch_y"
_btn_fillcolor
<-
o
.:
"fillcolor"
_btn_fontname
<-
o
.:
"fontname"
_btn_fontsize
<-
o
.:
"fontsize"
_btn_size
<-
o
.:
"size"
_btn_style
<-
o
.:
"style"
pure
$
BranchToNodeData
{
..
}
data
PeriodToNodeData
=
PeriodToNodeData
{
_ptn_fontsize
::
Text
,
_ptn_from
::
Text
,
_ptn_strFrom
::
Maybe
Text
,
_ptn_strTo
::
Maybe
Text
,
_ptn_to
::
Text
}
deriving
(
Show
,
Eq
,
Generic
)
instance
ToJSON
PeriodToNodeData
where
toJSON
PeriodToNodeData
{
..
}
=
object
[
"fontsize"
.=
_ptn_fontsize
,
"from"
.=
_ptn_from
,
"strFrom"
.=
_ptn_strFrom
,
"strTo"
.=
_ptn_strTo
,
"to"
.=
_ptn_to
]
instance
FromJSON
PeriodToNodeData
where
parseJSON
=
withObject
"PeriodToNodeData"
$
\
o
->
do
_ptn_fontsize
<-
o
.:
"fontsize"
_ptn_from
<-
o
.:
"from"
_ptn_strFrom
<-
o
.:?
"strFrom"
_ptn_strTo
<-
o
.:?
"strTo"
_ptn_to
<-
o
.:
"to"
pure
$
PeriodToNodeData
{
..
}
data
LayerData
=
LayerData
{
_ld_nodes
::
[
Int
]
}
deriving
(
Show
,
Eq
,
Generic
)
instance
ToJSON
LayerData
where
toJSON
LayerData
{
..
}
=
object
[
"nodes"
.=
toJSON
_ld_nodes
]
instance
FromJSON
LayerData
where
parseJSON
=
withObject
"LayerData"
$
\
o
->
do
_ld_nodes
<-
o
.:
"nodes"
pure
$
LayerData
{
..
}
data
NodeCommonData
=
NodeCommonData
{
_nd_height
::
!
Text
,
_nd_label
::
!
Text
,
_nd_name
::
!
Text
,
_nd_nodeType
::
!
Text
,
_nd_pos
::
!
Text
,
_nd_shape
::
!
Text
,
_nd_width
::
!
Text
}
deriving
(
Show
,
Eq
,
Generic
)
instance
ToJSON
NodeCommonData
where
toJSON
NodeCommonData
{
..
}
=
object
[
"height"
.=
_nd_height
,
"label"
.=
_nd_label
,
"name"
.=
_nd_name
,
"nodeType"
.=
_nd_nodeType
,
"pos"
.=
_nd_pos
,
"shape"
.=
_nd_shape
,
"width"
.=
_nd_width
]
instance
FromJSON
NodeCommonData
where
parseJSON
=
withObject
"NodeCommonData"
$
\
o
->
do
_nd_height
<-
o
.:
"height"
_nd_label
<-
o
.:
"label"
_nd_name
<-
o
.:
"name"
_nd_nodeType
<-
o
.:
"nodeType"
_nd_pos
<-
o
.:
"pos"
_nd_shape
<-
o
.:
"shape"
_nd_width
<-
o
.:
"width"
pure
$
NodeCommonData
{
..
}
data
EdgeCommonData
=
data
EdgeCommonData
=
EdgeCommonData
{
EdgeCommonData
{
...
@@ -173,13 +483,20 @@ $(deriveJSON (unPrefix "_phylo_Level" ) ''PhyloLevel )
...
@@ -173,13 +483,20 @@ $(deriveJSON (unPrefix "_phylo_Level" ) ''PhyloLevel )
$
(
deriveJSON
(
unPrefix
"_phylo_Group"
)
''
P
hyloGroup
)
$
(
deriveJSON
(
unPrefix
"_phylo_Group"
)
''
P
hyloGroup
)
instance
ToJSON
GraphData
where
instance
ToJSON
GraphData
where
toJSON
GraphData
{
..
}
=
object
toJSON
=
mkGraphData
[
"_subgraph_cnt"
.=
_gd__subgraph_cnt
,
"directed"
.=
_gd_directed
mkGraphData
::
GraphData
->
Value
,
"edges"
.=
_gd_edges
mkGraphData
GraphData
{
..
}
=
,
"objects"
.=
_gd_objects
let
hdrJSON
=
object
[
"_subgraph_cnt"
.=
_gd__subgraph_cnt
,
"strict"
.=
_gd_strict
,
"directed"
.=
_gd_directed
]
,
"edges"
.=
_gd_edges
,
"objects"
.=
_gd_objects
,
"strict"
.=
_gd_strict
]
datJSON
=
toJSON
_gd_data
in
case
(
hdrJSON
,
datJSON
)
of
(
Object
a
,
Object
b
)
->
Object
$
a
<>
b
_
->
panic
"[Gargantext.Core.Types.Phylo.mkGraphData] impossible: header or data didn't convert back to JSON Object."
instance
FromJSON
GraphData
where
instance
FromJSON
GraphData
where
parseJSON
=
withObject
"GraphData"
$
\
o
->
do
parseJSON
=
withObject
"GraphData"
$
\
o
->
do
...
@@ -188,6 +505,7 @@ instance FromJSON GraphData where
...
@@ -188,6 +505,7 @@ instance FromJSON GraphData where
_gd_edges
<-
o
.:
"edges"
_gd_edges
<-
o
.:
"edges"
_gd_objects
<-
o
.:
"objects"
_gd_objects
<-
o
.:
"objects"
_gd_strict
<-
o
.:
"strict"
_gd_strict
<-
o
.:
"strict"
_gd_data
<-
parseJSON
(
Object
o
)
pure
GraphData
{
..
}
pure
GraphData
{
..
}
instance
ToJSON
GvId
where
instance
ToJSON
GvId
where
...
@@ -198,14 +516,14 @@ instance FromJSON GvId where
...
@@ -198,14 +516,14 @@ instance FromJSON GvId where
instance
ToJSON
EdgeData
where
instance
ToJSON
EdgeData
where
toJSON
=
\
case
toJSON
=
\
case
GroupToAncestor
gvid
commonData
edgeTypeData
GroupToAncestor
gvid
commonData
edgeTypeData
->
mk
Nod
e
"ancestorLink"
gvid
commonData
edgeTypeData
->
mk
Edg
e
"ancestorLink"
gvid
commonData
edgeTypeData
GroupToGroup
gvid
commonData
edgeTypeData
GroupToGroup
gvid
commonData
edgeTypeData
->
mk
Nod
e
"link"
gvid
commonData
edgeTypeData
->
mk
Edg
e
"link"
gvid
commonData
edgeTypeData
BranchToGroup
gvid
commonData
edgeTypeData
BranchToGroup
gvid
commonData
edgeTypeData
->
mk
Nod
e
"branchLink"
gvid
commonData
edgeTypeData
->
mk
Edg
e
"branchLink"
gvid
commonData
edgeTypeData
mk
Nod
e
::
ToJSON
a
=>
Text
->
GvId
->
EdgeCommonData
->
a
->
Value
mk
Edg
e
::
ToJSON
a
=>
Text
->
GvId
->
EdgeCommonData
->
a
->
Value
mk
Nod
e
edgeType
gvid
commonData
edgeTypeData
=
mk
Edg
e
edgeType
gvid
commonData
edgeTypeData
=
let
commonDataJSON
=
toJSON
commonData
let
commonDataJSON
=
toJSON
commonData
edgeTypeDataJSON
=
toJSON
edgeTypeData
edgeTypeDataJSON
=
toJSON
edgeTypeData
header
=
object
$
[
"edgeType"
.=
toJSON
edgeType
header
=
object
$
[
"edgeType"
.=
toJSON
edgeType
...
@@ -214,7 +532,7 @@ mkNode edgeType gvid commonData edgeTypeData =
...
@@ -214,7 +532,7 @@ mkNode edgeType gvid commonData edgeTypeData =
in
case
(
commonDataJSON
,
edgeTypeDataJSON
,
header
)
of
in
case
(
commonDataJSON
,
edgeTypeDataJSON
,
header
)
of
(
Object
hdr
,
Object
cdJSON
,
Object
etDataJSON
)
(
Object
hdr
,
Object
cdJSON
,
Object
etDataJSON
)
->
Object
$
hdr
<>
cdJSON
<>
etDataJSON
->
Object
$
hdr
<>
cdJSON
<>
etDataJSON
_
->
panic
"[Gargantext.Core.Types.Phylo.mk
Nod
e] impossible: commonData, header or edgeTypeDataJSON didn't convert back to JSON Object."
_
->
panic
"[Gargantext.Core.Types.Phylo.mk
Edg
e] impossible: commonData, header or edgeTypeDataJSON didn't convert back to JSON Object."
instance
FromJSON
EdgeData
where
instance
FromJSON
EdgeData
where
...
@@ -307,10 +625,57 @@ instance ToSchema GvId where
...
@@ -307,10 +625,57 @@ instance ToSchema GvId where
declareNamedSchema
=
genericDeclareNamedSchema
defaultSchemaOptions
declareNamedSchema
=
genericDeclareNamedSchema
defaultSchemaOptions
instance
ToSchema
EdgeData
where
instance
ToSchema
EdgeData
where
declareNamedSchema
=
genericDeclareNamedSchema
defaultSchemaOptions
declareNamedSchema
=
genericDeclareNamedSchema
defaultSchemaOptions
instance
ToSchema
GraphDataData
where
declareNamedSchema
=
genericDeclareNamedSchema
(
unPrefixSwagger
"_gdd_"
)
instance
ToSchema
GraphData
where
instance
ToSchema
GraphData
where
declareNamedSchema
=
genericDeclareNamedSchema
(
unPrefixSwagger
"_gd_"
)
declareNamedSchema
=
genericDeclareNamedSchema
(
unPrefixSwagger
"_gd_"
)
-- | Arbitrary instances
-- | Arbitrary instances
instance
Arbitrary
LayerData
where
arbitrary
=
LayerData
<$>
arbitrary
instance
Arbitrary
NodeCommonData
where
arbitrary
=
NodeCommonData
<$>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
instance
Arbitrary
GroupToNodeData
where
arbitrary
=
GroupToNodeData
<$>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
instance
Arbitrary
BranchToNodeData
where
arbitrary
=
BranchToNodeData
<$>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
instance
Arbitrary
PeriodToNodeData
where
arbitrary
=
PeriodToNodeData
<$>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
instance
Arbitrary
BranchToGroupData
where
instance
Arbitrary
BranchToGroupData
where
arbitrary
=
BranchToGroupData
<$>
arbitrary
<*>
arbitrary
arbitrary
=
BranchToGroupData
<$>
arbitrary
<*>
arbitrary
instance
Arbitrary
GroupToGroupData
where
instance
Arbitrary
GroupToGroupData
where
...
@@ -329,7 +694,11 @@ instance Arbitrary EdgeCommonData where
...
@@ -329,7 +694,11 @@ instance Arbitrary EdgeCommonData where
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
instance
Arbitrary
ObjectData
where
instance
Arbitrary
ObjectData
where
arbitrary
=
ObjectData
<$>
(
String
<$>
arbitrary
)
-- temporary, it doesn't matter.
arbitrary
=
oneof
[
GroupToNode
<$>
arbitrary
<*>
arbitrary
<*>
arbitrary
,
BranchToNode
<$>
arbitrary
<*>
arbitrary
<*>
arbitrary
,
PeriodToNode
<$>
arbitrary
<*>
arbitrary
<*>
arbitrary
,
Layer
<$>
arbitrary
<*>
arbitrary
<*>
arbitrary
]
instance
Arbitrary
GvId
where
instance
Arbitrary
GvId
where
arbitrary
=
GvId
<$>
arbitrary
arbitrary
=
GvId
<$>
arbitrary
instance
Arbitrary
EdgeData
where
instance
Arbitrary
EdgeData
where
...
@@ -338,8 +707,12 @@ instance Arbitrary EdgeData where
...
@@ -338,8 +707,12 @@ instance Arbitrary EdgeData where
,
BranchToGroup
<$>
arbitrary
<*>
arbitrary
<*>
arbitrary
,
BranchToGroup
<$>
arbitrary
<*>
arbitrary
<*>
arbitrary
]
]
instance
Arbitrary
GraphData
where
instance
Arbitrary
GraphData
where
arbitrary
=
GraphData
<$>
arbitrary
arbitrary
=
GraphData
<$>
arbitrary
<*>
arbitrary
<*>
vectorOf
10
arbitrary
<*>
vectorOf
10
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
instance
Arbitrary
GraphDataData
where
<*>
arbitrary
arbitrary
=
GraphDataData
<$>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
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