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
   7 import Gargantext.Prelude
   8
   9 import Gargantext.API.Admin.Orchestrator.Types
  10
  11
  12 jobLogInit :: Int -> JobLog
  13 jobLogInit rem =
  14   JobLog { _scst_succeeded = Just 0
  15          , _scst_remaining = Just rem
  16          , _scst_failed = Just 0
  17          , _scst_events = Just [] }
  18
  19 jobLogSuccess :: JobLog -> JobLog
  20 jobLogSuccess jl = over (scst_succeeded . _Just) (+ 1) $
  21                    over (scst_remaining . _Just) (\x -> x - 1) jl
  22
  23 jobLogFail :: JobLog -> JobLog
  24 jobLogFail jl = over (scst_failed . _Just) (+ 1) $
  25                 over (scst_remaining . _Just) (\x -> x - 1) jl
  26
  27 jobLogFailTotal :: JobLog -> JobLog
  28 jobLogFailTotal (JobLog { _scst_succeeded = mSucc
  29                         , _scst_remaining = mRem
  30                         , _scst_failed = mFail
  31                         , _scst_events = evt }) =
  32   JobLog { _scst_succeeded = mSucc
  33          , _scst_remaining = newRem
  34          , _scst_failed = newFail
  35          , _scst_events = evt }
  36   where
  37     (newRem, newFail) = case mRem of
  38       Nothing -> (Nothing, mFail)
  39       Just rem -> (Just 0, (+ rem) <$> mFail)
  40
  41 jobLogEvt :: JobLog -> ScraperEvent -> JobLog
  42 jobLogEvt jl evt = over (scst_events . _Just) (\evts -> (evt:evts)) jl
  43
  44 runJobLog :: MonadBase IO m => Int -> (JobLog -> m ()) -> m (m (), m (), m JobLog)
  45 runJobLog num logStatus = do
  46   jlRef <- liftBase $ newIORef $ jobLogInit num
  47
  48   return (logRefF jlRef, logRefSuccessF jlRef, getRefF jlRef)
  49
  50   where
  51     logRefF ref = do
  52       jl <- liftBase $ readIORef ref
  53       logStatus jl
  54     logRefSuccessF ref = do
  55       jl <- liftBase $ readIORef ref
  56       let jl' = jobLogSuccess jl
  57       liftBase $ writeIORef ref jl'
  58       logStatus jl'
  59     getRefF ref = do
  60       liftBase $ readIORef ref