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
158
Issues
158
List
Board
Labels
Milestones
Merge Requests
11
Merge Requests
11
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
d10c458f
Commit
d10c458f
authored
Nov 26, 2018
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[DB][FLOW] Grah and Dashbord nodes (arbitrary).
parent
dcb60231
Pipeline
#24
failed with stage
Changes
4
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
40 additions
and
2 deletions
+40
-2
Flow.hs
src/Gargantext/Database/Flow.hs
+4
-1
Node.hs
src/Gargantext/Database/Node.hs
+30
-0
Tree.hs
src/Gargantext/Database/Tree.hs
+1
-1
Node.hs
src/Gargantext/Database/Types/Node.hs
+5
-0
No files found.
src/Gargantext/Database/Flow.hs
View file @
d10c458f
...
...
@@ -36,7 +36,7 @@ import qualified Data.Map as DM
import
Gargantext.Core.Types
(
NodePoly
(
..
),
ListType
(
..
),
listTypeId
)
import
Gargantext.Database.Bashql
(
runCmd'
)
-- , del)
import
Gargantext.Database.Ngrams
(
insertNgrams
,
Ngrams
(
..
),
NgramsT
(
..
),
NgramsIndexed
(
..
),
indexNgramsT
,
ngramsTypeId
,
NgramsType
(
..
),
text2ngrams
)
import
Gargantext.Database.Node
(
getRoot
,
mkRoot
,
mkCorpus
,
Cmd
(
..
),
mkList
)
import
Gargantext.Database.Node
(
getRoot
,
mkRoot
,
mkCorpus
,
Cmd
(
..
),
mkList
,
mkGraph
,
mkDashboard
)
import
Gargantext.Database.Node.Document.Add
(
add
)
import
Gargantext.Database.Node.Document.Insert
(
insertDocuments
,
ReturnId
(
..
),
addUniqIds
)
import
Gargantext.Database.NodeNgram
(
NodeNgramPoly
(
..
),
insertNodeNgrams
)
...
...
@@ -102,6 +102,9 @@ flowDatabase ff fp cName = do
inserted
<-
runCmd'
$
add
corpusId2
(
map
reId
ids
)
printDebug
"Inserted : "
(
length
inserted
)
_
<-
runCmd'
$
mkDashboard
corpusId2
userId
_
<-
runCmd'
$
mkGraph
corpusId2
userId
pure
corpusId2
-- runCmd' $ del [corpusId2, corpusId]
...
...
src/Gargantext/Database/Node.hs
View file @
d10c458f
...
...
@@ -390,6 +390,29 @@ nodeListW maybeName maybeList pId = node NodeList name list (Just pId)
name
=
maybe
"Listes"
identity
maybeName
list
=
maybe
arbitraryList
identity
maybeList
------------------------------------------------------------------------
arbitraryGraph
::
HyperdataGraph
arbitraryGraph
=
HyperdataGraph
(
Just
"Preferences"
)
nodeGraphW
::
Maybe
Name
->
Maybe
HyperdataGraph
->
ParentId
->
UserId
->
NodeWrite'
nodeGraphW
maybeName
maybeGraph
pId
=
node
NodeGraph
name
graph
(
Just
pId
)
where
name
=
maybe
"Graph"
identity
maybeName
graph
=
maybe
arbitraryGraph
identity
maybeGraph
------------------------------------------------------------------------
arbitraryDashboard
::
HyperdataDashboard
arbitraryDashboard
=
HyperdataDashboard
(
Just
"Preferences"
)
nodeDashboardW
::
Maybe
Name
->
Maybe
HyperdataDashboard
->
ParentId
->
UserId
->
NodeWrite'
nodeDashboardW
maybeName
maybeDashboard
pId
=
node
NodeDashboard
name
dashboard
(
Just
pId
)
where
name
=
maybe
"Dashboard"
identity
maybeName
dashboard
=
maybe
arbitraryDashboard
identity
maybeDashboard
------------------------------------------------------------------------
node
::
(
ToJSON
a
,
Hyperdata
a
)
=>
NodeType
->
Name
->
a
->
Maybe
ParentId
->
UserId
->
NodeWrite'
node
nodeType
name
hyperData
parentId
userId
=
Node
Nothing
typeId
userId
parentId
name
Nothing
byteData
...
...
@@ -537,6 +560,13 @@ mkCorpus n h p u = insertNodesR' [nodeCorpusW n h p u]
mkList
::
ParentId
->
UserId
->
Cmd
[
Int
]
mkList
p
u
=
insertNodesR'
[
nodeListW
Nothing
Nothing
p
u
]
mkGraph
::
ParentId
->
UserId
->
Cmd
[
Int
]
mkGraph
p
u
=
insertNodesR'
[
nodeGraphW
Nothing
Nothing
p
u
]
mkDashboard
::
ParentId
->
UserId
->
Cmd
[
Int
]
mkDashboard
p
u
=
insertNodesR'
[
nodeDashboardW
Nothing
Nothing
p
u
]
-- | Default CorpusId Master and ListId Master
src/Gargantext/Database/Tree.hs
View file @
d10c458f
...
...
@@ -100,7 +100,7 @@ dbTree conn rootId = map (\(nId, tId, pId, n) -> DbTreeNode nId tId pId n) <$> q
UNION ALL
SELECT n.id, n.typename, n.parent_id, n.name
FROM nodes AS n JOIN descendants AS d ON n.parent_id = d.id
where n.typename in (2,3,30,31,5)
where n.typename in (2,3,30,31,5
,7,9
)
),
ancestors (id, typename, parent_id, name) AS
(
...
...
src/Gargantext/Database/Types/Node.hs
View file @
d10c458f
...
...
@@ -298,6 +298,11 @@ $(deriveJSON (unPrefix "hyperdataResource_") ''HyperdataResource)
instance
Hyperdata
HyperdataResource
------------------------------------------------------------------------
data
HyperdataDashboard
=
HyperdataDashboard
{
hyperdataDashboard_preferences
::
Maybe
Text
}
deriving
(
Show
,
Generic
)
$
(
deriveJSON
(
unPrefix
"hyperdataDashboard_"
)
''
H
yperdataDashboard
)
instance
Hyperdata
HyperdataDashboard
-- TODO add the Graph Structure here
data
HyperdataGraph
=
HyperdataGraph
{
hyperdataGraph_preferences
::
Maybe
Text
...
...
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