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