module Stratosphere.IoTSiteWise.AssetModel.PropertyTypeProperty (
        module Exports, PropertyTypeProperty(..), mkPropertyTypeProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.IoTSiteWise.AssetModel.AttributeProperty as Exports
import {-# SOURCE #-} Stratosphere.IoTSiteWise.AssetModel.MetricProperty as Exports
import {-# SOURCE #-} Stratosphere.IoTSiteWise.AssetModel.TransformProperty as Exports
import Stratosphere.ResourceProperties
import Stratosphere.Value
data PropertyTypeProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-iotsitewise-assetmodel-propertytype.html>
    PropertyTypeProperty {PropertyTypeProperty -> ()
haddock_workaround_ :: (),
                          -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-iotsitewise-assetmodel-propertytype.html#cfn-iotsitewise-assetmodel-propertytype-attribute>
                          PropertyTypeProperty -> Maybe AttributeProperty
attribute :: (Prelude.Maybe AttributeProperty),
                          -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-iotsitewise-assetmodel-propertytype.html#cfn-iotsitewise-assetmodel-propertytype-metric>
                          PropertyTypeProperty -> Maybe MetricProperty
metric :: (Prelude.Maybe MetricProperty),
                          -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-iotsitewise-assetmodel-propertytype.html#cfn-iotsitewise-assetmodel-propertytype-transform>
                          PropertyTypeProperty -> Maybe TransformProperty
transform :: (Prelude.Maybe TransformProperty),
                          -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-iotsitewise-assetmodel-propertytype.html#cfn-iotsitewise-assetmodel-propertytype-typename>
                          PropertyTypeProperty -> Value Text
typeName :: (Value Prelude.Text)}
  deriving stock (PropertyTypeProperty -> PropertyTypeProperty -> Bool
(PropertyTypeProperty -> PropertyTypeProperty -> Bool)
-> (PropertyTypeProperty -> PropertyTypeProperty -> Bool)
-> Eq PropertyTypeProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PropertyTypeProperty -> PropertyTypeProperty -> Bool
== :: PropertyTypeProperty -> PropertyTypeProperty -> Bool
$c/= :: PropertyTypeProperty -> PropertyTypeProperty -> Bool
/= :: PropertyTypeProperty -> PropertyTypeProperty -> Bool
Prelude.Eq, Int -> PropertyTypeProperty -> ShowS
[PropertyTypeProperty] -> ShowS
PropertyTypeProperty -> String
(Int -> PropertyTypeProperty -> ShowS)
-> (PropertyTypeProperty -> String)
-> ([PropertyTypeProperty] -> ShowS)
-> Show PropertyTypeProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PropertyTypeProperty -> ShowS
showsPrec :: Int -> PropertyTypeProperty -> ShowS
$cshow :: PropertyTypeProperty -> String
show :: PropertyTypeProperty -> String
$cshowList :: [PropertyTypeProperty] -> ShowS
showList :: [PropertyTypeProperty] -> ShowS
Prelude.Show)
mkPropertyTypeProperty ::
  Value Prelude.Text -> PropertyTypeProperty
mkPropertyTypeProperty :: Value Text -> PropertyTypeProperty
mkPropertyTypeProperty Value Text
typeName
  = PropertyTypeProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (), typeName :: Value Text
typeName = Value Text
typeName,
       attribute :: Maybe AttributeProperty
attribute = Maybe AttributeProperty
forall a. Maybe a
Prelude.Nothing, metric :: Maybe MetricProperty
metric = Maybe MetricProperty
forall a. Maybe a
Prelude.Nothing,
       transform :: Maybe TransformProperty
transform = Maybe TransformProperty
forall a. Maybe a
Prelude.Nothing}
instance ToResourceProperties PropertyTypeProperty where
  toResourceProperties :: PropertyTypeProperty -> ResourceProperties
toResourceProperties PropertyTypeProperty {Maybe AttributeProperty
Maybe TransformProperty
Maybe MetricProperty
()
Value Text
haddock_workaround_ :: PropertyTypeProperty -> ()
attribute :: PropertyTypeProperty -> Maybe AttributeProperty
metric :: PropertyTypeProperty -> Maybe MetricProperty
transform :: PropertyTypeProperty -> Maybe TransformProperty
typeName :: PropertyTypeProperty -> Value Text
haddock_workaround_ :: ()
attribute :: Maybe AttributeProperty
metric :: Maybe MetricProperty
transform :: Maybe TransformProperty
typeName :: Value Text
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::IoTSiteWise::AssetModel.PropertyType",
         supportsTags :: Bool
supportsTags = Bool
Prelude.False,
         properties :: Object
properties = [Item Object] -> Object
forall l. IsList l => [Item l] -> l
Prelude.fromList
                        ([(Key, Value)] -> [(Key, Value)] -> [(Key, Value)]
forall a. Semigroup a => a -> a -> a
(Prelude.<>)
                           [Key
"TypeName" 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
typeName]
                           ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
                              [Key -> AttributeProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"Attribute" (AttributeProperty -> (Key, Value))
-> Maybe AttributeProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe AttributeProperty
attribute,
                               Key -> MetricProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"Metric" (MetricProperty -> (Key, Value))
-> Maybe MetricProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe MetricProperty
metric,
                               Key -> TransformProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"Transform" (TransformProperty -> (Key, Value))
-> Maybe TransformProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe TransformProperty
transform]))}
instance JSON.ToJSON PropertyTypeProperty where
  toJSON :: PropertyTypeProperty -> Value
toJSON PropertyTypeProperty {Maybe AttributeProperty
Maybe TransformProperty
Maybe MetricProperty
()
Value Text
haddock_workaround_ :: PropertyTypeProperty -> ()
attribute :: PropertyTypeProperty -> Maybe AttributeProperty
metric :: PropertyTypeProperty -> Maybe MetricProperty
transform :: PropertyTypeProperty -> Maybe TransformProperty
typeName :: PropertyTypeProperty -> Value Text
haddock_workaround_ :: ()
attribute :: Maybe AttributeProperty
metric :: Maybe MetricProperty
transform :: Maybe TransformProperty
typeName :: Value Text
..}
    = [(Key, Value)] -> Value
JSON.object
        ([Item [(Key, Value)]] -> [(Key, Value)]
forall l. IsList l => [Item l] -> l
Prelude.fromList
           ([(Key, Value)] -> [(Key, Value)] -> [(Key, Value)]
forall a. Semigroup a => a -> a -> a
(Prelude.<>)
              [Key
"TypeName" 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
typeName]
              ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
                 [Key -> AttributeProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"Attribute" (AttributeProperty -> (Key, Value))
-> Maybe AttributeProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe AttributeProperty
attribute,
                  Key -> MetricProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"Metric" (MetricProperty -> (Key, Value))
-> Maybe MetricProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe MetricProperty
metric,
                  Key -> TransformProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"Transform" (TransformProperty -> (Key, Value))
-> Maybe TransformProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe TransformProperty
transform])))
instance Property "Attribute" PropertyTypeProperty where
  type PropertyType "Attribute" PropertyTypeProperty = AttributeProperty
  set :: PropertyType "Attribute" PropertyTypeProperty
