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.Format.ISO8601 (iso8601Show)
  17 import Gargantext.API.Admin.Types (HasSettings)
  18 import Gargantext.API.Prelude (GargM, GargError)
  19 import Gargantext.Core.Types.Search (HyperdataRow(..), toHyperdataRow)
  20 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument)
  21 import Gargantext.Database.Admin.Types.Node (ContextTitle, NodeId(..), NodeTypeId, UserId, unNodeId)
  22 import Gargantext.Database.Prelude (CmdCommon)
  23 import Gargantext.Database.Query.Table.NodeContext (getNodeContext, getContextsForNgramsTerms, ContextForNgramsTerms(..), {- getContextNgrams, -} getContextNgramsMatchingFTS)
  24 import qualified Gargantext.Database.Query.Table.NodeContext as DNC
  25 import Gargantext.Database.Schema.NodeContext (NodeContext, NodeContextPoly(..))
  26 import Gargantext.Prelude
  27 import Gargantext.Prelude.Crypto.Hash (Hash)
  28 import GHC.Generics (Generic)
  29
  30 data ContextGQL = ContextGQL
  31   { c_id        :: Int
  32   , c_hash_id   :: Maybe Hash
  33   , c_typename  :: NodeTypeId
  34   , c_user_id   :: UserId
  35   , c_parent_id :: Maybe Int
  36   , c_name      :: ContextTitle
  37   , c_date      :: Text  -- TODO UTCTime
  38   , c_hyperdata :: Maybe HyperdataRowDocumentGQL
  39   , c_score     :: Maybe Double
  40   , c_category  :: Maybe Int
  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_terms :: [Text]
  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 data ContextNgramsArgs
  98   = ContextNgramsArgs
  99     { context_id  :: Int
 100     , list_id     :: Int }
 101     deriving (Generic, GQLType)
 102
 103 type GqlM e env = Resolver QUERY e (GargM env GargError)
 104 type GqlM' e env a = ResolverM e (GargM env GargError) a
 105
 106 -- GQL API
 107
 108 -- | Function to resolve context from a query.
 109 resolveNodeContext
 110   :: (CmdCommon env)
 111   => NodeContextArgs -> GqlM e env [NodeContextGQL]
 112 resolveNodeContext NodeContextArgs { context_id, node_id } =
 113   dbNodeContext context_id node_id
 114
 115 resolveContextsForNgrams
 116   :: (CmdCommon env)
 117   => ContextsForNgramsArgs -> GqlM e env [ContextGQL]
 118 resolveContextsForNgrams ContextsForNgramsArgs { corpus_id, ngrams_terms } =
 119   dbContextForNgrams corpus_id ngrams_terms
 120
 121 resolveContextNgrams
 122   :: (CmdCommon env)
 123   => ContextNgramsArgs -> GqlM e env [Text]
 124 resolveContextNgrams ContextNgramsArgs { context_id, list_id } =
 125   dbContextNgrams context_id list_id
 126
 127 -- DB
 128
 129 -- | Inner function to fetch the node context DB.
 130 dbNodeContext
 131   :: (CmdCommon env)
 132   => Int -> Int -> GqlM e env [NodeContextGQL]
 133 dbNodeContext context_id node_id = do
 134   -- lift $ printDebug "[dbUsers]" user_id
 135 --  user <- getUsersWithId user_id
 136 --  hyperdata <- getUserHyperdata user_id
 137 --  lift (map toUser <$> zip user hyperdata)
 138   c <- lift $ getNodeContext (NodeId context_id) (NodeId node_id)
 139   pure $ toNodeContextGQL <$> [c]
 140
 141 -- | Returns list of `ContextGQL` for given ngrams in given corpus id.
 142 dbContextForNgrams
 143   :: (CmdCommon env)
 144   => Int -> [Text] -> GqlM e env [ContextGQL]
 145 dbContextForNgrams node_id ngrams_terms = do
 146   contextsForNgramsTerms <- lift $ getContextsForNgramsTerms (NodeId node_id) ngrams_terms
 147   --lift $ printDebug "[dbContextForNgrams] contextsForNgramsTerms" contextsForNgramsTerms
 148   pure $ toContextGQL <$> contextsForNgramsTerms
 149
 150 -- | Fetch ngrams matching given context in a given list id.
 151 dbContextNgrams
 152   :: (CmdCommon env)
 153   => Int -> Int -> GqlM e env [Text]
 154 dbContextNgrams context_id list_id = do
 155   lift $ getContextNgramsMatchingFTS (NodeId context_id) (NodeId list_id)
 156
 157 -- Conversion functions
 158
 159 toNodeContextGQL :: NodeContext -> NodeContextGQL
 160 toNodeContextGQL (NodeContext { _nc_node_id = NodeId nc_node_id
 161                               , _nc_context_id = NodeId nc_context_id
 162                               , .. }) =
 163   NodeContextGQL { nc_id = _nc_id
 164                  , nc_node_id
 165                  , nc_context_id
 166                  , nc_score = _nc_score
 167                  , nc_category = _nc_category }
 168
 169 toContextGQL :: ContextForNgramsTerms -> ContextGQL
 170 toContextGQL ContextForNgramsTerms { _cfnt_nodeId = c_id
 171                                    , _cfnt_hash = c_hash_id
 172                                    , _cfnt_nodeTypeId = c_typename
 173                                    , _cfnt_userId = c_user_id
 174                                    , _cfnt_parentId = m_c_parent_id
 175                                    , _cfnt_c_title = c_name
 176                                    , _cfnt_date = c_date
 177                                    , _cfnt_hyperdata =hyperdata
 178                                    , _cfnt_score = c_score
 179                                    , _cfnt_category = c_category } =
 180   ContextGQL { c_id = unNodeId c_id
 181              , c_parent_id = unNodeId <$> m_c_parent_id
 182              , c_date = pack $ iso8601Show c_date
 183              , c_hyperdata = toHyperdataRowDocumentGQL hyperdata
 184              , c_score
 185              , c_category
 186              , .. }
 187
 188 toHyperdataRowDocumentGQL :: HyperdataDocument -> Maybe HyperdataRowDocumentGQL
 189 toHyperdataRowDocumentGQL hyperdata =
 190   case toHyperdataRow hyperdata of
 191     HyperdataRowDocument { .. } ->
 192       Just $ HyperdataRowDocumentGQL { hrd_abstract           = _hr_abstract
 193                                      , hrd_authors            = _hr_authors
 194                                      , hrd_bdd                = _hr_bdd
 195                                      , hrd_doi                = _hr_doi
 196                                      , hrd_institutes         = _hr_institutes
 197                                      , hrd_language_iso2      = _hr_language_iso2
 198                                      , hrd_page               = _hr_page
 199                                      , hrd_publication_date   = _hr_publication_date
 200                                      , hrd_publication_day    = _hr_publication_day
 201                                      , hrd_publication_hour   = _hr_publication_hour
 202                                      , hrd_publication_minute = _hr_publication_minute
 203                                      , hrd_publication_month  = _hr_publication_month
 204                                      , hrd_publication_second = _hr_publication_second
 205                                      , hrd_publication_year   = _hr_publication_year
 206                                      , hrd_source             = _hr_source
 207                                      , hrd_title              = _hr_title
 208                                      , hrd_url                = _hr_url
 209                                      , hrd_uniqId             = _hr_uniqId
 210                                      , hrd_uniqIdBdd          = _hr_uniqIdBdd
 211                                      }
 212     HyperdataRowContact { } -> Nothing
 213
 214 updateNodeContextCategory :: ( CmdCommon env, HasSettings env) =>
 215                              NodeContextCategoryMArgs -> GqlM' e env [Int]
 216 updateNodeContextCategory NodeContextCategoryMArgs { context_id, node_id, category } = do
 217   _ <- lift $ DNC.updateNodeContextCategory (NodeId context_id) (NodeId node_id) category
 218
 219   pure [1]