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   (theFullDate, (year, month, day)) <- liftBase
  93                                  $ dateSplit EN
  94                                  $ Just
  95                                  $ view du_date doc <> "T:0:0:0"
  96
  97   let hd = HyperdataDocument { _hd_bdd = Nothing
  98                              , _hd_doi = Nothing
  99                              , _hd_url = Nothing
 100                              , _hd_uniqId = Nothing
 101                              , _hd_uniqIdBdd = Nothing
 102                              , _hd_page = Nothing
 103                              , _hd_title = Just $ view du_title doc
 104                              , _hd_authors = Just $ view du_authors doc
 105                              , _hd_institutes = Nothing
 106                              , _hd_source             = Just $ view du_sources doc
 107                              , _hd_abstract           = Just $ view du_abstract doc
 108                              , _hd_publication_date   = fmap (T.pack . show) theFullDate
 109                              , _hd_publication_year   = year
 110                              , _hd_publication_month  = month
 111                              , _hd_publication_day    = day
 112                              , _hd_publication_hour   = Nothing
 113                              , _hd_publication_minute = Nothing
 114                              , _hd_publication_second = Nothing
 115                              , _hd_language_iso2 = Just $ T.pack $ show EN }
 116
 117   docIds <- insertMasterDocs (Nothing :: Maybe HyperdataCorpus) (Multi EN) [hd]
 118   _ <- Doc.add cId docIds
 119
 120   pure $ jobLogSuccess jl