module Stratosphere.QuickSight.Dashboard.ShapeConditionalFormatProperty (
module Exports, ShapeConditionalFormatProperty(..),
mkShapeConditionalFormatProperty
) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.QuickSight.Dashboard.ConditionalFormattingColorProperty as Exports
import Stratosphere.ResourceProperties
data ShapeConditionalFormatProperty
=
ShapeConditionalFormatProperty {ShapeConditionalFormatProperty -> ()
haddock_workaround_ :: (),
ShapeConditionalFormatProperty
-> ConditionalFormattingColorProperty
backgroundColor :: ConditionalFormattingColorProperty}
deriving stock (ShapeConditionalFormatProperty
-> ShapeConditionalFormatProperty -> Bool
(ShapeConditionalFormatProperty
-> ShapeConditionalFormatProperty -> Bool)
-> (ShapeConditionalFormatProperty
-> ShapeConditionalFormatProperty -> Bool)
-> Eq ShapeConditionalFormatProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ShapeConditionalFormatProperty
-> ShapeConditionalFormatProperty -> Bool
== :: ShapeConditionalFormatProperty
-> ShapeConditionalFormatProperty -> Bool
$c/= :: ShapeConditionalFormatProperty
-> ShapeConditionalFormatProperty -> Bool
/= :: ShapeConditionalFormatProperty
-> ShapeConditionalFormatProperty -> Bool
Prelude.Eq, Int -> ShapeConditionalFormatProperty -> ShowS
[ShapeConditionalFormatProperty] -> ShowS
ShapeConditionalFormatProperty -> String
(Int -> ShapeConditionalFormatProperty -> ShowS)
-> (ShapeConditionalFormatProperty -> String)
-> ([ShapeConditionalFormatProperty] -> ShowS)
-> Show ShapeConditionalFormatProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ShapeConditionalFormatProperty -> ShowS
showsPrec :: Int -> ShapeConditionalFormatProperty -> ShowS
$cshow :: ShapeConditionalFormatProperty -> String
show :: ShapeConditionalFormatProperty -> String
$cshowList :: [ShapeConditionalFormatProperty] -> ShowS
showList :: [ShapeConditionalFormatProperty] -> ShowS
Prelude.Show)
mkShapeConditionalFormatProperty ::
ConditionalFormattingColorProperty
-> ShapeConditionalFormatProperty
mkShapeConditionalFormatProperty :: ConditionalFormattingColorProperty
-> ShapeConditionalFormatProperty
mkShapeConditionalFormatProperty ConditionalFormattingColorProperty
backgroundColor
= ShapeConditionalFormatProperty
{haddock_workaround_ :: ()
haddock_workaround_ = (), backgroundColor :: ConditionalFormattingColorProperty
backgroundColor = ConditionalFormattingColorProperty
backgroundColor}
instance ToResourceProperties ShapeConditionalFormatProperty where
toResourceProperties :: ShapeConditionalFormatProperty -> ResourceProperties
toResourceProperties ShapeConditionalFormatProperty {()
ConditionalFormattingColorProperty
haddock_workaround_ :: ShapeConditionalFormatProperty -> ()
backgroundColor :: ShapeConditionalFormatProperty
-> ConditionalFormattingColorProperty
haddock_workaround_ :: ()
backgroundColor :: ConditionalFormattingColorProperty
..}
= ResourceProperties
{awsType :: Text
awsType = Text
"AWS::QuickSight::Dashboard.ShapeConditionalFormat",
supportsTags :: Bool
supportsTags = Bool
Prelude.False,
properties :: Object
properties = [Key
"BackgroundColor" Key -> ConditionalFormattingColorProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= ConditionalFormattingColorProperty
backgroundColor]}
instance JSON.ToJSON ShapeConditionalFormatProperty where
toJSON :: ShapeConditionalFormatProperty -> Value
toJSON ShapeConditionalFormatProperty {()
ConditionalFormattingColorProperty
haddock_workaround_ :: ShapeConditionalFormatProperty -> ()
backgroundColor :: ShapeConditionalFormatProperty
-> ConditionalFormattingColorProperty
haddock_workaround_ :: ()
backgroundColor :: ConditionalFormattingColorProperty
..}
= [(Key, Value)] -> Value
JSON.object [Key
"BackgroundColor" Key -> ConditionalFormattingColorProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= ConditionalFormattingColorProperty
backgroundColor]
instance Property "BackgroundColor" ShapeConditionalFormatProperty where
type PropertyType "BackgroundColor" ShapeConditionalFormatProperty = ConditionalFormattingColorProperty
set :: PropertyType "BackgroundColor" ShapeConditionalFormatProperty
-> ShapeConditionalFormatProperty -> ShapeConditionalFormatProperty
set PropertyType "BackgroundColor" ShapeConditionalFormatProperty
newValue ShapeConditionalFormatProperty {()
ConditionalFormattingColorProperty
haddock_workaround_ :: ShapeConditionalFormatProperty -> ()
backgroundColor :: ShapeConditionalFormatProperty
-> ConditionalFormattingColorProperty
haddock_workaround_ :: ()
backgroundColor :: ConditionalFormattingColorProperty
..}
= ShapeConditionalFormatProperty {backgroundColor :: ConditionalFormattingColorProperty
backgroundColor = PropertyType "BackgroundColor" ShapeConditionalFormatProperty
ConditionalFormattingColorProperty
newValue, ()
haddock_workaround_ :: ()
haddock_workaround_ :: ()
..}