{-# LANGUAGE DeriveAnyClass #-}

module Hercules.API.Effects.EffectInfo where

import Hercules.API.Build.DerivationInfo.DerivationInput (DerivationInput)
import Hercules.API.Effects.EffectEvent (EffectEvent)
import Hercules.API.Prelude
import Hercules.API.Projects.Job (Job)
import Hercules.API.Projects.Project (Project)

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

data EffectInfo = EffectInfo
  { EffectInfo -> EffectStatus
status :: EffectStatus,
    EffectInfo -> Id Job
jobId :: Id Job,
    EffectInfo -> Id Project
projectId :: Id Project,
    EffectInfo -> Text
platform :: Text,
    EffectInfo -> [Text]
requiredSystemFeatures :: [Text],
    EffectInfo -> [DerivationInput]
inputDerivations :: [DerivationInput],
    EffectInfo -> [[EffectEvent]]
events :: [[EffectEvent]],
    EffectInfo -> Bool
mayCancel :: Bool,
    EffectInfo -> Maybe EffectEvent
dummy :: Maybe EffectEvent -- TODO: remove and update/fix codegen
  }
  deriving ((forall x. EffectInfo -> Rep EffectInfo x)
-> (forall x. Rep EffectInfo x -> EffectInfo) -> Generic EffectInfo
forall x. Rep EffectInfo x -> EffectInfo
forall x. EffectInfo -> Rep EffectInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EffectInfo x -> EffectInfo
$cfrom :: forall x. EffectInfo -> Rep EffectInfo x
Generic, Int -> EffectInfo -> ShowS
[EffectInfo] -> ShowS
EffectInfo -> String
(Int -> EffectInfo -> ShowS)
-> (EffectInfo -> String)
-> ([EffectInfo] -> ShowS)
-> Show EffectInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EffectInfo] -> ShowS
$cshowList :: [EffectInfo] -> ShowS
show :: EffectInfo -> String
$cshow :: EffectInfo -> String
showsPrec :: Int -> EffectInfo -> ShowS
$cshowsPrec :: Int -> EffectInfo -> ShowS
Show, EffectInfo -> EffectInfo -> Bool
(EffectInfo -> EffectInfo -> Bool)
-> (EffectInfo -> EffectInfo -> Bool) -> Eq EffectInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EffectInfo -> EffectInfo -> Bool
$c/= :: EffectInfo -> EffectInfo -> Bool
== :: EffectInfo -> EffectInfo -> Bool
$c== :: EffectInfo -> EffectInfo -> Bool
Eq, EffectInfo -> ()
(EffectInfo -> ()) -> NFData EffectInfo
forall a. (a -> ()) -> NFData a
rnf :: EffectInfo -> ()
$crnf :: EffectInfo -> ()
NFData, [EffectInfo] -> Encoding
[EffectInfo] -> Value
EffectInfo -> Encoding
EffectInfo -> Value
(EffectInfo -> Value)
-> (EffectInfo -> Encoding)
-> ([EffectInfo] -> Value)
-> ([EffectInfo] -> Encoding)
-> ToJSON EffectInfo
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [EffectInfo] -> Encoding
$ctoEncodingList :: [EffectInfo] -> Encoding
toJSONList :: [EffectInfo] -> Value
$ctoJSONList :: [EffectInfo] -> Value
toEncoding :: EffectInfo -> Encoding
$ctoEncoding :: EffectInfo -> Encoding
toJSON :: EffectInfo -> Value
$ctoJSON :: EffectInfo -> Value
ToJSON, Value -> Parser [EffectInfo]
Value -> Parser EffectInfo
(Value -> Parser EffectInfo)
-> (Value -> Parser [EffectInfo]) -> FromJSON EffectInfo
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [EffectInfo]
$cparseJSONList :: Value -> Parser [EffectInfo]
parseJSON :: Value -> Parser EffectInfo
$cparseJSON :: Value -> Parser EffectInfo
FromJSON, Proxy EffectInfo -> Declare (Definitions Schema) NamedSchema
(Proxy EffectInfo -> Declare (Definitions Schema) NamedSchema)
-> ToSchema EffectInfo
forall a.
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
declareNamedSchema :: Proxy EffectInfo -> Declare (Definitions Schema) NamedSchema
$cdeclareNamedSchema :: Proxy EffectInfo -> Declare (Definitions Schema) NamedSchema
ToSchema)