src/Gargantext/API/GraphQL/TreeFirstLevel.hs

   1 {-# LANGUAGE DeriveAnyClass #-}
   2 {-# LANGUAGE DuplicateRecordFields #-}
   3
   4 module Gargantext.API.GraphQL.TreeFirstLevel where
   5
   6 import Data.Morpheus.Types (GQLType, lift, Resolver, QUERY)
   7 import Data.Text (Text)
   8 import GHC.Generics (Generic)
   9 import Gargantext.API.Prelude (GargM, GargError)
  10 import Gargantext.Core.Types (Tree, NodeTree, NodeType)
  11 import Gargantext.Core.Types.Main ( Tree(TreeN), _tn_node, _tn_children, NodeTree(NodeTree, _nt_id, _nt_type), _nt_name )
  12 import Gargantext.Database.Admin.Config (fromNodeTypeId)
  13 import Gargantext.Database.Admin.Types.Node (allNodeTypes, NodeId (NodeId))
  14 import Gargantext.Database.Prelude (CmdCommon)
  15 import Gargantext.Database.Query.Table.Node (getNode)
  16 import Gargantext.Database.Schema.Node (NodePoly(_node_parent_id))
  17 import Gargantext.Prelude
  18 import qualified Gargantext.Database.Admin.Types.Node as NN
  19 import qualified Gargantext.Database.Query.Tree as T
  20 import qualified Gargantext.Database.Schema.Node as N
  21
  22 data TreeArgs = TreeArgs
  23   {
  24     root_id :: Int
  25   } deriving (Generic, GQLType)
  26
  27 data TreeNode = TreeNode
  28   {
  29     name      :: Text
  30   , id        :: Int
  31   , node_type :: NodeType
  32   , parent_id :: Maybe Int
  33   } deriving (Generic, GQLType)
  34
  35 data TreeFirstLevel m = TreeFirstLevel
  36   {
  37     root     :: TreeNode
  38   , parent   :: m (Maybe TreeNode)
  39   , children :: [TreeNode]
  40   } deriving (Generic, GQLType)
  41
  42 type GqlM e env = Resolver QUERY e (GargM env GargError)
  43
  44 type ParentId = Maybe NodeId
  45
  46 resolveTree :: (CmdCommon env) => TreeArgs -> GqlM e env (TreeFirstLevel (GqlM e env))
  47 resolveTree TreeArgs { root_id } = dbTree root_id
  48
  49 dbTree :: (CmdCommon env) =>
  50           Int -> GqlM e env (TreeFirstLevel (GqlM e env))
  51 dbTree root_id = do
  52   let rId = NodeId root_id
  53   t <- lift $ T.tree T.TreeFirstLevel rId allNodeTypes
  54   n <- lift $ getNode $ NodeId root_id
  55   let pId = toParentId n
  56   pure $ toTree rId pId t
  57   where
  58     toParentId N.Node { _node_parent_id } = _node_parent_id
  59
  60
  61 toTree :: (CmdCommon env) => NodeId -> ParentId -> Tree NodeTree -> TreeFirstLevel (GqlM e env)
  62 toTree rId pId TreeN { _tn_node, _tn_children } = TreeFirstLevel
  63   { parent   = resolveParent pId
  64   , root     = toTreeNode pId _tn_node
  65   , children = map childrenToTreeNodes $ zip _tn_children $ repeat rId
  66   }
  67
  68 toTreeNode :: ParentId -> NodeTree -> TreeNode
  69 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}
  70   where
  71     id2int :: NodeId -> Int
  72     id2int (NodeId n) = n
  73
  74 childrenToTreeNodes :: (Tree NodeTree, NodeId) -> TreeNode
  75 childrenToTreeNodes (TreeN {_tn_node}, rId) = toTreeNode (Just rId) _tn_node
  76
  77 resolveParent :: (CmdCommon env) => Maybe NodeId -> GqlM e env (Maybe TreeNode)
  78 resolveParent (Just pId) = do
  79   node <- lift $ getNode pId
  80   pure $ nodeToTreeNode node
  81 resolveParent Nothing = pure Nothing
  82
  83
  84 nodeToTreeNode :: NN.Node json -> Maybe TreeNode
  85 nodeToTreeNode N.Node {..} = if (fromNodeTypeId _node_typename /= NN.NodeFolderShared) && (fromNodeTypeId _node_typename /= NN.NodeTeam)
  86                              then
  87                              Just TreeNode { id        = NN.unNodeId _node_id
  88                                            , name      = _node_name
  89                                            , node_type = fromNodeTypeId _node_typename
  90                                            , parent_id = NN.unNodeId <$> _node_parent_id
  91                                            }
  92                              else
  93                              Nothing