src/Gargantext/API/GraphQL/Context.hs

   1 {-# LANGUAGE DeriveAnyClass #-}
   2 {-# LANGUAGE DuplicateRecordFields #-}
   3
   4 module Gargantext.API.GraphQL.Context where
   5
   6 -- TODO Add support for adding FrameWrite comments for a Context
   7
   8 import Data.Morpheus.Types
   9   ( GQLType
  10   , Resolver
  11   , QUERY
  12   , lift
  13   )
  14 import Gargantext.API.Prelude (GargM, GargError)
  15 import Gargantext.Core.Mail.Types (HasMail)
  16 import Gargantext.Database.Admin.Types.Node (NodeId(..))
  17 import Gargantext.Database.Prelude (HasConnectionPool, HasConfig)
  18 import Gargantext.Database.Query.Table.NodeContext (getNodeContext)
  19 import Gargantext.Database.Schema.NodeContext (NodeContext, NodeContextPoly(..))
  20 import Gargantext.Prelude
  21 import GHC.Generics (Generic)
  22
  23 data NodeContextGQL = NodeContextGQL
  24    { nc_id         :: Maybe Int
  25    , nc_node_id    :: Int
  26    , nc_context_id :: Int
  27    , nc_score      :: Maybe Double
  28    , nc_category   :: Maybe Int
  29    }
  30   deriving (Generic, GQLType, Show)
  31
  32 -- | Arguments to the "context node" query.
  33 data NodeContextArgs
  34   = NodeContextArgs
  35     { context_id :: Int
  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 context from a query.
  42 resolveNodeContext
  43   :: (HasConnectionPool env, HasConfig env, HasMail env)
  44   => NodeContextArgs -> GqlM e env [NodeContextGQL]
  45 resolveNodeContext NodeContextArgs { context_id, node_id } = dbNodeContext context_id node_id
  46
  47 -- | Inner function to fetch the node context DB.
  48 dbNodeContext
  49   :: (HasConnectionPool env, HasConfig env, HasMail env)
  50   => Int -> Int -> GqlM e env [NodeContextGQL]
  51 dbNodeContext context_id node_id = do
  52   -- lift $ printDebug "[dbUsers]" user_id
  53 --  user <- getUsersWithId user_id
  54 --  hyperdata <- getUserHyperdata user_id
  55 --  lift (map toUser <$> zip user hyperdata)
  56   c <- lift $ getNodeContext (NodeId context_id) (NodeId node_id)
  57   pure [toNodeContextGQL c]
  58
  59 toNodeContextGQL :: NodeContext -> NodeContextGQL
  60 toNodeContextGQL (NodeContext { _nc_node_id = NodeId nc_node_id
  61                               , _nc_context_id = NodeId nc_context_id
  62                               , .. }) =
  63   NodeContextGQL { nc_id = _nc_id
  64                  , nc_node_id
  65                  , nc_context_id
  66                  , nc_score = _nc_score
  67                  , nc_category = _nc_category }