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 Data.Text (Text, pack)
  16 import Data.Time (UTCTime)
  17 import Data.Time.Format.ISO8601 (iso8601Show)
  18 import Gargantext.API.Admin.Types (HasSettings)
  19 import Gargantext.API.Prelude (GargM, GargError)
  20 import Gargantext.Core.Types.Search (HyperdataRow(..), toHyperdataRow)
  21 import Gargantext.Core.Mail.Types (HasMail)
  22 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument)
  23 import Gargantext.Database.Admin.Types.Node (ContextTitle, NodeId(..), NodeTypeId, ParentId, UserId, unNodeId)
  24 import Gargantext.Database.Prelude (HasConnectionPool, HasConfig)
  25 import Gargantext.Database.Query.Table.NodeContext (getNodeContext, getContextsForNgrams)
  26 import qualified Gargantext.Database.Query.Table.NodeContext as DNC
  27 import Gargantext.Database.Schema.NodeContext (NodeContext, NodeContextPoly(..))
  28 import Gargantext.Prelude
  29 import Gargantext.Prelude.Crypto.Hash (Hash)
  30 import GHC.Generics (Generic)
  31
  32 data ContextGQL = ContextGQL
  33   { c_id        :: Int
  34   , c_hash_id   :: Maybe Hash
  35   , c_typename  :: NodeTypeId
  36   , c_user_id   :: UserId
  37   , c_parent_id :: Maybe Int
  38   , c_name      :: ContextTitle
  39   , c_date      :: Text  -- TODO UTCTime
  40   , c_hyperdata :: Maybe HyperdataRowDocumentGQL
  41   } deriving (Generic, GQLType, Show)
  42
  43 -- We need this type instead of HyperdataRow(HyperdataRowDocument)
  44 -- because the latter is a sum type (of doc and contact) and we return
  45 -- docs here only. Without the union type, GraphQL endpoint is simpler.
  46 data HyperdataRowDocumentGQL =
  47   HyperdataRowDocumentGQL { hrd_abstract           :: !Text
  48                           , hrd_authors            :: !Text
  49                           , hrd_bdd                :: !Text
  50                           , hrd_doi                :: !Text
  51                           , hrd_institutes         :: !Text
  52                           , hrd_language_iso2      :: !Text
  53                           , hrd_page               :: !Int
  54                           , hrd_publication_date   :: !Text
  55                           , hrd_publication_day    :: !Int
  56                           , hrd_publication_hour   :: !Int
  57                           , hrd_publication_minute :: !Int
  58                           , hrd_publication_month  :: !Int
  59                           , hrd_publication_second :: !Int
  60                           , hrd_publication_year   :: !Int
  61                           , hrd_source             :: !Text
  62                           , hrd_title              :: !Text
  63                           , hrd_url                :: !Text
  64                           , hrd_uniqId             :: !Text
  65                           , hrd_uniqIdBdd          :: !Text
  66                           } deriving (Generic, GQLType, Show)
  67
  68 data NodeContextGQL = NodeContextGQL
  69    { nc_id         :: Maybe Int
  70    , nc_node_id    :: Int
  71    , nc_context_id :: Int
  72    , nc_score      :: Maybe Double
  73    , nc_category   :: Maybe Int
  74    } deriving (Generic, GQLType, Show)
  75
  76 -- | Arguments to the "context node" query.
  77 --   "context_id" is doc id
  78 --   "node_id" is it's corpus id
  79 data NodeContextArgs
  80   = NodeContextArgs
  81     { context_id :: Int
  82     , node_id    :: Int
  83     } deriving (Generic, GQLType)
  84
  85 data ContextsForNgramsArgs
  86   = ContextsForNgramsArgs
  87     { corpus_id :: Int
  88     , ngrams_ids :: [Int]
  89     } deriving (Generic, GQLType)
  90
  91 data NodeContextCategoryMArgs = NodeContextCategoryMArgs
  92   { context_id :: Int
  93   , node_id    :: Int
  94   , category   :: Int
  95   } deriving (Generic, GQLType)
  96
  97 type GqlM e env = Resolver QUERY e (GargM env GargError)
  98 type GqlM' e env a = ResolverM e (GargM env GargError) a
  99
 100 -- GQL API
 101
 102 -- | Function to resolve context from a query.
 103 resolveNodeContext
 104   :: (HasConnectionPool env, HasConfig env, HasMail env)
 105   => NodeContextArgs -> GqlM e env [NodeContextGQL]
 106 resolveNodeContext NodeContextArgs { context_id, node_id } =
 107   dbNodeContext context_id node_id
 108
 109 resolveContextsForNgrams
 110   :: (HasConnectionPool env, HasConfig env, HasMail env)
 111   => ContextsForNgramsArgs -> GqlM e env [ContextGQL]
 112 resolveContextsForNgrams ContextsForNgramsArgs { corpus_id, ngrams_ids } =
 113   dbContextForNgrams corpus_id ngrams_ids
 114
 115 -- DB
 116
 117 -- | Inner function to fetch the node context DB.
 118 dbNodeContext
 119   :: (HasConnectionPool env, HasConfig env, HasMail env)
 120   => Int -> Int -> GqlM e env [NodeContextGQL]
 121 dbNodeContext context_id node_id = do
 122   -- lift $ printDebug "[dbUsers]" user_id
 123 --  user <- getUsersWithId user_id
 124 --  hyperdata <- getUserHyperdata user_id
 125 --  lift (map toUser <$> zip user hyperdata)
 126   c <- lift $ getNodeContext (NodeId context_id) (NodeId node_id)
 127   pure $ toNodeContextGQL <$> [c]
 128
 129 dbContextForNgrams
 130   :: (HasConnectionPool env, HasConfig env, HasMail env)
 131   => Int -> [Int] -> GqlM e env [ContextGQL]
 132 dbContextForNgrams node_id ngrams_ids = do
 133   contextTuples <- lift $ getContextsForNgrams (NodeId node_id) ngrams_ids
 134   lift $ printDebug "[dbContextForNgrams] contextTuples" contextTuples
 135   pure $ toContextGQL <$> contextTuples
 136
 137 -- Conversion functions
 138
 139 toNodeContextGQL :: NodeContext -> NodeContextGQL
 140 toNodeContextGQL (NodeContext { _nc_node_id = NodeId nc_node_id
 141                               , _nc_context_id = NodeId nc_context_id
 142                               , .. }) =
 143   NodeContextGQL { nc_id = _nc_id
 144                  , nc_node_id
 145                  , nc_context_id
 146                  , nc_score = _nc_score
 147                  , nc_category = _nc_category }
 148
 149 toContextGQL :: (NodeId, Maybe Hash, NodeTypeId, UserId, Maybe ParentId, ContextTitle, UTCTime, HyperdataDocument) -> ContextGQL
 150 toContextGQL ( c_id
 151              , c_hash_id
 152              , c_typename
 153              , c_user_id
 154              , m_c_parent_id
 155              , c_name
 156              , c_date
 157              , hyperdata ) = ContextGQL { c_id = unNodeId c_id
 158                                         , c_parent_id = unNodeId <$> m_c_parent_id
 159                                         , c_date = pack $ iso8601Show c_date
 160                                         , c_hyperdata = toHyperdataRowDocumentGQL hyperdata
 161                                         , .. }
 162
 163 toHyperdataRowDocumentGQL :: HyperdataDocument -> Maybe HyperdataRowDocumentGQL
 164 toHyperdataRowDocumentGQL hyperdata =
 165   case toHyperdataRow hyperdata of
 166     HyperdataRowDocument { .. } ->
 167       Just $ HyperdataRowDocumentGQL { hrd_abstract           = _hr_abstract
 168                                      , hrd_authors            = _hr_authors
 169                                      , hrd_bdd                = _hr_bdd
 170                                      , hrd_doi                = _hr_doi
 171                                      , hrd_institutes         = _hr_institutes
 172                                      , hrd_language_iso2      = _hr_language_iso2
 173                                      , hrd_page               = _hr_page
 174                                      , hrd_publication_date   = _hr_publication_date
 175                                      , hrd_publication_day    = _hr_publication_day
 176                                      , hrd_publication_hour   = _hr_publication_hour
 177                                      , hrd_publication_minute = _hr_publication_minute
 178                                      , hrd_publication_month  = _hr_publication_month
 179                                      , hrd_publication_second = _hr_publication_second
 180                                      , hrd_publication_year   = _hr_publication_year
 181                                      , hrd_source             = _hr_source
 182                                      , hrd_title              = _hr_title
 183                                      , hrd_url                = _hr_url
 184                                      , hrd_uniqId             = _hr_uniqId
 185                                      , hrd_uniqIdBdd          = _hr_uniqIdBdd
 186                                      }
 187     HyperdataRowContact _ _ _ -> Nothing
 188
 189 updateNodeContextCategory :: (HasConnectionPool env, HasConfig env, HasMail env, HasSettings env) =>
 190                              NodeContextCategoryMArgs -> GqlM' e env [Int]
 191 updateNodeContextCategory NodeContextCategoryMArgs { context_id, node_id, category } = do
 192   _ <- lift $ DNC.updateNodeContextCategory (NodeId context_id) (NodeId node_id) category
 193
 194   pure [1]