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
148
Issues
148
List
Board
Labels
Milestones
Merge Requests
7
Merge Requests
7
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
3c15465f
Commit
3c15465f
authored
Apr 24, 2024
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Plain Diff
Merge remote-tracking branch 'origin/dev-breadcrumbs-fix' into dev
parents
cd0fea68
b0f85b12
Changes
5
Show whitespace changes
Inline
Side-by-side
Showing
5 changed files
with
90 additions
and
58 deletions
+90
-58
GraphQL.hs
src/Gargantext/API/GraphQL.hs
+2
-0
Node.hs
src/Gargantext/API/GraphQL/Node.hs
+33
-17
PolicyCheck.hs
src/Gargantext/API/GraphQL/PolicyCheck.hs
+5
-5
TreeFirstLevel.hs
src/Gargantext/API/GraphQL/TreeFirstLevel.hs
+34
-31
Node.hs
src/Gargantext/Database/Query/Table/Node.hs
+16
-5
No files found.
src/Gargantext/API/GraphQL.hs
View file @
3c15465f
...
...
@@ -70,6 +70,7 @@ data Query m
,
languages
::
m
[
GQLNLP
.
LanguageTuple
]
,
nodes
::
GQLNode
.
NodeArgs
->
m
[
GQLNode
.
Node
]
,
nodes_corpus
::
GQLNode
.
CorpusArgs
->
m
[
GQLNode
.
Corpus
]
,
node_children
::
GQLNode
.
NodeChildrenArgs
->
m
[
GQLNode
.
Node
]
,
node_parent
::
GQLNode
.
NodeParentArgs
->
m
[
GQLNode
.
Node
]
,
user_infos
::
GQLUserInfo
.
UserInfoArgs
->
m
[
GQLUserInfo
.
UserInfo
]
,
users
::
GQLUser
.
UserArgs
->
m
[
GQLUser
.
User
m
]
...
...
@@ -121,6 +122,7 @@ rootResolver authenticatedUser policyManager =
,
languages
=
GQLNLP
.
resolveLanguages
,
nodes
=
GQLNode
.
resolveNodes
authenticatedUser
policyManager
,
nodes_corpus
=
GQLNode
.
resolveNodesCorpus
,
node_children
=
GQLNode
.
resolveNodeChildren
,
node_parent
=
GQLNode
.
resolveNodeParent
,
user_infos
=
GQLUserInfo
.
resolveUserInfos
authenticatedUser
policyManager
,
users
=
GQLUser
.
resolveUsers
authenticatedUser
policyManager
...
...
src/Gargantext/API/GraphQL/Node.hs
View file @
3c15465f
...
...
@@ -14,23 +14,21 @@ Portability : POSIX
module
Gargantext.API.GraphQL.Node
where
import
Data.Aeson
import
Data.Aeson
(
Result
(
..
),
Value
(
..
)
)
import
Data.Aeson.KeyMap
qualified
as
KM
import
Data.Morpheus.Types
(
GQLType
)
import
Data.Text
qualified
as
T
import
Gargantext.API.Admin.Auth.Types
import
Gargantext.API.Auth.PolicyCheck
import
Gargantext.API.Admin.Auth.Types
(
AuthenticatedUser
)
import
Gargantext.API.Auth.PolicyCheck
(
nodeChecks
,
AccessPolicyManager
)
import
Gargantext.API.GraphQL.PolicyCheck
(
withPolicy
)
import
Gargantext.API.GraphQL.Types
import
Gargantext.Core
import
Gargantext.API.GraphQL.Types
(
GqlM
)
import
Gargantext.Core
(
HasDBid
(
lookupDBid
)
)
import
Gargantext.Database.Admin.Types.Node
(
NodeType
)
import
Gargantext.Database.Admin.Types.Node
qualified
as
NN
import
Gargantext.Database.Prelude
(
CmdCommon
)
-- , JSONB)
import
Gargantext.Database.Query.Table.Node
(
getClosestParentIdByType
,
getNode
)
import
Gargantext.Database.Query.Table.Node
(
getClosest
ChildrenByType
,
getClosest
ParentIdByType
,
getNode
)
import
Gargantext.Database.Schema.Node
qualified
as
N
import
Gargantext.Prelude
import
PUBMED.Types
qualified
as
PUBMED
import
Prelude
qualified
data
Corpus
=
Corpus
{
id
::
Int
...
...
@@ -89,7 +87,13 @@ dbNodesCorpus corpus_id = do
data
NodeParentArgs
=
NodeParentArgs
{
node_id
::
Int
,
parent_type
::
Text
,
parent_type
::
NodeType
}
deriving
(
Generic
,
GQLType
)
data
NodeChildrenArgs
=
NodeChildrenArgs
{
node_id
::
Int
,
child_type
::
NodeType
}
deriving
(
Generic
,
GQLType
)
resolveNodeParent
...
...
@@ -97,16 +101,21 @@ resolveNodeParent
=>
NodeParentArgs
->
GqlM
e
env
[
Node
]
resolveNodeParent
NodeParentArgs
{
node_id
,
parent_type
}
=
dbParentNodes
node_id
parent_type
resolveNodeChildren
::
(
CmdCommon
env
)
=>
NodeChildrenArgs
->
GqlM
e
env
[
Node
]
resolveNodeChildren
NodeChildrenArgs
{
node_id
,
child_type
}
=
dbChildNodes
node_id
child_type
dbParentNodes
::
(
CmdCommon
env
)
=>
Int
->
Text
->
GqlM
e
env
[
Node
]
dbParentNodes
node_id
parent
_t
ype
=
do
let
mParentType
=
readEither
(
T
.
unpack
parent_type
)
::
Either
Prelude
.
String
NodeType
case
mParentType
of
Left
err
->
do
lift
$
printDebug
"[dbParentNodes] error reading parent type"
(
T
.
pack
err
)
pure
[]
Right
parentType
->
do
=>
Int
->
NodeType
->
GqlM
e
env
[
Node
]
dbParentNodes
node_id
parent
T
ype
=
do
--
let mParentType = readEither (T.unpack parent_type) :: Either Prelude.String NodeType
--
case mParentType of
--
Left err -> do
--
lift $ printDebug "[dbParentNodes] error reading parent type" (T.pack err)
--
pure []
--
Right parentType -> do
mNodeId
<-
lift
$
getClosestParentIdByType
(
NN
.
UnsafeMkNodeId
node_id
)
parentType
-- (fromNodeTypeId parent_type_id)
case
mNodeId
of
Nothing
->
pure
[]
...
...
@@ -114,6 +123,13 @@ dbParentNodes node_id parent_type = do
node
<-
lift
$
getNode
id
pure
[
toNode
node
]
dbChildNodes
::
(
CmdCommon
env
)
=>
Int
->
NodeType
->
GqlM
e
env
[
Node
]
dbChildNodes
node_id
childType
=
do
childIds
<-
lift
$
getClosestChildrenByType
(
NN
.
UnsafeMkNodeId
node_id
)
childType
-- (fromNodeTypeId parent_type_id)
children
<-
lift
$
mapM
getNode
childIds
pure
$
toNode
<$>
children
toNode
::
NN
.
Node
json
->
Node
toNode
N
.
Node
{
..
}
=
Node
{
id
=
nid
,
name
=
_node_name
...
...
src/Gargantext/API/GraphQL/PolicyCheck.hs
View file @
3c15465f
...
...
@@ -3,11 +3,11 @@ module Gargantext.API.GraphQL.PolicyCheck where
import
Prelude
import
Control.Monad.Except
import
Gargantext.API.Admin.Auth.Types
import
Gargantext.API.Auth.PolicyCheck
import
Gargantext.API.Errors.Types
import
Gargantext.API.GraphQL.Types
import
Control.Monad.Except
(
MonadError
(
..
),
MonadTrans
(
..
))
import
Gargantext.API.Admin.Auth.Types
(
AuthenticatedUser
)
import
Gargantext.API.Auth.PolicyCheck
(
BoolExpr
,
AccessCheck
,
AccessPolicyManager
(
..
),
AccessResult
(
..
))
import
Gargantext.API.Errors.Types
(
BackendInternalError
(
..
)
)
import
Gargantext.API.GraphQL.Types
(
GqlM
)
import
Gargantext.Database.Prelude
(
HasConnectionPool
,
HasConfig
)
withPolicy
::
(
HasConnectionPool
env
,
HasConfig
env
)
...
...
src/Gargantext/API/GraphQL/TreeFirstLevel.hs
View file @
3c15465f
...
...
@@ -15,15 +15,15 @@ Portability : POSIX
module
Gargantext.API.GraphQL.TreeFirstLevel
where
import
Data.Morpheus.Types
(
GQLType
)
import
Gargantext.API.Admin.Auth.Types
import
Gargantext.API.Auth.PolicyCheck
import
Gargantext.API.GraphQL.PolicyCheck
import
Gargantext.API.GraphQL.Types
import
Gargantext.API.Admin.Auth.Types
(
AuthenticatedUser
)
import
Gargantext.API.Auth.PolicyCheck
(
AccessPolicyManager
,
nodeChecks
)
import
Gargantext.API.GraphQL.PolicyCheck
(
withPolicy
)
import
Gargantext.API.GraphQL.Types
(
GqlM
)
import
Gargantext.Core
(
fromDBid
)
import
Gargantext.Core.Types
(
Tree
,
NodeTree
,
NodeType
)
import
Gargantext.Core.Types.Main
(
Tree
(
TreeN
),
_tn_node
,
_tn_children
,
NodeTree
(
NodeTree
,
_nt_id
,
_nt_type
),
_nt_name
)
-- import Gargantext.Core.Types (ContextId, CorpusId, ListId
)
import
Gargantext.Core.Types.Main
(
Tree
(
..
),
_tn_node
,
_tn_children
,
NodeTree
(
..
),
_nt_name
)
import
Gargantext.Database.Admin.Config
()
import
Gargantext.Database.Admin.Types.Node
(
allNodeTypes
,
NodeId
(
UnsafeMkNodeId
)
)
import
Gargantext.Database.Admin.Types.Node
(
allNodeTypes
,
NodeId
(
..
),
NodeType
)
import
Gargantext.Database.Admin.Types.Node
qualified
as
NN
import
Gargantext.Database.Prelude
(
CmdCommon
)
import
Gargantext.Database.Query.Table.Node
(
getNode
)
...
...
@@ -52,6 +52,7 @@ data TreeFirstLevel m = TreeFirstLevel
,
children
::
[
TreeNode
]
}
deriving
(
Generic
,
GQLType
)
data
BreadcrumbArgs
=
BreadcrumbArgs
{
node_id
::
Int
...
...
@@ -105,7 +106,8 @@ resolveParent Nothing = pure Nothing
nodeToTreeNode
::
HasCallStack
=>
NN
.
Node
json
->
Maybe
TreeNode
nodeToTreeNode
N
.
Node
{
..
}
=
if
(
fromDBid
_node_typename
/=
NN
.
NodeFolderShared
)
&&
(
fromDBid
_node_typename
/=
NN
.
NodeTeam
)
nodeToTreeNode
N
.
Node
{
..
}
=
if
(
fromDBid
_node_typename
/=
NN
.
NodeFolderShared
)
&&
(
fromDBid
_node_typename
/=
NN
.
NodeTeam
)
then
Just
TreeNode
{
id
=
NN
.
unNodeId
_node_id
,
name
=
_node_name
...
...
@@ -115,21 +117,22 @@ nodeToTreeNode N.Node {..} = if (fromDBid _node_typename /= NN.NodeFolderShared)
else
Nothing
resolveBreadcrumb
::
(
CmdCommon
env
)
=>
BreadcrumbArgs
->
GqlM
e
env
(
BreadcrumbInfo
)
resolveBreadcrumb
::
(
CmdCommon
env
)
=>
BreadcrumbArgs
->
GqlM
e
env
BreadcrumbInfo
resolveBreadcrumb
BreadcrumbArgs
{
node_id
}
=
dbRecursiveParents
node_id
convertDbTreeToTreeNode
::
HasCallStack
=>
T
.
DbTreeNode
->
TreeNode
convertDbTreeToTreeNode
T
.
DbTreeNode
{
_dt_name
,
_dt_nodeId
,
_dt_typeId
,
_dt_parentId
}
=
TreeNode
convertDbTreeToTreeNode
T
.
DbTreeNode
{
_dt_name
,
_dt_nodeId
,
_dt_typeId
,
_dt_parentId
}
=
TreeNode
{
name
=
_dt_name
,
id
=
NN
.
unNodeId
_dt_nodeId
,
node_type
=
fromDBid
_dt_typeId
,
parent_id
=
NN
.
unNodeId
<$>
_dt_parentId
}
dbRecursiveParents
::
(
CmdCommon
env
)
=>
Int
->
GqlM
e
env
(
BreadcrumbInfo
)
dbRecursiveParents
node_id
=
do
let
nId
=
UnsafeMkNodeId
node_id
dbRecursiveParents
::
(
CmdCommon
env
)
=>
Int
->
GqlM
e
env
BreadcrumbInfo
dbRecursiveParents
nodeId
=
do
let
nId
=
UnsafeMkNodeId
nodeId
dbParents
<-
lift
$
T
.
recursiveParents
nId
allNodeTypes
let
treeNodes
=
map
convertDbTreeToTreeNode
dbParents
let
breadcrumbInfo
=
BreadcrumbInfo
{
parents
=
treeNodes
}
pure
breadcrumbInfo
pure
$
BreadcrumbInfo
{
parents
=
treeNodes
}
src/Gargantext/Database/Query/Table/Node.hs
View file @
3c15465f
...
...
@@ -173,15 +173,26 @@ getChildrenByType :: HasDBid NodeType
->
NodeType
->
DBCmd
err
[
NodeId
]
getChildrenByType
nId
nType
=
do
result
<-
runPGSQuery
query
(
PGS
.
Only
nId
)
children_lst
<-
mapM
(
\
(
id
,
_
)
->
getChildrenByType
id
nType
)
result
pure
$
concat
$
[
fst
<$>
filter
(
\
(
_
,
pTypename
)
->
pTypename
==
toDBid
nType
)
result
]
++
children_lst
childrenFirstLevel
<-
getClosestChildrenByType
nId
nType
childrenLst
<-
mapM
(
\
id
->
getChildrenByType
id
nType
)
childrenFirstLevel
pure
$
childrenFirstLevel
++
concat
childrenLst
-- | Given a node id, find all it's children (only first level) of
-- given node type.
getClosestChildrenByType
::
HasDBid
NodeType
=>
NodeId
->
NodeType
->
DBCmd
err
[
NodeId
]
getClosestChildrenByType
nId
nType
=
do
results
<-
runPGSQuery
query
(
nId
,
toDBid
nType
)
pure
$
(
\
(
PGS
.
Only
nodeId
)
->
nodeId
)
<$>
results
where
query
::
PGS
.
Query
query
=
[
sql
|
SELECT n.id
, n.typename
SELECT n.id
FROM nodes n
WHERE n.parent_id = ?;
WHERE n.parent_id = ?
AND n.typename = ?;
|]
------------------------------------------------------------------------
...
...
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