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 dbContextForNgrams
 142   :: (CmdCommon env)
 143   => Int -> [Text] -> GqlM e env [ContextGQL]
 144 dbContextForNgrams node_id ngrams_terms = do
 145   contextsForNgramsTerms <- lift $ getContextsForNgramsTerms (NodeId node_id) ngrams_terms
 146   --lift $ printDebug "[dbContextForNgrams] contextsForNgramsTerms" contextsForNgramsTerms
 147   pure $ toContextGQL <$> contextsForNgramsTerms
 148
 149 dbContextNgrams
 150   :: (CmdCommon env)
 151   => Int -> Int -> GqlM e env [Text]
 152 dbContextNgrams context_id list_id = do
 153   lift $ getContextNgramsMatchingFTS (NodeId context_id) (NodeId list_id)
 154
 155 -- Conversion functions
 156
 157 toNodeContextGQL :: NodeContext -> NodeContextGQL
 158 toNodeContextGQL (NodeContext { _nc_node_id = NodeId nc_node_id
 159                               , _nc_context_id = NodeId nc_context_id
 160                               , .. }) =
 161   NodeContextGQL { nc_id = _nc_id
 162                  , nc_node_id
 163                  , nc_context_id
 164                  , nc_score = _nc_score
 165                  , nc_category = _nc_category }
 166
 167 toContextGQL :: ContextForNgramsTerms -> ContextGQL
 168 toContextGQL ContextForNgramsTerms { _cfnt_nodeId = c_id
 169                                    , _cfnt_hash = c_hash_id
 170                                    , _cfnt_nodeTypeId = c_typename
 171                                    , _cfnt_userId = c_user_id
 172                                    , _cfnt_parentId = m_c_parent_id
 173                                    , _cfnt_c_title = c_name
 174                                    , _cfnt_date = c_date
 175                                    , _cfnt_hyperdata =hyperdata
 176                                    , _cfnt_score = c_score
 177                                    , _cfnt_category = c_category } =
 178   ContextGQL { c_id = unNodeId c_id
 179              , c_parent_id = unNodeId <$> m_c_parent_id
 180              , c_date = pack $ iso8601Show c_date
 181              , c_hyperdata = toHyperdataRowDocumentGQL hyperdata
 182              , c_score
 183              , c_category
 184              , .. }
 185
 186 toHyperdataRowDocumentGQL :: HyperdataDocument -> Maybe HyperdataRowDocumentGQL
 187 toHyperdataRowDocumentGQL hyperdata =
 188   case toHyperdataRow hyperdata of
 189     HyperdataRowDocument { .. } ->
 190       Just $ HyperdataRowDocumentGQL { hrd_abstract           = _hr_abstract
 191                                      , hrd_authors            = _hr_authors
 192                                      , hrd_bdd                = _hr_bdd
 193                                      , hrd_doi                = _hr_doi
 194                                      , hrd_institutes         = _hr_institutes
 195                                      , hrd_language_iso2      = _hr_language_iso2
 196                                      , hrd_page               = _hr_page
 197                                      , hrd_publication_date   = _hr_publication_date
 198                                      , hrd_publication_day    = _hr_publication_day
 199                                      , hrd_publication_hour   = _hr_publication_hour
 200                                      , hrd_publication_minute = _hr_publication_minute
 201                                      , hrd_publication_month  = _hr_publication_month
 202                                      , hrd_publication_second = _hr_publication_second
 203                                      , hrd_publication_year   = _hr_publication_year
 204                                      , hrd_source             = _hr_source
 205                                      , hrd_title              = _hr_title
 206                                      , hrd_url                = _hr_url
 207                                      , hrd_uniqId             = _hr_uniqId
 208                                      , hrd_uniqIdBdd          = _hr_uniqIdBdd
 209                                      }
 210     HyperdataRowContact { } -> Nothing
 211
 212 updateNodeContextCategory :: ( CmdCommon env, HasSettings env) =>
 213                              NodeContextCategoryMArgs -> GqlM' e env [Int]
 214 updateNodeContextCategory NodeContextCategoryMArgs { context_id, node_id, category } = do
 215   _ <- lift $ DNC.updateNodeContextCategory (NodeId context_id) (NodeId node_id) category
 216
 217   pure [1]