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   mcId <- getClosestParentIdByType' nId NodeCorpus
  85   let cId = case mcId of
  86         Just c  -> c
  87         Nothing -> panic $ T.pack $ "[G.A.N.DU] Node has no corpus parent: " <> show nId
  88
  89   (year, month, day) <- liftBase $ getCurrentTime >>= return . toGregorian . utctDay
  90   let nowS = T.pack $ show year <> "-" <> show month <> "-" <> show day
  91   let hd = HyperdataDocument { _hd_bdd = Nothing
  92                              , _hd_doi = Nothing
  93                              , _hd_url = Nothing
  94                              , _hd_uniqId = Nothing
  95                              , _hd_uniqIdBdd = Nothing
  96                              , _hd_page = Nothing
  97                              , _hd_title = Just $ view du_title doc
  98                              , _hd_authors = Just $ view du_authors doc
  99                              , _hd_institutes = Nothing
 100                              , _hd_source = Just $ view du_sources doc
 101                              , _hd_abstract = Just $ view du_abstract doc
 102                              , _hd_publication_date = Just nowS
 103                              , _hd_publication_year = Just $ fromIntegral year
 104                              , _hd_publication_month = Just month
 105                              , _hd_publication_day = Just day
 106                              , _hd_publication_hour = Nothing
 107                              , _hd_publication_minute = Nothing
 108                              , _hd_publication_second = Nothing
 109                              , _hd_language_iso2 = Just $ T.pack $ show EN }
 110   _ <- flowDataText (RootId (NodeId uId)) (DataNew [[hd]]) (Multi EN) cId Nothing logStatus
 111
 112   pure $ jobLogSuccess jl