{-# LANGUAGE OverloadedStrings #-}

-- | Status values derived from a job row by the queue status SQL.
module Arbiter.Core.Job.Status
  ( JobStatus (..)
  , jobStatusToText
  , jobStatusFromText
  ) where

import Data.Aeson (FromJSON (..), ToJSON (..), withText)
import Data.Text (Text)
import Data.Text qualified as T
import GHC.Generics (Generic)

-- | Effective job status. Arbiter derives status from the stored fields. The status SQL
-- in "Arbiter.Core.Sql.Jobs" is its source of truth.
data JobStatus = Ready | InFlight | Backoff | Scheduled | Suspended | Throttled | Cancelled
  deriving stock (JobStatus
JobStatus -> JobStatus -> Bounded JobStatus
forall a. a -> a -> Bounded a
$cminBound :: JobStatus
minBound :: JobStatus
$cmaxBound :: JobStatus
maxBound :: JobStatus
Bounded, Int -> JobStatus
JobStatus -> Int
JobStatus -> [JobStatus]
JobStatus -> JobStatus
JobStatus -> JobStatus -> [JobStatus]
JobStatus -> JobStatus -> JobStatus -> [JobStatus]
(JobStatus -> JobStatus)
-> (JobStatus -> JobStatus)
-> (Int -> JobStatus)
-> (JobStatus -> Int)
-> (JobStatus -> [JobStatus])
-> (JobStatus -> JobStatus -> [JobStatus])
-> (JobStatus -> JobStatus -> [JobStatus])
-> (JobStatus -> JobStatus -> JobStatus -> [JobStatus])
-> Enum 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
$csucc :: JobStatus -> JobStatus
succ :: JobStatus -> JobStatus
$cpred :: JobStatus -> JobStatus
pred :: JobStatus -> JobStatus
$ctoEnum :: Int -> JobStatus
toEnum :: Int -> JobStatus
$cfromEnum :: JobStatus -> Int
fromEnum :: JobStatus -> Int
$cenumFrom :: JobStatus -> [JobStatus]
enumFrom :: JobStatus -> [JobStatus]
$cenumFromThen :: JobStatus -> JobStatus -> [JobStatus]
enumFromThen :: JobStatus -> JobStatus -> [JobStatus]
$cenumFromTo :: JobStatus -> JobStatus -> [JobStatus]
enumFromTo :: JobStatus -> JobStatus -> [JobStatus]
$cenumFromThenTo :: JobStatus -> JobStatus -> JobStatus -> [JobStatus]
enumFromThenTo :: JobStatus -> JobStatus -> JobStatus -> [JobStatus]
Enum, JobStatus -> JobStatus -> Bool
(JobStatus -> JobStatus -> Bool)
-> (JobStatus -> JobStatus -> Bool) -> Eq JobStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JobStatus -> JobStatus -> Bool
== :: JobStatus -> JobStatus -> Bool
$c/= :: JobStatus -> JobStatus -> Bool
/= :: JobStatus -> JobStatus -> Bool
Eq, (forall x. JobStatus -> Rep JobStatus x)
-> (forall x. Rep JobStatus x -> JobStatus) -> Generic JobStatus
forall x. Rep JobStatus x -> JobStatus
forall x. JobStatus -> Rep JobStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. JobStatus -> Rep JobStatus x
from :: forall x. JobStatus -> Rep JobStatus x
$cto :: forall x. Rep JobStatus x -> JobStatus
to :: forall x. Rep JobStatus x -> JobStatus
Generic, Int -> JobStatus -> ShowS
[JobStatus] -> ShowS
JobStatus -> String
(Int -> JobStatus -> ShowS)
-> (JobStatus -> String)
-> ([JobStatus] -> ShowS)
-> Show JobStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JobStatus -> ShowS
showsPrec :: Int -> JobStatus -> ShowS
$cshow :: JobStatus -> String
show :: JobStatus -> String
$cshowList :: [JobStatus] -> ShowS
showList :: [JobStatus] -> ShowS
Show)

-- | The wire name for a status.
jobStatusToText :: JobStatus -> Text
jobStatusToText :: JobStatus -> Text
jobStatusToText JobStatus
Ready = Text
"ready"
jobStatusToText JobStatus
InFlight = Text
"in_flight"
jobStatusToText JobStatus
Backoff = Text
"backoff"
jobStatusToText JobStatus
Scheduled = Text
"scheduled"
jobStatusToText JobStatus
Suspended = Text
"suspended"
jobStatusToText JobStatus
Throttled = Text
"throttled"
jobStatusToText JobStatus
Cancelled = Text
"cancelled"

-- | Strict inverse of 'jobStatusToText'. Unknown values are rejected.
jobStatusFromText :: Text -> Either Text JobStatus
jobStatusFromText :: Text -> Either Text JobStatus
jobStatusFromText Text
name =
  Either Text JobStatus
-> (JobStatus -> Either Text JobStatus)
-> Maybe JobStatus
-> Either Text JobStatus
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Either Text JobStatus
forall a b. a -> Either a b
Left (Text
"unknown job status: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name)) JobStatus -> Either Text JobStatus
forall a b. b -> Either a b
Right (Maybe JobStatus -> Either Text JobStatus)
-> Maybe JobStatus -> Either Text JobStatus
forall a b. (a -> b) -> a -> b
$
    Text -> [(Text, JobStatus)] -> Maybe JobStatus
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
name [(JobStatus -> Text
jobStatusToText JobStatus
status, JobStatus
status) | JobStatus
status <- [JobStatus
forall a. Bounded a => a
minBound .. JobStatus
forall a. Bounded a => a
maxBound]]

instance ToJSON JobStatus where
  toJSON :: JobStatus -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (JobStatus -> Text) -> JobStatus -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JobStatus -> Text
jobStatusToText

instance FromJSON JobStatus where
  parseJSON :: Value -> Parser JobStatus
parseJSON = String -> (Text -> Parser JobStatus) -> Value -> Parser JobStatus
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"JobStatus" ((Text -> Parser JobStatus) -> Value -> Parser JobStatus)
-> (Text -> Parser JobStatus) -> Value -> Parser JobStatus
forall a b. (a -> b) -> a -> b
$ (Text -> Parser JobStatus)
-> (JobStatus -> Parser JobStatus)
-> Either Text JobStatus
-> Parser JobStatus
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Parser JobStatus
forall a. HasCallStack => String -> Parser a
forall (m :: * -> *) a.
(MonadFail m, HasCallStack) =>
String -> m a
fail (String -> Parser JobStatus)
-> (Text -> String) -> Text -> Parser JobStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) JobStatus -> Parser JobStatus
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text JobStatus -> Parser JobStatus)
-> (Text -> Either Text JobStatus) -> Text -> Parser JobStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text JobStatus
jobStatusFromText