1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
{-|
Module : Gargantext.API.GraphQL.TreeFirstLevel
Description :
Copyright : (c) CNRS, 2017
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DuplicateRecordFields #-}
module Gargantext.API.GraphQL.TreeFirstLevel where
import Data.Morpheus.Types (GQLType)
import Gargantext.API.Admin.Auth.Types ( AuthenticatedUser(..) )
import Gargantext.API.Auth.PolicyCheck (AccessPolicyManager, nodeReadChecks)
import Gargantext.API.GraphQL.PolicyCheck (withPolicy)
import Gargantext.API.GraphQL.Types ( GqlM )
import Gargantext.Core (fromDBid)
-- 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(..), NodeType)
import Gargantext.Database.Admin.Types.Node qualified as NN
import Gargantext.Database.Prelude (IsDBEnvExtra)
import Gargantext.Database.Query.Table.Node (getNode)
import Gargantext.Database.Query.Tree qualified as T
import Gargantext.Database.Schema.Node (NodePoly(_node_parent_id))
import Gargantext.Database.Schema.Node qualified as N
import Gargantext.Prelude
data TreeArgs = TreeArgs
{
root_id :: Int
} deriving (Generic, GQLType)
data TreeNode = TreeNode
{
name :: Text
, id :: Int
, node_type :: NodeType
, parent_id :: Maybe Int
} deriving (Generic, GQLType)
data TreeFirstLevel m = TreeFirstLevel
{
root :: TreeNode
, parent :: m (Maybe TreeNode)
, children :: [TreeNode]
} deriving (Generic, GQLType)
data BreadcrumbArgs = BreadcrumbArgs
{
node_id :: Int
} deriving (Generic, GQLType)
data BreadcrumbInfo = BreadcrumbInfo
{
parents :: [TreeNode]
} deriving (Generic, GQLType)
type ParentId = Maybe NodeId
resolveTree :: (IsDBEnvExtra env)
=> AuthenticatedUser
-> AccessPolicyManager
-> TreeArgs
-> GqlM e env (TreeFirstLevel (GqlM e env))
resolveTree autUser mgr TreeArgs { root_id } =
withPolicy autUser mgr (nodeReadChecks $ UnsafeMkNodeId root_id) $ dbTree (_auth_user_id autUser) root_id
dbTree :: (IsDBEnvExtra env) =>
NN.UserId -> Int -> GqlM e env (TreeFirstLevel (GqlM e env))
dbTree loggedInUserId root_id = do
let rId = UnsafeMkNodeId root_id
t <- lift $ T.tree loggedInUserId T.TreeFirstLevel rId allNodeTypes
n <- lift $ getNode $ UnsafeMkNodeId root_id
let pId = toParentId n
pure $ toTree rId pId t
where
toParentId N.Node { _node_parent_id } = _node_parent_id
toTree :: (IsDBEnvExtra env) => NodeId -> ParentId -> Tree NodeTree -> TreeFirstLevel (GqlM e env)
toTree rId pId TreeN { _tn_node, _tn_children } = TreeFirstLevel
{ parent = resolveParent pId
, root = toTreeNode pId _tn_node
, children = map childrenToTreeNodes $ zip _tn_children $ repeat rId
}
toTreeNode :: ParentId -> NodeTree -> TreeNode
toTreeNode pId NodeTree { _nt_name, _nt_id, _nt_type } = TreeNode { name = _nt_name, id = NN._NodeId _nt_id, node_type = _nt_type, parent_id = NN._NodeId <$> pId}
childrenToTreeNodes :: (Tree NodeTree, NodeId) -> TreeNode
childrenToTreeNodes (TreeN {_tn_node}, rId) = toTreeNode (Just rId) _tn_node
resolveParent :: (IsDBEnvExtra env) => Maybe NodeId -> GqlM e env (Maybe TreeNode)
resolveParent (Just pId) = do
node <- lift $ getNode pId
pure $ nodeToTreeNode node
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)
then
Just TreeNode { id = NN.unNodeId _node_id
, name = _node_name
, node_type = fromDBid _node_typename
, parent_id = NN.unNodeId <$> _node_parent_id
}
else
Nothing
resolveBreadcrumb :: (IsDBEnvExtra 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
{ name = _dt_name
, id = NN.unNodeId _dt_nodeId
, node_type = fromDBid _dt_typeId
, parent_id = NN.unNodeId <$> _dt_parentId
}
dbRecursiveParents :: (IsDBEnvExtra env) => Int -> GqlM e env BreadcrumbInfo
dbRecursiveParents nodeId = do
let nId = UnsafeMkNodeId nodeId
dbParents <- lift $ T.recursiveParents nId allNodeTypes
let treeNodes = map convertDbTreeToTreeNode dbParents
pure $ BreadcrumbInfo { parents = treeNodes }