Job.hs 2.29 KB
Newer Older
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 9

import Gargantext.Prelude

10
import Gargantext.API.Admin.Orchestrator.Types
11

12

13 14 15 16 17 18 19
jobLogInit :: Int -> JobLog
jobLogInit rem =
  JobLog { _scst_succeeded = Just 0
         , _scst_remaining = Just rem
         , _scst_failed = Just 0
         , _scst_events = Just [] }

20 21 22 23 24 25 26 27
addEvent :: T.Text -> T.Text -> JobLog -> JobLog
addEvent level message (JobLog { _scst_events = mEvts, .. }) = JobLog { _scst_events = Just (evts <> [ newEvt ]), .. }
  where
    evts = fromMaybe [] mEvts
    newEvt = ScraperEvent { _scev_message = Just message
                          , _scev_level = Just level
                          , _scev_date = Nothing }

28
jobLogSuccess :: JobLog -> JobLog
29 30
jobLogSuccess jl = over (scst_succeeded . _Just) (+ 1) $
                   over (scst_remaining . _Just) (\x -> x - 1) jl
31 32

jobLogFail :: JobLog -> JobLog
33 34 35 36 37 38 39 40
jobLogFail jl = over (scst_failed . _Just) (+ 1) $
                over (scst_remaining . _Just) (\x -> x - 1) jl

jobLogFailTotal :: JobLog -> JobLog
jobLogFailTotal (JobLog { _scst_succeeded = mSucc
                        , _scst_remaining = mRem
                        , _scst_failed = mFail
                        , _scst_events = evt }) =
41
  JobLog { _scst_succeeded = mSucc
42 43
         , _scst_remaining = newRem
         , _scst_failed = newFail
44
         , _scst_events = evt }
45 46 47 48 49
  where
    (newRem, newFail) = case mRem of
      Nothing -> (Nothing, mFail)
      Just rem -> (Just 0, (+ rem) <$> mFail)

50 51 52
jobLogFailTotalWithMessage :: T.Text -> JobLog -> JobLog
jobLogFailTotalWithMessage message jl = addEvent "ERROR" message $ jobLogFailTotal jl

53 54
jobLogEvt :: JobLog -> ScraperEvent -> JobLog
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 61 62 63

  return (logRefF jlRef, logRefSuccessF jlRef, getRefF jlRef)

  where
    logRefF ref = do
64
      jl <- liftBase $ readIORef ref
65 66
      logStatus jl
    logRefSuccessF ref = do
67
      jl <- liftBase $ readIORef ref
68 69 70
      let jl' = jobLogSuccess jl
      liftBase $ writeIORef ref jl'
      logStatus jl'
71
    getRefF ref = do
72
      liftBase $ readIORef ref