-> PropertyTypeProperty -> PropertyTypeProperty
set PropertyType "Attribute" PropertyTypeProperty
newValue PropertyTypeProperty {Maybe AttributeProperty
Maybe TransformProperty
Maybe MetricProperty
()
Value Text
haddock_workaround_ :: PropertyTypeProperty -> ()
attribute :: PropertyTypeProperty -> Maybe AttributeProperty
metric :: PropertyTypeProperty -> Maybe MetricProperty
transform :: PropertyTypeProperty -> Maybe TransformProperty
typeName :: PropertyTypeProperty -> Value Text
haddock_workaround_ :: ()
attribute :: Maybe AttributeProperty
metric :: Maybe MetricProperty
transform :: Maybe TransformProperty
typeName :: Value Text
..}
    = PropertyTypeProperty {attribute :: Maybe AttributeProperty
attribute = AttributeProperty -> Maybe AttributeProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "Attribute" PropertyTypeProperty
AttributeProperty
newValue, Maybe TransformProperty
Maybe MetricProperty
()
Value Text
haddock_workaround_ :: ()
metric :: Maybe MetricProperty
transform :: Maybe TransformProperty
typeName :: Value Text
haddock_workaround_ :: ()
metric :: Maybe MetricProperty
transform :: Maybe TransformProperty
typeName :: Value Text
..}
instance Property "Metric" PropertyTypeProperty where
  type PropertyType "Metric" PropertyTypeProperty = MetricProperty
  set :: PropertyType "Metric" PropertyTypeProperty
