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
Christian Merten
haskell-gargantext
Commits
3fa76e98
Commit
3fa76e98
authored
Jun 01, 2022
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[FEAT] Team Management : list members of a team
parent
17d0cdba
Changes
6
Hide whitespace changes
Inline
Side-by-side
Showing
6 changed files
with
102 additions
and
19 deletions
+102
-19
gargantext.cabal
gargantext.cabal
+1
-1
Share.hs
src/Gargantext/Database/Action/Share.hs
+55
-3
Join.hs
src/Gargantext/Database/Query/Join.hs
+23
-0
Node.hs
src/Gargantext/Database/Query/Table/Node.hs
+0
-2
NodeNode.hs
src/Gargantext/Database/Query/Table/NodeNode.hs
+18
-13
Types.hs
src/Gargantext/Database/Types.hs
+5
-0
No files found.
gargantext.cabal
View file @
3fa76e98
...
...
@@ -5,7 +5,7 @@ cabal-version: 1.12
-- see: https://github.com/sol/hpack
name: gargantext
version: 0.0.5.8.9.3
version:
0.0.5.8.9.3
synopsis: Search, map, share
description: Please see README.md
category: Data
...
...
src/Gargantext/Database/Action/Share.hs
View file @
3fa76e98
...
...
@@ -10,22 +10,30 @@ Portability : POSIX
-}
{-# LANGUAGE Arrows #-}
module
Gargantext.Database.Action.Share
where
import
Control.Lens
(
view
)
import
Gargantext.Database
import
Control.Arrow
(
returnA
)
import
Control.Lens
(
view
,
(
^.
))
import
Data.Text
(
Text
)
import
Gargantext.Core.Types.Individu
(
User
(
..
))
import
Gargantext.Database
import
Gargantext.Database.Action.User
(
getUserId
)
import
Gargantext.Database.Admin.Config
(
hasNodeType
,
isInNodeTypes
)
import
Gargantext.Database.Admin.Types.Hyperdata
(
HyperdataAny
(
..
))
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Query.Join
(
leftJoin3'
)
import
Gargantext.Database.Query.Table.Node
(
getNode
,
getNodesWith
)
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
,
errorWith
)
import
Gargantext.Database.Query.Table.NodeNode
(
deleteNodeNode
)
import
Gargantext.Database.Query.Table.NodeNode
(
deleteNodeNode
,
queryNodeNodeTable
)
import
Gargantext.Database.Query.Table.User
import
Gargantext.Database.Query.Tree.Root
(
getRootId
)
import
Gargantext.Database.Schema.Node
import
Gargantext.Prelude
import
Opaleye
hiding
(
not
)
import
qualified
Opaleye
as
O
-- | TODO move in PhyloConfig of Gargantext
publicNodeTypes
::
[
NodeType
]
...
...
@@ -39,6 +47,50 @@ data ShareNodeWith = ShareNodeWith_User { snwu_nodetype :: NodeType
,
snwn_node_id
::
NodeId
}
------------------------------------------------------------------------
todo
::
a
todo
=
undefined
deleteMemberShip
::
HasNodeError
err
=>
[
SharedFolderId
]
->
Cmd
err
Int
deleteMemberShip
=
todo
------------------------------------------------------------------------
type
SharedFolderId
=
NodeId
type
TeamNodeId
=
NodeId
-- List members of a Team
-- Result gives the username and its SharedFolderId that has to be eventually
-- used for the membership
membersOf
::
HasNodeError
err
=>
TeamNodeId
->
Cmd
err
[(
Text
,
SharedFolderId
)]
membersOf
nId
=
runOpaQuery
(
membersOfQuery
nId
)
membersOfQuery
::
TeamNodeId
->
SelectArr
()
(
Column
(
Nullable
SqlText
),
Column
(
Nullable
SqlInt4
))
membersOfQuery
(
NodeId
sharedFolderId
)
=
proc
()
->
do
(
nn
,
(
n
,
u
))
<-
nodeNode_node_User
-<
()
restrict
-<
nn
^.
nn_node2_id
.==
sqlInt4
sharedFolderId
returnA
-<
(
user_username
u
,
n
^.
node_id
)
nodeNode_node_User
::
O
.
Select
(
NodeNodeRead
,
(
NodeReadNull
,
UserReadNull
))
nodeNode_node_User
=
leftJoin3'
queryNodeNodeTable
queryNodeTable
queryUserTable
cond12
cond23
where
cond12
::
(
NodeNodeRead
,
(
NodeRead
,
UserReadNull
))
->
Column
SqlBool
cond12
(
nn
,
(
n
,
_u
))
=
(
nn
^.
nn_node1_id
.==
n
^.
node_id
)
cond23
::
(
NodeRead
,
UserRead
)
->
Column
SqlBool
cond23
(
n
,
u
)
=
(
n
^.
node_user_id
.==
user_id
u
)
------------------------------------------------------------------------
-- To Share a Node Team with a user, use this function
-- basically used with the invitation to a team
shareNodeWith
::
HasNodeError
err
=>
ShareNodeWith
->
NodeId
...
...
src/Gargantext/Database/Query/Join.hs
View file @
3fa76e98
...
...
@@ -24,7 +24,9 @@ Multiple Join functions with Opaleye.
module
Gargantext.Database.Query.Join
(
leftJoin2
,
leftJoin3
,
leftJoin3'
,
leftJoin4
,
leftJoin4'
,
leftJoin5
,
leftJoin6
,
leftJoin7
...
...
@@ -64,6 +66,27 @@ leftJoin3 :: Select columnsA -> Select columnsB -> Select columnsC
leftJoin3
q1
q2
q3
cond
=
((,,)
<$>
q1
<*>
q2
<*>
q3
)
>>>
keepWhen
cond
leftJoin3'
::
(
Default
Unpackspec
b2
b2
,
Default
Unpackspec
b3
b3
,
Default
Unpackspec
fieldsL
fieldsL
,
Default
Unpackspec
fieldsR
fieldsR
,
Default
NullMaker
b3
b4
,
Default
NullMaker
b2
b5
,
Default
NullMaker
fieldsR
b2
)
=>
Select
fieldsL
->
Select
b3
->
Select
fieldsR
->
((
fieldsL
,
(
b3
,
b2
))
->
Column
SqlBool
)
->
((
b3
,
fieldsR
)
->
Column
SqlBool
)
->
Select
(
fieldsL
,
(
b4
,
b5
))
leftJoin3'
q1
q2
q3
cond12
cond23
=
leftJoin
q1
(
leftJoin
q2
q3
cond23
)
cond12
leftJoin4'
::
Select
columnsA
->
Select
columnsB
->
Select
columnsC
->
Select
columnsD
->
((
columnsA
,
columnsB
,
columnsC
,
columnsD
)
->
Column
SqlBool
)
->
Select
(
columnsA
,
columnsB
,
columnsC
,
columnsD
)
leftJoin4'
q1
q2
q3
q4
cond
=
((,,,)
<$>
q1
<*>
q2
<*>
q3
<*>
q4
)
>>>
keepWhen
cond
leftJoin4
::
(
Default
Unpackspec
b2
b2
,
Default
Unpackspec
fieldsL
fieldsL
,
Default
Unpackspec
b3
b3
,
Default
Unpackspec
b4
b4
,
Default
Unpackspec
b5
b5
,
...
...
src/Gargantext/Database/Query/Table/Node.hs
View file @
3fa76e98
...
...
@@ -9,7 +9,6 @@ Stability : experimental
Portability : POSIX
-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE Arrows #-}
...
...
@@ -42,7 +41,6 @@ import Gargantext.Database.Query.Table.Node.Error
import
Gargantext.Database.Schema.Node
import
Gargantext.Prelude
hiding
(
sum
,
head
)
queryNodeSearchTable
::
Select
NodeSearchRead
queryNodeSearchTable
=
selectTable
nodeTableSearch
...
...
src/Gargantext/Database/Query/Table/NodeNode.hs
View file @
3fa76e98
{-|
Module : Gargantext.Database.Select.Table.NodeNode
{-| Module : Gargantext.Database.Select.Table.NodeNode
Description :
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
...
...
@@ -106,26 +105,32 @@ type Node2_Id = NodeId
deleteNodeNode
::
Node1_Id
->
Node2_Id
->
Cmd
err
Int
deleteNodeNode
n1
n2
=
mkCmd
$
\
conn
->
fromIntegral
<$>
runDelete_
conn
(
Delete
nodeNodeTable
(
\
(
NodeNode
n1_id
n2_id
_
_
)
->
n1_id
.==
pgNodeId
n1
.&&
n2_id
.==
pgNodeId
n2
)
rCount
)
(
Delete
nodeNodeTable
(
\
(
NodeNode
n1_id
n2_id
_
_
)
->
n1_id
.==
pgNodeId
n1
.&&
n2_id
.==
pgNodeId
n2
)
rCount
)
------------------------------------------------------------------------
selectPublicNodes
::
HasDBid
NodeType
=>
(
Hyperdata
a
,
DefaultFromField
SqlJsonb
a
)
selectPublicNodes
::
HasDBid
NodeType
=>
(
Hyperdata
a
,
DefaultFromField
SqlJsonb
a
)
=>
Cmd
err
[(
Node
a
,
Maybe
Int
)]
selectPublicNodes
=
runOpaQuery
(
queryWithType
NodeFolderPublic
)
queryWithType
::
HasDBid
NodeType
=>
NodeType
->
O
.
Select
(
NodeRead
,
Column
(
Nullable
SqlInt4
))
queryWithType
::
HasDBid
NodeType
=>
NodeType
->
O
.
Select
(
NodeRead
,
Column
(
Nullable
SqlInt4
))
queryWithType
nt
=
proc
()
->
do
(
n
,
nn
)
<-
joinOn1
-<
()
(
n
,
nn
)
<-
node_NodeNode
-<
()
restrict
-<
n
^.
node_typename
.==
(
sqlInt4
$
toDBid
nt
)
returnA
-<
(
n
,
nn
^.
nn_node2_id
)
joinOn1
::
O
.
Select
(
NodeRead
,
NodeNodeReadNull
)
joinOn1
=
leftJoin
queryNodeTable
queryNodeNodeTable
cond
node_NodeNode
::
O
.
Select
(
NodeRead
,
NodeNodeReadNull
)
node_NodeNode
=
leftJoin
queryNodeTable
queryNodeNodeTable
cond
where
cond
::
(
NodeRead
,
NodeNodeRead
)
->
Column
SqlBool
cond
(
n
,
nn
)
=
nn
^.
nn_node1_id
.==
n
^.
node_id
src/Gargantext/Database/Types.hs
View file @
3fa76e98
...
...
@@ -15,6 +15,7 @@ Portability : POSIX
module
Gargantext.Database.Types
where
import
Data.Text
(
Text
)
import
Data.Hashable
(
Hashable
)
import
Gargantext.Core.Text
(
HasText
(
..
))
import
Gargantext.Database.Schema.Prelude
...
...
@@ -57,3 +58,7 @@ instance DefaultFromField SqlFloat8 (Maybe Double) where
instance
DefaultFromField
SqlInt4
(
Maybe
Int
)
where
defaultFromField
=
fromPGSFromField
instance
DefaultFromField
(
Nullable
SqlText
)
Text
where
defaultFromField
=
fromPGSFromField
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