{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
module Gargantext.API.Node.DocumentsFromWriteNodes
where
import qualified Data.Text as T
import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
import Gargantext.API.Admin.Types (HasSettings)
+import Gargantext.API.Job (jobLogSuccess, jobLogFailTotalWithMessage)
import Gargantext.API.Prelude (GargServer)
import Gargantext.Core (Lang(..))
import Gargantext.Core.Text.Corpus.Parsers.FrameWrite
-> (JobLog -> m ())
-> m JobLog
documentsFromWriteNodes uId nId _p logStatus = do
-
- logStatus JobLog { _scst_succeeded = Just 1
- , _scst_failed = Just 0
- , _scst_remaining = Just 1
- , _scst_events = Just []
- }
+ let jobLog = JobLog { _scst_succeeded = Just 1
+ , _scst_failed = Just 0
+ , _scst_remaining = Just 1
+ , _scst_events = Just []
+ }
+ logStatus jobLog
mcId <- getClosestParentIdByType' nId NodeCorpus
- let cId = maybe (panic "[G.A.N.DFWN] Node has no parent") identity mcId
+ cId <- case mcId of
+ Just cId -> pure cId
+ Nothing -> do
+ let msg = T.pack $ "[G.A.N.DFWN] Node has no corpus parent: " <> show nId
+ logStatus $ jobLogFailTotalWithMessage msg jobLog
+ panic msg
frameWriteIds <- getChildrenByType nId NodeFrameWrite
let parsedE = (\(node, contents) -> hyperdataDocumentFromFrameWrite (node ^. node_hyperdata, contents)) <$> frameWritesWithContents
let parsed = rights parsedE
- _ <- flowDataText (RootId (NodeId uId)) (DataNew [parsed]) (Multi EN) cId Nothing
+ _ <- flowDataText (RootId (NodeId uId)) (DataNew [parsed]) (Multi EN) cId Nothing logStatus
- pure JobLog { _scst_succeeded = Just 2
- , _scst_failed = Just 0
- , _scst_remaining = Just 0
- , _scst_events = Just []
- }
+ pure $ jobLogSuccess jobLog
------------------------------------------------------------------------
hyperdataDocumentFromFrameWrite :: (HyperdataFrame, T.Text) -> Either T.Text HyperdataDocument
hyperdataDocumentFromFrameWrite (HyperdataFrame { _hf_base, _hf_frame_id }, contents) =
case parseLines contents of
Left _ -> Left "Error parsing node"
Right (Parsed { authors, contents = c, date, source, title = t }) ->
- let authorJoinSingle (Author { firstName, lastName }) = T.concat [ lastName, ", ", firstName ] in
- let authors' = T.concat $ authorJoinSingle <$> authors in
+ let authorJoinSingle (Author { firstName, lastName }) = T.concat [ lastName, ", ", firstName ]
+ authors' = T.concat $ authorJoinSingle <$> authors
+ date' = (\(Date { year, month, day }) -> T.concat [ T.pack $ show year, "-"
+ , T.pack $ show month, "-"
+ , T.pack $ show day ]) <$> date
+ year' = fromIntegral $ maybe 2021 (\(Date { year }) -> year) date
+ month' = fromIntegral $ maybe 10 (\(Date { month }) -> month) date
+ day' = fromIntegral $ maybe 4 (\(Date { day }) -> day) date in
Right HyperdataDocument { _hd_bdd = Just "FrameWrite"
, _hd_doi = Nothing
, _hd_url = Nothing
, _hd_institutes = Nothing
, _hd_source = source
, _hd_abstract = Just c
- , _hd_publication_date = date
- , _hd_publication_year = Just 2021 -- TODO
- , _hd_publication_month = Just 10 -- TODO
- , _hd_publication_day = Just 4 -- TODO
+ , _hd_publication_date = date'
+ , _hd_publication_year = Just year'
+ , _hd_publication_month = Just month'
+ , _hd_publication_day = Just day'
, _hd_publication_hour = Nothing
, _hd_publication_minute = Nothing
, _hd_publication_second = Nothing