]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/API/GraphQL/Node.hs
Merge branch 'dev' into dev-openalex
[gargantext.git] / 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 , type_id :: Int
34 } deriving (Show, Generic, GQLType)
35
36 data Node = Node
37 { id :: Int
38 , name :: Text
39 , parent_id :: Maybe Int
40 , type_id :: Int
41 } deriving (Show, Generic, GQLType)
42
43 data CorpusArgs
44 = CorpusArgs
45 { corpus_id :: Int
46 } deriving (Generic, GQLType)
47
48 data NodeArgs
49 = NodeArgs
50 { node_id :: Int
51 } deriving (Generic, GQLType)
52
53 type GqlM e env = Resolver QUERY e (GargM env GargError)
54
55 -- | Function to resolve user from a query.
56 resolveNodes
57 :: (CmdCommon env)
58 => NodeArgs -> GqlM e env [Node]
59 resolveNodes NodeArgs { node_id } = dbNodes node_id
60
61 resolveNodesCorpus
62 :: (CmdCommon env)
63 => CorpusArgs -> GqlM e env [Corpus]
64 resolveNodesCorpus CorpusArgs { corpus_id } = dbNodesCorpus corpus_id
65
66 dbNodes
67 :: (CmdCommon env)
68 => Int -> GqlM e env [Node]
69 dbNodes node_id = do
70 node <- lift $ getNode $ NodeId node_id
71 pure [toNode node]
72
73 dbNodesCorpus
74 :: (CmdCommon env)
75 => Int -> GqlM e env [Corpus]
76 dbNodesCorpus corpus_id = do
77 corpus <- lift $ getNode $ NodeId corpus_id
78 pure [toCorpus corpus]
79
80 data NodeParentArgs
81 = NodeParentArgs
82 { node_id :: Int
83 , parent_type :: Text
84 } deriving (Generic, GQLType)
85
86 resolveNodeParent
87 :: (CmdCommon env)
88 => NodeParentArgs -> GqlM e env [Node]
89 resolveNodeParent NodeParentArgs { node_id, parent_type } = dbParentNodes node_id parent_type
90
91 dbParentNodes
92 :: (CmdCommon env)
93 => Int -> Text -> GqlM e env [Node]
94 dbParentNodes node_id parent_type = do
95 let mParentType = readEither (T.unpack parent_type) :: Either Prelude.String NodeType
96 case mParentType of
97 Left err -> do
98 lift $ printDebug "[dbParentNodes] error reading parent type" (T.pack err)
99 pure []
100 Right parentType -> do
101 mNodeId <- lift $ getClosestParentIdByType (NodeId node_id) parentType -- (fromNodeTypeId parent_type_id)
102 case mNodeId of
103 Nothing -> pure []
104 Just id -> do
105 node <- lift $ getNode id
106 pure [toNode node]
107
108 toNode :: NN.Node json -> Node
109 toNode N.Node { .. } = Node { id = NN.unNodeId _node_id
110 , name = _node_name
111 , parent_id = NN.unNodeId <$> _node_parent_id
112 , type_id = _node_typename }
113
114 toCorpus :: NN.Node Value -> Corpus
115 toCorpus N.Node { .. } = Corpus { id = NN.unNodeId _node_id
116 , name = _node_name
117 , parent_id = NN.unNodeId <$> _node_parent_id
118 , type_id = _node_typename }
119
120 pubmedAPIKeyFromValue :: Value -> Maybe PUBMED.APIKey
121 pubmedAPIKeyFromValue (Object kv) =
122 case HashMap.lookup "pubmed_api_key" kv of
123 Nothing -> Nothing
124 Just v -> case fromJSON v of
125 Error _ -> Nothing
126 Success v' -> Just v'
127 pubmedAPIKeyFromValue _ = Nothing