module Faktory.Job
( Job
, JobId
, JobOptions
, perform
, retry
, once
, queue
, jobtype
, at
, in_
, newJob
, jobJid
, jobArg
) where
import Faktory.Prelude
import Data.Aeson
import Data.Aeson.Casing
import Data.List.NonEmpty (NonEmpty)
import qualified Data.List.NonEmpty as NE
import Data.Time
import Faktory.Client (Client, pushJob)
import Faktory.Settings (Queue)
import GHC.Generics
import GHC.Stack
import System.Random
data Job arg = Job
{ jobJid :: JobId
, jobJobtype :: String
, jobArgs :: NonEmpty arg
, jobRetry :: Maybe Int
, jobQueue :: Maybe Queue
, jobAt :: Maybe UTCTime
}
deriving Generic
data JobUpdate
= SetRetry Int
| SetQueue Queue
| SetJobtype String
| SetAt UTCTime
| SetIn NominalDiffTime
newtype JobOptions = JobOptions [JobUpdate]
deriving newtype (Semigroup, Monoid)
perform :: (HasCallStack, ToJSON arg) => JobOptions -> Client -> arg -> IO JobId
perform options client arg = do
job <- applyOptions options =<< newJob arg
jobJid job <$ pushJob client job
applyOptions :: JobOptions -> Job arg -> IO (Job arg)
applyOptions (JobOptions patches) = go patches
where
go [] job = pure job
go (set : sets) job = case set of
SetRetry n -> go sets $ job { jobRetry = Just n }
SetQueue q -> go sets $ job { jobQueue = Just q }
SetJobtype jt -> go sets $ job { jobJobtype = jt }
SetAt time -> go sets $ job { jobAt = Just time }
SetIn diff -> do
now <- getCurrentTime
go sets $ job { jobAt = Just $ addUTCTime diff now }
retry :: Int -> JobOptions
retry n = JobOptions [SetRetry n]
once :: JobOptions
once = retry (-1)
queue :: Queue -> JobOptions
queue q = JobOptions [SetQueue q]
jobtype :: String -> JobOptions
jobtype jt = JobOptions [SetJobtype jt]
at :: UTCTime -> JobOptions
at t = JobOptions [SetAt t]
in_ :: NominalDiffTime -> JobOptions
in_ i = JobOptions [SetIn i]
newJob :: arg -> IO (Job arg)
newJob arg = do
jobId <- take 12 . randomRs ('a', 'z') <$> newStdGen
pure Job
{ jobJid = jobId
, jobJobtype = "Default"
, jobArgs = pure arg
, jobRetry = Nothing
, jobQueue = Nothing
, jobAt = Nothing
}
jobArg :: Job arg -> arg
jobArg Job {..} = NE.head jobArgs
instance ToJSON args => ToJSON (Job args) where
toJSON = genericToJSON $ aesonPrefix snakeCase
toEncoding = genericToEncoding $ aesonPrefix snakeCase
instance FromJSON args => FromJSON (Job args) where
parseJSON = genericParseJSON $ aesonPrefix snakeCase
type JobId = String