module Stratosphere.CodePipeline.Pipeline.StageDeclarationProperty (
        module Exports, StageDeclarationProperty(..),
        mkStageDeclarationProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.CodePipeline.Pipeline.ActionDeclarationProperty as Exports
import {-# SOURCE #-} Stratosphere.CodePipeline.Pipeline.BeforeEntryConditionsProperty as Exports
import {-# SOURCE #-} Stratosphere.CodePipeline.Pipeline.BlockerDeclarationProperty as Exports
import {-# SOURCE #-} Stratosphere.CodePipeline.Pipeline.FailureConditionsProperty as Exports
import {-# SOURCE #-} Stratosphere.CodePipeline.Pipeline.SuccessConditionsProperty as Exports
import Stratosphere.ResourceProperties
import Stratosphere.Value
data StageDeclarationProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-codepipeline-pipeline-stagedeclaration.html>
    StageDeclarationProperty {StageDeclarationProperty -> ()
haddock_workaround_ :: (),
                              -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-codepipeline-pipeline-stagedeclaration.html#cfn-codepipeline-pipeline-stagedeclaration-actions>
                              StageDeclarationProperty -> [ActionDeclarationProperty]
actions :: [ActionDeclarationProperty],
                              -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-codepipeline-pipeline-stagedeclaration.html#cfn-codepipeline-pipeline-stagedeclaration-beforeentry>
                              StageDeclarationProperty -> Maybe BeforeEntryConditionsProperty
beforeEntry :: (Prelude.Maybe BeforeEntryConditionsProperty),
                              -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-codepipeline-pipeline-stagedeclaration.html#cfn-codepipeline-pipeline-stagedeclaration-blockers>
                              StageDeclarationProperty -> Maybe [BlockerDeclarationProperty]
blockers :: (Prelude.Maybe [BlockerDeclarationProperty]),
                              -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-codepipeline-pipeline-stagedeclaration.html#cfn-codepipeline-pipeline-stagedeclaration-name>
                              StageDeclarationProperty -> Value Text
name :: (Value Prelude.Text),
                              -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-codepipeline-pipeline-stagedeclaration.html#cfn-codepipeline-pipeline-stagedeclaration-onfailure>
                              StageDeclarationProperty -> Maybe FailureConditionsProperty
onFailure :: (Prelude.Maybe FailureConditionsProperty),
                              -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-codepipeline-pipeline-stagedeclaration.html#cfn-codepipeline-pipeline-stagedeclaration-onsuccess>
                              StageDeclarationProperty -> Maybe SuccessConditionsProperty
onSuccess :: (Prelude.Maybe SuccessConditionsProperty)}
  deriving stock (StageDeclarationProperty -> StageDeclarationProperty -> Bool
(StageDeclarationProperty -> StageDeclarationProperty -> Bool)
-> (StageDeclarationProperty -> StageDeclarationProperty -> Bool)
-> Eq StageDeclarationProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StageDeclarationProperty -> StageDeclarationProperty -> Bool
== :: StageDeclarationProperty -> StageDeclarationProperty -> Bool
$c/= :: StageDeclarationProperty -> StageDeclarationProperty -> Bool
/= :: StageDeclarationProperty -> StageDeclarationProperty -> Bool
Prelude.Eq, Int -> StageDeclarationProperty -> ShowS
[StageDeclarationProperty] -> ShowS
StageDeclarationProperty -> String
(Int -> StageDeclarationProperty -> ShowS)
-> (StageDeclarationProperty -> String)
-> ([StageDeclarationProperty] -> ShowS)
-> Show StageDeclarationProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StageDeclarationProperty -> ShowS
showsPrec :: Int -> StageDeclarationProperty -> ShowS
$cshow :: StageDeclarationProperty -> String
show :: StageDeclarationProperty -> String
$cshowList :: [StageDeclarationProperty] -> ShowS
showList :: [StageDeclarationProperty] -> ShowS
Prelude.Show)
mkStageDeclarationProperty ::
  [ActionDeclarationProperty]
  -> Value Prelude.Text -> StageDeclarationProperty
mkStageDeclarationProperty :: [ActionDeclarationProperty]
-> Value Text -> StageDeclarationProperty
mkStageDeclarationProperty [ActionDeclarationProperty]
actions Value Text
name
  = StageDeclarationProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (), actions :: [ActionDeclarationProperty]
actions = [ActionDeclarationProperty]
actions, name :: Value Text
name = Value Text
name,
       beforeEntry :: Maybe BeforeEntryConditionsProperty
beforeEntry = Maybe BeforeEntryConditionsProperty
forall a. Maybe a
Prelude.Nothing, blockers :: Maybe [BlockerDeclarationProperty]
blockers = Maybe [BlockerDeclarationProperty]
forall a. Maybe a
Prelude.Nothing,
       onFailure :: Maybe FailureConditionsProperty
onFailure = Maybe FailureConditionsProperty
forall a. Maybe a
Prelude.Nothing, onSuccess :: Maybe SuccessConditionsProperty
onSuccess = Maybe SuccessConditionsProperty
forall a. Maybe a
Prelude.Nothing}
instance ToResourceProperties StageDeclarationProperty where
  toResourceProperties :: StageDeclarationProperty -> ResourceProperties
toResourceProperties StageDeclarationProperty {[ActionDeclarationProperty]
Maybe [BlockerDeclarationProperty]
Maybe FailureConditionsProperty
Maybe BeforeEntryConditionsProperty
Maybe SuccessConditionsProperty
()
Value Text
haddock_workaround_ :: StageDeclarationProperty -> ()
actions :: StageDeclarationProperty -> [ActionDeclarationProperty]
beforeEntry :: StageDeclarationProperty -> Maybe BeforeEntryConditionsProperty
blockers :: StageDeclarationProperty -> Maybe [BlockerDeclarationProperty]
name :: StageDeclarationProperty -> Value Text
onFailure :: StageDeclarationProperty -> Maybe FailureConditionsProperty
onSuccess :: StageDeclarationProperty -> Maybe SuccessConditionsProperty
haddock_workaround_ :: ()
actions :: [ActionDeclarationProperty]
beforeEntry :: Maybe BeforeEntryConditionsProperty
blockers :: Maybe [BlockerDeclarationProperty]
name :: Value Text
onFailure :: Maybe FailureConditionsProperty
onSuccess :: Maybe SuccessConditionsProperty
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::CodePipeline::Pipeline.StageDeclaration",
         supportsTags :: Bool
supportsTags = Bool
Prelude.False,
         properties :: Object
properties = [Item Object] -> Object
forall l. IsList l => [Item l] -> l
Prelude.fromList
                        ([(Key, Value)] -> [(Key, Value)] -> [(Key, Value)]
forall a. Semigroup a => a -> a -> a
(Prelude.<>)
                           [Key
"Actions" Key -> [ActionDeclarationProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= [ActionDeclarationProperty]
actions, Key
"Name" Key -> Value Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= Value Text
name]
                           ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
                              [Key -> BeforeEntryConditionsProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"BeforeEntry" (BeforeEntryConditionsProperty -> (Key, Value))
-> Maybe BeforeEntryConditionsProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe BeforeEntryConditionsProperty
beforeEntry,
                               Key -> [BlockerDeclarationProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"Blockers" ([BlockerDeclarationProperty] -> (Key, Value))
-> Maybe [BlockerDeclarationProperty] -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [BlockerDeclarationProperty]
blockers,
                               Key -> FailureConditionsProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"OnFailure" (FailureConditionsProperty -> (Key, Value))
-> Maybe FailureConditionsProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe FailureConditionsProperty
onFailure,
                               Key -> SuccessConditionsProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"OnSuccess" (SuccessConditionsProperty -> (Key, Value))
-> Maybe SuccessConditionsProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe SuccessConditionsProperty
onSuccess]))}
instance JSON.ToJSON StageDeclarationProperty where
  toJSON :: StageDeclarationProperty -> Value
toJSON StageDeclarationProperty {[ActionDeclarationProperty]
Maybe [BlockerDeclarationProperty]
Maybe FailureConditionsProperty
Maybe BeforeEntryConditionsProperty
Maybe SuccessConditionsProperty
()
Value Text
haddock_workaround_ :: StageDeclarationProperty -> ()
actions :: StageDeclarationProperty -> [ActionDeclarationProperty]
beforeEntry :: StageDeclarationProperty -> Maybe BeforeEntryConditionsProperty
blockers :: StageDeclarationProperty -> Maybe [BlockerDeclarationProperty]
name :: StageDeclarationProperty -> Value Text
onFailure :: StageDeclarationProperty -> Maybe FailureConditionsProperty
onSuccess :: StageDeclarationProperty -> Maybe SuccessConditionsProperty
haddock_workaround_ :: ()
actions :: [ActionDeclarationProperty]
beforeEntry :: Maybe BeforeEntryConditionsProperty
blockers :: Maybe [BlockerDeclarationProperty]
name :: Value Text
onFailure :: Maybe FailureConditionsProperty
onSuccess :: Maybe SuccessConditionsProperty
..}
    = [(Key, Value)] -> Value
JSON.object
        ([Item [(Key, Value)]] -> [(Key, Value)]
forall l. IsList l => [Item l] -> l
Prelude.fromList
           ([(Key, Value)] -> [(Key, Value)] -> [(Key, Value)]
forall a. Semigroup a => a -> a -> a
(Prelude.<>)
              [Key
"Actions" Key -> [ActionDeclarationProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= [ActionDeclarationProperty]
actions, Key
"Name" Key -> Value Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= Value Text
name]
              ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
                 [Key -> BeforeEntryConditionsProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"BeforeEntry" (BeforeEntryConditionsProperty -> (Key, Value))
-> Maybe BeforeEntryConditionsProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe BeforeEntryConditionsProperty
beforeEntry,
                  Key -> [BlockerDeclarationProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"Blockers" ([BlockerDeclarationProperty] -> (Key, Value))
-> Maybe [BlockerDeclarationProperty] -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [BlockerDeclarationProperty]
blockers,
                  Key -> FailureConditionsProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"OnFailure" (FailureConditionsProperty -> (Key, Value))
-> Maybe FailureConditionsProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe FailureConditionsProperty
onFailure,
                  Key -> SuccessConditionsProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"OnSuccess" (SuccessConditionsProperty -> (Key, Value))
-> Maybe SuccessConditionsProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe SuccessConditionsProperty
onSuccess])))
instance Property "Actions" StageDeclarationProperty where
  type PropertyType "Actions" StageDeclarationProperty = [ActionDeclarationProperty]
  set :: PropertyType "Actions" StageDeclarationProperty
-> StageDeclarationProperty -> StageDeclarationProperty
set PropertyType "Actions" StageDeclarationProperty
newValue StageDeclarationProperty {[ActionDeclarationProperty]
Maybe [BlockerDeclarationProperty]
Maybe FailureConditionsProperty
Maybe BeforeEntryConditionsProperty
Maybe SuccessConditionsProperty
()
Value Text
haddock_workaround_ :: StageDeclarationProperty -> ()
actions :: StageDeclarationProperty -> [ActionDeclarationProperty]
beforeEntry :: StageDeclarationProperty -> Maybe BeforeEntryConditionsProperty
blockers :: StageDeclarationProperty -> Maybe [BlockerDeclarationProperty]
name :: StageDeclarationProperty -> Value Text
onFailure :: StageDeclarationProperty -> Maybe FailureConditionsProperty
onSuccess :: StageDeclarationProperty -> Maybe SuccessConditionsProperty
haddock_workaround_ :: ()
actions :: [ActionDeclarationProperty]
beforeEntry :: Maybe BeforeEntryConditionsProperty
blockers :: Maybe [BlockerDeclarationProperty]
name :: Value Text
onFailure :: Maybe FailureConditionsProperty
onSuccess :: Maybe SuccessConditionsProperty
..}
    = StageDeclarationProperty {actions :: [ActionDeclarationProperty]
actions = [ActionDeclarationProperty]
PropertyType "Actions" StageDeclarationProperty
newValue, Maybe [BlockerDeclarationProperty]
Maybe FailureConditionsProperty
Maybe BeforeEntryConditionsProperty
Maybe SuccessConditionsProperty
()
Value Text
haddock_workaround_ :: ()
beforeEntry :: Maybe BeforeEntryConditionsProperty
blockers :: Maybe [BlockerDeclarationProperty]
name :: Value Text
onFailure :: Maybe FailureConditionsProperty
onSuccess :: Maybe SuccessConditionsProperty
haddock_workaround_ :: ()
beforeEntry :: Maybe BeforeEntryConditionsProperty
blockers :: Maybe [BlockerDeclarationProperty]
name :: Value Text
onFailure :: Maybe FailureConditionsProperty
onSuccess :: Maybe SuccessConditionsProperty
..}
instance Property "BeforeEntry" StageDeclarationProperty where
  type PropertyType "BeforeEntry" StageDeclarationProperty = BeforeEntryConditionsProperty
  set :: PropertyType "BeforeEntry" StageDeclarationProperty
-> StageDeclarationProperty -> StageDeclarationProperty
set PropertyType "BeforeEntry" StageDeclarationProperty
newValue StageDeclarationProperty {[ActionDeclarationProperty]
Maybe [BlockerDeclarationProperty]
Maybe FailureConditionsProperty
Maybe BeforeEntryConditionsProperty
Maybe SuccessConditionsProperty
()
Value Text
haddock_workaround_ :: StageDeclarationProperty -> ()
actions :: StageDeclarationProperty -> [ActionDeclarationProperty]
beforeEntry :: StageDeclarationProperty -> Maybe BeforeEntryConditionsProperty
blockers :: StageDeclarationProperty -> Maybe [BlockerDeclarationProperty]
name :: StageDeclarationProperty -> Value Text
onFailure :: StageDeclarationProperty -> Maybe FailureConditionsProperty
onSuccess :: StageDeclarationProperty -> Maybe SuccessConditionsProperty
haddock_workaround_ :: ()
actions :: [ActionDeclarationProperty]
beforeEntry :: Maybe BeforeEntryConditionsProperty
blockers :: Maybe [BlockerDeclarationProperty]
name :: Value Text
onFailure :: Maybe FailureConditionsProperty
onSuccess :: Maybe SuccessConditionsProperty
..}
    = StageDeclarationProperty
        {beforeEntry :: Maybe BeforeEntryConditionsProperty
beforeEntry = BeforeEntryConditionsProperty
-> Maybe BeforeEntryConditionsProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "BeforeEntry" StageDeclarationProperty
BeforeEntryConditionsProperty
newValue, [ActionDeclarationProperty]
Maybe [BlockerDeclarationProperty]
Maybe FailureConditionsProperty
Maybe SuccessConditionsProperty
()
Value Text
haddock_workaround_ :: ()
actions :: [ActionDeclarationProperty]
blockers :: Maybe [BlockerDeclarationProperty]
name :: Value Text
onFailure :: Maybe FailureConditionsProperty
onSuccess :: Maybe SuccessConditionsProperty
haddock_workaround_ :: ()
actions :: [ActionDeclarationProperty]
blockers :: Maybe [BlockerDeclarationProperty]
name :: Value Text
onFailure :: Maybe FailureConditionsProperty
onSuccess :: Maybe SuccessConditionsProperty
..}
instance Property "Blockers" StageDeclarationProperty where
  type PropertyType "Blockers" StageDeclarationProperty = [BlockerDeclarationProperty]
  set :: PropertyType "Blockers" StageDeclarationProperty
-> StageDeclarationProperty -> StageDeclarationProperty
set PropertyType "Blockers" StageDeclarationProperty
newValue StageDeclarationProperty {[ActionDeclarationProperty]
Maybe [BlockerDeclarationProperty]
Maybe FailureConditionsProperty
Maybe BeforeEntryConditionsProperty
Maybe SuccessConditionsProperty
()
Value Text
haddock_workaround_ :: StageDeclarationProperty -> ()
actions :: StageDeclarationProperty -> [ActionDeclarationProperty]
beforeEntry :: StageDeclarationProperty -> Maybe BeforeEntryConditionsProperty
blockers :: StageDeclarationProperty -> Maybe [BlockerDeclarationProperty]
name :: StageDeclarationProperty -> Value Text
onFailure :: StageDeclarationProperty -> Maybe FailureConditionsProperty
onSuccess :: StageDeclarationProperty -> Maybe SuccessConditionsProperty
haddock_workaround_ :: ()
actions :: [ActionDeclarationProperty]
beforeEntry :: Maybe BeforeEntryConditionsProperty
blockers :: Maybe [BlockerDeclarationProperty]
name :: Value Text
onFailure :: Maybe FailureConditionsProperty
onSuccess :: Maybe SuccessConditionsProperty
..}
    = StageDeclarationProperty {blockers :: Maybe [BlockerDeclarationProperty]
blockers = [BlockerDeclarationProperty] -> Maybe [BlockerDeclarationProperty]
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure [BlockerDeclarationProperty]
PropertyType "Blockers" StageDeclarationProperty
newValue, [ActionDeclarationProperty]
Maybe FailureConditionsProperty
Maybe BeforeEntryConditionsProperty
Maybe SuccessConditionsProperty
()
Value Text
haddock_workaround_ :: ()
actions :: [ActionDeclarationProperty]
beforeEntry :: Maybe BeforeEntryConditionsProperty
name :: Value Text
onFailure :: Maybe FailureConditionsProperty
onSuccess :: Maybe SuccessConditionsProperty
haddock_workaround_ :: ()
actions :: [ActionDeclarationProperty]
beforeEntry :: Maybe BeforeEntryConditionsProperty
name :: Value Text
onFailure :: Maybe FailureConditionsProperty
onSuccess :: Maybe SuccessConditionsProperty
..}
instance Property "Name" StageDeclarationProperty where
  type PropertyType "Name" StageDeclarationProperty = Value Prelude.Text
  set :: PropertyType "Name" StageDeclarationProperty
-> StageDeclarationProperty -> StageDeclarationProperty
set PropertyType "Name" StageDeclarationProperty
newValue StageDeclarationProperty {[ActionDeclarationProperty]
Maybe [BlockerDeclarationProperty]
Maybe FailureConditionsProperty
Maybe BeforeEntryConditionsProperty
Maybe SuccessConditionsProperty
()
Value Text
haddock_workaround_ :: StageDeclarationProperty -> ()
actions :: StageDeclarationProperty -> [ActionDeclarationProperty]
beforeEntry :: StageDeclarationProperty -> Maybe BeforeEntryConditionsProperty
blockers :: StageDeclarationProperty -> Maybe [BlockerDeclarationProperty]
name :: StageDeclarationProperty -> Value Text
onFailure :: StageDeclarationProperty -> Maybe FailureConditionsProperty
onSuccess :: StageDeclarationProperty -> Maybe SuccessConditionsProperty
haddock_workaround_ :: ()
actions :: [ActionDeclarationProperty]
beforeEntry :: Maybe BeforeEntryConditionsProperty
blockers :: Maybe [BlockerDeclarationProperty]
name :: Value Text
onFailure :: Maybe FailureConditionsProperty
onSuccess :: Maybe SuccessConditionsProperty
..}
    = StageDeclarationProperty {name :: Value Text
name = PropertyType "Name" StageDeclarationProperty
Value Text
newValue, [ActionDeclarationProperty]
Maybe [BlockerDeclarationProperty]
Maybe FailureConditionsProperty
Maybe BeforeEntryConditionsProperty
Maybe SuccessConditionsProperty
()
haddock_workaround_ :: ()
actions :: [ActionDeclarationProperty]
beforeEntry :: Maybe BeforeEntryConditionsProperty
blockers :: Maybe [BlockerDeclarationProperty]
onFailure :: Maybe FailureConditionsProperty
onSuccess :: Maybe SuccessConditionsProperty
haddock_workaround_ :: ()
actions :: [ActionDeclarationProperty]
beforeEntry :: Maybe BeforeEntryConditionsProperty
blockers :: Maybe [BlockerDeclarationProperty]
onFailure :: Maybe FailureConditionsProperty
onSuccess :: Maybe SuccessConditionsProperty
..}
instance Property "OnFailure" StageDeclarationProperty where
  type PropertyType "OnFailure" StageDeclarationProperty = FailureConditionsProperty
  set :: PropertyType "OnFailure" StageDeclarationProperty
-> StageDeclarationProperty -> StageDeclarationProperty
set PropertyType "OnFailure" StageDeclarationProperty
newValue StageDeclarationProperty {[ActionDeclarationProperty]
Maybe [BlockerDeclarationProperty]
Maybe FailureConditionsProperty
Maybe BeforeEntryConditionsProperty
Maybe SuccessConditionsProperty
()
Value Text
haddock_workaround_ :: StageDeclarationProperty -> ()
actions :: StageDeclarationProperty -> [ActionDeclarationProperty]
beforeEntry :: StageDeclarationProperty -> Maybe BeforeEntryConditionsProperty
blockers :: StageDeclarationProperty -> Maybe [BlockerDeclarationProperty]
name :: StageDeclarationProperty -> Value Text
onFailure :: StageDeclarationProperty -> Maybe FailureConditionsProperty
onSuccess :: StageDeclarationProperty -> Maybe SuccessConditionsProperty
haddock_workaround_ :: ()
actions :: [ActionDeclarationProperty]
beforeEntry :: Maybe BeforeEntryConditionsProperty
blockers :: Maybe [BlockerDeclarationProperty]
name :: Value Text
onFailure :: Maybe FailureConditionsProperty
onSuccess :: Maybe SuccessConditionsProperty
..}
    = StageDeclarationProperty {onFailure :: Maybe FailureConditionsProperty
onFailure = FailureConditionsProperty -> Maybe FailureConditionsProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "OnFailure" StageDeclarationProperty
FailureConditionsProperty
newValue, [ActionDeclarationProperty]
Maybe [BlockerDeclarationProperty]
Maybe BeforeEntryConditionsProperty
Maybe SuccessConditionsProperty
()
Value Text
haddock_workaround_ :: ()
actions :: [ActionDeclarationProperty]
beforeEntry :: Maybe BeforeEntryConditionsProperty
blockers :: Maybe [BlockerDeclarationProperty]
name :: Value Text
onSuccess :: Maybe SuccessConditionsProperty
haddock_workaround_ :: ()
actions :: [ActionDeclarationProperty]
beforeEntry :: Maybe BeforeEntryConditionsProperty
blockers :: Maybe [BlockerDeclarationProperty]
name :: Value Text
onSuccess :: Maybe SuccessConditionsProperty
..}
instance Property "OnSuccess" StageDeclarationProperty where
  type PropertyType "OnSuccess" StageDeclarationProperty = SuccessConditionsProperty
  set :: PropertyType "OnSuccess" StageDeclarationProperty
-> StageDeclarationProperty -> StageDeclarationProperty
set PropertyType "OnSuccess" StageDeclarationProperty
newValue StageDeclarationProperty {[ActionDeclarationProperty]
Maybe [BlockerDeclarationProperty]
Maybe FailureConditionsProperty
Maybe BeforeEntryConditionsProperty
Maybe SuccessConditionsProperty
()
Value Text
haddock_workaround_ :: StageDeclarationProperty -> ()
actions :: StageDeclarationProperty -> [ActionDeclarationProperty]
beforeEntry :: StageDeclarationProperty -> Maybe BeforeEntryConditionsProperty
blockers :: StageDeclarationProperty -> Maybe [BlockerDeclarationProperty]
name :: StageDeclarationProperty -> Value Text
onFailure :: StageDeclarationProperty -> Maybe FailureConditionsProperty
onSuccess :: StageDeclarationProperty -> Maybe SuccessConditionsProperty
haddock_workaround_ :: ()
actions :: [ActionDeclarationProperty]
beforeEntry :: Maybe BeforeEntryConditionsProperty
blockers :: Maybe [BlockerDeclarationProperty]
name :: Value Text
onFailure :: Maybe FailureConditionsProperty
onSuccess :: Maybe SuccessConditionsProperty
..}
    = StageDeclarationProperty {onSuccess :: Maybe SuccessConditionsProperty
onSuccess = SuccessConditionsProperty -> Maybe SuccessConditionsProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "OnSuccess" StageDeclarationProperty
SuccessConditionsProperty
newValue, [ActionDeclarationProperty]
Maybe [BlockerDeclarationProperty]
Maybe FailureConditionsProperty
Maybe BeforeEntryConditionsProperty
()
Value Text
haddock_workaround_ :: ()
actions :: [ActionDeclarationProperty]
beforeEntry :: Maybe BeforeEntryConditionsProperty
blockers :: Maybe [BlockerDeclarationProperty]
name :: Value Text
onFailure :: Maybe FailureConditionsProperty
haddock_workaround_ :: ()
actions :: [ActionDeclarationProperty]
beforeEntry :: Maybe BeforeEntryConditionsProperty
blockers :: Maybe [BlockerDeclarationProperty]
name :: Value Text
onFailure :: Maybe FailureConditionsProperty
..}