[GraphQL] add basic query for node

src/Gargantext/API/GraphQL.hs

@@ -4,18 +4,12 @@
 {-# LANGUAGE PartialTypeSignatures #-}  -- to automatically use suggested type hole signatures during compilation
 {-# LANGUAGE TypeOperators #-}
 
-{-# OPTIONS_GHC -fno-warn-unused-imports #-}
-
 module Gargantext.API.GraphQL where
 
-import Control.Lens ((#))
-import Control.Monad.Base (liftBase)
-import Control.Monad.IO.Class (liftIO)
 import Data.ByteString.Lazy.Char8
   ( ByteString
   )
 import Data.List.NonEmpty (NonEmpty ((:|)))
-import Data.Maybe (fromMaybe)
 import Data.Morpheus
   ( App
   , deriveApp )
@@ -25,59 +19,39 @@ import Data.Morpheus.Server
 import Data.Morpheus.Subscriptions
   ( Event (..)
   , Hashable
-  , PubApp
-  , SubApp
   , httpPubApp
-  , webSocketsApp
   )
 import Data.Morpheus.Types
   ( GQLRequest
   , GQLResponse
   , GQLType
-  , ResolverQ
   , RootResolver(..)
   , Undefined(..)
-  , lift
-  , liftEither
-  , publish
-  , render
   )
-import Data.Morpheus.Types.Internal.AST
-  ( msg )
-import Data.Text (Text)
-import qualified Data.Text.Lazy as LT
-import Data.Text.Lazy.Encoding (decodeUtf8)
-import Data.Typeable (Typeable)
 import Gargantext.API.Admin.Auth.Types (AuthenticatedUser)
 import Gargantext.API.Admin.Orchestrator.Types (JobLog)
 import Gargantext.API.Prelude (HasJobEnv')
 import qualified Gargantext.API.GraphQL.AsyncTask as GQLAT
+import qualified Gargantext.API.GraphQL.Node as GQLNode
 import qualified Gargantext.API.GraphQL.User as GQLUser
 import qualified Gargantext.API.GraphQL.UserInfo as GQLUserInfo
-import Gargantext.API.Prelude (GargServerT, GargM, GargError, _ServerError)
+import Gargantext.API.Prelude (GargM, GargError)
 import Gargantext.Core.Mail.Types (HasMail)
-import Gargantext.Database.Prelude (Cmd, HasConnectionPool, HasConfig)
-import Gargantext.Database.Schema.User (UserPoly(..))
+import Gargantext.Database.Prelude (HasConnectionPool, HasConfig)
 import Gargantext.Prelude
 import GHC.Generics (Generic)
-import GHC.TypeLits
 import Network.HTTP.Media ((//), (/:))
-import Network.WebSockets
-  ( ServerApp,
-  )
 import qualified Prelude as Prelude
 import Servant
-  ( (:<|>) (..),
-    (:>),
-    Accept (..),
-    Get,
-    JSON,
-    MimeRender (..),
-    PlainText,
-    Post,
-    ReqBody,
-    ServerT,
-    err401
+  ( (:<|>) (..)
+  , (:>)
+  , Accept (..)
+  , Get
+  , JSON
+  , MimeRender (..)
+  , Post
+  , ReqBody
+  ,  ServerT
   )
 import qualified Servant.Auth as SA
 import qualified Servant.Auth.Server as SAS
@@ -85,9 +59,11 @@ import qualified Servant.Auth.Server as SAS
 -- | Represents possible GraphQL queries.
 data Query m
   = Query
-    { job_logs :: GQLAT.JobLogArgs -> m [JobLog]
-    , user_infos :: GQLUserInfo.UserInfoArgs -> m [GQLUserInfo.UserInfo]
-    , users :: GQLUser.UserArgs -> m [GQLUser.User m]
+    { job_logs    :: GQLAT.JobLogArgs -> m [JobLog]
+    , nodes       :: GQLNode.NodeArgs -> m [GQLNode.Node]
+    , node_parent :: GQLNode.NodeParentArgs -> m [GQLNode.Node]
+    , user_infos  :: GQLUserInfo.UserInfoArgs -> m [GQLUserInfo.UserInfo]
+    , users       :: GQLUser.UserArgs -> m [GQLUser.User m]
     } deriving (Generic, GQLType)
 
 data Mutation m
@@ -117,9 +93,11 @@ rootResolver
   => RootResolver (GargM env GargError) e Query Mutation Undefined
 rootResolver =
   RootResolver
-    { queryResolver = Query { job_logs = GQLAT.resolveJobLogs
-                            , user_infos = GQLUserInfo.resolveUserInfos
-                            , users = GQLUser.resolveUsers }
+    { queryResolver = Query { job_logs    = GQLAT.resolveJobLogs
+                            , nodes       = GQLNode.resolveNodes
+                            , node_parent = GQLNode.resolveNodeParent
+                            , user_infos  = GQLUserInfo.resolveUserInfos
+                            , users       = GQLUser.resolveUsers }
     , mutationResolver = Mutation { update_user_info = GQLUserInfo.updateUserInfo }
     , subscriptionResolver = Undefined }
 

src/Gargantext/API/GraphQL/AsyncTask.hs

@@ -47,7 +47,7 @@ dbJobLogs job_log_id = do
   env <- ask
   _ <- lift $ do
     --val <- liftBase $ readMVar $ env ^. job_env . jenv_jobs . env_state_mvar
-    let val = env ^. job_env
+    let val = env
     printDebug "[dbJobLogs] env ^. job_env ^. jenv_jobs" val 
     printDebug "[dbJobLogs] job_log_id" job_log_id
   pure []

src/Gargantext/API/GraphQL/Node.hs

+
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+
+module Gargantext.API.GraphQL.Node where
+
+import Data.Morpheus.Types
+  ( GQLType
+  , Resolver
+  , QUERY
+  , lift
+  )
+import Data.Text (Text)
+import Gargantext.API.Prelude (GargM, GargError)
+import Gargantext.Core.Mail.Types (HasMail)
+import Gargantext.Database.Admin.Config (fromNodeTypeId)
+import Gargantext.Database.Admin.Types.Node (NodeId(..))
+import qualified Gargantext.Database.Admin.Types.Node as NN
+import Gargantext.Database.Query.Table.Node (getClosestParentIdByType, getNode)
+import Gargantext.Database.Prelude (HasConnectionPool, HasConfig)
+import qualified Gargantext.Database.Schema.Node as N
+import Gargantext.Prelude
+import GHC.Generics (Generic)
+
+data Node = Node
+  { id        :: Int
+  , name      :: Text
+  , parent_id :: Maybe Int
+  , type_id   :: Int
+  } deriving (Show, Generic, GQLType)
+
+data NodeArgs
+  = NodeArgs
+    { node_id        :: Int
+    } deriving (Generic, GQLType)
+
+type GqlM e env = Resolver QUERY e (GargM env GargError)
+
+-- | Function to resolve user from a query.
+resolveNodes
+  :: (HasConnectionPool env, HasConfig env, HasMail env)
+  => NodeArgs -> GqlM e env [Node]
+resolveNodes NodeArgs { node_id } = dbNodes node_id
+
+dbNodes
+  :: (HasConnectionPool env, HasConfig env, HasMail env)
+  => Int -> GqlM e env [Node]
+dbNodes node_id = do
+  node <- lift $ getNode $ NodeId node_id
+  pure [toNode node]
+
+data NodeParentArgs
+  = NodeParentArgs
+    { node_id        :: Int
+    , parent_type_id :: Int
+    } deriving (Generic, GQLType)
+
+resolveNodeParent
+  :: (HasConnectionPool env, HasConfig env, HasMail env)
+  => NodeParentArgs -> GqlM e env [Node]
+resolveNodeParent NodeParentArgs { node_id, parent_type_id } = dbParentNodes node_id parent_type_id
+
+dbParentNodes
+  :: (HasConnectionPool env, HasConfig env, HasMail env)
+  => Int -> Int -> GqlM e env [Node]
+dbParentNodes node_id parent_type_id = do
+  mNodeId <- lift $ getClosestParentIdByType (NodeId node_id) (fromNodeTypeId parent_type_id)
+  case mNodeId of
+    Nothing -> pure []
+    Just id -> do
+      node <- lift $ getNode id
+      pure [toNode node]
+
+toNode :: NN.Node json -> Node
+toNode (N.Node { .. }) = Node { id = NN.unNodeId _node_id
+                              , name = _node_name
+                              , parent_id = NN.unNodeId <$> _node_parent_id
+                              , type_id = _node_typename }