[graphql] implement an endpoint for node contexts

gargantext.cabal

@@ -120,6 +120,7 @@ library
       Gargantext.API.GraphQL
       Gargantext.API.GraphQL.Annuaire
       Gargantext.API.GraphQL.AsyncTask
+      Gargantext.API.GraphQL.Context
       Gargantext.API.GraphQL.IMT
       Gargantext.API.GraphQL.Node
       Gargantext.API.GraphQL.Team

src/Gargantext/API/GraphQL.hs

@@ -36,6 +36,7 @@ import Gargantext.API.Admin.Orchestrator.Types (JobLog)
 import Gargantext.API.Prelude (HasJobEnv')
 import qualified Gargantext.API.GraphQL.Annuaire as GQLA
 import qualified Gargantext.API.GraphQL.AsyncTask as GQLAT
+import qualified Gargantext.API.GraphQL.Context as GQLCTX
 import qualified Gargantext.API.GraphQL.IMT as GQLIMT
 import qualified Gargantext.API.GraphQL.Node as GQLNode
 import qualified Gargantext.API.GraphQL.User as GQLUser
@@ -66,6 +67,7 @@ import Gargantext.API.Admin.Types (HasSettings)
 data Query m
   = Query
     { annuaire_contacts :: GQLA.AnnuaireContactArgs -> m [GQLA.AnnuaireContact]
+    , contexts    :: GQLCTX.NodeContextArgs -> m [GQLCTX.NodeContextGQL]
     , imt_schools :: GQLIMT.SchoolsArgs -> m [GQLIMT.School]
     , job_logs    :: GQLAT.JobLogArgs -> m (Map Int JobLog)
     , nodes       :: GQLNode.NodeArgs -> m [GQLNode.Node]
@@ -78,8 +80,8 @@ data Query m
 
 data Mutation m
   = Mutation
-    { update_user_info        :: GQLUserInfo.UserInfoMArgs -> m Int 
-    , delete_team_membership :: GQLTeam.TeamDeleteMArgs -> m [Int] 
+    { update_user_info        :: GQLUserInfo.UserInfoMArgs -> m Int
+    , delete_team_membership :: GQLTeam.TeamDeleteMArgs -> m [Int]
     } deriving (Generic, GQLType)
 
 -- | Possible GraphQL Events, i.e. here we describe how we will
@@ -105,6 +107,7 @@ rootResolver
 rootResolver =
   RootResolver
     { queryResolver = Query { annuaire_contacts = GQLA.resolveAnnuaireContacts
+                            , contexts          = GQLCTX.resolveNodeContext
                             , imt_schools       = GQLIMT.resolveSchools
                             , job_logs          = GQLAT.resolveJobLogs
                             , nodes             = GQLNode.resolveNodes
@@ -113,7 +116,7 @@ rootResolver =
                             , users             = GQLUser.resolveUsers
                             , tree              = GQLTree.resolveTree
                             , team              = GQLTeam.resolveTeam }
-    , mutationResolver = Mutation { update_user_info       = GQLUserInfo.updateUserInfo 
+    , mutationResolver = Mutation { update_user_info       = GQLUserInfo.updateUserInfo
                                   , delete_team_membership = GQLTeam.deleteTeamMembership }
     , subscriptionResolver = Undefined }
 
@@ -149,7 +152,7 @@ gqapi = Proxy
 --   App e IO ->
 --   Server (API name)
 -- serveEndpoint publish app' = (liftIO . httpPubApp publish app') :<|> withSchema app' :<|> pure httpPlayground
--- 
+--
 -- withSchema :: (Applicative f) => App e m -> f Text
 -- withSchema = pure . LT.toStrict . decodeUtf8 . render
 

src/Gargantext/API/GraphQL/Context.hs

+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+
+module Gargantext.API.GraphQL.Context where
+
+-- TODO Add support for adding FrameWrite comments for a Context
+
+import Data.Morpheus.Types
+  ( GQLType
+  , Resolver
+  , QUERY
+  , lift
+  )
+import Gargantext.API.Prelude (GargM, GargError)
+import Gargantext.Core.Mail.Types (HasMail)
+import Gargantext.Database.Admin.Types.Node (NodeId(..))
+import Gargantext.Database.Prelude (HasConnectionPool, HasConfig)
+import Gargantext.Database.Query.Table.NodeContext (getNodeContext)
+import Gargantext.Database.Schema.NodeContext (NodeContext, NodeContextPoly(..))
+import Gargantext.Prelude
+import GHC.Generics (Generic)
+
+data NodeContextGQL = NodeContextGQL
+   { nc_id         :: Maybe Int
+   , nc_node_id    :: Int
+   , nc_context_id :: Int
+   , nc_score      :: Maybe Double
+   , nc_category   :: Maybe Int
+   }
+  deriving (Generic, GQLType, Show)
+
+-- | Arguments to the "context node" query.
+data NodeContextArgs
+  = NodeContextArgs
+    { context_id :: Int
+    , node_id    :: Int
+    } deriving (Generic, GQLType)
+
+type GqlM e env = Resolver QUERY e (GargM env GargError)
+
+-- | Function to resolve context from a query.
+resolveNodeContext
+  :: (HasConnectionPool env, HasConfig env, HasMail env)
+  => NodeContextArgs -> GqlM e env [NodeContextGQL]
+resolveNodeContext NodeContextArgs { context_id, node_id } = dbNodeContext context_id node_id
+
+-- | Inner function to fetch the node context DB.
+dbNodeContext
+  :: (HasConnectionPool env, HasConfig env, HasMail env)
+  => Int -> Int -> GqlM e env [NodeContextGQL]
+dbNodeContext context_id node_id = do
+  -- lift $ printDebug "[dbUsers]" user_id
+--  user <- getUsersWithId user_id
+--  hyperdata <- getUserHyperdata user_id
+--  lift (map toUser <$> zip user hyperdata)
+  c <- lift $ getNodeContext (NodeId context_id) (NodeId node_id)
+  pure [toNodeContextGQL c]
+
+toNodeContextGQL :: NodeContext -> NodeContextGQL
+toNodeContextGQL (NodeContext { _nc_node_id = NodeId nc_node_id
+                              , _nc_context_id = NodeId nc_context_id
+                              , .. }) =
+  NodeContextGQL { nc_id = _nc_id
+                 , nc_node_id
+                 , nc_context_id
+                 , nc_score = _nc_score
+                 , nc_category = _nc_category }

src/Gargantext/Core/Text/List.hs

@@ -159,7 +159,7 @@ buildNgramsTermsList :: ( HasNodeError err
                      -> GroupParams
                      -> (NgramsType, MapListSize)
                      -> m (Map NgramsType [NgramsElement])
-buildNgramsTermsList user uCid mCid mfslw groupParams (nt, MapListSize mapListSize)= do
+buildNgramsTermsList user uCid mCid mfslw groupParams (nt, MapListSize mapListSize) = do
 
 -- Filter 0 With Double
 -- Computing global speGen score

src/Gargantext/Database/Query/Table/NodeContext.hs

@@ -26,6 +26,7 @@ module Gargantext.Database.Query.Table.NodeContext
   , selectDocs
   , nodeContextsCategory
   , nodeContextsScore
+  , getNodeContexts
   , getNodeContext
   , insertNodeContext
   , deleteNodeContext
@@ -47,6 +48,7 @@ import qualified Opaleye as O
 import Gargantext.Core
 import Gargantext.Core.Types
 import Gargantext.Database.Admin.Types.Hyperdata
+import Gargantext.Database.Query.Table.Node.Error (HasNodeError, NodeError(DoesNotExist), nodeError)
 import Gargantext.Database.Prelude
 import Gargantext.Database.Schema.Context
 import Gargantext.Database.Schema.Node
@@ -62,15 +64,30 @@ _nodesContexts = runOpaQuery queryNodeContextTable
 
 ------------------------------------------------------------------------
 -- | Basic NodeContext tools
-getNodeContext :: NodeId -> Cmd err [NodeContext]
-getNodeContext n = runOpaQuery (selectNodeContext $ pgNodeId n)
+getNodeContexts :: NodeId -> Cmd err [NodeContext]
+getNodeContexts n = runOpaQuery (selectNodeContexts $ pgNodeId n)
   where
-    selectNodeContext :: Column SqlInt4 -> Select NodeContextRead
-    selectNodeContext n' = proc () -> do
+    selectNodeContexts :: Column SqlInt4 -> Select NodeContextRead
+    selectNodeContexts n' = proc () -> do
       ns <- queryNodeContextTable -< ()
       restrict -< _nc_node_id ns .== n'
       returnA -< ns
 
+
+getNodeContext :: HasNodeError err => ContextId -> NodeId -> Cmd err NodeContext
+getNodeContext c n = do
+  maybeNodeContext <- headMay <$>  runOpaQuery (selectNodeContext (pgNodeId c) (pgNodeId n))
+  case maybeNodeContext of
+    Nothing -> nodeError (DoesNotExist c)
+    Just  r -> pure r
+  where
+    selectNodeContext :: Column SqlInt4 -> Column SqlInt4 -> Select NodeContextRead
+    selectNodeContext c' n' = proc () -> do
+      ns <- queryNodeContextTable -< ()
+      restrict -< _nc_context_id ns .== c'
+      restrict -< _nc_node_id ns .== n'
+      returnA -< ns
+
 ------------------------------------------------------------------------
 insertNodeContext :: [NodeContext] -> Cmd err Int
 insertNodeContext ns = mkCmd $ \conn -> fromIntegral <$> (runInsert_ conn

src/Gargantext/Database/Schema/NodeContext.hs

@@ -61,7 +61,7 @@ nodeContextTable :: Table NodeContextWrite NodeContextRead
 nodeContextTable  =
   Table "nodes_contexts"
          ( pNodeContext
-           NodeContext { _nc_id         = optionalTableField "id" 
+           NodeContext { _nc_id         = optionalTableField "id"
                        , _nc_node_id    = requiredTableField "node_id"
                        , _nc_context_id = requiredTableField "context_id"
                        , _nc_score      = optionalTableField "score"