module Stratosphere.IoTSiteWise.AssetModel.MetricProperty (
        module Exports, MetricProperty(..), mkMetricProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.IoTSiteWise.AssetModel.ExpressionVariableProperty as Exports
import {-# SOURCE #-} Stratosphere.IoTSiteWise.AssetModel.MetricWindowProperty as Exports
import Stratosphere.ResourceProperties
import Stratosphere.Value
data MetricProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-iotsitewise-assetmodel-metric.html>
    MetricProperty {MetricProperty -> ()
haddock_workaround_ :: (),
                    -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-iotsitewise-assetmodel-metric.html#cfn-iotsitewise-assetmodel-metric-expression>
                    MetricProperty -> Value Text
expression :: (Value Prelude.Text),
                    -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-iotsitewise-assetmodel-metric.html#cfn-iotsitewise-assetmodel-metric-variables>
                    MetricProperty -> [ExpressionVariableProperty]
variables :: [ExpressionVariableProperty],
                    -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-iotsitewise-assetmodel-metric.html#cfn-iotsitewise-assetmodel-metric-window>
                    MetricProperty -> MetricWindowProperty
window :: MetricWindowProperty}
  deriving stock (MetricProperty -> MetricProperty -> Bool
(MetricProperty -> MetricProperty -> Bool)
-> (MetricProperty -> MetricProperty -> Bool) -> Eq MetricProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MetricProperty -> MetricProperty -> Bool
== :: MetricProperty -> MetricProperty -> Bool
$c/= :: MetricProperty -> MetricProperty -> Bool
/= :: MetricProperty -> MetricProperty -> Bool
Prelude.Eq, Int -> MetricProperty -> ShowS
[MetricProperty] -> ShowS
MetricProperty -> String
(Int -> MetricProperty -> ShowS)
-> (MetricProperty -> String)
-> ([MetricProperty] -> ShowS)
-> Show MetricProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MetricProperty -> ShowS
showsPrec :: Int -> MetricProperty -> ShowS
$cshow :: MetricProperty -> String
show :: MetricProperty -> String
$cshowList :: [MetricProperty] -> ShowS
showList :: [MetricProperty] -> ShowS
Prelude.Show)
mkMetricProperty ::
  Value Prelude.Text
  -> [ExpressionVariableProperty]
     -> MetricWindowProperty -> MetricProperty
mkMetricProperty :: Value Text
-> [ExpressionVariableProperty]
-> MetricWindowProperty
-> MetricProperty
mkMetricProperty Value Text
expression [ExpressionVariableProperty]
variables MetricWindowProperty
window
  = MetricProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (), expression :: Value Text
expression = Value Text
expression,
       variables :: [ExpressionVariableProperty]
variables = [ExpressionVariableProperty]
variables, window :: MetricWindowProperty
window = MetricWindowProperty
window}
instance ToResourceProperties MetricProperty where
  toResourceProperties :: MetricProperty -> ResourceProperties
toResourceProperties MetricProperty {[ExpressionVariableProperty]
()
Value Text
MetricWindowProperty
haddock_workaround_ :: MetricProperty -> ()
expression :: MetricProperty -> Value Text
variables :: MetricProperty -> [ExpressionVariableProperty]
window :: MetricProperty -> MetricWindowProperty
haddock_workaround_ :: ()
expression :: Value Text
variables :: [ExpressionVariableProperty]
window :: MetricWindowProperty
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::IoTSiteWise::AssetModel.Metric",
         supportsTags :: Bool
supportsTags = Bool
Prelude.False,
         properties :: Object
properties = [Key
"Expression" 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
expression,
                       Key
"Variables" Key -> [ExpressionVariableProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= [ExpressionVariableProperty]
variables, Key
"Window" Key -> MetricWindowProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= MetricWindowProperty
window]}
instance JSON.ToJSON MetricProperty where
  toJSON :: MetricProperty -> Value
toJSON MetricProperty {[ExpressionVariableProperty]
()
Value Text
MetricWindowProperty
haddock_workaround_ :: MetricProperty -> ()
expression :: MetricProperty -> Value Text
variables :: MetricProperty -> [ExpressionVariableProperty]
window :: MetricProperty -> MetricWindowProperty
haddock_workaround_ :: ()
expression :: Value Text
variables :: [ExpressionVariableProperty]
window :: MetricWindowProperty
..}
    = [(Key, Value)] -> Value
JSON.object
        [Key
"Expression" 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
expression, Key
"Variables" Key -> [ExpressionVariableProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= [ExpressionVariableProperty]
variables,
         Key
"Window" Key -> MetricWindowProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= MetricWindowProperty
window]
instance Property "Expression" MetricProperty where
  type PropertyType "Expression" MetricProperty = Value Prelude.Text
  set :: PropertyType "Expression" MetricProperty
-> MetricProperty -> MetricProperty
set PropertyType "Expression" MetricProperty
newValue MetricProperty {[ExpressionVariableProperty]
()
Value Text
MetricWindowProperty
haddock_workaround_ :: MetricProperty -> ()
expression :: MetricProperty -> Value Text
variables :: MetricProperty -> [ExpressionVariableProperty]
window :: MetricProperty -> MetricWindowProperty
haddock_workaround_ :: ()
expression :: Value Text
variables :: [ExpressionVariableProperty]
window :: MetricWindowProperty
..}
    = MetricProperty {expression :: Value Text
expression = PropertyType "Expression" MetricProperty
Value Text
newValue, [ExpressionVariableProperty]
()
MetricWindowProperty
haddock_workaround_ :: ()
variables :: [ExpressionVariableProperty]
window :: MetricWindowProperty
haddock_workaround_ :: ()
variables :: [ExpressionVariableProperty]
window :: MetricWindowProperty
..}
instance Property "Variables" MetricProperty where
  type PropertyType "Variables" MetricProperty = [ExpressionVariableProperty]
  set :: PropertyType "Variables" MetricProperty
-> MetricProperty -> MetricProperty
set PropertyType "Variables" MetricProperty
newValue MetricProperty {[ExpressionVariableProperty]
()
Value Text
MetricWindowProperty
haddock_workaround_ :: MetricProperty -> ()
expression :: MetricProperty -> Value Text
variables :: MetricProperty -> [ExpressionVariableProperty]
window :: MetricProperty -> MetricWindowProperty
haddock_workaround_ :: ()
expression :: Value Text
variables :: [ExpressionVariableProperty]
window :: MetricWindowProperty
..}
    = MetricProperty {variables :: [ExpressionVariableProperty]
variables = [ExpressionVariableProperty]
PropertyType "Variables" MetricProperty
newValue, ()
Value Text
MetricWindowProperty
haddock_workaround_ :: ()
expression :: Value Text
window :: MetricWindowProperty
haddock_workaround_ :: ()
expression :: Value Text
window :: MetricWindowProperty
..}
instance Property "Window" MetricProperty where
  type PropertyType "Window" MetricProperty = MetricWindowProperty
  set :: PropertyType "Window" MetricProperty
-> MetricProperty -> MetricProperty
set PropertyType "Window" MetricProperty
newValue MetricProperty {[ExpressionVariableProperty]
()
Value Text
MetricWindowProperty
haddock_workaround_ :: MetricProperty -> ()
expression :: MetricProperty -> Value Text
variables :: MetricProperty -> [ExpressionVariableProperty]
window :: MetricProperty -> MetricWindowProperty
haddock_workaround_ :: ()
expression :: Value Text
variables :: [ExpressionVariableProperty]
window :: MetricWindowProperty
..}
    = MetricProperty {window :: MetricWindowProperty
window = PropertyType "Window" MetricProperty
MetricWindowProperty
newValue, [ExpressionVariableProperty]
()
Value Text
haddock_workaround_ :: ()
expression :: Value Text
variables :: [ExpressionVariableProperty]
haddock_workaround_ :: ()
expression :: Value Text
variables :: [ExpressionVariableProperty]
..}