src/Gargantext/API/GraphQL/TreeFirstLevel.hs

   1 {-# LANGUAGE DeriveAnyClass #-}
   2 {-# LANGUAGE DuplicateRecordFields #-}
   3
   4 module Gargantext.API.GraphQL.TreeFirstLevel where
   5
   6 import Gargantext.Prelude
   7 import Data.Morpheus.Types (GQLType, lift, Resolver, QUERY)
   8 import GHC.Generics (Generic)
   9 import Data.Text (Text)
  10 import Gargantext.API.Prelude (GargM, GargError)
  11 import Gargantext.Database.Prelude (HasConnectionPool, HasConfig)
  12 import Gargantext.Core.Mail.Types (HasMail)
  13 import qualified Gargantext.Database.Query.Tree as T
  14 import Gargantext.Database.Admin.Types.Node (allNodeTypes, NodeId (NodeId))
  15 import Gargantext.Core.Types (Tree, NodeTree, NodeType)
  16 import Gargantext.Core.Types.Main
  17     ( Tree(TreeN), _tn_node, _tn_children, NodeTree(NodeTree, _nt_id, _nt_type), _nt_name )
  18
  19 data TreeArgs = TreeArgs
  20   {
  21     root_id :: Int
  22   } deriving (Generic, GQLType)
  23
  24 data TreeNode = TreeNode
  25   {
  26     name      :: Text
  27   , id        :: Int
  28   , node_type :: NodeType
  29   } deriving (Generic, GQLType)
  30
  31 data TreeFirstLevel  = TreeFirstLevel
  32   {
  33     root     :: TreeNode
  34   , parent   :: Maybe TreeNode
  35   , children :: [TreeNode]
  36   } deriving (Generic, GQLType)
  37
  38 type GqlM e env = Resolver QUERY e (GargM env GargError)
  39
  40 resolveTree :: (HasConnectionPool env, HasConfig env, HasMail env) => TreeArgs -> GqlM e env TreeFirstLevel
  41 resolveTree TreeArgs { root_id } = dbTree root_id
  42
  43 dbTree :: (HasConnectionPool env, HasConfig env, HasMail env) => Int -> GqlM e env TreeFirstLevel
  44 dbTree root_id = do
  45   t <- lift $ T.tree T.TreeFirstLevel (NodeId root_id) allNodeTypes
  46   pure $ toTree t
  47
  48 toTree :: Tree NodeTree -> TreeFirstLevel
  49 toTree TreeN {_tn_node, _tn_children} = TreeFirstLevel
  50   { parent   = Nothing -- TODO
  51   , root     = toTreeNode _tn_node
  52   , children = map childrenToTreeNodes _tn_children
  53   }
  54
  55 toTreeNode :: NodeTree -> TreeNode
  56 toTreeNode NodeTree {_nt_name, _nt_id, _nt_type} = TreeNode { name = _nt_name, id = id2int _nt_id, node_type = _nt_type}
  57   where
  58     id2int :: NodeId -> Int
  59     id2int (NodeId n) = n
  60
  61 childrenToTreeNodes :: Tree NodeTree -> TreeNode
  62 childrenToTreeNodes TreeN {_tn_node} = toTreeNode _tn_node