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
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DuplicateRecordFields #-}
module Gargantext.API.GraphQL.TreeFirstLevel where
import Data.Morpheus.Types (GQLType, lift, Resolver, QUERY)
import Data.Text (Text)
import GHC.Generics (Generic)
import Gargantext.API.Prelude (GargM, GargError)
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.Database.Admin.Config (fromNodeTypeId)
import Gargantext.Database.Admin.Types.Node (allNodeTypes, NodeId (NodeId))
import Gargantext.Database.Prelude (CmdCommon)
import Gargantext.Database.Query.Table.Node (getNode)
import Gargantext.Database.Schema.Node (NodePoly(_node_parent_id))
import Gargantext.Prelude
import qualified Gargantext.Database.Admin.Types.Node as NN
import qualified Gargantext.Database.Query.Tree as T
import qualified Gargantext.Database.Schema.Node as N
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)
type GqlM e env = Resolver QUERY e (GargM env GargError)
type ParentId = Maybe NodeId
resolveTree :: (CmdCommon env) => TreeArgs -> GqlM e env (TreeFirstLevel (GqlM e env))
resolveTree TreeArgs { root_id } = dbTree root_id
dbTree :: (CmdCommon env) =>
Int -> GqlM e env (TreeFirstLevel (GqlM e env))
dbTree root_id = do
let rId = NodeId root_id
t <- lift $ T.tree T.TreeFirstLevel rId allNodeTypes
n <- lift $ getNode $ NodeId root_id
let pId = toParentId n
pure $ toTree rId pId t
where
toParentId N.Node { _node_parent_id } = _node_parent_id
toTree :: (CmdCommon 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 = id2int _nt_id, node_type = _nt_type, parent_id = id2int <$> pId}
where
id2int :: NodeId -> Int
id2int (NodeId n) = n
childrenToTreeNodes :: (Tree NodeTree, NodeId) -> TreeNode
childrenToTreeNodes (TreeN {_tn_node}, rId) = toTreeNode (Just rId) _tn_node
resolveParent :: (CmdCommon env) => Maybe NodeId -> GqlM e env (Maybe TreeNode)
resolveParent (Just pId) = do
node <- lift $ getNode pId
pure $ nodeToTreeNode node
resolveParent Nothing = pure Nothing
nodeToTreeNode :: NN.Node json -> Maybe TreeNode
nodeToTreeNode N.Node {..} = if (fromNodeTypeId _node_typename /= NN.NodeFolderShared) && (fromNodeTypeId _node_typename /= NN.NodeTeam)
then
Just TreeNode { id = NN.unNodeId _node_id
, name = _node_name
, node_type = fromNodeTypeId _node_typename
, parent_id = NN.unNodeId <$> _node_parent_id
}
else
Nothing