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   , ResolverM
  12   , QUERY
  13   , lift
  14   )
  15 import Gargantext.API.Admin.Types (HasSettings)
  16 import Gargantext.API.Prelude (GargM, GargError)
  17 import Gargantext.Core.Mail.Types (HasMail)
  18 import Gargantext.Database.Admin.Types.Node (NodeId(..))
  19 import Gargantext.Database.Prelude (HasConnectionPool, HasConfig)
  20 import Gargantext.Database.Query.Table.NodeContext (getNodeContext)
  21 import qualified Gargantext.Database.Query.Table.NodeContext as DNC
  22 import Gargantext.Database.Schema.NodeContext (NodeContext, NodeContextPoly(..))
  23 import Gargantext.Prelude
  24 import GHC.Generics (Generic)
  25
  26 data NodeContextGQL = NodeContextGQL
  27    { nc_id         :: Maybe Int
  28    , nc_node_id    :: Int
  29    , nc_context_id :: Int
  30    , nc_score      :: Maybe Double
  31    , nc_category   :: Maybe Int
  32    }
  33   deriving (Generic, GQLType, Show)
  34
  35 -- | Arguments to the "context node" query.
  36 data NodeContextArgs
  37   = NodeContextArgs
  38     { context_id :: Int
  39     , node_id    :: Int
  40     } deriving (Generic, GQLType)
  41
  42 data NodeContextCategoryMArgs = NodeContextCategoryMArgs
  43   { context_id :: Int
  44   , node_id    :: Int
  45   , category   :: Int
  46   } deriving (Generic, GQLType)
  47
  48 type GqlM e env = Resolver QUERY e (GargM env GargError)
  49 type GqlM' e env a = ResolverM e (GargM env GargError) a
  50
  51 -- | Function to resolve context from a query.
  52 resolveNodeContext
  53   :: (HasConnectionPool env, HasConfig env, HasMail env)
  54   => NodeContextArgs -> GqlM e env [NodeContextGQL]
  55 resolveNodeContext NodeContextArgs { context_id, node_id } = dbNodeContext context_id node_id
  56
  57 -- | Inner function to fetch the node context DB.
  58 dbNodeContext
  59   :: (HasConnectionPool env, HasConfig env, HasMail env)
  60   => Int -> Int -> GqlM e env [NodeContextGQL]
  61 dbNodeContext context_id node_id = do
  62   -- lift $ printDebug "[dbUsers]" user_id
  63 --  user <- getUsersWithId user_id
  64 --  hyperdata <- getUserHyperdata user_id
  65 --  lift (map toUser <$> zip user hyperdata)
  66   c <- lift $ getNodeContext (NodeId context_id) (NodeId node_id)
  67   pure [toNodeContextGQL c]
  68
  69 toNodeContextGQL :: NodeContext -> NodeContextGQL
  70 toNodeContextGQL (NodeContext { _nc_node_id = NodeId nc_node_id
  71                               , _nc_context_id = NodeId nc_context_id
  72                               , .. }) =
  73   NodeContextGQL { nc_id = _nc_id
  74                  , nc_node_id
  75                  , nc_context_id
  76                  , nc_score = _nc_score
  77                  , nc_category = _nc_category }
  78
  79 updateNodeContextCategory :: (HasConnectionPool env, HasConfig env, HasMail env, HasSettings env) =>
  80                              NodeContextCategoryMArgs -> GqlM' e env [Int]
  81 updateNodeContextCategory NodeContextCategoryMArgs { context_id, node_id, category } = do
  82   _ <- lift $ DNC.updateNodeContextCategory (NodeId context_id) (NodeId node_id) category
  83
  84   pure [1]