module Stratosphere.Bedrock.Flow.LoopFlowNodeConfigurationProperty (
        module Exports, LoopFlowNodeConfigurationProperty(..),
        mkLoopFlowNodeConfigurationProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.Bedrock.Flow.FlowDefinitionProperty as Exports
import Stratosphere.ResourceProperties
data LoopFlowNodeConfigurationProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-bedrock-flow-loopflownodeconfiguration.html>
    LoopFlowNodeConfigurationProperty {LoopFlowNodeConfigurationProperty -> ()
haddock_workaround_ :: (),
                                       -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-bedrock-flow-loopflownodeconfiguration.html#cfn-bedrock-flow-loopflownodeconfiguration-definition>
                                       LoopFlowNodeConfigurationProperty -> FlowDefinitionProperty
definition :: FlowDefinitionProperty}
  deriving stock (LoopFlowNodeConfigurationProperty
-> LoopFlowNodeConfigurationProperty -> Bool
(LoopFlowNodeConfigurationProperty
 -> LoopFlowNodeConfigurationProperty -> Bool)
-> (LoopFlowNodeConfigurationProperty
    -> LoopFlowNodeConfigurationProperty -> Bool)
-> Eq LoopFlowNodeConfigurationProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LoopFlowNodeConfigurationProperty
-> LoopFlowNodeConfigurationProperty -> Bool
== :: LoopFlowNodeConfigurationProperty
-> LoopFlowNodeConfigurationProperty -> Bool
$c/= :: LoopFlowNodeConfigurationProperty
-> LoopFlowNodeConfigurationProperty -> Bool
/= :: LoopFlowNodeConfigurationProperty
-> LoopFlowNodeConfigurationProperty -> Bool
Prelude.Eq, Int -> LoopFlowNodeConfigurationProperty -> ShowS
[LoopFlowNodeConfigurationProperty] -> ShowS
LoopFlowNodeConfigurationProperty -> String
(Int -> LoopFlowNodeConfigurationProperty -> ShowS)
-> (LoopFlowNodeConfigurationProperty -> String)
-> ([LoopFlowNodeConfigurationProperty] -> ShowS)
-> Show LoopFlowNodeConfigurationProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LoopFlowNodeConfigurationProperty -> ShowS
showsPrec :: Int -> LoopFlowNodeConfigurationProperty -> ShowS
$cshow :: LoopFlowNodeConfigurationProperty -> String
show :: LoopFlowNodeConfigurationProperty -> String
$cshowList :: [LoopFlowNodeConfigurationProperty] -> ShowS
showList :: [LoopFlowNodeConfigurationProperty] -> ShowS
Prelude.Show)
mkLoopFlowNodeConfigurationProperty ::
  FlowDefinitionProperty -> LoopFlowNodeConfigurationProperty
mkLoopFlowNodeConfigurationProperty :: FlowDefinitionProperty -> LoopFlowNodeConfigurationProperty
mkLoopFlowNodeConfigurationProperty FlowDefinitionProperty
definition
  = LoopFlowNodeConfigurationProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (), definition :: FlowDefinitionProperty
definition = FlowDefinitionProperty
definition}
instance ToResourceProperties LoopFlowNodeConfigurationProperty where
  toResourceProperties :: LoopFlowNodeConfigurationProperty -> ResourceProperties
toResourceProperties LoopFlowNodeConfigurationProperty {()
FlowDefinitionProperty
haddock_workaround_ :: LoopFlowNodeConfigurationProperty -> ()
definition :: LoopFlowNodeConfigurationProperty -> FlowDefinitionProperty
haddock_workaround_ :: ()
definition :: FlowDefinitionProperty
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::Bedrock::Flow.LoopFlowNodeConfiguration",
         supportsTags :: Bool
supportsTags = Bool
Prelude.False,
         properties :: Object
properties = [Key
"Definition" Key -> FlowDefinitionProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= FlowDefinitionProperty
definition]}
instance JSON.ToJSON LoopFlowNodeConfigurationProperty where
  toJSON :: LoopFlowNodeConfigurationProperty -> Value
toJSON LoopFlowNodeConfigurationProperty {()
FlowDefinitionProperty
haddock_workaround_ :: LoopFlowNodeConfigurationProperty -> ()
definition :: LoopFlowNodeConfigurationProperty -> FlowDefinitionProperty
haddock_workaround_ :: ()
definition :: FlowDefinitionProperty
..}
    = [(Key, Value)] -> Value
JSON.object [Key
"Definition" Key -> FlowDefinitionProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= FlowDefinitionProperty
definition]
instance Property "Definition" LoopFlowNodeConfigurationProperty where
  type PropertyType "Definition" LoopFlowNodeConfigurationProperty = FlowDefinitionProperty
  set :: PropertyType "Definition" LoopFlowNodeConfigurationProperty
-> LoopFlowNodeConfigurationProperty
-> LoopFlowNodeConfigurationProperty
set PropertyType "Definition" LoopFlowNodeConfigurationProperty
newValue LoopFlowNodeConfigurationProperty {()
FlowDefinitionProperty
haddock_workaround_ :: LoopFlowNodeConfigurationProperty -> ()
definition :: LoopFlowNodeConfigurationProperty -> FlowDefinitionProperty
haddock_workaround_ :: ()
definition :: FlowDefinitionProperty
..}
    = LoopFlowNodeConfigurationProperty {definition :: FlowDefinitionProperty
definition = PropertyType "Definition" LoopFlowNodeConfigurationProperty
FlowDefinitionProperty
newValue, ()
haddock_workaround_ :: ()
haddock_workaround_ :: ()
..}