]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/API/GraphQL/Node.hs
[FEAT] CodeBook docker fix
[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.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 }