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
Julien Moutinho
haskell-gargantext
Commits
65978a65
Commit
65978a65
authored
Oct 15, 2018
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[API/Database] mk/post Node.
parent
f40b051d
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
45 additions
and
21 deletions
+45
-21
Node.hs
src/Gargantext/API/Node.hs
+31
-14
Bashql.hs
src/Gargantext/Database/Bashql.hs
+8
-7
Node.hs
src/Gargantext/Database/Node.hs
+6
-0
No files found.
src/Gargantext/API/Node.hs
View file @
65978a65
...
...
@@ -46,7 +46,7 @@ import Gargantext.Database.Types.Node
import
Gargantext.Database.Node
(
runCmd
,
getNodesWithParentId
,
getNode
,
getNodesWith
,
deleteNode
,
deleteNodes
)
,
deleteNode
,
deleteNodes
,
mk
)
import
qualified
Gargantext.Database.Node.Update
as
U
(
update
,
Update
(
..
))
import
Gargantext.Database.Facet
(
FacetDoc
,
getDocFacet
,
FacetChart
)
...
...
@@ -71,21 +71,38 @@ type Roots = Get '[JSON] [Node Value]
type
NodesAPI
=
Delete
'[
J
SON
]
Int
------------------------------------------------------------------------
------------------------------------------------------------------------
data
RenameNode
=
RenameNode
{
r_name
::
Text
}
deriving
(
Generic
)
instance
FromJSON
RenameNode
instance
ToJSON
RenameNode
instance
ToSchema
RenameNode
instance
Arbitrary
RenameNode
where
arbitrary
=
elements
[
RenameNode
"test"
]
------------------------------------------------------------------------
data
Rename
=
Rename
{
name
::
Text
}
data
PostNode
=
PostNode
{
pn_name
::
Text
,
pn_typename
::
NodeType
}
deriving
(
Generic
)
instance
FromJSON
Renam
e
instance
ToJSON
Renam
e
instance
ToSchema
Renam
e
instance
Arbitrary
Renam
e
where
arbitrary
=
elements
[
Rename
"test"
]
instance
FromJSON
PostNod
e
instance
ToJSON
PostNod
e
instance
ToSchema
PostNod
e
instance
Arbitrary
PostNod
e
where
arbitrary
=
elements
[
PostNode
"Node test"
NodeCorpus
]
------------------------------------------------------------------------
------------------------------------------------------------------------
type
NodeAPI
=
Get
'[
J
SON
]
(
Node
Value
)
:<|>
"rename"
:>
Summary
" Rename
Node"
:>
ReqBody
'[
J
SON
]
Rename
:<|>
"rename"
:>
Summary
" Rename
Node Node"
:>
ReqBody
'[
J
SON
]
Rename
Node
:>
Put
'[
J
SON
]
[
Int
]
:<|>
Post
'[
J
SON
]
Int
:<|>
Summary
" PostNode Node with ParentId as {id}"
:>
ReqBody
'[
J
SON
]
PostNode
:>
Post
'[
J
SON
]
Int
:<|>
Put
'[
J
SON
]
Int
:<|>
Delete
'[
J
SON
]
Int
:<|>
"children"
:>
Summary
" Summary children"
...
...
@@ -163,14 +180,14 @@ nodeAPI conn id = liftIO (putStrLn ("/node" :: Text) >> getNode co
-- :<|> query
-- | Check if the name is less than 255 char
--rename :: Connection -> NodeId -> Rename -> Server NodeAPI
rename
::
Connection
->
NodeId
->
Rename
->
Handler
[
Int
]
rename
c
nId
(
Rename
name
)
=
liftIO
$
U
.
update
(
U
.
Rename
nId
name
)
c
rename
::
Connection
->
NodeId
->
Rename
Node
->
Handler
[
Int
]
rename
c
nId
(
Rename
Node
name
)
=
liftIO
$
U
.
update
(
U
.
Rename
nId
name
)
c
nodesAPI
::
Connection
->
[
NodeId
]
->
Server
NodesAPI
nodesAPI
conn
ids
=
deleteNodes'
conn
ids
postNode
::
Connection
->
NodeId
->
Handler
Int
postNode
=
undefined
-- TODO
postNode
::
Connection
->
NodeId
->
PostNode
->
Handler
Int
postNode
c
pId
(
PostNode
name
nt
)
=
liftIO
$
mk
c
pId
nt
name
putNode
::
Connection
->
NodeId
->
Handler
Int
putNode
=
undefined
-- TODO
...
...
src/Gargantext/Database/Bashql.hs
View file @
65978a65
...
...
@@ -148,24 +148,25 @@ put u = mkCmd $ U.update u
-- jump NodeId
-- touch Dir
type
Corpus
Name
=
Text
type
Name
=
Text
mkCorpus
::
ToJSON
a
=>
CorpusName
->
(
a
->
Text
)
->
[
a
]
->
Cmd
NewNode
mkCorpus
corpusName
title
ns
=
do
mkCorpus
::
ToJSON
a
=>
Name
->
(
a
->
Text
)
->
[
a
]
->
Cmd
NewNode
mkCorpus
name
title
ns
=
do
pid
<-
last
<$>
home
let
uid
=
1
postNode
uid
pid
(
Node'
NodeCorpus
corpusN
ame
emptyObject
postNode
uid
pid
(
Node'
NodeCorpus
n
ame
emptyObject
(
map
(
\
n
->
Node'
Document
(
title
n
)
(
toJSON
n
)
[]
)
ns
)
)
-- |
-- import IMTClient as C
-- postAnnuaire "Annuaire IMT" (\n -> (maybe "" identity (C.prenom n)) <> " " <> (maybe "" identity (C.nom n))) (take 30 annuaire)
postAnnuaire
::
ToJSON
a
=>
Corpus
Name
->
(
a
->
Text
)
->
[
a
]
->
Cmd
NewNode
postAnnuaire
corpusN
ame
title
ns
=
do
postAnnuaire
::
ToJSON
a
=>
Name
->
(
a
->
Text
)
->
[
a
]
->
Cmd
NewNode
postAnnuaire
n
ame
title
ns
=
do
pid
<-
last
<$>
home
let
uid
=
1
postNode
uid
pid
(
Node'
Annuaire
corpusN
ame
emptyObject
postNode
uid
pid
(
Node'
Annuaire
n
ame
emptyObject
(
map
(
\
n
->
Node'
UserPage
(
title
n
)
(
toJSON
n
)
[]
)
ns
)
)
...
...
src/Gargantext/Database/Node.hs
View file @
65978a65
...
...
@@ -396,3 +396,9 @@ childWith uId pId (Node' Document txt v []) = node2table uId pId (Node' Document
childWith
uId
pId
(
Node'
UserPage
txt
v
[]
)
=
node2table
uId
pId
(
Node'
UserPage
txt
v
[]
)
childWith
_
_
(
Node'
_
_
_
_
)
=
panic
"This NodeType can not be a child"
mk
::
Connection
->
ParentId
->
NodeType
->
Text
->
IO
Int
mk
c
pId
nt
name
=
fromIntegral
<$>
mkNode
pId
[
node
1
pId
nt
name
""
]
c
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