{-# LANGUAGE AllowAmbiguousTypes #-}
module IHP.Job.Types
( Job (..)
, JobWorkerArgs (..)
, JobWorker (..)
, JobStatus (..)
, Worker (..)
, JobWorkerProcess (..)
, JobWorkerProcessMessage (..)
)
where
import IHP.Prelude
import IHP.FrameworkConfig
import qualified Control.Concurrent.Async as Async
import qualified IHP.PGListener as PGListener
import qualified Control.Concurrent as Concurrent
class Job job where
perform :: (?modelContext :: ModelContext, ?context :: FrameworkConfig) => job -> IO ()
maxAttempts :: (?job :: job) => Int
maxAttempts = Int
10
timeoutInMicroseconds :: (?job :: job) => Maybe Int
timeoutInMicroseconds = forall a. Maybe a
Nothing
queuePollInterval :: Int
queuePollInterval = Int
60 forall a. Num a => a -> a -> a
* Int
1000000
maxConcurrency :: Int
maxConcurrency = Int
16
class Worker application where
workers :: application -> [JobWorker]
data JobWorkerArgs = JobWorkerArgs
{ JobWorkerArgs -> UUID
workerId :: UUID
, JobWorkerArgs -> ModelContext
modelContext :: ModelContext
, JobWorkerArgs -> FrameworkConfig
frameworkConfig :: FrameworkConfig
, JobWorkerArgs -> PGListener
pgListener :: PGListener.PGListener
}
newtype JobWorker = JobWorker (JobWorkerArgs -> IO JobWorkerProcess)
data JobStatus
= JobStatusNotStarted
| JobStatusRunning
| JobStatusFailed
| JobStatusTimedOut
| JobStatusSucceeded
| JobStatusRetry
deriving (JobStatus -> JobStatus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JobStatus -> JobStatus -> Bool
$c/= :: JobStatus -> JobStatus -> Bool
== :: JobStatus -> JobStatus -> Bool
$c== :: JobStatus -> JobStatus -> Bool
Eq, Int -> JobStatus -> ShowS
[JobStatus] -> ShowS
JobStatus -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JobStatus] -> ShowS
$cshowList :: [JobStatus] -> ShowS
show :: JobStatus -> String
$cshow :: JobStatus -> String
showsPrec :: Int -> JobStatus -> ShowS
$cshowsPrec :: Int -> JobStatus -> ShowS
Show, ReadPrec [JobStatus]
ReadPrec JobStatus
Int -> ReadS JobStatus
ReadS [JobStatus]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [JobStatus]
$creadListPrec :: ReadPrec [JobStatus]
readPrec :: ReadPrec JobStatus
$creadPrec :: ReadPrec JobStatus
readList :: ReadS [JobStatus]
$creadList :: ReadS [JobStatus]
readsPrec :: Int -> ReadS JobStatus
$creadsPrec :: Int -> ReadS JobStatus
Read, Int -> JobStatus
JobStatus -> Int
JobStatus -> [JobStatus]
JobStatus -> JobStatus
JobStatus -> JobStatus -> [JobStatus]
JobStatus -> JobStatus -> JobStatus -> [JobStatus]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: JobStatus -> JobStatus -> JobStatus -> [JobStatus]
$cenumFromThenTo :: JobStatus -> JobStatus -> JobStatus -> [JobStatus]
enumFromTo :: JobStatus -> JobStatus -> [JobStatus]
$cenumFromTo :: JobStatus -> JobStatus -> [JobStatus]
enumFromThen :: JobStatus -> JobStatus -> [JobStatus]
$cenumFromThen :: JobStatus -> JobStatus -> [JobStatus]
enumFrom :: JobStatus -> [JobStatus]
$cenumFrom :: JobStatus -> [JobStatus]
fromEnum :: JobStatus -> Int
$cfromEnum :: JobStatus -> Int
toEnum :: Int -> JobStatus
$ctoEnum :: Int -> JobStatus
pred :: JobStatus -> JobStatus
$cpred :: JobStatus -> JobStatus
succ :: JobStatus -> JobStatus
$csucc :: JobStatus -> JobStatus
Enum)
data JobWorkerProcess
= JobWorkerProcess
{ JobWorkerProcess -> [Async ()]
runners :: [Async ()]
, JobWorkerProcess -> Subscription
subscription :: PGListener.Subscription
, JobWorkerProcess -> Async ()
poller :: Async ()
, JobWorkerProcess -> MVar JobWorkerProcessMessage
action :: Concurrent.MVar JobWorkerProcessMessage
}
data JobWorkerProcessMessage
= JobAvailable
| Stop