Skip to content

Instantly share code, notes, and snippets.

@pbrisbin
Created March 1, 2021 18:45
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save pbrisbin/7b6f348ff5ff67f63f0f982d378866de to your computer and use it in GitHub Desktop.
Save pbrisbin/7b6f348ff5ff67f63f0f982d378866de to your computer and use it in GitHub Desktop.
-- Form 1
-----------------------------------------------------------------------------------------
data Job arg = Job
{ jobJid :: JobId
, jobJobtype :: String
, jobArgs :: NonEmpty arg
, jobRetry :: Maybe Int
, jobQueue :: Maybe Queue
, jobAt :: Maybe UTCTime
}
deriving stock Generic
data JobUpdate
= SetRetry Int
| SetQueue Queue
| SetJobtype String
| SetAt UTCTime
| SetIn NominalDiffTime
| SetCustom Value
newtype JobOptions = JobOptions [JobUpdate]
deriving newtype (Semigroup, Monoid)
applyOptions :: Producer -> JobOptions -> Job arg -> IO (Job arg)
applyOptions producer (JobOptions patches) = go patches
where
namespace = -- ...
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 $ namespaceQueue namespace 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 }
SetCustom val -> go sets $ job { jobCustom = Just val }
retry :: Int -> JobOptions
retry n = JobOptions [SetRetry n]
-- | Equivalent to @'retry' (-1)@: no retries, and move to Dead on failure
once :: JobOptions
once = retry (-1)
queue :: Queue -> JobOptions
queue q = JobOptions [SetQueue q]
-- Etc...
-- Form 2
-----------------------------------------------------------------------------------------
data BatchOptions arg = BatchOptions
{ boDescription :: Option (First Text)
, boSuccess :: Option (First (Job arg))
, boComplete :: Option (First (Job arg))
}
deriving stock Generic
deriving Semigroup via GenericSemigroupMonoid (BatchOptions arg)
description :: Text -> BatchOptions arg
description d = BatchOptions
{ boDescription = Option $ Just $ First d
, boSuccess = Option Nothing
, boComplete = Option Nothing
}
complete :: Job arg -> BatchOptions arg
complete job = BatchOptions
{ boDescription = Option Nothing
, boSuccess = Option Nothing
, boComplete = Option $ Just $ First job
}
-- etc...
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment