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