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
141
Issues
141
List
Board
Labels
Milestones
Merge Requests
5
Merge Requests
5
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
c81552e7
Commit
c81552e7
authored
Jul 12, 2020
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[REFACT] HyperData
parent
455311ee
Pipeline
#943
failed with stage
Changes
3
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
16 additions
and
45 deletions
+16
-45
Hyperdata.hs
src/Gargantext/Database/Admin/Types/Hyperdata.hs
+8
-25
Node.hs
src/Gargantext/Database/Query/Table/Node.hs
+1
-14
API.hs
src/Gargantext/Viz/Phylo/API.hs
+7
-6
No files found.
src/Gargantext/Database/Admin/Types/Hyperdata.hs
View file @
c81552e7
...
...
@@ -305,32 +305,23 @@ instance Hyperdata HyperdataResource
------------------------------------------------------------------------
------------------------------------------------------------------------
-- TODO add the Graph Structure here
data
HyperdataPhylo
=
HyperdataPhylo
{
hyperdataPhylo_preferences
::
!
(
Maybe
Text
)
,
hyperdataPhylo_data
::
!
(
Maybe
Phylo
)
}
deriving
(
Show
,
Generic
)
$
(
deriveJSON
(
unPrefix
"hyperdataPhylo_"
)
''
H
yperdataPhylo
)
instance
Hyperdata
HyperdataPhylo
------------------------------------------------------------------------
-- | TODO FEATURE: Notebook saved in the node
data
HyperdataNotebook
=
HyperdataNotebook
{
hyperdataNotebook_preferences
::
!
(
Maybe
Text
)
}
deriving
(
Show
,
Generic
)
$
(
deriveJSON
(
unPrefix
"hyperdataNotebook_"
)
''
H
yperdataNotebook
)
instance
Hyperdata
HyperdataNotebook
-- | TODO CLEAN
-- | TODO FEATURE: Notebook saved in the node
data
HyperData
=
HyperdataTexts
{
hd_preferences
::
!
(
Maybe
Text
)}
|
HyperdataList'
{
hd_preferences
::
!
(
Maybe
Text
)}
|
HyperdataDashboard
{
hd_preferences
::
!
(
Maybe
Text
)
,
hd_charts
::
!
[
Chart
]
|
HyperdataDashboard
{
hd_preferences
::
!
(
Maybe
Text
)
,
hd_charts
::
!
[
Chart
]
}
|
HyperdataNotebook
{
hd_preferences
::
!
(
Maybe
Text
)}
|
HyperdataPhylo
{
hd_preferences
::
!
(
Maybe
Text
)
,
hd_data
::
!
(
Maybe
Phylo
)
}
deriving
(
Show
,
Generic
)
$
(
deriveJSON
(
unPrefix
"hd_"
)
''
H
yperData
)
instance
Hyperdata
HyperData
------------------------------------------------------------------------
...
...
@@ -398,10 +389,6 @@ instance FromField HyperdataListModel
where
fromField
=
fromField'
instance
FromField
HyperdataPhylo
where
fromField
=
fromField'
instance
FromField
HyperdataAnnuaire
where
fromField
=
fromField'
...
...
@@ -440,10 +427,6 @@ instance QueryRunnerColumnDefault PGJsonb HyperdataListModel
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
instance
QueryRunnerColumnDefault
PGJsonb
HyperdataPhylo
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
instance
QueryRunnerColumnDefault
PGJsonb
HyperdataAnnuaire
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
src/Gargantext/Database/Query/Table/Node.hs
View file @
c81552e7
...
...
@@ -240,6 +240,7 @@ instance HasDefault NodeType where
NodeTexts
->
"Texts"
NodeList
->
"Lists"
NodeListCooc
->
"Cooc"
NodePhylo
->
"Phylo"
_
->
panic
"HasDefaultName undefined"
------------------------------------------------------------------------
...
...
@@ -278,16 +279,6 @@ mkGraph p u = insertNodesR [nodeGraphW Nothing Nothing p u]
insertGraph
::
ParentId
->
UserId
->
HyperdataGraph
->
Cmd
err
[
GraphId
]
insertGraph
p
u
h
=
insertNodesR
[
nodeGraphW
Nothing
(
Just
h
)
p
u
]
------------------------------------------------------------------------
arbitraryPhylo
::
HyperdataPhylo
arbitraryPhylo
=
HyperdataPhylo
Nothing
Nothing
nodePhyloW
::
Maybe
Name
->
Maybe
HyperdataPhylo
->
ParentId
->
UserId
->
NodeWrite
nodePhyloW
maybeName
maybePhylo
pId
=
node
NodePhylo
name
graph
(
Just
pId
)
where
name
=
maybe
"Phylo"
identity
maybeName
graph
=
maybe
arbitraryPhylo
identity
maybePhylo
------------------------------------------------------------------------
arbitraryDashboard
::
HyperData
arbitraryDashboard
=
HyperdataDashboard
(
Just
"Preferences"
)
[]
...
...
@@ -454,10 +445,6 @@ mkDashboard p u = insertNodesR [nodeDashboardW Nothing Nothing p u]
name
=
maybe
"Board"
identity
maybeName
dashboard
=
maybe
arbitraryDashboard
identity
maybeDashboard
mkPhylo
::
ParentId
->
UserId
->
Cmd
err
[
NodeId
]
mkPhylo
p
u
=
insertNodesR
[
nodePhyloW
Nothing
Nothing
p
u
]
getListsWithParentId
::
NodeId
->
Cmd
err
[
Node
HyperdataList
]
getListsWithParentId
n
=
runOpaQuery
$
selectNodesWith'
n
(
Just
NodeList
)
...
...
src/Gargantext/Viz/Phylo/API.hs
View file @
c81552e7
...
...
@@ -32,7 +32,7 @@ import Web.HttpApiData (parseUrlPiece, readTextData)
import
Gargantext.API.Prelude
import
Gargantext.Database.Admin.Types.Hyperdata
import
Gargantext.Database.Admin.Types.Node
-- (PhyloId, ListId, CorpusId, UserId, NodeId(..))
import
Gargantext.Database.Query.Table.Node
(
insertNodes
,
node
PhyloW
,
getNodeWith
)
import
Gargantext.Database.Query.Table.Node
(
insertNodes
,
node
,
getNodeWith
)
import
Gargantext.Database.Schema.Node
(
_node_hyperdata
)
import
Gargantext.Prelude
import
Gargantext.Viz.Phylo
...
...
@@ -95,15 +95,16 @@ type GetPhylo = QueryParam "listId" ListId
-- Add real text processing
-- Fix Filter parameters
getPhylo
::
PhyloId
->
GargServer
GetPhylo
--getPhylo phId _lId l msb _f _b _l' _ms _x _y _z _ts _s _o _e _d _b' = do
getPhylo
phId
_lId
l
msb
=
do
phNode
<-
getNodeWith
phId
(
Proxy
::
Proxy
Hyper
dataPhylo
)
phNode
<-
getNodeWith
phId
(
Proxy
::
Proxy
Hyper
Data
)
let
level
=
maybe
2
identity
l
branc
=
maybe
2
identity
msb
maybePhylo
=
h
yperdataPhylo
_data
$
_node_hyperdata
phNode
maybePhylo
=
h
d
_data
$
_node_hyperdata
phNode
p
<-
liftBase
$
viewPhylo2Svg
$
viewPhylo
level
branc
$
maybe
phyloFromQuery
identity
maybePhylo
p
<-
liftBase
$
viewPhylo2Svg
$
viewPhylo
level
branc
$
maybe
phyloFromQuery
identity
maybePhylo
pure
(
SVG
p
)
------------------------------------------------------------------------
type
PostPhylo
=
QueryParam
"listId"
ListId
...
...
@@ -119,7 +120,7 @@ postPhylo n userId _lId = do
-- _sft = Just (Software "Gargantext" "4")
-- _prm = initPhyloParam vrs sft (Just q)
phy
<-
flowPhylo
n
pId
<-
insertNodes
[
node
PhyloW
(
Just
"Phylo"
)
(
Just
$
HyperdataPhylo
Nothing
(
Just
phy
))
n
userId
]
pId
<-
insertNodes
[
node
NodePhylo
"Phylo"
(
HyperdataPhylo
Nothing
(
Just
phy
))
(
Just
n
)
userId
]
pure
$
NodeId
(
fromIntegral
pId
)
------------------------------------------------------------------------
...
...
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