{-# LANGUAGE DeriveAnyClass #-}

module Hercules.API.Agent.Socket.ServicePayload where

import Hercules.API.Agent.Build.BuildTask (BuildTask)
import Hercules.API.Agent.Effect.EffectTask (EffectTask)
import Hercules.API.Agent.Evaluate.EvaluateTask (EvaluateTask)
import Hercules.API.Agent.LifeCycle.ServiceInfo (ServiceInfo)
import Hercules.API.Prelude
import Hercules.API.Task

data Cancel = MkCancel {Cancel -> Id (Task Any)
taskId :: Id (Task Any)}
  deriving ((forall x. Cancel -> Rep Cancel x)
-> (forall x. Rep Cancel x -> Cancel) -> Generic Cancel
forall x. Rep Cancel x -> Cancel
forall x. Cancel -> Rep Cancel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Cancel x -> Cancel
$cfrom :: forall x. Cancel -> Rep Cancel x
Generic, Int -> Cancel -> ShowS
[Cancel] -> ShowS
Cancel -> String
(Int -> Cancel -> ShowS)
-> (Cancel -> String) -> ([Cancel] -> ShowS) -> Show Cancel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cancel] -> ShowS
$cshowList :: [Cancel] -> ShowS
show :: Cancel -> String
$cshow :: Cancel -> String
showsPrec :: Int -> Cancel -> ShowS
$cshowsPrec :: Int -> Cancel -> ShowS
Show, Cancel -> Cancel -> Bool
(Cancel -> Cancel -> Bool)
-> (Cancel -> Cancel -> Bool) -> Eq Cancel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cancel -> Cancel -> Bool
$c/= :: Cancel -> Cancel -> Bool
== :: Cancel -> Cancel -> Bool
$c== :: Cancel -> Cancel -> Bool
Eq, Cancel -> ()
(Cancel -> ()) -> NFData Cancel
forall a. (a -> ()) -> NFData a
rnf :: Cancel -> ()
$crnf :: Cancel -> ()
NFData, [Cancel] -> Encoding
[Cancel] -> Value
Cancel -> Encoding
Cancel -> Value
(Cancel -> Value)
-> (Cancel -> Encoding)
-> ([Cancel] -> Value)
-> ([Cancel] -> Encoding)
-> ToJSON Cancel
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Cancel] -> Encoding
$ctoEncodingList :: [Cancel] -> Encoding
toJSONList :: [Cancel] -> Value
$ctoJSONList :: [Cancel] -> Value
toEncoding :: Cancel -> Encoding
$ctoEncoding :: Cancel -> Encoding
toJSON :: Cancel -> Value
$ctoJSON :: Cancel -> Value
ToJSON, Value -> Parser [Cancel]
Value -> Parser Cancel
(Value -> Parser Cancel)
-> (Value -> Parser [Cancel]) -> FromJSON Cancel
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Cancel]
$cparseJSONList :: Value -> Parser [Cancel]
parseJSON :: Value -> Parser Cancel
$cparseJSON :: Value -> Parser Cancel
FromJSON)

data ServicePayload
  = ServiceInfo ServiceInfo
  | StartEvaluation EvaluateTask
  | StartBuild BuildTask
  | StartEffect EffectTask
  | Cancel Cancel
  deriving ((forall x. ServicePayload -> Rep ServicePayload x)
-> (forall x. Rep ServicePayload x -> ServicePayload)
-> Generic ServicePayload
forall x. Rep ServicePayload x -> ServicePayload
forall x. ServicePayload -> Rep ServicePayload x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ServicePayload x -> ServicePayload
$cfrom :: forall x. ServicePayload -> Rep ServicePayload x
Generic, Int -> ServicePayload -> ShowS
[ServicePayload] -> ShowS
ServicePayload -> String
(Int -> ServicePayload -> ShowS)
-> (ServicePayload -> String)
-> ([ServicePayload] -> ShowS)
-> Show ServicePayload
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ServicePayload] -> ShowS
$cshowList :: [ServicePayload] -> ShowS
show :: ServicePayload -> String
$cshow :: ServicePayload -> String
showsPrec :: Int -> ServicePayload -> ShowS
$cshowsPrec :: Int -> ServicePayload -> ShowS
Show, ServicePayload -> ServicePayload -> Bool
(ServicePayload -> ServicePayload -> Bool)
-> (ServicePayload -> ServicePayload -> Bool) -> Eq ServicePayload
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ServicePayload -> ServicePayload -> Bool
$c/= :: ServicePayload -> ServicePayload -> Bool
== :: ServicePayload -> ServicePayload -> Bool
$c== :: ServicePayload -> ServicePayload -> Bool
Eq, ServicePayload -> ()
(ServicePayload -> ()) -> NFData ServicePayload
forall a. (a -> ()) -> NFData a
rnf :: ServicePayload -> ()
$crnf :: ServicePayload -> ()
NFData, [ServicePayload] -> Encoding
[ServicePayload] -> Value
ServicePayload -> Encoding
ServicePayload -> Value
(ServicePayload -> Value)
-> (ServicePayload -> Encoding)
-> ([ServicePayload] -> Value)
-> ([ServicePayload] -> Encoding)
-> ToJSON ServicePayload
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ServicePayload] -> Encoding
$ctoEncodingList :: [ServicePayload] -> Encoding
toJSONList :: [ServicePayload] -> Value
$ctoJSONList :: [ServicePayload] -> Value
toEncoding :: ServicePayload -> Encoding
$ctoEncoding :: ServicePayload -> Encoding
toJSON :: ServicePayload -> Value
$ctoJSON :: ServicePayload -> Value
ToJSON, Value -> Parser [ServicePayload]
Value -> Parser ServicePayload
(Value -> Parser ServicePayload)
-> (Value -> Parser [ServicePayload]) -> FromJSON ServicePayload
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ServicePayload]
$cparseJSONList :: Value -> Parser [ServicePayload]
parseJSON :: Value -> Parser ServicePayload
$cparseJSON :: Value -> Parser ServicePayload
FromJSON)