src/Gargantext/API/Job.hs

   1 module Gargantext.API.Job where
   2
   3 import Control.Lens (over, _Just)
   4 import Data.IORef
   5 import Data.Maybe
   6 import qualified Data.Text as T
   7
   8 import Gargantext.Prelude
   9
  10 import Gargantext.API.Admin.Orchestrator.Types
  11
  12
  13 jobLogInit :: Int -> JobLog
  14 jobLogInit rem =
  15   JobLog { _scst_succeeded = Just 0
  16          , _scst_remaining = Just rem
  17          , _scst_failed = Just 0
  18          , _scst_events = Just [] }
  19
  20 addEvent :: T.Text -> T.Text -> JobLog -> JobLog
  21 addEvent level message (JobLog { _scst_events = mEvts, .. }) = JobLog { _scst_events = Just (evts <> [ newEvt ]), .. }
  22   where
  23     evts = fromMaybe [] mEvts
  24     newEvt = ScraperEvent { _scev_message = Just message
  25                           , _scev_level = Just level
  26                           , _scev_date = Nothing }
  27
  28 jobLogSuccess :: JobLog -> JobLog
  29 jobLogSuccess jl = over (scst_succeeded . _Just) (+ 1) $
  30                    over (scst_remaining . _Just) (\x -> x - 1) jl
  31
  32 jobLogFail :: JobLog -> JobLog
  33 jobLogFail jl = over (scst_failed . _Just) (+ 1) $
  34                 over (scst_remaining . _Just) (\x -> x - 1) jl
  35
  36 jobLogFailTotal :: JobLog -> JobLog
  37 jobLogFailTotal (JobLog { _scst_succeeded = mSucc
  38                         , _scst_remaining = mRem
  39                         , _scst_failed = mFail
  40                         , _scst_events = evt }) =
  41   JobLog { _scst_succeeded = mSucc
  42          , _scst_remaining = newRem
  43          , _scst_failed = newFail
  44          , _scst_events = evt }
  45   where
  46     (newRem, newFail) = case mRem of
  47       Nothing -> (Nothing, mFail)
  48       Just rem -> (Just 0, (+ rem) <$> mFail)
  49
  50 jobLogFailTotalWithMessage :: T.Text -> JobLog -> JobLog
  51 jobLogFailTotalWithMessage message jl = addEvent "ERROR" message $ jobLogFailTotal jl
  52
  53 jobLogEvt :: JobLog -> ScraperEvent -> JobLog
  54 jobLogEvt jl evt = over (scst_events . _Just) (\evts -> (evt:evts)) jl
  55
  56 runJobLog :: MonadBase IO m => Int -> (JobLog -> m ()) -> m (m (), m (), m JobLog)
  57 runJobLog num logStatus = do
  58   jlRef <- liftBase $ newIORef $ jobLogInit num
  59
  60   return (logRefF jlRef, logRefSuccessF jlRef, getRefF jlRef)
  61
  62   where
  63     logRefF ref = do
  64       jl <- liftBase $ readIORef ref
  65       logStatus jl
  66     logRefSuccessF ref = do
  67       jl <- liftBase $ readIORef ref
  68       let jl' = jobLogSuccess jl
  69       liftBase $ writeIORef ref jl'
  70       logStatus jl'
  71     getRefF ref = do
  72       liftBase $ readIORef ref