src/Gargantext/API/GraphQL/Node.hs

   1
   2 {-# LANGUAGE DeriveAnyClass #-}
   3 {-# LANGUAGE DuplicateRecordFields #-}
   4
   5 module Gargantext.API.GraphQL.Node where
   6
   7 import Data.Morpheus.Types
   8   ( GQLType
   9   , Resolver
  10   , QUERY
  11   , lift
  12   )
  13 import Data.Text (Text)
  14 import Gargantext.API.Prelude (GargM, GargError)
  15 import Gargantext.Core.Mail.Types (HasMail)
  16 import Gargantext.Database.Admin.Config (fromNodeTypeId)
  17 import Gargantext.Database.Admin.Types.Node (NodeId(..))
  18 import qualified Gargantext.Database.Admin.Types.Node as NN
  19 import Gargantext.Database.Query.Table.Node (getClosestParentIdByType, getNode)
  20 import Gargantext.Database.Prelude (HasConnectionPool, HasConfig)
  21 import qualified Gargantext.Database.Schema.Node as N
  22 import Gargantext.Prelude
  23 import GHC.Generics (Generic)
  24
  25 data Node = Node
  26   { id        :: Int
  27   , name      :: Text
  28   , parent_id :: Maybe Int
  29   , type_id   :: Int
  30   } deriving (Show, Generic, GQLType)
  31
  32 data NodeArgs
  33   = NodeArgs
  34     { node_id        :: Int
  35     } deriving (Generic, GQLType)
  36
  37 type GqlM e env = Resolver QUERY e (GargM env GargError)
  38
  39 -- | Function to resolve user from a query.
  40 resolveNodes
  41   :: (HasConnectionPool env, HasConfig env, HasMail env)
  42   => NodeArgs -> GqlM e env [Node]
  43 resolveNodes NodeArgs { node_id } = dbNodes node_id
  44
  45 dbNodes
  46   :: (HasConnectionPool env, HasConfig env, HasMail env)
  47   => Int -> GqlM e env [Node]
  48 dbNodes node_id = do
  49   node <- lift $ getNode $ NodeId node_id
  50   pure [toNode node]
  51
  52 data NodeParentArgs
  53   = NodeParentArgs
  54     { node_id        :: Int
  55     , parent_type_id :: Int
  56     } deriving (Generic, GQLType)
  57
  58 resolveNodeParent
  59   :: (HasConnectionPool env, HasConfig env, HasMail env)
  60   => NodeParentArgs -> GqlM e env [Node]
  61 resolveNodeParent NodeParentArgs { node_id, parent_type_id } = dbParentNodes node_id parent_type_id
  62
  63 dbParentNodes
  64   :: (HasConnectionPool env, HasConfig env, HasMail env)
  65   => Int -> Int -> GqlM e env [Node]
  66 dbParentNodes node_id parent_type_id = do
  67   mNodeId <- lift $ getClosestParentIdByType (NodeId node_id) (fromNodeTypeId parent_type_id)
  68   case mNodeId of
  69     Nothing -> pure []
  70     Just id -> do
  71       node <- lift $ getNode id
  72       pure [toNode node]
  73
  74 toNode :: NN.Node json -> Node
  75 toNode (N.Node { .. }) = Node { id = NN.unNodeId _node_id
  76                               , name = _node_name
  77                               , parent_id = NN.unNodeId <$> _node_parent_id
  78                               , type_id = _node_typename }