-> PropertyTypeProperty -> PropertyTypeProperty
set PropertyType "Metric" PropertyTypeProperty
newValue PropertyTypeProperty {Maybe AttributeProperty
Maybe TransformProperty
Maybe MetricProperty
()
Value Text
haddock_workaround_ :: PropertyTypeProperty -> ()
attribute :: PropertyTypeProperty -> Maybe AttributeProperty
metric :: PropertyTypeProperty -> Maybe MetricProperty
transform :: PropertyTypeProperty -> Maybe TransformProperty
typeName :: PropertyTypeProperty -> Value Text
haddock_workaround_ :: ()
attribute :: Maybe AttributeProperty
metric :: Maybe MetricProperty
transform :: Maybe TransformProperty
typeName :: Value Text
..}
    = PropertyTypeProperty {metric :: Maybe MetricProperty
metric = MetricProperty -> Maybe MetricProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "Metric" PropertyTypeProperty
MetricProperty
newValue, Maybe AttributeProperty
Maybe TransformProperty
()
Value Text
haddock_workaround_ :: ()
attribute :: Maybe AttributeProperty
transform :: Maybe TransformProperty
typeName :: Value Text
haddock_workaround_ :: ()
attribute :: Maybe AttributeProperty
transform :: Maybe TransformProperty
typeName :: Value Text
..}
instance Property "Transform" PropertyTypeProperty where
  type PropertyType "Transform" PropertyTypeProperty = TransformProperty
  set :: PropertyType "Transform" PropertyTypeProperty
-> PropertyTypeProperty -> PropertyTypeProperty
set PropertyType "Transform" PropertyTypeProperty
newValue PropertyTypeProperty {Maybe AttributeProperty
Maybe TransformProperty
Maybe MetricProperty
()
Value Text
haddock_workaround_ :: PropertyTypeProperty -> ()
attribute :: PropertyTypeProperty -> Maybe AttributeProperty
metric :: PropertyTypeProperty -> Maybe MetricProperty
transform :: PropertyTypeProperty -> Maybe TransformProperty
typeName :: PropertyTypeProperty -> Value Text
haddock_workaround_ :: ()
attribute :: Maybe AttributeProperty
metric :: Maybe MetricProperty
transform :: Maybe TransformProperty
typeName :: Value Text
..}
    = PropertyTypeProperty {transform :: Maybe TransformProperty
transform = TransformProperty -> Maybe TransformProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "Transform" PropertyTypeProperty
TransformProperty
newValue, Maybe AttributeProperty
Maybe MetricProperty
()
Value Text
haddock_workaround_ :: ()
attribute :: Maybe AttributeProperty
metric :: Maybe MetricProperty
typeName :: Value Text
haddock_workaround_ :: ()
attribute :: Maybe AttributeProperty
metric :: Maybe MetricProperty
typeName :: Value Text
..}
instance Property "TypeName" PropertyTypeProperty where
  type PropertyType "TypeName" PropertyTypeProperty = Value Prelude.Text
  set :: PropertyType "TypeName" PropertyTypeProperty
-> PropertyTypeProperty -> PropertyTypeProperty
set PropertyType "TypeName" PropertyTypeProperty
newValue PropertyTypeProperty {Maybe AttributeProperty
Maybe TransformProperty
Maybe MetricProperty
()
Value Text
haddock_workaround_ :: PropertyTypeProperty -> ()
attribute :: PropertyTypeProperty -> Maybe AttributeProperty
metric :: PropertyTypeProperty -> Maybe MetricProperty
transform :: PropertyTypeProperty -> Maybe TransformProperty
typeName :: PropertyTypeProperty -> Value Text
haddock_workaround_ :: ()
attribute :: Maybe AttributeProperty
metric :: Maybe MetricProperty
transform :: Maybe TransformProperty
typeName :: Value Text
..}
    = PropertyTypeProperty {typeName :: Value Text
typeName = PropertyType "TypeName" PropertyTypeProperty
Value Text
newValue, Maybe AttributeProperty
Maybe TransformProperty
Maybe MetricProperty
()
haddock_workaround_ :: ()
attribute :: Maybe AttributeProperty
metric :: Maybe MetricProperty
transform :: Maybe TransformProperty
haddock_workaround_ :: ()
attribute :: Maybe AttributeProperty
metric :: Maybe MetricProperty
transform :: Maybe TransformProperty
..}