src/Gargantext/API/GraphQL/Node.hs

   1 {-# LANGUAGE DeriveAnyClass #-}
   2 {-# LANGUAGE DuplicateRecordFields #-}
   3
   4 module Gargantext.API.GraphQL.Node where
   5
   6 import Data.Aeson
   7 import Data.Either (Either(..))
   8 import qualified Data.HashMap.Strict as HashMap
   9 import Data.Morpheus.Types
  10   ( GQLType
  11   , Resolver
  12   , QUERY
  13   , lift
  14   )
  15 import Data.Text (Text)
  16 import qualified Data.Text as T
  17 import Gargantext.API.Prelude (GargM, GargError)
  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 (CmdCommon)  -- , JSONB)
  22 import qualified Gargantext.Database.Schema.Node as N
  23 import Gargantext.Prelude
  24 import GHC.Generics (Generic)
  25 import qualified Prelude
  26 import qualified PUBMED.Types as PUBMED
  27 import Text.Read (readEither)
  28
  29 data Corpus = Corpus
  30   { id           :: Int
  31   , name         :: Text
  32   , parent_id    :: Maybe Int
  33   , pubmedAPIKey :: Maybe PUBMED.APIKey
  34   , type_id      :: Int
  35   } deriving (Show, Generic, GQLType)
  36
  37 data Node = Node
  38   { id           :: Int
  39   , name         :: Text
  40   , parent_id    :: Maybe Int
  41   , type_id      :: Int
  42   } deriving (Show, Generic, GQLType)
  43
  44 data CorpusArgs
  45   = CorpusArgs
  46     { corpus_id :: Int
  47     } deriving (Generic, GQLType)
  48
  49 data NodeArgs
  50   = NodeArgs
  51     { node_id :: Int
  52     } deriving (Generic, GQLType)
  53
  54 type GqlM e env = Resolver QUERY e (GargM env GargError)
  55
  56 -- | Function to resolve user from a query.
  57 resolveNodes
  58   :: (CmdCommon env)
  59   => NodeArgs -> GqlM e env [Node]
  60 resolveNodes NodeArgs { node_id } = dbNodes node_id
  61
  62 resolveNodesCorpus
  63   :: (CmdCommon env)
  64   => CorpusArgs -> GqlM e env [Corpus]
  65 resolveNodesCorpus CorpusArgs { corpus_id } = dbNodesCorpus corpus_id
  66
  67 dbNodes
  68   :: (CmdCommon env)
  69   => Int -> GqlM e env [Node]
  70 dbNodes node_id = do
  71   node <- lift $ getNode $ NodeId node_id
  72   pure [toNode node]
  73
  74 dbNodesCorpus
  75   :: (CmdCommon env)
  76   => Int -> GqlM e env [Corpus]
  77 dbNodesCorpus corpus_id = do
  78   corpus <- lift $ getNode $ NodeId corpus_id
  79   pure [toCorpus corpus]
  80
  81 data NodeParentArgs
  82   = NodeParentArgs
  83     { node_id     :: Int
  84     , parent_type :: Text
  85     } deriving (Generic, GQLType)
  86
  87 resolveNodeParent
  88   :: (CmdCommon env)
  89   => NodeParentArgs -> GqlM e env [Node]
  90 resolveNodeParent NodeParentArgs { node_id, parent_type } = dbParentNodes node_id parent_type
  91
  92 dbParentNodes
  93   :: (CmdCommon env)
  94   => Int -> Text -> GqlM e env [Node]
  95 dbParentNodes node_id parent_type = do
  96   let mParentType = readEither (T.unpack parent_type) :: Either Prelude.String NodeType
  97   case mParentType of
  98     Left err -> do
  99       lift $ printDebug "[dbParentNodes] error reading parent type" (T.pack err)
 100       pure []
 101     Right parentType -> do
 102       mNodeId <- lift $ getClosestParentIdByType (NodeId node_id) parentType -- (fromNodeTypeId parent_type_id)
 103       case mNodeId of
 104         Nothing -> pure []
 105         Just id -> do
 106           node <- lift $ getNode id
 107           pure [toNode node]
 108
 109 toNode :: NN.Node json -> Node
 110 toNode N.Node { .. } = Node { id = NN.unNodeId _node_id
 111                             , name = _node_name
 112                             , parent_id = NN.unNodeId <$> _node_parent_id
 113                             , type_id = _node_typename }
 114
 115 toCorpus :: NN.Node Value -> Corpus
 116 toCorpus N.Node { .. } = Corpus { id = NN.unNodeId _node_id
 117                                 , name = _node_name
 118                                 , parent_id = NN.unNodeId <$> _node_parent_id
 119                                 , pubmedAPIKey = pubmedAPIKeyFromValue _node_hyperdata
 120                                 , type_id = _node_typename }
 121
 122 pubmedAPIKeyFromValue :: Value -> Maybe PUBMED.APIKey
 123 pubmedAPIKeyFromValue (Object kv) =
 124   case HashMap.lookup "pubmed_api_key" kv of
 125     Nothing -> Nothing
 126     Just v  -> case fromJSON v of
 127       Error _    -> Nothing
 128       Success v' -> Just v'
 129 pubmedAPIKeyFromValue _           = Nothing