Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
H
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
Przemyslaw Kaminski
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