module Stratosphere.QuickSight.Template.DecimalPlacesConfigurationProperty (
        DecimalPlacesConfigurationProperty(..),
        mkDecimalPlacesConfigurationProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import Stratosphere.ResourceProperties
import Stratosphere.Value
data DecimalPlacesConfigurationProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-quicksight-template-decimalplacesconfiguration.html>
    DecimalPlacesConfigurationProperty {DecimalPlacesConfigurationProperty -> ()
haddock_workaround_ :: (),
                                        -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-quicksight-template-decimalplacesconfiguration.html#cfn-quicksight-template-decimalplacesconfiguration-decimalplaces>
                                        DecimalPlacesConfigurationProperty -> Value Double
decimalPlaces :: (Value Prelude.Double)}
  deriving stock (DecimalPlacesConfigurationProperty
-> DecimalPlacesConfigurationProperty -> Bool
(DecimalPlacesConfigurationProperty
 -> DecimalPlacesConfigurationProperty -> Bool)
-> (DecimalPlacesConfigurationProperty
    -> DecimalPlacesConfigurationProperty -> Bool)
-> Eq DecimalPlacesConfigurationProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DecimalPlacesConfigurationProperty
-> DecimalPlacesConfigurationProperty -> Bool
== :: DecimalPlacesConfigurationProperty
-> DecimalPlacesConfigurationProperty -> Bool
$c/= :: DecimalPlacesConfigurationProperty
-> DecimalPlacesConfigurationProperty -> Bool
/= :: DecimalPlacesConfigurationProperty
-> DecimalPlacesConfigurationProperty -> Bool
Prelude.Eq, Int -> DecimalPlacesConfigurationProperty -> ShowS
[DecimalPlacesConfigurationProperty] -> ShowS
DecimalPlacesConfigurationProperty -> String
(Int -> DecimalPlacesConfigurationProperty -> ShowS)
-> (DecimalPlacesConfigurationProperty -> String)
-> ([DecimalPlacesConfigurationProperty] -> ShowS)
-> Show DecimalPlacesConfigurationProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DecimalPlacesConfigurationProperty -> ShowS
showsPrec :: Int -> DecimalPlacesConfigurationProperty -> ShowS
$cshow :: DecimalPlacesConfigurationProperty -> String
show :: DecimalPlacesConfigurationProperty -> String
$cshowList :: [DecimalPlacesConfigurationProperty] -> ShowS
showList :: [DecimalPlacesConfigurationProperty] -> ShowS
Prelude.Show)
mkDecimalPlacesConfigurationProperty ::
  Value Prelude.Double -> DecimalPlacesConfigurationProperty
mkDecimalPlacesConfigurationProperty :: Value Double -> DecimalPlacesConfigurationProperty
mkDecimalPlacesConfigurationProperty Value Double
decimalPlaces
  = DecimalPlacesConfigurationProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (), decimalPlaces :: Value Double
decimalPlaces = Value Double
decimalPlaces}
instance ToResourceProperties DecimalPlacesConfigurationProperty where
  toResourceProperties :: DecimalPlacesConfigurationProperty -> ResourceProperties
toResourceProperties DecimalPlacesConfigurationProperty {()
Value Double
haddock_workaround_ :: DecimalPlacesConfigurationProperty -> ()
decimalPlaces :: DecimalPlacesConfigurationProperty -> Value Double
haddock_workaround_ :: ()
decimalPlaces :: Value Double
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::QuickSight::Template.DecimalPlacesConfiguration",
         supportsTags :: Bool
supportsTags = Bool
Prelude.False,
         properties :: Object
properties = [Key
"DecimalPlaces" Key -> Value Double -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= Value Double
decimalPlaces]}
instance JSON.ToJSON DecimalPlacesConfigurationProperty where
  toJSON :: DecimalPlacesConfigurationProperty -> Value
toJSON DecimalPlacesConfigurationProperty {()
Value Double
haddock_workaround_ :: DecimalPlacesConfigurationProperty -> ()
decimalPlaces :: DecimalPlacesConfigurationProperty -> Value Double
haddock_workaround_ :: ()
decimalPlaces :: Value Double
..}
    = [(Key, Value)] -> Value
JSON.object [Key
"DecimalPlaces" Key -> Value Double -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= Value Double
decimalPlaces]
instance Property "DecimalPlaces" DecimalPlacesConfigurationProperty where
  type PropertyType "DecimalPlaces" DecimalPlacesConfigurationProperty = Value Prelude.Double
  set :: PropertyType "DecimalPlaces" DecimalPlacesConfigurationProperty
-> DecimalPlacesConfigurationProperty
-> DecimalPlacesConfigurationProperty
set PropertyType "DecimalPlaces" DecimalPlacesConfigurationProperty
newValue DecimalPlacesConfigurationProperty {()
Value Double
haddock_workaround_ :: DecimalPlacesConfigurationProperty -> ()
decimalPlaces :: DecimalPlacesConfigurationProperty -> Value Double
haddock_workaround_ :: ()
decimalPlaces :: Value Double
..}
    = DecimalPlacesConfigurationProperty {decimalPlaces :: Value Double
decimalPlaces = PropertyType "DecimalPlaces" DecimalPlacesConfigurationProperty
Value Double
newValue, ()
haddock_workaround_ :: ()
haddock_workaround_ :: ()
..}