module Stratosphere.ApplicationInsights.Application.SubComponentTypeConfigurationProperty (
module Exports, SubComponentTypeConfigurationProperty(..),
mkSubComponentTypeConfigurationProperty
) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.ApplicationInsights.Application.SubComponentConfigurationDetailsProperty as Exports
import Stratosphere.ResourceProperties
import Stratosphere.Value
data SubComponentTypeConfigurationProperty
=
SubComponentTypeConfigurationProperty {SubComponentTypeConfigurationProperty -> ()
haddock_workaround_ :: (),
SubComponentTypeConfigurationProperty
-> SubComponentConfigurationDetailsProperty
subComponentConfigurationDetails :: SubComponentConfigurationDetailsProperty,
SubComponentTypeConfigurationProperty -> Value Text
subComponentType :: (Value Prelude.Text)}
deriving stock (SubComponentTypeConfigurationProperty
-> SubComponentTypeConfigurationProperty -> Bool
(SubComponentTypeConfigurationProperty
-> SubComponentTypeConfigurationProperty -> Bool)
-> (SubComponentTypeConfigurationProperty
-> SubComponentTypeConfigurationProperty -> Bool)
-> Eq SubComponentTypeConfigurationProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SubComponentTypeConfigurationProperty
-> SubComponentTypeConfigurationProperty -> Bool
== :: SubComponentTypeConfigurationProperty
-> SubComponentTypeConfigurationProperty -> Bool
$c/= :: SubComponentTypeConfigurationProperty
-> SubComponentTypeConfigurationProperty -> Bool
/= :: SubComponentTypeConfigurationProperty
-> SubComponentTypeConfigurationProperty -> Bool
Prelude.Eq, Int -> SubComponentTypeConfigurationProperty -> ShowS
[SubComponentTypeConfigurationProperty] -> ShowS
SubComponentTypeConfigurationProperty -> String
(Int -> SubComponentTypeConfigurationProperty -> ShowS)
-> (SubComponentTypeConfigurationProperty -> String)
-> ([SubComponentTypeConfigurationProperty] -> ShowS)
-> Show SubComponentTypeConfigurationProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SubComponentTypeConfigurationProperty -> ShowS
showsPrec :: Int -> SubComponentTypeConfigurationProperty -> ShowS
$cshow :: SubComponentTypeConfigurationProperty -> String
show :: SubComponentTypeConfigurationProperty -> String
$cshowList :: [SubComponentTypeConfigurationProperty] -> ShowS
showList :: [SubComponentTypeConfigurationProperty] -> ShowS
Prelude.Show)
mkSubComponentTypeConfigurationProperty ::
SubComponentConfigurationDetailsProperty
-> Value Prelude.Text -> SubComponentTypeConfigurationProperty
mkSubComponentTypeConfigurationProperty :: SubComponentConfigurationDetailsProperty
-> Value Text -> SubComponentTypeConfigurationProperty
mkSubComponentTypeConfigurationProperty
SubComponentConfigurationDetailsProperty
subComponentConfigurationDetails
Value Text
subComponentType
= SubComponentTypeConfigurationProperty
{haddock_workaround_ :: ()
haddock_workaround_ = (),
subComponentConfigurationDetails :: SubComponentConfigurationDetailsProperty
subComponentConfigurationDetails = SubComponentConfigurationDetailsProperty
subComponentConfigurationDetails,
subComponentType :: Value Text
subComponentType = Value Text
subComponentType}
instance ToResourceProperties SubComponentTypeConfigurationProperty where
toResourceProperties :: SubComponentTypeConfigurationProperty -> ResourceProperties
toResourceProperties SubComponentTypeConfigurationProperty {()
Value Text
SubComponentConfigurationDetailsProperty
haddock_workaround_ :: SubComponentTypeConfigurationProperty -> ()
subComponentConfigurationDetails :: SubComponentTypeConfigurationProperty
-> SubComponentConfigurationDetailsProperty
subComponentType :: SubComponentTypeConfigurationProperty -> Value Text
haddock_workaround_ :: ()
subComponentConfigurationDetails :: SubComponentConfigurationDetailsProperty
subComponentType :: Value Text
..}
= ResourceProperties
{awsType :: Text
awsType = Text
"AWS::ApplicationInsights::Application.SubComponentTypeConfiguration",
supportsTags :: Bool
supportsTags = Bool
Prelude.False,
properties :: Object
properties = [Key
"SubComponentConfigurationDetails"
Key -> SubComponentConfigurationDetailsProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= SubComponentConfigurationDetailsProperty
subComponentConfigurationDetails,
Key
"SubComponentType" 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
subComponentType]}
instance JSON.ToJSON SubComponentTypeConfigurationProperty where
toJSON :: SubComponentTypeConfigurationProperty -> Value
toJSON SubComponentTypeConfigurationProperty {()
Value Text
SubComponentConfigurationDetailsProperty
haddock_workaround_ :: SubComponentTypeConfigurationProperty -> ()
subComponentConfigurationDetails :: SubComponentTypeConfigurationProperty
-> SubComponentConfigurationDetailsProperty
subComponentType :: SubComponentTypeConfigurationProperty -> Value Text
haddock_workaround_ :: ()
subComponentConfigurationDetails :: SubComponentConfigurationDetailsProperty
subComponentType :: Value Text
..}
= [(Key, Value)] -> Value
JSON.object
[Key
"SubComponentConfigurationDetails"
Key -> SubComponentConfigurationDetailsProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= SubComponentConfigurationDetailsProperty
subComponentConfigurationDetails,
Key
"SubComponentType" 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
subComponentType]
instance Property "SubComponentConfigurationDetails" SubComponentTypeConfigurationProperty where
type PropertyType "SubComponentConfigurationDetails" SubComponentTypeConfigurationProperty = SubComponentConfigurationDetailsProperty
set :: PropertyType
"SubComponentConfigurationDetails"
SubComponentTypeConfigurationProperty
-> SubComponentTypeConfigurationProperty
-> SubComponentTypeConfigurationProperty
set PropertyType
"SubComponentConfigurationDetails"
SubComponentTypeConfigurationProperty
newValue SubComponentTypeConfigurationProperty {()
Value Text
SubComponentConfigurationDetailsProperty
haddock_workaround_ :: SubComponentTypeConfigurationProperty -> ()
subComponentConfigurationDetails :: SubComponentTypeConfigurationProperty
-> SubComponentConfigurationDetailsProperty
subComponentType :: SubComponentTypeConfigurationProperty -> Value Text
haddock_workaround_ :: ()
subComponentConfigurationDetails :: SubComponentConfigurationDetailsProperty
subComponentType :: Value Text
..}
= SubComponentTypeConfigurationProperty
{subComponentConfigurationDetails :: SubComponentConfigurationDetailsProperty
subComponentConfigurationDetails = PropertyType
"SubComponentConfigurationDetails"
SubComponentTypeConfigurationProperty
SubComponentConfigurationDetailsProperty
newValue, ()
Value Text
haddock_workaround_ :: ()
subComponentType :: Value Text
haddock_workaround_ :: ()
subComponentType :: Value Text
..}
instance Property "SubComponentType" SubComponentTypeConfigurationProperty where
type PropertyType "SubComponentType" SubComponentTypeConfigurationProperty = Value Prelude.Text
set :: PropertyType
"SubComponentType" SubComponentTypeConfigurationProperty
-> SubComponentTypeConfigurationProperty
-> SubComponentTypeConfigurationProperty
set PropertyType
"SubComponentType" SubComponentTypeConfigurationProperty
newValue SubComponentTypeConfigurationProperty {()
Value Text
SubComponentConfigurationDetailsProperty
haddock_workaround_ :: SubComponentTypeConfigurationProperty -> ()
subComponentConfigurationDetails :: SubComponentTypeConfigurationProperty
-> SubComponentConfigurationDetailsProperty
subComponentType :: SubComponentTypeConfigurationProperty -> Value Text
haddock_workaround_ :: ()
subComponentConfigurationDetails :: SubComponentConfigurationDetailsProperty
subComponentType :: Value Text
..}
= SubComponentTypeConfigurationProperty
{subComponentType :: Value Text
subComponentType = PropertyType
"SubComponentType" SubComponentTypeConfigurationProperty
Value Text
newValue, ()
SubComponentConfigurationDetailsProperty
haddock_workaround_ :: ()
subComponentConfigurationDetails :: SubComponentConfigurationDetailsProperty
haddock_workaround_ :: ()
subComponentConfigurationDetails :: SubComponentConfigurationDetailsProperty
..}