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
198
Issues
198
List
Board
Labels
Milestones
Merge Requests
12
Merge Requests
12
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
c38cd6a5
Commit
c38cd6a5
authored
Jul 08, 2020
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[CLEAN] NodeError sugar (msg)
parent
74722401
Changes
2
Show whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
17 additions
and
9 deletions
+17
-9
Share.hs
src/Gargantext/Database/Action/Share.hs
+9
-9
Error.hs
src/Gargantext/Database/Query/Table/Node/Error.hs
+8
-0
No files found.
src/Gargantext/Database/Action/Share.hs
View file @
c38cd6a5
...
@@ -21,7 +21,7 @@ import Gargantext.Database.Admin.Types.Node (NodeId)
...
@@ -21,7 +21,7 @@ import Gargantext.Database.Admin.Types.Node (NodeId)
import
Gargantext.Database.Admin.Types.Node
-- (NodeType(..))
import
Gargantext.Database.Admin.Types.Node
-- (NodeType(..))
import
Gargantext.Database.Prelude
(
Cmd
)
import
Gargantext.Database.Prelude
(
Cmd
)
import
Gargantext.Database.Query.Table.Node
(
getNode
,
getNodesWith
)
import
Gargantext.Database.Query.Table.Node
(
getNode
,
getNodesWith
)
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
)
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
,
msg
)
import
Gargantext.Database.Query.Table.NodeNode
(
insertNodeNode
,
deleteNodeNode
)
import
Gargantext.Database.Query.Table.NodeNode
(
insertNodeNode
,
deleteNodeNode
)
import
Gargantext.Database.Query.Tree.Root
(
getRootId
)
import
Gargantext.Database.Query.Tree.Root
(
getRootId
)
import
Gargantext.Database.Schema.Node
import
Gargantext.Database.Schema.Node
...
@@ -40,40 +40,40 @@ shareNodeWith n nt u = do
...
@@ -40,40 +40,40 @@ shareNodeWith n nt u = do
NodeFolderShared
->
do
NodeFolderShared
->
do
userIdCheck
<-
getUserId
u
userIdCheck
<-
getUserId
u
if
not
(
hasNodeType
nodeToCheck
NodeTeam
)
if
not
(
hasNodeType
nodeToCheck
NodeTeam
)
then
panic
"Can share node Team only"
then
msg
"Can share node Team only"
else
else
if
(
view
node_userId
nodeToCheck
==
userIdCheck
)
if
(
view
node_userId
nodeToCheck
==
userIdCheck
)
then
panic
"Can share to others only"
then
msg
"Can share to others only"
else
do
else
do
folderSharedId
<-
getFolderId
u
NodeFolderShared
folderSharedId
<-
getFolderId
u
NodeFolderShared
insertNodeNode
[
NodeNode
folderSharedId
n
Nothing
Nothing
]
insertNodeNode
[
NodeNode
folderSharedId
n
Nothing
Nothing
]
NodeFolderPublic
->
if
not
(
hasNodeType
nodeToCheck
NodeGraph
)
NodeFolderPublic
->
if
not
(
hasNodeType
nodeToCheck
NodeGraph
)
then
panic
"Can share node graph only"
then
msg
"Can share node graph only"
else
do
else
do
folderId
<-
getFolderId
(
UserDBId
$
view
node_userId
nodeToCheck
)
NodeFolderPublic
folderId
<-
getFolderId
(
UserDBId
$
view
node_userId
nodeToCheck
)
NodeFolderPublic
insertNodeNode
[
NodeNode
folderId
n
Nothing
Nothing
]
insertNodeNode
[
NodeNode
folderId
n
Nothing
Nothing
]
_
->
panic
"shareNodeWith not implemented with this NodeType"
_
->
msg
"shareNodeWith not implemented with this NodeType"
------------------------------------------------------------------------
------------------------------------------------------------------------
getFolderId
::
User
->
NodeType
->
Cmd
err
NodeId
getFolderId
::
HasNodeError
err
=>
User
->
NodeType
->
Cmd
err
NodeId
getFolderId
u
nt
=
do
getFolderId
u
nt
=
do
rootId
<-
getRootId
u
rootId
<-
getRootId
u
s
<-
getNodesWith
rootId
HyperdataAny
(
Just
nt
)
Nothing
Nothing
s
<-
getNodesWith
rootId
HyperdataAny
(
Just
nt
)
Nothing
Nothing
case
head
s
of
case
head
s
of
Nothing
->
panic
"No folder shared found"
Nothing
->
msg
"No folder shared found"
Just
f
->
pure
(
_node_id
f
)
Just
f
->
pure
(
_node_id
f
)
------------------------------------------------------------------------
------------------------------------------------------------------------
type
TeamId
=
NodeId
type
TeamId
=
NodeId
delFolderTeam
::
User
->
TeamId
->
Cmd
err
Int
delFolderTeam
::
HasNodeError
err
=>
User
->
TeamId
->
Cmd
err
Int
delFolderTeam
u
nId
=
do
delFolderTeam
u
nId
=
do
folderSharedId
<-
getFolderId
u
NodeFolderShared
folderSharedId
<-
getFolderId
u
NodeFolderShared
deleteNodeNode
folderSharedId
nId
deleteNodeNode
folderSharedId
nId
unPublish
::
User
->
NodeId
->
Cmd
err
Int
unPublish
::
HasNodeError
err
=>
User
->
NodeId
->
Cmd
err
Int
unPublish
u
nId
=
do
unPublish
u
nId
=
do
folderId
<-
getFolderId
u
NodeFolderPublic
folderId
<-
getFolderId
u
NodeFolderPublic
deleteNodeNode
folderId
nId
deleteNodeNode
folderId
nId
...
...
src/Gargantext/Database/Query/Table/Node/Error.hs
View file @
c38cd6a5
...
@@ -19,6 +19,7 @@ Portability : POSIX
...
@@ -19,6 +19,7 @@ Portability : POSIX
module
Gargantext.Database.Query.Table.Node.Error
where
module
Gargantext.Database.Query.Table.Node.Error
where
import
Data.Text
(
Text
)
import
Gargantext.Database.Admin.Types.Node
(
NodeId
)
import
Gargantext.Database.Admin.Types.Node
(
NodeId
)
import
Control.Lens
(
Prism
'
,
(
#
),
(
^?
))
import
Control.Lens
(
Prism
'
,
(
#
),
(
^?
))
import
Control.Monad.Error.Class
(
MonadError
(
..
))
import
Control.Monad.Error.Class
(
MonadError
(
..
))
...
@@ -39,6 +40,7 @@ data NodeError = NoListFound
...
@@ -39,6 +40,7 @@ data NodeError = NoListFound
|
ManyNodeUsers
|
ManyNodeUsers
|
DoesNotExist
NodeId
|
DoesNotExist
NodeId
|
NeedsConfiguration
|
NeedsConfiguration
|
NodeError
Text
instance
Show
NodeError
instance
Show
NodeError
where
where
...
@@ -56,10 +58,16 @@ instance Show NodeError
...
@@ -56,10 +58,16 @@ instance Show NodeError
show
ManyNodeUsers
=
"Many userNode/user"
show
ManyNodeUsers
=
"Many userNode/user"
show
(
DoesNotExist
n
)
=
"Node does not exist"
<>
show
n
show
(
DoesNotExist
n
)
=
"Node does not exist"
<>
show
n
show
NeedsConfiguration
=
"Needs configuration"
show
NeedsConfiguration
=
"Needs configuration"
show
(
NodeError
e
)
=
"NodeError: "
<>
cs
e
class
HasNodeError
e
where
class
HasNodeError
e
where
_NodeError
::
Prism'
e
NodeError
_NodeError
::
Prism'
e
NodeError
msg
::
(
MonadError
e
m
,
HasNodeError
e
)
=>
Text
->
m
a
msg
x
=
nodeError
(
NodeError
x
)
nodeError
::
(
MonadError
e
m
nodeError
::
(
MonadError
e
m
,
HasNodeError
e
)
,
HasNodeError
e
)
=>
NodeError
->
m
a
=>
NodeError
->
m
a
...
...
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