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
147
Issues
147
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
0e129af0
Commit
0e129af0
authored
Jun 18, 2018
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[BASHQL] Node' hierarchy (post/get/update semantics to get).
parent
bfd3789f
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
61 additions
and
17 deletions
+61
-17
Database.hs
src/Gargantext/Database.hs
+3
-15
Node.hs
src/Gargantext/Database/Node.hs
+58
-2
No files found.
src/Gargantext/Database.hs
View file @
0e129af0
...
...
@@ -82,6 +82,7 @@ type UserId = Int
-- List of NodeId
-- type PWD a = PWD UserId [a]
type
PWD
=
[
NodeId
]
--data PWD' a = a | PWD' [a]
-- | TODO get Children or Node
get
::
Connection
->
PWD
->
IO
[
Node
Value
]
...
...
@@ -145,26 +146,17 @@ ls' = do
h
<-
home
c
ls
c
h
type
Children
a
=
Maybe
a
post'
::
IO
Int64
post'
=
do
c
<-
connectGargandb
"gargantext.ini"
h
<-
home
c
let
userId
=
1
-- TODO semantic to achieve
-- post c h [ Corpus "name" "{}" NoChildren
-- , Project "name" "{}" (Children [Corpus "test 2" "" (Children [ Document "title" "metaData" NoChildren
-- , Document "title" "jsonData" NoChildren
-- ]
-- )
-- ]
-- )
-- ]
post
c
h
[
node
userId
(
last
h
)
Corpus
"name"
"{}"
,
node
userId
(
last
h
)
Project
"name"
"{}"
]
data
Children
a
=
NoChildren
|
Children
a
postR'
::
IO
[
Int
]
postR'
=
do
...
...
@@ -176,10 +168,6 @@ postR' = do
]
del'
::
[
NodeId
]
->
IO
Int
del'
ns
=
do
c
<-
connectGargandb
"gargantext.ini"
...
...
src/Gargantext/Database/Node.hs
View file @
0e129af0
...
...
@@ -236,9 +236,14 @@ getNodesWithType conn type_id = do
runQuery
conn
$
selectNodesWithType
type_id
type
UserId
=
NodeId
type
NodeWrite'
=
NodePoly
(
Maybe
Int
)
Int
Int
(
ParentId
)
Text
(
Maybe
UTCTime
)
ByteString
type
TypeId
=
Int
------------------------------------------------------------------------
-- Quick and dirty
------------------------------------------------------------------------
type
NodeWrite'
=
NodePoly
(
Maybe
Int
)
Int
Int
(
ParentId
)
Text
(
Maybe
UTCTime
)
ByteString
--node :: UserId -> ParentId -> NodeType -> Text -> Value -> NodeWrite'
node
::
UserId
->
ParentId
->
NodeType
->
Text
->
Value
->
NodeWrite'
node
userId
parentId
nodeType
name
nodeData
=
Node
Nothing
typeId
userId
parentId
name
Nothing
byteData
...
...
@@ -259,9 +264,60 @@ node2write pid (Node id tn ud _ nm dt hp) = ((pgInt4 <$> id)
mkNode
::
Connection
->
ParentId
->
[
NodeWrite'
]
->
IO
Int64
mkNode
conn
pid
ns
=
runInsertMany
conn
nodeTable'
$
map
(
node2write
pid
)
ns
mkNodeR
::
Connection
->
ParentId
->
[
NodeWrite'
]
->
IO
[
Int
]
mkNodeR
conn
pid
ns
=
runInsertManyReturning
conn
nodeTable'
(
map
(
node2write
pid
)
ns
)
(
\
(
i
,
_
,
_
,
_
,
_
,
_
,
_
)
->
i
)
------------------------------------------------------------------------
-- TODO Hierachy of Nodes
-- post and get same types Node' and update if changes
{- TODO semantic to achieve
post c uid pid [ Node' Corpus "name" "{}" []
, Node' Folder "name" "{}" [Node' Corpus "test 2" "" [ Node' Document "title" "metaData" []
, Node' Document "title" "jsonData" []
]
]
]
-}
------------------------------------------------------------------------
-- TODO
-- currently this function remove the child relation
-- needs a Temporary type between Node' and NodeWriteT
node2table'
::
UserId
->
ParentId
->
Node'
->
[
NodeWriteT
]
node2table'
uid
pid
(
Node'
nt
txt
v
[]
)
=
[(
Nothing
,
(
pgInt4
$
nodeTypeId
nt
),
(
pgInt4
uid
),
(
pgInt4
pid
)
,
pgStrictText
txt
,
Nothing
,
pgStrictJSONB
$
DB
.
pack
$
DBL
.
unpack
$
encode
v
)]
node2table'
uid
pid
(
Node'
nt
txt
v
(
c
:
cs
))
=
node2table'
uid
pid
(
Node'
nt
txt
v
[]
)
<>
node2table'
uid
pid
c
<>
node2table'
uid
pid
(
Node'
nt
txt
v
cs
)
nodes2table
::
UserId
->
ParentId
->
[
Node'
]
->
[[
NodeWriteT
]]
nodes2table
_
_
[]
=
[]
nodes2table
uid
pid
ns
=
map
(
node2table'
uid
pid
)
ns
data
Node'
=
Node'
{
_n_type
::
NodeType
,
_n_name
::
Text
,
_n_data
::
Value
,
_n_children
::
[
Node'
]
}
deriving
(
Show
)
type
NodeWriteT
=
(
Maybe
(
Column
PGInt4
)
,
Column
PGInt4
,
Column
PGInt4
,
Column
PGInt4
,
Column
PGText
,
Maybe
(
Column
PGTimestamptz
)
,
Column
PGJsonb
)
mkNode'
::
Connection
->
[
NodeWriteT
]
->
IO
Int64
mkNode'
conn
ns
=
runInsertMany
conn
nodeTable'
ns
mkNodeR'
::
Connection
->
[
NodeWriteT
]
->
IO
[
Int
]
mkNodeR'
conn
ns
=
runInsertManyReturning
conn
nodeTable'
ns
(
\
(
i
,
_
,
_
,
_
,
_
,
_
,
_
)
->
i
)
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