Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
H
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
Przemyslaw Kaminski
haskell-gargantext
Commits
a9cac7ec
Commit
a9cac7ec
authored
Jul 10, 2020
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[CLEAN] Instances HyperData (WIP)
parent
1eed5eba
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
16 additions
and
22 deletions
+16
-22
Node.hs
src/Gargantext/Database/Action/Node.hs
+4
-8
Hyperdata.hs
src/Gargantext/Database/Admin/Types/Hyperdata.hs
+3
-7
Node.hs
src/Gargantext/Database/Query/Table/Node.hs
+9
-7
No files found.
src/Gargantext/Database/Action/Node.hs
View file @
a9cac7ec
...
...
@@ -95,20 +95,16 @@ mkNodeWithParent NodeGraph (Just i) uId name =
where
hd
=
arbitraryGraph
mkNodeWithParent
NodeDashboard
(
Just
i
)
uId
name
=
insertNodesWithParentR
(
Just
i
)
[
node
NodeDashboard
name
hd
Nothing
uId
]
where
hd
=
arbitraryDashboard
mkNodeWithParent
NodeFrameWrite
i
u
n
=
mkNodeWithParent_ConfigureHyperdata
NodeFrameWrite
i
u
n
mkNodeWithParent
NodeFrameCalc
i
u
n
=
mkNodeWithParent_ConfigureHyperdata
NodeFrameCalc
i
u
n
mkNodeWithParent
_
_
_
_
=
nodeError
NotImplYet
mkNodeWithParent
n
(
Just
i
)
uId
name
=
insertNodesWithParentR
(
Just
i
)
[
node
NodeDashboard
name
(
hasDefaultData
n
)
Nothing
uId
]
-- mkNodeWithParent _ _ _ _ = nodeError NotImplYet
-- | Sugar to create a node, get his NodeId and update his Hyperdata after
...
...
src/Gargantext/Database/Admin/Types/Hyperdata.hs
View file @
a9cac7ec
...
...
@@ -296,13 +296,6 @@ $(deriveJSON (unPrefix "hyperdataResource_") ''HyperdataResource)
instance
Hyperdata
HyperdataResource
------------------------------------------------------------------------
data
HyperdataDashboard
=
HyperdataDashboard
{
hyperdataDashboard_preferences
::
!
(
Maybe
Text
)
,
hyperdataDashboard_charts
::
!
[
Chart
]
}
deriving
(
Show
,
Generic
)
$
(
deriveJSON
(
unPrefix
"hyperdataDashboard_"
)
''
H
yperdataDashboard
)
instance
Hyperdata
HyperdataDashboard
------------------------------------------------------------------------
-- TODO add the Graph Structure here
data
HyperdataPhylo
=
HyperdataPhylo
{
hyperdataPhylo_preferences
::
!
(
Maybe
Text
)
...
...
@@ -324,6 +317,9 @@ instance Hyperdata HyperdataNotebook
-- | TODO CLEAN
data
HyperData
=
HyperdataTexts
{
hd_preferences
::
!
(
Maybe
Text
)}
|
HyperdataList'
{
hd_preferences
::
!
(
Maybe
Text
)}
|
HyperdataDashboard
{
hd_preferences
::
!
(
Maybe
Text
)
,
hd_charts
::
!
[
Chart
]
}
deriving
(
Show
,
Generic
)
$
(
deriveJSON
(
unPrefix
"hd_"
)
''
H
yperData
)
...
...
src/Gargantext/Database/Query/Table/Node.hs
View file @
a9cac7ec
...
...
@@ -228,17 +228,19 @@ class HasDefault a where
instance
HasDefault
NodeType
where
hasDefaultData
nt
=
case
nt
of
NodeTexts
->
HyperdataTexts
(
Just
"Preferences"
)
NodeList
->
HyperdataList'
(
Just
"Preferences"
)
NodeListCooc
->
HyperdataList'
(
Just
"Preferences"
)
_
->
undefined
NodeTexts
->
HyperdataTexts
(
Just
"Preferences"
)
NodeList
->
HyperdataList'
(
Just
"Preferences"
)
NodeListCooc
->
HyperdataList'
(
Just
"Preferences"
)
-- NodeFolder -> defaultFolder
NodeDashboard
->
arbitraryDashboard
_
->
panic
"HasDefaultData undefined"
--NodeAnnuaire -> HyperdataAnnuaire (Just "Title") (Just "Description")
hasDefaultName
nt
=
case
nt
of
NodeTexts
->
"Texts"
NodeList
->
"Lists"
NodeListCooc
->
"Cooc"
_
->
undefined
_
->
panic
"HasDefaultName undefined"
------------------------------------------------------------------------
nodeDefault
::
NodeType
->
ParentId
->
UserId
->
NodeWrite
...
...
@@ -287,7 +289,7 @@ nodePhyloW maybeName maybePhylo pId = node NodePhylo name graph (Just pId)
graph
=
maybe
arbitraryPhylo
identity
maybePhylo
------------------------------------------------------------------------
arbitraryDashboard
::
Hyper
dataDashboard
arbitraryDashboard
::
Hyper
Data
arbitraryDashboard
=
HyperdataDashboard
(
Just
"Preferences"
)
[]
------------------------------------------------------------------------
...
...
@@ -446,7 +448,7 @@ mkNode nt p u = insertNodesR [nodeDefault nt p u]
mkDashboard
::
ParentId
->
UserId
->
Cmd
err
[
NodeId
]
mkDashboard
p
u
=
insertNodesR
[
nodeDashboardW
Nothing
Nothing
p
u
]
where
nodeDashboardW
::
Maybe
Name
->
Maybe
Hyper
dataDashboard
->
ParentId
->
UserId
->
NodeWrite
nodeDashboardW
::
Maybe
Name
->
Maybe
Hyper
Data
->
ParentId
->
UserId
->
NodeWrite
nodeDashboardW
maybeName
maybeDashboard
pId
=
node
NodeDashboard
name
dashboard
(
Just
pId
)
where
name
=
maybe
"Board"
identity
maybeName
...
...
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