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       documentUpload uId nId q (liftBase . log')
  73     )
  74
  75 documentUpload :: (FlowCmdM env err m)
  76                => UserId
  77                -> NodeId
  78                -> DocumentUpload
  79                -> (JobLog -> m ())
  80                -> m JobLog
  81 documentUpload _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   mcId <- getClosestParentIdByType' nId NodeCorpus
  88   let cId = case mcId of
  89         Just c  -> c
  90         Nothing -> panic $ T.pack $ "[G.A.N.DU] Node has no corpus parent: " <> show nId
  91
  92   let (theFullDate, (year, month, day)) = dateSplit EN
  93                                           $ Just
  94                                           $ view du_date doc <> "T:0:0:0"
  95
  96   let hd = HyperdataDocument { _hd_bdd = Nothing
  97                              , _hd_doi = Nothing
  98                              , _hd_url = Nothing
  99                              , _hd_uniqId = Nothing
 100                              , _hd_uniqIdBdd = Nothing
 101                              , _hd_page = Nothing
 102                              , _hd_title = Just $ view du_title doc
 103                              , _hd_authors = Just $ view du_authors doc
 104                              , _hd_institutes = Nothing
 105                              , _hd_source             = Just $ view du_sources doc
 106                              , _hd_abstract           = Just $ view du_abstract doc
 107                              , _hd_publication_date   = fmap (T.pack . show) theFullDate
 108                              , _hd_publication_year   = year
 109                              , _hd_publication_month  = month
 110                              , _hd_publication_day    = day
 111                              , _hd_publication_hour   = Nothing
 112                              , _hd_publication_minute = Nothing
 113                              , _hd_publication_second = Nothing
 114                              , _hd_language_iso2 = Just $ T.pack $ show EN }
 115
 116   docIds <- insertMasterDocs (Nothing :: Maybe HyperdataCorpus) (Multi EN) [hd]
 117   _ <- Doc.add cId docIds
 118
 119   pure $ jobLogSuccess jl