{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}

module Hercules.API.Projects.SimpleJob where

import Hercules.API.Prelude
import Hercules.API.Projects.SimpleProject (SimpleProject)

data SimpleJob = SimpleJob
  { SimpleJob -> Id "Job"
id :: Id "Job",
    SimpleJob -> SimpleProject
project :: SimpleProject,
    SimpleJob -> Int64
index :: Int64,
    SimpleJob -> JobStatus
status :: JobStatus,
    SimpleJob -> JobPhase
phase :: JobPhase
  }
  deriving ((forall x. SimpleJob -> Rep SimpleJob x)
-> (forall x. Rep SimpleJob x -> SimpleJob) -> Generic SimpleJob
forall x. Rep SimpleJob x -> SimpleJob
forall x. SimpleJob -> Rep SimpleJob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SimpleJob x -> SimpleJob
$cfrom :: forall x. SimpleJob -> Rep SimpleJob x
Generic, Int -> SimpleJob -> ShowS
[SimpleJob] -> ShowS
SimpleJob -> String
(Int -> SimpleJob -> ShowS)
-> (SimpleJob -> String)
-> ([SimpleJob] -> ShowS)
-> Show SimpleJob
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SimpleJob] -> ShowS
$cshowList :: [SimpleJob] -> ShowS
show :: SimpleJob -> String
$cshow :: SimpleJob -> String
showsPrec :: Int -> SimpleJob -> ShowS
$cshowsPrec :: Int -> SimpleJob -> ShowS
Show, SimpleJob -> SimpleJob -> Bool
(SimpleJob -> SimpleJob -> Bool)
-> (SimpleJob -> SimpleJob -> Bool) -> Eq SimpleJob
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SimpleJob -> SimpleJob -> Bool
$c/= :: SimpleJob -> SimpleJob -> Bool
== :: SimpleJob -> SimpleJob -> Bool
$c== :: SimpleJob -> SimpleJob -> Bool
Eq, SimpleJob -> ()
(SimpleJob -> ()) -> NFData SimpleJob
forall a. (a -> ()) -> NFData a
rnf :: SimpleJob -> ()
$crnf :: SimpleJob -> ()
NFData, [SimpleJob] -> Encoding
[SimpleJob] -> Value
SimpleJob -> Encoding
SimpleJob -> Value
(SimpleJob -> Value)
-> (SimpleJob -> Encoding)
-> ([SimpleJob] -> Value)
-> ([SimpleJob] -> Encoding)
-> ToJSON SimpleJob
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [SimpleJob] -> Encoding
$ctoEncodingList :: [SimpleJob] -> Encoding
toJSONList :: [SimpleJob] -> Value
$ctoJSONList :: [SimpleJob] -> Value
toEncoding :: SimpleJob -> Encoding
$ctoEncoding :: SimpleJob -> Encoding
toJSON :: SimpleJob -> Value
$ctoJSON :: SimpleJob -> Value
ToJSON, Value -> Parser [SimpleJob]
Value -> Parser SimpleJob
(Value -> Parser SimpleJob)
-> (Value -> Parser [SimpleJob]) -> FromJSON SimpleJob
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [SimpleJob]
$cparseJSONList :: Value -> Parser [SimpleJob]
parseJSON :: Value -> Parser SimpleJob
$cparseJSON :: Value -> Parser SimpleJob
FromJSON, Proxy SimpleJob -> Declare (Definitions Schema) NamedSchema
(Proxy SimpleJob -> Declare (Definitions Schema) NamedSchema)
-> ToSchema SimpleJob
forall a.
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
declareNamedSchema :: Proxy SimpleJob -> Declare (Definitions Schema) NamedSchema
$cdeclareNamedSchema :: Proxy SimpleJob -> Declare (Definitions Schema) NamedSchema
ToSchema)

