1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
{-|
Module : Gargantext.Utils.Jobs.Monad
Description : Job monad
Copyright : (c) CNRS, 2024
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
module Gargantext.Utils.Jobs.Monad (
-- * Types and classes
JobError(..)
-- * Reporting errors to users in a friendly way
, ToHumanFriendlyError(..)
-- * Tracking jobs status
, MonadJobStatus(..)
-- * Functions
, markFailedNoErr
, markFailureNoErr
) where
import Control.Exception.Safe
import Data.Kind (Type)
import Data.Proxy
import Data.Text qualified as T
import Data.Void (Void)
import Gargantext.Utils.Jobs.Error
import Prelude
data JobError
=
-- | We expected to find a job tagged internall as \"job\", but we found the input @T.Text@ instead.
InvalidIDType T.Text
-- | The given ID expired.
| IDExpired Int
| InvalidMacID T.Text
| UnknownJob Int
| JobException SomeException
deriving Show
-- | Polymorphic logger over any monad @m@.
type LoggerM m w = w -> m ()
-- | A @'Logger' w@ is a function that can do something with "messages" of type
-- @w@ in IO.
type Logger w = LoggerM IO w
--
-- Tracking jobs status
--
-- | A monad to query for the status of a particular job /and/ submit updates for in-progress jobs.
class MonadJobStatus m where
-- | This is type family for the concrete 'JobHandle' that is associated to
-- a job when it starts and it can be used to query for its completion status. Different environment
-- can decide how this will look like.
type JobHandle m :: Type
type JobOutputType m :: Type
type JobEventType m :: Type
-- | A job handle that doesn't do anything. Sometimes useful in all those circumstances
-- where we need to test a function taking a 'JobHandle' as input but we are not interested
-- in the progress tracking.
noJobHandle :: Proxy m -> JobHandle m
-- | Retrevies the latest 'JobEventType' from the underlying monad. It can be
-- used to query the latest status for a particular job, given its 'JobHandle' as input.
getLatestJobStatus :: JobHandle m -> m (JobEventType m)
-- | Adds an extra \"tracer\" that logs events to the passed action. Produces
-- a new 'JobHandle'.
withTracer :: Logger (JobEventType m) -> JobHandle m -> (JobHandle m -> m a) -> m a
-- Creating events
-- | Start tracking a new 'JobEventType' with 'n' remaining steps.
markStarted :: Int -> JobHandle m -> m ()
-- | Mark 'n' steps of the job as succeeded, while simultaneously substracting this number
-- from the remaining steps.
markProgress :: Int -> JobHandle m -> m ()
-- | Mark 'n' step of the job as failed, while simultaneously substracting this number
-- from the remaining steps. Attach an optional error message to the failure.
markFailure :: forall e. ToHumanFriendlyError e => Int -> Maybe e -> JobHandle m -> m ()
-- | Finish tracking a job by marking all the remaining steps as succeeded.
markComplete :: JobHandle m -> m ()
-- | Finish tracking a job by marking all the remaining steps as failed. Attach an optional
-- message to the failure.
markFailed :: forall e. ToHumanFriendlyError e => Maybe e -> JobHandle m -> m ()
-- | Add 'n' more steps to the running computation, they will be marked as remaining.
addMoreSteps :: MonadJobStatus m => Int -> JobHandle m -> m ()
-- | Helper on top of 'markFailed' for when we don't have a diagnostic to log.
markFailedNoErr :: MonadJobStatus m => JobHandle m -> m ()
markFailedNoErr = markFailed (Nothing :: Maybe Void)
markFailureNoErr :: MonadJobStatus m => Int -> JobHandle m -> m ()
markFailureNoErr steps = markFailure steps (Nothing :: Maybe Void)