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 qualified Data.Text as T
  12 import Data.Time.Clock
  13 import Data.Time.Calendar
  14 import GHC.Generics (Generic)
  15 import Servant
  16 import Servant.Job.Async
  17
  18 import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
  19 import Gargantext.API.Job (jobLogSuccess)
  20 import Gargantext.API.Prelude
  21 import Gargantext.Core (Lang(..))
  22 import Gargantext.Core.Text.Terms (TermType(..))
  23 import Gargantext.Core.Types.Individu (User(..))
  24 import Gargantext.Core.Utils.Prefix (unCapitalize, dropPrefix)
  25 import Gargantext.Database.Action.Flow (flowDataText, DataText(..))
  26 import Gargantext.Database.Action.Flow.Types
  27 import Gargantext.Database.Admin.Types.Hyperdata.Document (HyperdataDocument(..))
  28 import Gargantext.Database.Admin.Types.Node
  29 import Gargantext.Database.Query.Table.Node (getClosestParentIdByType')
  30 import Gargantext.Prelude
  31
  32 data DocumentUpload = DocumentUpload
  33   { _du_abstract :: T.Text
  34   , _du_authors  :: T.Text
  35   , _du_sources  :: T.Text
  36   , _du_title    :: T.Text }
  37   deriving (Generic)
  38
  39 $(makeLenses ''DocumentUpload)
  40
  41 instance ToSchema DocumentUpload
  42 instance FromJSON DocumentUpload
  43   where
  44     parseJSON = genericParseJSON
  45             ( defaultOptions { sumEncoding = ObjectWithSingleField
  46                             , fieldLabelModifier = unCapitalize . dropPrefix "_du_"
  47                             , omitNothingFields = True
  48                             }
  49             )
  50 instance ToJSON DocumentUpload
  51   where
  52     toJSON = genericToJSON
  53            ( defaultOptions { sumEncoding = ObjectWithSingleField
  54                             , fieldLabelModifier = unCapitalize . dropPrefix "_du_"
  55                             , omitNothingFields = True
  56                             }
  57            )
  58
  59 type API = Summary " Document upload"
  60            :> "document"
  61            :> "upload"
  62            :> "async"
  63            :> AsyncJobs JobLog '[JSON] DocumentUpload JobLog
  64
  65 api :: UserId -> NodeId -> GargServer API
  66 api uId nId =
  67   serveJobsAPI $
  68     JobFunction (\q log' -> do
  69       documentUpload uId nId q (liftBase . log')
  70     )
  71
  72 documentUpload :: (FlowCmdM env err m)
  73                => UserId
  74                -> NodeId
  75                -> DocumentUpload
  76                -> (JobLog -> m ())
  77                -> m JobLog
  78 documentUpload uId nId doc logStatus = do
  79   let jl = JobLog { _scst_succeeded = Just 0
  80                   , _scst_failed    = Just 0
  81                   , _scst_remaining = Just 1
  82                   , _scst_events    = Just [] }
  83   logStatus jl
  84
  85   mcId <- getClosestParentIdByType' nId NodeCorpus
  86   let cId = case mcId of
  87         Just c  -> c
  88         Nothing -> panic $ T.pack $ "[G.A.N.DU] Node has no corpus parent: " <> show nId
  89
  90   (year, month, day) <- liftBase $ getCurrentTime >>= return . toGregorian . utctDay
  91   let nowS = T.pack $ show year <> "-" <> show month <> "-" <> show day
  92
  93   let hd = HyperdataDocument { _hd_bdd = Nothing
  94                              , _hd_doi = Nothing
  95                              , _hd_url = Nothing
  96                              , _hd_uniqId = Nothing
  97                              , _hd_uniqIdBdd = Nothing
  98                              , _hd_page = Nothing
  99                              , _hd_title = Just $ view du_title doc
 100                              , _hd_authors = Just $ view du_authors doc
 101                              , _hd_institutes = Nothing
 102                              , _hd_source = Just $ view du_sources doc
 103                              , _hd_abstract = Just $ view du_abstract doc
 104                              , _hd_publication_date = Just nowS
 105                              , _hd_publication_year = Just $ fromIntegral year
 106                              , _hd_publication_month = Just month
 107                              , _hd_publication_day = Just day
 108                              , _hd_publication_hour = Nothing
 109                              , _hd_publication_minute = Nothing
 110                              , _hd_publication_second = Nothing
 111                              , _hd_language_iso2 = Just $ T.pack $ show EN }
 112
 113   _ <- flowDataText (RootId (NodeId uId)) (DataNew [[hd]]) (Multi EN) cId Nothing
 114
 115   pure $ jobLogSuccess jl