src/Gargantext/Prelude/Job.hs

   1 module Gargantext.Prelude.Job where
   2
   3 import Data.IORef
   4 import Data.Maybe
   5
   6 import Gargantext.Prelude
   7
   8 import Gargantext.API.Admin.Orchestrator.Types (JobLog(..))
   9
  10
  11 jobLogInit :: Int -> JobLog
  12 jobLogInit rem =
  13   JobLog { _scst_succeeded = Just 0
  14          , _scst_remaining = Just rem
  15          , _scst_failed = Just 0
  16          , _scst_events = Just [] }
  17
  18 jobLogSuccess :: JobLog -> JobLog
  19 jobLogSuccess (JobLog { _scst_succeeded = mSucc
  20                       , _scst_remaining = mRem
  21                       , _scst_failed = mFail
  22                       , _scst_events = evt }) =
  23   JobLog { _scst_succeeded = (+ 1) <$> mSucc
  24          , _scst_remaining = (\x -> x - 1) <$> mRem
  25          , _scst_failed = mFail
  26          , _scst_events = evt }
  27
  28
  29 jobLogFail :: JobLog -> JobLog
  30 jobLogFail (JobLog { _scst_succeeded = mSucc
  31                    , _scst_remaining = mRem
  32                    , _scst_failed = mFail
  33                    , _scst_events = evt }) =
  34   JobLog { _scst_succeeded = mSucc
  35          , _scst_remaining = (\x -> x - 1) <$> mRem
  36          , _scst_failed = (+ 1) <$> mFail
  37          , _scst_events = evt }
  38
  39 runJobLog :: MonadBase IO m => Int -> (JobLog -> m ()) -> m (m (), m (), m JobLog)
  40 runJobLog num logStatus = do
  41   jlRef <- liftBase $ newIORef $ jobLogInit num
  42
  43   return (logRefF jlRef, logRefSuccessF jlRef, getRefF jlRef)
  44
  45   where
  46     logRefF ref = do
  47       jl <- liftBase $ readIORef ref
  48       logStatus jl
  49     logRefSuccessF ref = do
  50       jl <- liftBase $ readIORef ref
  51       let jl' = jobLogSuccess jl
  52       liftBase $ writeIORef ref jl'
  53       logStatus jl'
  54     getRefF ref = do
  55       liftBase $ readIORef ref