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.Either (Either(..))
   8 import Data.Morpheus.Types
   9   ( GQLType
  10   , Resolver
  11   , QUERY
  12   , lift
  13   )
  14 import Data.Text (Text)
  15 import qualified Data.Text as T
  16 import Gargantext.API.Prelude (GargM, GargError)
  17 import Gargantext.Core.Mail.Types (HasMail)
  18 import Gargantext.Database.Admin.Types.Node (NodeId(..), NodeType)
  19 import qualified Gargantext.Database.Admin.Types.Node as NN
  20 import Gargantext.Database.Query.Table.Node (getClosestParentIdByType, getNode)
  21 import Gargantext.Database.Prelude (HasConnectionPool, HasConfig)
  22 import qualified Gargantext.Database.Schema.Node as N
  23 import Gargantext.Prelude
  24 import GHC.Generics (Generic)
  25 import qualified Prelude as Prelude
  26 import Text.Read (readEither)
  27
  28 data Node = Node
  29   { id        :: Int
  30   , name      :: Text
  31   , parent_id :: Maybe Int
  32   , type_id   :: Int
  33   } deriving (Show, Generic, GQLType)
  34
  35 data NodeArgs
  36   = NodeArgs
  37     { node_id        :: Int
  38     } deriving (Generic, GQLType)
  39
  40 type GqlM e env = Resolver QUERY e (GargM env GargError)
  41
  42 -- | Function to resolve user from a query.
  43 resolveNodes
  44   :: (HasConnectionPool env, HasConfig env, HasMail env)
  45   => NodeArgs -> GqlM e env [Node]
  46 resolveNodes NodeArgs { node_id } = dbNodes node_id
  47
  48 dbNodes
  49   :: (HasConnectionPool env, HasConfig env, HasMail env)
  50   => Int -> GqlM e env [Node]
  51 dbNodes node_id = do
  52   node <- lift $ getNode $ NodeId node_id
  53   pure [toNode node]
  54
  55 data NodeParentArgs
  56   = NodeParentArgs
  57     { node_id     :: Int
  58     , parent_type :: Text
  59     } deriving (Generic, GQLType)
  60
  61 resolveNodeParent
  62   :: (HasConnectionPool env, HasConfig env, HasMail env)
  63   => NodeParentArgs -> GqlM e env [Node]
  64 resolveNodeParent NodeParentArgs { node_id, parent_type } = dbParentNodes node_id parent_type
  65
  66 dbParentNodes
  67   :: (HasConnectionPool env, HasConfig env, HasMail env)
  68   => Int -> Text -> GqlM e env [Node]
  69 dbParentNodes node_id parent_type = do
  70   let mParentType = readEither (T.unpack parent_type) :: Either Prelude.String NodeType
  71   case mParentType of
  72     Left err -> do
  73       lift $ printDebug "[dbParentNodes] error reading parent type" (T.pack err)
  74       pure []
  75     Right parentType -> do
  76       mNodeId <- lift $ getClosestParentIdByType (NodeId node_id) parentType -- (fromNodeTypeId parent_type_id)
  77       case mNodeId of
  78         Nothing -> pure []
  79         Just id -> do
  80           node <- lift $ getNode id
  81           pure [toNode node]
  82
  83 toNode :: NN.Node json -> Node
  84 toNode (N.Node { .. }) = Node { id = NN.unNodeId _node_id
  85                               , name = _node_name
  86                               , parent_id = NN.unNodeId <$> _node_parent_id
  87                               , type_id = _node_typename }