data JobPhase
  = Queued
  | Evaluating
  | Building
  | Effects
  | Done
  deriving ((forall x. JobPhase -> Rep JobPhase x)
-> (forall x. Rep JobPhase x -> JobPhase) -> Generic JobPhase
forall x. Rep JobPhase x -> JobPhase
forall x. JobPhase -> Rep JobPhase x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JobPhase x -> JobPhase
$cfrom :: forall x. JobPhase -> Rep JobPhase x
Generic, Int -> JobPhase -> ShowS
[JobPhase] -> ShowS
JobPhase -> String
(Int -> JobPhase -> ShowS)
-> (JobPhase -> String) -> ([JobPhase] -> ShowS) -> Show JobPhase
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JobPhase] -> ShowS
$cshowList :: [JobPhase] -> ShowS
show :: JobPhase -> String
$cshow :: JobPhase -> String
showsPrec :: Int -> JobPhase -> ShowS
$cshowsPrec :: Int -> JobPhase -> ShowS
Show, JobPhase -> JobPhase -> Bool
(JobPhase -> JobPhase -> Bool)
-> (JobPhase -> JobPhase -> Bool) -> Eq JobPhase
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JobPhase -> JobPhase -> Bool
$c/= :: JobPhase -> JobPhase -> Bool
== :: JobPhase -> JobPhase -> Bool
$c== :: JobPhase -> JobPhase -> Bool
Eq, JobPhase -> ()
(JobPhase -> ()) -> NFData JobPhase
forall a. (a -> ()) -> NFData a
rnf :: JobPhase -> ()
$crnf :: JobPhase -> ()
NFData, [JobPhase] -> Encoding
[JobPhase] -> Value
JobPhase -> Encoding
JobPhase -> Value
(JobPhase -> Value)
-> (JobPhase -> Encoding)
-> ([JobPhase] -> Value)
-> ([JobPhase] -> Encoding)
-> ToJSON JobPhase
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [JobPhase] -> Encoding
$ctoEncodingList :: [JobPhase] -> Encoding
toJSONList :: [JobPhase] -> Value
$ctoJSONList :: [JobPhase] -> Value
toEncoding :: JobPhase -> Encoding
$ctoEncoding :: JobPhase -> Encoding
toJSON :: JobPhase -> Value
$ctoJSON :: JobPhase -> Value
ToJSON, Value -> Parser [JobPhase]
Value -> Parser JobPhase
(Value -> Parser JobPhase)
-> (Value -> Parser [JobPhase]) -> FromJSON JobPhase
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [JobPhase]
$cparseJSONList :: Value -> Parser [JobPhase]
parseJSON :: Value -> Parser JobPhase
$cparseJSON :: Value -> Parser JobPhase
FromJSON, Proxy JobPhase -> Declare (Definitions Schema) NamedSchema
(Proxy JobPhase -> Declare (Definitions Schema) NamedSchema)
-> ToSchema JobPhase
forall a.
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
declareNamedSchema :: Proxy JobPhase -> Declare (Definitions Schema) NamedSchema
$cdeclareNamedSchema :: Proxy JobPhase -> Declare (Definitions Schema) NamedSchema
ToSchema)

data JobStatus
  = Pending
  | Failure
  | Success
  deriving ((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
$cto :: forall x. Rep JobStatus x -> JobStatus
$cfrom :: forall x. JobStatus -> Rep JobStatus x
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
showList :: [JobStatus] -> ShowS
$cshowList :: [JobStatus] -> ShowS
show :: JobStatus -> String
$cshow :: JobStatus -> String
showsPrec :: Int -> JobStatus -> ShowS
$cshowsPrec :: Int -> JobStatus -> ShowS
Show, JobStatus -> JobStatus -> Bool
(JobStatus -> JobStatus -> Bool)
-> (JobStatus -> JobStatus -> Bool) -> Eq JobStatus
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, JobStatus -> ()
(JobStatus -> ()) -> NFData JobStatus
forall a. (a -> ()) -> NFData a
rnf :: JobStatus -> ()
$crnf :: JobStatus -> ()
NFData, [JobStatus] -> Encoding
[JobStatus] -> Value
JobStatus -> Encoding
JobStatus -> Value
(JobStatus -> Value)
-> (JobStatus -> Encoding)
-> ([JobStatus] -> Value)
-> ([JobStatus] -> Encoding)
-> ToJSON JobStatus
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [JobStatus] -> Encoding
$ctoEncodingList :: [JobStatus] -> Encoding
toJSONList :: [JobStatus] -> Value
$ctoJSONList :: [JobStatus] -> Value
toEncoding :: JobStatus -> Encoding
$ctoEncoding :: JobStatus -> Encoding
toJSON :: JobStatus -> Value
$ctoJSON :: JobStatus -> Value
ToJSON, Value -> Parser [JobStatus]
Value -> Parser JobStatus
(Value -> Parser JobStatus)
-> (Value -> Parser [JobStatus]) -> FromJSON JobStatus
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [JobStatus]
$cparseJSONList :: Value -> Parser [JobStatus]
parseJSON :: Value -> Parser JobStatus
$cparseJSON :: Value -> Parser JobStatus
FromJSON, Proxy JobStatus -> Declare (Definitions Schema) NamedSchema
(Proxy JobStatus -> Declare (Definitions Schema) NamedSchema)
-> ToSchema JobStatus
forall a.
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
declareNamedSchema :: Proxy JobStatus -> Declare (Definitions Schema) NamedSchema
$cdeclareNamedSchema :: Proxy JobStatus -> Declare (Definitions Schema) NamedSchema
ToSchema)

-- | Whichever is "worse": 'Failure' wins out, otherwise 'Pending' wins out, otherwise all are 'Success'.
instance Semigroup JobStatus where
  JobStatus
Failure <> :: JobStatus -> JobStatus -> JobStatus
<> JobStatus
_ = JobStatus
Failure
  JobStatus
_ <> JobStatus
Failure = JobStatus
Failure
  JobStatus
Pending <> JobStatus
_ = JobStatus
Pending
  JobStatus
_ <> JobStatus
Pending = JobStatus
Pending
  JobStatus
Success <> JobStatus
Success = JobStatus
Success

-- | @mappend@: Whichever is "worse": 'Failure' wins out, otherwise 'Pending' wins out, otherwise all are 'Success'.
--
-- @mempty@: 'Success'
instance Monoid JobStatus where
  mappend :: JobStatus -> JobStatus -> JobStatus
mappend = JobStatus -> JobStatus -> JobStatus
forall a. Semigroup a => a -> a -> a
(<>)

  mempty :: JobStatus
mempty = JobStatus
Success