module Stratosphere.EMRServerless.Application.InitialCapacityConfigKeyValuePairProperty (
        module Exports, InitialCapacityConfigKeyValuePairProperty(..),
        mkInitialCapacityConfigKeyValuePairProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.EMRServerless.Application.InitialCapacityConfigProperty as Exports
import Stratosphere.ResourceProperties
import Stratosphere.Value
data InitialCapacityConfigKeyValuePairProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-emrserverless-application-initialcapacityconfigkeyvaluepair.html>
    InitialCapacityConfigKeyValuePairProperty {InitialCapacityConfigKeyValuePairProperty -> ()
haddock_workaround_ :: (),
                                               -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-emrserverless-application-initialcapacityconfigkeyvaluepair.html#cfn-emrserverless-application-initialcapacityconfigkeyvaluepair-key>
                                               InitialCapacityConfigKeyValuePairProperty -> Value Text
key :: (Value Prelude.Text),
                                               -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-emrserverless-application-initialcapacityconfigkeyvaluepair.html#cfn-emrserverless-application-initialcapacityconfigkeyvaluepair-value>
                                               InitialCapacityConfigKeyValuePairProperty
-> InitialCapacityConfigProperty
value :: InitialCapacityConfigProperty}
  deriving stock (InitialCapacityConfigKeyValuePairProperty
-> InitialCapacityConfigKeyValuePairProperty -> Bool
(InitialCapacityConfigKeyValuePairProperty
 -> InitialCapacityConfigKeyValuePairProperty -> Bool)
-> (InitialCapacityConfigKeyValuePairProperty
    -> InitialCapacityConfigKeyValuePairProperty -> Bool)
-> Eq InitialCapacityConfigKeyValuePairProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InitialCapacityConfigKeyValuePairProperty
-> InitialCapacityConfigKeyValuePairProperty -> Bool
== :: InitialCapacityConfigKeyValuePairProperty
-> InitialCapacityConfigKeyValuePairProperty -> Bool
$c/= :: InitialCapacityConfigKeyValuePairProperty
-> InitialCapacityConfigKeyValuePairProperty -> Bool
/= :: InitialCapacityConfigKeyValuePairProperty
-> InitialCapacityConfigKeyValuePairProperty -> Bool
Prelude.Eq, Int -> InitialCapacityConfigKeyValuePairProperty -> ShowS
[InitialCapacityConfigKeyValuePairProperty] -> ShowS
InitialCapacityConfigKeyValuePairProperty -> String
(Int -> InitialCapacityConfigKeyValuePairProperty -> ShowS)
-> (InitialCapacityConfigKeyValuePairProperty -> String)
-> ([InitialCapacityConfigKeyValuePairProperty] -> ShowS)
-> Show InitialCapacityConfigKeyValuePairProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InitialCapacityConfigKeyValuePairProperty -> ShowS
showsPrec :: Int -> InitialCapacityConfigKeyValuePairProperty -> ShowS
$cshow :: InitialCapacityConfigKeyValuePairProperty -> String
show :: InitialCapacityConfigKeyValuePairProperty -> String
$cshowList :: [InitialCapacityConfigKeyValuePairProperty] -> ShowS
showList :: [InitialCapacityConfigKeyValuePairProperty] -> ShowS
Prelude.Show)
mkInitialCapacityConfigKeyValuePairProperty ::
  Value Prelude.Text
  -> InitialCapacityConfigProperty
     -> InitialCapacityConfigKeyValuePairProperty
mkInitialCapacityConfigKeyValuePairProperty :: Value Text
-> InitialCapacityConfigProperty
-> InitialCapacityConfigKeyValuePairProperty
mkInitialCapacityConfigKeyValuePairProperty Value Text
key InitialCapacityConfigProperty
value
  = InitialCapacityConfigKeyValuePairProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (), key :: Value Text
key = Value Text
key, value :: InitialCapacityConfigProperty
value = InitialCapacityConfigProperty
value}
instance ToResourceProperties InitialCapacityConfigKeyValuePairProperty where
  toResourceProperties :: InitialCapacityConfigKeyValuePairProperty -> ResourceProperties
