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(..))
  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 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   :: (CmdCommon env)
 105   => NodeContextArgs -> GqlM e env [NodeContextGQL]
 106 resolveNodeContext NodeContextArgs { context_id, node_id } =
 107   dbNodeContext context_id node_id
 108
 109 resolveContextsForNgrams
 110   :: (CmdCommon env)
 111   => ContextsForNgramsArgs -> GqlM e env [ContextGQL]
 112 resolveContextsForNgrams ContextsForNgramsArgs { corpus_id, ngrams_terms } =
 113   dbContextForNgrams corpus_id ngrams_terms
 114
 115 -- DB
 116
 117 -- | Inner function to fetch the node context DB.
 118 dbNodeContext
 119   :: (CmdCommon 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   :: (CmdCommon env)
 131   => Int -> [Text] -> GqlM e env [ContextGQL]
 132 dbContextForNgrams node_id ngrams_terms = do
 133   contextsForNgramsTerms <- lift $ getContextsForNgramsTerms (NodeId node_id) ngrams_terms
 134   --lift $ printDebug "[dbContextForNgrams] contextsForNgramsTerms" contextsForNgramsTerms
 135   pure $ toContextGQL <$> contextsForNgramsTerms
 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 :: ContextForNgramsTerms -> ContextGQL
 150 toContextGQL ContextForNgramsTerms { _cfnt_nodeId = c_id
 151                                    , _cfnt_hash = c_hash_id
 152                                    , _cfnt_nodeTypeId = c_typename
 153                                    , _cfnt_userId = c_user_id
 154                                    , _cfnt_parentId = m_c_parent_id
 155                                    , _cfnt_c_title = c_name
 156                                    , _cfnt_date = c_date
 157                                    , _cfnt_hyperdata =hyperdata
 158                                    , _cfnt_score = c_score
 159                                    , _cfnt_category = c_category } =
 160   ContextGQL { c_id = unNodeId c_id
 161              , c_parent_id = unNodeId <$> m_c_parent_id
 162              , c_date = pack $ iso8601Show c_date
 163              , c_hyperdata = toHyperdataRowDocumentGQL hyperdata
 164              , c_score
 165              , c_category
 166              , .. }
 167
 168 toHyperdataRowDocumentGQL :: HyperdataDocument -> Maybe HyperdataRowDocumentGQL
 169 toHyperdataRowDocumentGQL hyperdata =
 170   case toHyperdataRow hyperdata of
 171     HyperdataRowDocument { .. } ->
 172       Just $ HyperdataRowDocumentGQL { hrd_abstract           = _hr_abstract
 173                                      , hrd_authors            = _hr_authors
 174                                      , hrd_bdd                = _hr_bdd
 175                                      , hrd_doi                = _hr_doi
 176                                      , hrd_institutes         = _hr_institutes
 177                                      , hrd_language_iso2      = _hr_language_iso2
 178                                      , hrd_page               = _hr_page
 179                                      , hrd_publication_date   = _hr_publication_date
 180                                      , hrd_publication_day    = _hr_publication_day
 181                                      , hrd_publication_hour   = _hr_publication_hour
 182                                      , hrd_publication_minute = _hr_publication_minute
 183                                      , hrd_publication_month  = _hr_publication_month
 184                                      , hrd_publication_second = _hr_publication_second
 185                                      , hrd_publication_year   = _hr_publication_year
 186                                      , hrd_source             = _hr_source
 187                                      , hrd_title              = _hr_title
 188                                      , hrd_url                = _hr_url
 189                                      , hrd_uniqId             = _hr_uniqId
 190                                      , hrd_uniqIdBdd          = _hr_uniqIdBdd
 191                                      }
 192     HyperdataRowContact { } -> Nothing
 193
 194 updateNodeContextCategory :: ( CmdCommon env, HasSettings env) =>
 195                              NodeContextCategoryMArgs -> GqlM' e env [Int]
 196 updateNodeContextCategory NodeContextCategoryMArgs { context_id, node_id, category } = do
 197   _ <- lift $ DNC.updateNodeContextCategory (NodeId context_id) (NodeId node_id) category
 198
 199   pure [1]