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