toResourceProperties InitialCapacityConfigKeyValuePairProperty {()
Value Text
InitialCapacityConfigProperty
haddock_workaround_ :: InitialCapacityConfigKeyValuePairProperty -> ()
key :: InitialCapacityConfigKeyValuePairProperty -> Value Text
value :: InitialCapacityConfigKeyValuePairProperty
-> InitialCapacityConfigProperty
haddock_workaround_ :: ()
key :: Value Text
value :: InitialCapacityConfigProperty
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::EMRServerless::Application.InitialCapacityConfigKeyValuePair",
         supportsTags :: Bool
supportsTags = Bool
Prelude.False,
         properties :: Object
properties = [Key
"Key" 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
key, Key
"Value" Key -> InitialCapacityConfigProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= InitialCapacityConfigProperty
value]}
instance JSON.ToJSON InitialCapacityConfigKeyValuePairProperty where
  toJSON :: InitialCapacityConfigKeyValuePairProperty -> Value
toJSON InitialCapacityConfigKeyValuePairProperty {()
Value Text
InitialCapacityConfigProperty
haddock_workaround_ :: InitialCapacityConfigKeyValuePairProperty -> ()
key :: InitialCapacityConfigKeyValuePairProperty -> Value Text
value :: InitialCapacityConfigKeyValuePairProperty
-> InitialCapacityConfigProperty
haddock_workaround_ :: ()
key :: Value Text
value :: InitialCapacityConfigProperty
..}
    = [(Key, Value)] -> Value
JSON.object [Key
"Key" 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
key, Key
"Value" Key -> InitialCapacityConfigProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= InitialCapacityConfigProperty
value]
instance Property "Key" InitialCapacityConfigKeyValuePairProperty where
  type PropertyType "Key" InitialCapacityConfigKeyValuePairProperty = Value Prelude.Text
  set :: PropertyType "Key" InitialCapacityConfigKeyValuePairProperty
-> InitialCapacityConfigKeyValuePairProperty
-> InitialCapacityConfigKeyValuePairProperty
set PropertyType "Key" InitialCapacityConfigKeyValuePairProperty
newValue InitialCapacityConfigKeyValuePairProperty {()
Value Text
InitialCapacityConfigProperty
haddock_workaround_ :: InitialCapacityConfigKeyValuePairProperty -> ()
key :: InitialCapacityConfigKeyValuePairProperty -> Value Text
value :: InitialCapacityConfigKeyValuePairProperty
-> InitialCapacityConfigProperty
haddock_workaround_ :: ()
key :: Value Text
value :: InitialCapacityConfigProperty
..}
    = InitialCapacityConfigKeyValuePairProperty {key :: Value Text
key = PropertyType "Key" InitialCapacityConfigKeyValuePairProperty
Value Text
newValue, ()
InitialCapacityConfigProperty
haddock_workaround_ :: ()
value :: InitialCapacityConfigProperty
haddock_workaround_ :: ()
value :: InitialCapacityConfigProperty
..}
instance Property "Value" InitialCapacityConfigKeyValuePairProperty where
  type PropertyType "Value" InitialCapacityConfigKeyValuePairProperty = InitialCapacityConfigProperty
  set :: PropertyType "Value" InitialCapacityConfigKeyValuePairProperty
-> InitialCapacityConfigKeyValuePairProperty
-> InitialCapacityConfigKeyValuePairProperty
set PropertyType "Value" InitialCapacityConfigKeyValuePairProperty
newValue InitialCapacityConfigKeyValuePairProperty {()
Value Text
InitialCapacityConfigProperty
haddock_workaround_ :: InitialCapacityConfigKeyValuePairProperty -> ()
key :: InitialCapacityConfigKeyValuePairProperty -> Value Text
value :: InitialCapacityConfigKeyValuePairProperty
-> InitialCapacityConfigProperty
haddock_workaround_ :: ()
key :: Value Text
value :: InitialCapacityConfigProperty
..}
    = InitialCapacityConfigKeyValuePairProperty {value :: InitialCapacityConfigProperty
value = PropertyType "Value" InitialCapacityConfigKeyValuePairProperty
InitialCapacityConfigProperty
newValue, ()
Value Text
haddock_workaround_ :: ()
key :: Value Text
haddock_workaround_ :: ()
key :: Value Text
..}