src/Gargantext/API/GraphQL/Node.hs

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