{-| Module : Gargantext.API.Node.DocumentUpload Description : Copyright : (c) CNRS, 2017-Present License : AGPL + CECILL v3 Maintainer : team@gargantext.org Stability : experimental Portability : POSIX -} {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE MonoLocalBinds #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeOperators #-} module Gargantext.API.Node.DocumentUpload where import Control.Lens (view) import Data.Text qualified as T import Gargantext.API.Admin.EnvTypes (GargJob(..), Env) import Gargantext.API.Admin.Orchestrator.Types import Gargantext.API.Admin.Types (HasSettings) import Gargantext.API.Errors.Types ( BackendInternalError ) import Gargantext.API.Node.DocumentUpload.Types import Gargantext.API.Prelude ( GargM ) import Gargantext.API.Routes.Named.Document qualified as Named import Gargantext.Core (Lang(..)) import Gargantext.Core.NLP (nlpServerGet) import Gargantext.Core.Text.Corpus.Parsers.Date (mDateSplit) import Gargantext.Core.Text.Terms (TermType(..)) import Gargantext.Database.Action.Flow (addDocumentsToHyperCorpus) import Gargantext.Database.Action.Flow.Types ( FlowCmdM ) import Gargantext.Database.Admin.Types.Hyperdata.Corpus ( HyperdataCorpus ) import Gargantext.Database.Admin.Types.Hyperdata.Document (HyperdataDocument(..)) import Gargantext.Database.Admin.Types.Node ( DocId, NodeId, NodeType(NodeCorpus) ) import Gargantext.Database.Query.Table.Node (getClosestParentIdByType') import Gargantext.Prelude import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..)) import Servant.Server.Generic (AsServerT) api :: NodeId -> Named.DocumentUploadAPI (AsServerT (GargM Env BackendInternalError)) api nId = Named.DocumentUploadAPI $ AsyncJobs $ serveJobsAPI UploadDocumentJob $ \jHandle q -> do documentUploadAsync nId q jHandle documentUploadAsync :: (FlowCmdM env err m, MonadJobStatus m, HasSettings env) => NodeId -> DocumentUpload -> JobHandle m -> m () documentUploadAsync nId doc jobHandle = do markStarted 1 jobHandle _docIds <- documentUpload nId doc -- printDebug "documentUploadAsync" docIds markComplete jobHandle documentUpload :: (FlowCmdM env err m, HasSettings env) => NodeId -> DocumentUpload -> m [DocId] documentUpload nId doc = do mcId <- getClosestParentIdByType' nId NodeCorpus let cId = case mcId of Just c -> c Nothing -> panicTrace $ T.pack $ "[G.A.N.DU] Node has no corpus parent: " <> show nId let mDateS = Just $ view du_date doc let (theFullDate, (year, month, day)) = mDateSplit mDateS let hd = HyperdataDocument { _hd_bdd = Nothing , _hd_doi = Nothing , _hd_url = Nothing , _hd_page = Nothing , _hd_title = Just $ if view du_title doc == "" then T.take 50 (view du_abstract doc) else view du_title doc , _hd_authors = Just $ view du_authors doc , _hd_institutes = Nothing , _hd_source = Just $ view du_sources doc , _hd_abstract = Just $ view du_abstract doc , _hd_publication_date = fmap (T.pack . show) theFullDate , _hd_publication_year = year , _hd_publication_month = month , _hd_publication_day = day , _hd_publication_hour = Nothing , _hd_publication_minute = Nothing , _hd_publication_second = Nothing , _hd_language_iso2 = Just $ view du_language doc } let lang = EN ncs <- view $ nlpServerGet lang addDocumentsToHyperCorpus ncs (Nothing :: Maybe HyperdataCorpus) (Multi lang) cId [hd]