src/Gargantext/API/Node/DocumentUpload.hs

   1 {-# LANGUAGE AllowAmbiguousTypes #-}
   2 {-# LANGUAGE MonoLocalBinds      #-}
   3 {-# LANGUAGE TemplateHaskell     #-}
   4 {-# LANGUAGE TypeOperators       #-}
   5
   6 module Gargantext.API.Node.DocumentUpload where
   7
   8 import Control.Lens (makeLenses, view)
   9 import Data.Aeson
  10 import Data.Swagger (ToSchema)
  11 import GHC.Generics (Generic)
  12 import Servant
  13 import Servant.Job.Async
  14 import qualified Data.Text as T
  15
  16 import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
  17 import Gargantext.API.Job (jobLogSuccess)
  18 import Gargantext.API.Prelude
  19 import Gargantext.Core (Lang(..))
  20 import Gargantext.Core.Text.Corpus.Parsers.Date (dateSplit)
  21 import Gargantext.Core.Utils.Prefix (unCapitalize, dropPrefix)
  22 import Gargantext.Database.Action.Flow.Types
  23 import Gargantext.Core.Text.Terms (TermType(..))
  24 import Gargantext.Database.Action.Flow (insertMasterDocs)
  25 import Gargantext.Database.Admin.Types.Hyperdata.Document (HyperdataDocument(..))
  26 import qualified Gargantext.Database.Query.Table.Node.Document.Add  as Doc  (add)
  27 import Gargantext.Database.Admin.Types.Node
  28 import Gargantext.Database.Query.Table.Node (getClosestParentIdByType')
  29 import Gargantext.Prelude
  30 import Gargantext.Database.Admin.Types.Hyperdata.Corpus (HyperdataCorpus(..))
  31
  32
  33 data DocumentUpload = DocumentUpload
  34   { _du_abstract :: T.Text
  35   , _du_authors  :: T.Text
  36   , _du_sources  :: T.Text
  37   , _du_title    :: T.Text
  38   , _du_date     :: T.Text
  39   }
  40   deriving (Generic)
  41
  42 $(makeLenses ''DocumentUpload)
  43
  44 instance ToSchema DocumentUpload
  45 instance FromJSON DocumentUpload
  46   where
  47     parseJSON = genericParseJSON
  48             ( defaultOptions { sumEncoding = ObjectWithSingleField
  49                             , fieldLabelModifier = unCapitalize . dropPrefix "_du_"
  50                             , omitNothingFields = True
  51                             }
  52             )
  53 instance ToJSON DocumentUpload
  54   where
  55     toJSON = genericToJSON
  56            ( defaultOptions { sumEncoding = ObjectWithSingleField
  57                             , fieldLabelModifier = unCapitalize . dropPrefix "_du_"
  58                             , omitNothingFields = True
  59                             }
  60            )
  61
  62 type API = Summary " Document upload"
  63            :> "document"
  64            :> "upload"
  65            :> "async"
  66            :> AsyncJobs JobLog '[JSON] DocumentUpload JobLog
  67
  68 api :: UserId -> NodeId -> GargServer API
  69 api uId nId =
  70   serveJobsAPI $
  71     JobFunction (\q log' -> do
  72       documentUploadAsync uId nId q (liftBase . log')
  73     )
  74
  75 documentUploadAsync :: (FlowCmdM env err m)
  76                => UserId
  77                -> NodeId
  78                -> DocumentUpload
  79                -> (JobLog -> m ())
  80                -> m JobLog
  81 documentUploadAsync _uId nId doc logStatus = do
  82   let jl = JobLog { _scst_succeeded = Just 0
  83                   , _scst_failed    = Just 0
  84                   , _scst_remaining = Just 1
  85                   , _scst_events    = Just [] }
  86   logStatus jl
  87   _ <- documentUpload nId doc
  88   pure $ jobLogSuccess jl
  89
  90
  91
  92 documentUpload :: (FlowCmdM env err m)
  93                => NodeId
  94                -> DocumentUpload
  95                -> m [DocId]
  96 documentUpload nId doc = do
  97   mcId <- getClosestParentIdByType' nId NodeCorpus
  98   let cId = case mcId of
  99         Just c  -> c
 100         Nothing -> panic $ T.pack $ "[G.A.N.DU] Node has no corpus parent: " <> show nId
 101
 102   (theFullDate, (year, month, day)) <- liftBase
 103                                  $ dateSplit EN
 104                                  $ Just
 105                                  $ view du_date doc <> "T:0:0:0"
 106
 107   let hd = HyperdataDocument { _hd_bdd = Nothing
 108                              , _hd_doi = Nothing
 109                              , _hd_url = Nothing
 110                              , _hd_uniqId = Nothing
 111                              , _hd_uniqIdBdd = Nothing
 112                              , _hd_page = Nothing
 113                              , _hd_title = Just $ view du_title doc
 114                              , _hd_authors = Just $ view du_authors doc
 115                              , _hd_institutes = Nothing
 116                              , _hd_source             = Just $ view du_sources doc
 117                              , _hd_abstract           = Just $ view du_abstract doc
 118                              , _hd_publication_date   = fmap (T.pack . show) theFullDate
 119                              , _hd_publication_year   = year
 120                              , _hd_publication_month  = month
 121                              , _hd_publication_day    = day
 122                              , _hd_publication_hour   = Nothing
 123                              , _hd_publication_minute = Nothing
 124                              , _hd_publication_second = Nothing
 125                              , _hd_language_iso2 = Just $ T.pack $ show EN }
 126
 127   docIds <- insertMasterDocs (Nothing :: Maybe HyperdataCorpus) (Multi EN) [hd]
 128   _ <- Doc.add cId docIds
 129   pure docIds
 130
 131