module Stratosphere.Lightsail.Alarm (
        Alarm(..), mkAlarm
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import Stratosphere.ResourceProperties
import Stratosphere.Value
data Alarm
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-lightsail-alarm.html>
    Alarm {Alarm -> ()
haddock_workaround_ :: (),
           -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-lightsail-alarm.html#cfn-lightsail-alarm-alarmname>
           Alarm -> Value Text
alarmName :: (Value Prelude.Text),
           -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-lightsail-alarm.html#cfn-lightsail-alarm-comparisonoperator>
           Alarm -> Value Text
comparisonOperator :: (Value Prelude.Text),
           -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-lightsail-alarm.html#cfn-lightsail-alarm-contactprotocols>
           Alarm -> Maybe (ValueList Text)
contactProtocols :: (Prelude.Maybe (ValueList Prelude.Text)),
           -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-lightsail-alarm.html#cfn-lightsail-alarm-datapointstoalarm>
           Alarm -> Maybe (Value Integer)
datapointsToAlarm :: (Prelude.Maybe (Value Prelude.Integer)),
           -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-lightsail-alarm.html#cfn-lightsail-alarm-evaluationperiods>
           Alarm -> Value Integer
evaluationPeriods :: (Value Prelude.Integer),
           -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-lightsail-alarm.html#cfn-lightsail-alarm-metricname>
           Alarm -> Value Text
metricName :: (Value Prelude.Text),
           -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-lightsail-alarm.html#cfn-lightsail-alarm-monitoredresourcename>
           Alarm -> Value Text
monitoredResourceName :: (Value Prelude.Text),
           -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-lightsail-alarm.html#cfn-lightsail-alarm-notificationenabled>
           Alarm -> Maybe (Value Bool)
notificationEnabled :: (Prelude.Maybe (Value Prelude.Bool)),
           -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-lightsail-alarm.html#cfn-lightsail-alarm-notificationtriggers>
           Alarm -> Maybe (ValueList Text)
notificationTriggers :: (Prelude.Maybe (ValueList Prelude.Text)),
           -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-lightsail-alarm.html#cfn-lightsail-alarm-threshold>
           Alarm -> Value Double
threshold :: (Value Prelude.Double),
           -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-lightsail-alarm.html#cfn-lightsail-alarm-treatmissingdata>
           Alarm -> Maybe (Value Text)
treatMissingData :: (Prelude.Maybe (Value Prelude.Text))}
  deriving stock (Alarm -> Alarm -> Bool
(Alarm -> Alarm -> Bool) -> (Alarm -> Alarm -> Bool) -> Eq Alarm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Alarm -> Alarm -> Bool
== :: Alarm -> Alarm -> Bool
$c/= :: Alarm -> Alarm -> Bool
/= :: Alarm -> Alarm -> Bool
Prelude.Eq, Int -> Alarm -> ShowS
[Alarm] -> ShowS
Alarm -> String
(Int -> Alarm -> ShowS)
-> (Alarm -> String) -> ([Alarm] -> ShowS) -> Show Alarm
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Alarm -> ShowS
showsPrec :: Int -> Alarm -> ShowS
$cshow :: Alarm -> String
show :: Alarm -> String
$cshowList :: [Alarm] -> ShowS
showList :: [Alarm] -> ShowS
Prelude.Show)
mkAlarm ::
  Value Prelude.Text
  -> Value Prelude.Text
     -> Value Prelude.Integer
        -> Value Prelude.Text
           -> Value Prelude.Text -> Value Prelude.Double -> Alarm
mkAlarm :: Value Text
-> Value Text
-> Value Integer
-> Value Text
-> Value Text
-> Value Double
-> Alarm
mkAlarm
  Value Text
alarmName
  Value Text
comparisonOperator
  Value Integer
evaluationPeriods
  Value Text
metricName
  Value Text
monitoredResourceName
  Value Double
threshold
  = Alarm
      {haddock_workaround_ :: ()
haddock_workaround_ = (), alarmName :: Value Text
alarmName = Value Text
alarmName,
       comparisonOperator :: Value Text
comparisonOperator = Value Text
comparisonOperator,
       evaluationPeriods :: Value Integer
evaluationPeriods = Value Integer
evaluationPeriods, metricName :: Value Text
metricName = Value Text
metricName,
       monitoredResourceName :: Value Text
monitoredResourceName = Value Text
monitoredResourceName,
       threshold :: Value Double
threshold = Value Double
threshold, contactProtocols :: Maybe (ValueList Text)
contactProtocols = Maybe (ValueList Text)
forall a. Maybe a
Prelude.Nothing,
       datapointsToAlarm :: Maybe (Value Integer)
datapointsToAlarm = Maybe (Value Integer)
forall a. Maybe a
Prelude.Nothing,
       notificationEnabled :: Maybe (Value Bool)
notificationEnabled = Maybe (Value Bool)
forall a. Maybe a
Prelude.Nothing,
       notificationTriggers :: Maybe (ValueList Text)
notificationTriggers = Maybe (ValueList Text)
forall a. Maybe a
Prelude.Nothing,
       treatMissingData :: Maybe (Value Text)
treatMissingData = Maybe (Value Text)
forall a. Maybe a
Prelude.Nothing}
instance ToResourceProperties Alarm where
  toResourceProperties :: Alarm -> ResourceProperties
toResourceProperties Alarm {Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
()
Value Double
Value Integer
Value Text
haddock_workaround_ :: Alarm -> ()
alarmName :: Alarm -> Value Text
comparisonOperator :: Alarm -> Value Text
contactProtocols :: Alarm -> Maybe (ValueList Text)
datapointsToAlarm :: Alarm -> Maybe (Value Integer)
evaluationPeriods :: Alarm -> Value Integer
metricName :: Alarm -> Value Text
monitoredResourceName :: Alarm -> Value Text
notificationEnabled :: Alarm -> Maybe (Value Bool)
notificationTriggers :: Alarm -> Maybe (ValueList Text)
threshold :: Alarm -> Value Double
treatMissingData :: Alarm -> Maybe (Value Text)
haddock_workaround_ :: ()
alarmName :: Value Text
comparisonOperator :: Value Text
contactProtocols :: Maybe (ValueList Text)
datapointsToAlarm :: Maybe (Value Integer)
evaluationPeriods :: Value Integer
metricName :: Value Text
monitoredResourceName :: Value Text
notificationEnabled :: Maybe (Value Bool)
notificationTriggers :: Maybe (ValueList Text)
threshold :: Value Double
treatMissingData :: Maybe (Value Text)
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::Lightsail::Alarm", 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
"AlarmName" 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
alarmName,
                            Key
"ComparisonOperator" 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
comparisonOperator,
                            Key
"EvaluationPeriods" Key -> Value Integer -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= Value Integer
evaluationPeriods,
                            Key
"MetricName" 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
metricName,
                            Key
"MonitoredResourceName" 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
monitoredResourceName,
                            Key
"Threshold" 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
threshold]
                           ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
                              [Key -> ValueList Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"ContactProtocols" (ValueList Text -> (Key, Value))
-> Maybe (ValueList Text) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (ValueList Text)
contactProtocols,
                               Key -> Value Integer -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"DatapointsToAlarm" (Value Integer -> (Key, Value))
-> Maybe (Value Integer) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Integer)
datapointsToAlarm,
                               Key -> Value Bool -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"NotificationEnabled" (Value Bool -> (Key, Value))
-> Maybe (Value Bool) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Bool)
notificationEnabled,
                               Key -> ValueList Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"NotificationTriggers" (ValueList Text -> (Key, Value))
-> Maybe (ValueList Text) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (ValueList Text)
notificationTriggers,
                               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..=) Key
"TreatMissingData" (Value Text -> (Key, Value))
-> Maybe (Value Text) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Text)
treatMissingData]))}
instance JSON.ToJSON Alarm where
  toJSON :: Alarm -> Value
toJSON Alarm {Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
()
Value Double
Value Integer
Value Text
haddock_workaround_ :: Alarm -> ()
alarmName :: Alarm -> Value Text
comparisonOperator :: Alarm -> Value Text
contactProtocols :: Alarm -> Maybe (ValueList Text)
datapointsToAlarm :: Alarm -> Maybe (Value Integer)
evaluationPeriods :: Alarm -> Value Integer
metricName :: Alarm -> Value Text
monitoredResourceName :: Alarm -> Value Text
notificationEnabled :: Alarm -> Maybe (Value Bool)
notificationTriggers :: Alarm -> Maybe (ValueList Text)
threshold :: Alarm -> Value Double
treatMissingData :: Alarm -> Maybe (Value Text)
haddock_workaround_ :: ()
alarmName :: Value Text
comparisonOperator :: Value Text
contactProtocols :: Maybe (ValueList Text)
datapointsToAlarm :: Maybe (Value Integer)
evaluationPeriods :: Value Integer
metricName :: Value Text
monitoredResourceName :: Value Text
notificationEnabled :: Maybe (Value Bool)
notificationTriggers :: Maybe (ValueList Text)
threshold :: Value Double
treatMissingData :: Maybe (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
"AlarmName" 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
alarmName,
               Key
"ComparisonOperator" 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
comparisonOperator,
               Key
"EvaluationPeriods" Key -> Value Integer -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= Value Integer
evaluationPeriods,
               Key
"MetricName" 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
metricName,
               Key
"MonitoredResourceName" 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
monitoredResourceName,
               Key
"Threshold" 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
threshold]
              ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
                 [Key -> ValueList Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"ContactProtocols" (ValueList Text -> (Key, Value))
-> Maybe (ValueList Text) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (ValueList Text)
contactProtocols,
                  Key -> Value Integer -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"DatapointsToAlarm" (Value Integer -> (Key, Value))
-> Maybe (Value Integer) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Integer)
datapointsToAlarm,
                  Key -> Value Bool -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"NotificationEnabled" (Value Bool -> (Key, Value))
-> Maybe (Value Bool) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Bool)
notificationEnabled,
                  Key -> ValueList Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"NotificationTriggers" (ValueList Text -> (Key, Value))
-> Maybe (ValueList Text) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (ValueList Text)
notificationTriggers,
                  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..=) Key
"TreatMissingData" (Value Text -> (Key, Value))
-> Maybe (Value Text) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Text)
treatMissingData])))
instance Property "AlarmName" Alarm where
  type PropertyType "AlarmName" Alarm = Value Prelude.Text
  set :: PropertyType "AlarmName" Alarm -> Alarm -> Alarm
set PropertyType "AlarmName" Alarm
newValue Alarm {Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
()
Value Double
Value Integer
Value Text
haddock_workaround_ :: Alarm -> ()
alarmName :: Alarm -> Value Text
comparisonOperator :: Alarm -> Value Text
contactProtocols :: Alarm -> Maybe (ValueList Text)
datapointsToAlarm :: Alarm -> Maybe (Value Integer)
evaluationPeriods :: Alarm -> Value Integer
metricName :: Alarm -> Value Text
monitoredResourceName :: Alarm -> Value Text
notificationEnabled :: Alarm -> Maybe (Value Bool)
notificationTriggers :: Alarm -> Maybe (ValueList Text)
threshold :: Alarm -> Value Double
treatMissingData :: Alarm -> Maybe (Value Text)
haddock_workaround_ :: ()
alarmName :: Value Text
comparisonOperator :: Value Text
contactProtocols :: Maybe (ValueList Text)
datapointsToAlarm :: Maybe (Value Integer)
evaluationPeriods :: Value Integer
metricName :: Value Text
monitoredResourceName :: Value Text
notificationEnabled :: Maybe (Value Bool)
notificationTriggers :: Maybe (ValueList Text)
threshold :: Value Double
treatMissingData :: Maybe (Value Text)
..} = Alarm {alarmName :: Value Text
alarmName = PropertyType "AlarmName" Alarm
Value Text
newValue, Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
()
Value Double
Value Integer
Value Text
haddock_workaround_ :: ()
comparisonOperator :: Value Text
contactProtocols :: Maybe (ValueList Text)
datapointsToAlarm :: Maybe (Value Integer)
evaluationPeriods :: Value Integer
metricName :: Value Text
monitoredResourceName :: Value Text
notificationEnabled :: Maybe (Value Bool)
notificationTriggers :: Maybe (ValueList Text)
threshold :: Value Double
treatMissingData :: Maybe (Value Text)
haddock_workaround_ :: ()
comparisonOperator :: Value Text
contactProtocols :: Maybe (ValueList Text)
datapointsToAlarm :: Maybe (Value Integer)
evaluationPeriods :: Value Integer
metricName :: Value Text
monitoredResourceName :: Value Text
notificationEnabled :: Maybe (Value Bool)
notificationTriggers :: Maybe (ValueList Text)
threshold :: Value Double
treatMissingData :: Maybe (Value Text)
..}
instance Property "ComparisonOperator" Alarm where
  type PropertyType "ComparisonOperator" Alarm = Value Prelude.Text
  set :: PropertyType "ComparisonOperator" Alarm -> Alarm -> Alarm
set PropertyType "ComparisonOperator" Alarm
newValue Alarm {Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
()
Value Double
Value Integer
Value Text
haddock_workaround_ :: Alarm -> ()
alarmName :: Alarm -> Value Text
comparisonOperator :: Alarm -> Value Text
contactProtocols :: Alarm -> Maybe (ValueList Text)
datapointsToAlarm :: Alarm -> Maybe (Value Integer)
evaluationPeriods :: Alarm -> Value Integer
metricName :: Alarm -> Value Text
monitoredResourceName :: Alarm -> Value Text
notificationEnabled :: Alarm -> Maybe (Value Bool)
notificationTriggers :: Alarm -> Maybe (ValueList Text)
threshold :: Alarm -> Value Double
treatMissingData :: Alarm -> Maybe (Value Text)
haddock_workaround_ :: ()
alarmName :: Value Text
comparisonOperator :: Value Text
contactProtocols :: Maybe (ValueList Text)
datapointsToAlarm :: Maybe (Value Integer)
evaluationPeriods :: Value Integer
metricName :: Value Text
monitoredResourceName :: Value Text
notificationEnabled :: Maybe (Value Bool)
notificationTriggers :: Maybe (ValueList Text)
threshold :: Value Double
treatMissingData :: Maybe (Value Text)
..} = Alarm {comparisonOperator :: Value Text
comparisonOperator = PropertyType "ComparisonOperator" Alarm
Value Text
newValue, Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
()
Value Double
Value Integer
Value Text
haddock_workaround_ :: ()
alarmName :: Value Text
contactProtocols :: Maybe (ValueList Text)
datapointsToAlarm :: Maybe (Value Integer)
evaluationPeriods :: Value Integer
metricName :: Value Text
monitoredResourceName :: Value Text
notificationEnabled :: Maybe (Value Bool)
notificationTriggers :: Maybe (ValueList Text)
threshold :: Value Double
treatMissingData :: Maybe (Value Text)
haddock_workaround_ :: ()
alarmName :: Value Text
contactProtocols :: Maybe (ValueList Text)
datapointsToAlarm :: Maybe (Value Integer)
evaluationPeriods :: Value Integer
metricName :: Value Text
monitoredResourceName :: Value Text
notificationEnabled :: Maybe (Value Bool)
notificationTriggers :: Maybe (ValueList Text)
threshold :: Value Double
treatMissingData :: Maybe (Value Text)
..}
instance Property "ContactProtocols" Alarm where
  type PropertyType "ContactProtocols" Alarm = ValueList Prelude.Text
  set :: PropertyType "ContactProtocols" Alarm -> Alarm -> Alarm
set PropertyType "ContactProtocols" Alarm
newValue Alarm {Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
()
Value Double
Value Integer
Value Text
haddock_workaround_ :: Alarm -> ()
alarmName :: Alarm -> Value Text
comparisonOperator :: Alarm -> Value Text
contactProtocols :: Alarm -> Maybe (ValueList Text)
datapointsToAlarm :: Alarm -> Maybe (Value Integer)
evaluationPeriods :: Alarm -> Value Integer
metricName :: Alarm -> Value Text
monitoredResourceName :: Alarm -> Value Text
notificationEnabled :: Alarm -> Maybe (Value Bool)
notificationTriggers :: Alarm -> Maybe (ValueList Text)
threshold :: Alarm -> Value Double
treatMissingData :: Alarm -> Maybe (Value Text)
haddock_workaround_ :: ()
alarmName :: Value Text
comparisonOperator :: Value Text
contactProtocols :: Maybe (ValueList Text)
datapointsToAlarm :: Maybe (Value Integer)
evaluationPeriods :: Value Integer
metricName :: Value Text
monitoredResourceName :: Value Text
notificationEnabled :: Maybe (Value Bool)
notificationTriggers :: Maybe (ValueList Text)
threshold :: Value Double
treatMissingData :: Maybe (Value Text)
..}
    = Alarm {contactProtocols :: Maybe (ValueList Text)
contactProtocols = ValueList Text -> Maybe (ValueList Text)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "ContactProtocols" Alarm
ValueList Text
newValue, Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
()
Value Double
Value Integer
Value Text
haddock_workaround_ :: ()
alarmName :: Value Text
comparisonOperator :: Value Text
datapointsToAlarm :: Maybe (Value Integer)
evaluationPeriods :: Value Integer
metricName :: Value Text
monitoredResourceName :: Value Text
notificationEnabled :: Maybe (Value Bool)
notificationTriggers :: Maybe (ValueList Text)
threshold :: Value Double
treatMissingData :: Maybe (Value Text)
haddock_workaround_ :: ()
alarmName :: Value Text
comparisonOperator :: Value Text
datapointsToAlarm :: Maybe (Value Integer)
evaluationPeriods :: Value Integer
metricName :: Value Text
monitoredResourceName :: Value Text
notificationEnabled :: Maybe (Value Bool)
notificationTriggers :: Maybe (ValueList Text)
threshold :: Value Double
treatMissingData :: Maybe (Value Text)
..}
instance Property "DatapointsToAlarm" Alarm where
  type PropertyType "DatapointsToAlarm" Alarm = Value Prelude.Integer
  set :: PropertyType "DatapointsToAlarm" Alarm -> Alarm -> Alarm
set PropertyType "DatapointsToAlarm" Alarm
newValue Alarm {Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
()
Value Double
Value Integer
Value Text
haddock_workaround_ :: Alarm -> ()
alarmName :: Alarm -> Value Text
comparisonOperator :: Alarm -> Value Text
contactProtocols :: Alarm -> Maybe (ValueList Text)
datapointsToAlarm :: Alarm -> Maybe (Value Integer)
evaluationPeriods :: Alarm -> Value Integer
metricName :: Alarm -> Value Text
monitoredResourceName :: Alarm -> Value Text
notificationEnabled :: Alarm -> Maybe (Value Bool)
notificationTriggers :: Alarm -> Maybe (ValueList Text)
threshold :: Alarm -> Value Double
treatMissingData :: Alarm -> Maybe (Value Text)
haddock_workaround_ :: ()
alarmName :: Value Text
comparisonOperator :: Value Text
contactProtocols :: Maybe (ValueList Text)
datapointsToAlarm :: Maybe (Value Integer)
evaluationPeriods :: Value Integer
metricName :: Value Text
monitoredResourceName :: Value Text
notificationEnabled :: Maybe (Value Bool)
notificationTriggers :: Maybe (ValueList Text)
threshold :: Value Double
treatMissingData :: Maybe (Value Text)
..}
    = Alarm {datapointsToAlarm :: Maybe (Value Integer)
datapointsToAlarm = Value Integer -> Maybe (Value Integer)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "DatapointsToAlarm" Alarm
Value Integer
newValue, Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Text)
()
Value Double
Value Integer
Value Text
haddock_workaround_ :: ()
alarmName :: Value Text
comparisonOperator :: Value Text
contactProtocols :: Maybe (ValueList Text)
evaluationPeriods :: Value Integer
metricName :: Value Text
monitoredResourceName :: Value Text
notificationEnabled :: Maybe (Value Bool)
notificationTriggers :: Maybe (ValueList Text)
threshold :: Value Double
treatMissingData :: Maybe (Value Text)
haddock_workaround_ :: ()
alarmName :: Value Text
comparisonOperator :: Value Text
contactProtocols :: Maybe (ValueList Text)
evaluationPeriods :: Value Integer
metricName :: Value Text
monitoredResourceName :: Value Text
notificationEnabled :: Maybe (Value Bool)
notificationTriggers :: Maybe (ValueList Text)
threshold :: Value Double
treatMissingData :: Maybe (Value Text)
..}
instance Property "EvaluationPeriods" Alarm where
  type PropertyType "EvaluationPeriods" Alarm = Value Prelude.Integer
  set :: PropertyType "EvaluationPeriods" Alarm -> Alarm -> Alarm
set PropertyType "EvaluationPeriods" Alarm
newValue Alarm {Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
()
Value Double
Value Integer
Value Text
haddock_workaround_ :: Alarm -> ()
alarmName :: Alarm -> Value Text
comparisonOperator :: Alarm -> Value Text
contactProtocols :: Alarm -> Maybe (ValueList Text)
datapointsToAlarm :: Alarm -> Maybe (Value Integer)
evaluationPeriods :: Alarm -> Value Integer
metricName :: Alarm -> Value Text
monitoredResourceName :: Alarm -> Value Text
notificationEnabled :: Alarm -> Maybe (Value Bool)
notificationTriggers :: Alarm -> Maybe (ValueList Text)
threshold :: Alarm -> Value Double
treatMissingData :: Alarm -> Maybe (Value Text)
haddock_workaround_ :: ()
alarmName :: Value Text
comparisonOperator :: Value Text
contactProtocols :: Maybe (ValueList Text)
datapointsToAlarm :: Maybe (Value Integer)
evaluationPeriods :: Value Integer
metricName :: Value Text
monitoredResourceName :: Value Text
notificationEnabled :: Maybe (Value Bool)
notificationTriggers :: Maybe (ValueList Text)
threshold :: Value Double
treatMissingData :: Maybe (Value Text)
..} = Alarm {evaluationPeriods :: Value Integer
evaluationPeriods = PropertyType "EvaluationPeriods" Alarm
Value Integer
newValue, Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
()
Value Double
Value Text
haddock_workaround_ :: ()
alarmName :: Value Text
comparisonOperator :: Value Text
contactProtocols :: Maybe (ValueList Text)
datapointsToAlarm :: Maybe (Value Integer)
metricName :: Value Text
monitoredResourceName :: Value Text
notificationEnabled :: Maybe (Value Bool)
notificationTriggers :: Maybe (ValueList Text)
threshold :: Value Double
treatMissingData :: Maybe (Value Text)
haddock_workaround_ :: ()
alarmName :: Value Text
comparisonOperator :: Value Text
contactProtocols :: Maybe (ValueList Text)
datapointsToAlarm :: Maybe (Value Integer)
metricName :: Value Text
monitoredResourceName :: Value Text
notificationEnabled :: Maybe (Value Bool)
notificationTriggers :: Maybe (ValueList Text)
threshold :: Value Double
treatMissingData :: Maybe (Value Text)
..}
instance Property "MetricName" Alarm where
  type PropertyType "MetricName" Alarm = Value Prelude.Text
  set :: PropertyType "MetricName" Alarm -> Alarm -> Alarm
set PropertyType "MetricName" Alarm
newValue Alarm {Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
()
Value Double
Value Integer
Value Text
haddock_workaround_ :: Alarm -> ()
alarmName :: Alarm -> Value Text
comparisonOperator :: Alarm -> Value Text
contactProtocols :: Alarm -> Maybe (ValueList Text)
datapointsToAlarm :: Alarm -> Maybe (Value Integer)
evaluationPeriods :: Alarm -> Value Integer
metricName :: Alarm -> Value Text
monitoredResourceName :: Alarm -> Value Text
notificationEnabled :: Alarm -> Maybe (Value Bool)
notificationTriggers :: Alarm -> Maybe (ValueList Text)
threshold :: Alarm -> Value Double
treatMissingData :: Alarm -> Maybe (Value Text)
haddock_workaround_ :: ()
alarmName :: Value Text
comparisonOperator :: Value Text
contactProtocols :: Maybe (ValueList Text)
datapointsToAlarm :: Maybe (Value Integer)
evaluationPeriods :: Value Integer
metricName :: Value Text
monitoredResourceName :: Value Text
notificationEnabled :: Maybe (Value Bool)
notificationTriggers :: Maybe (ValueList Text)
threshold :: Value Double
treatMissingData :: Maybe (Value Text)
..} = Alarm {metricName :: Value Text
metricName = PropertyType "MetricName" Alarm
Value Text
newValue, Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
()
Value Double
Value Integer
Value Text
haddock_workaround_ :: ()
alarmName :: Value Text
comparisonOperator :: Value Text
contactProtocols :: Maybe (ValueList Text)
datapointsToAlarm :: Maybe (Value Integer)
evaluationPeriods :: Value Integer
monitoredResourceName :: Value Text
notificationEnabled :: Maybe (Value Bool)
notificationTriggers :: Maybe (ValueList Text)
threshold :: Value Double
treatMissingData :: Maybe (Value Text)
haddock_workaround_ :: ()
alarmName :: Value Text
comparisonOperator :: Value Text
contactProtocols :: Maybe (ValueList Text)
datapointsToAlarm :: Maybe (Value Integer)
evaluationPeriods :: Value Integer
monitoredResourceName :: Value Text
notificationEnabled :: Maybe (Value Bool)
notificationTriggers :: Maybe (ValueList Text)
threshold :: Value Double
treatMissingData :: Maybe (Value Text)
..}
instance Property "MonitoredResourceName" Alarm where
  type PropertyType "MonitoredResourceName" Alarm = Value Prelude.Text
  set :: PropertyType "MonitoredResourceName" Alarm -> Alarm -> Alarm
set PropertyType "MonitoredResourceName" Alarm
newValue Alarm {Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
()
Value Double
Value Integer
Value Text
haddock_workaround_ :: Alarm -> ()
alarmName :: Alarm -> Value Text
comparisonOperator :: Alarm -> Value Text
contactProtocols :: Alarm -> Maybe (ValueList Text)
datapointsToAlarm :: Alarm -> Maybe (Value Integer)
evaluationPeriods :: Alarm -> Value Integer
metricName :: Alarm -> Value Text
monitoredResourceName :: Alarm -> Value Text
notificationEnabled :: Alarm -> Maybe (Value Bool)
notificationTriggers :: Alarm -> Maybe (ValueList Text)
threshold :: Alarm -> Value Double
treatMissingData :: Alarm -> Maybe (Value Text)
haddock_workaround_ :: ()
alarmName :: Value Text
comparisonOperator :: Value Text
contactProtocols :: Maybe (ValueList Text)
datapointsToAlarm :: Maybe (Value Integer)
evaluationPeriods :: Value Integer
metricName :: Value Text
monitoredResourceName :: Value Text
notificationEnabled :: Maybe (Value Bool)
notificationTriggers :: Maybe (ValueList Text)
threshold :: Value Double
treatMissingData :: Maybe (Value Text)
..}
    = Alarm {monitoredResourceName :: Value Text
monitoredResourceName = PropertyType "MonitoredResourceName" Alarm
Value Text
newValue, Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
()
Value Double
Value Integer
Value Text
haddock_workaround_ :: ()
alarmName :: Value Text
comparisonOperator :: Value Text
contactProtocols :: Maybe (ValueList Text)
datapointsToAlarm :: Maybe (Value Integer)
evaluationPeriods :: Value Integer
metricName :: Value Text
notificationEnabled :: Maybe (Value Bool)
notificationTriggers :: Maybe (ValueList Text)
threshold :: Value Double
treatMissingData :: Maybe (Value Text)
haddock_workaround_ :: ()
alarmName :: Value Text
comparisonOperator :: Value Text
contactProtocols :: Maybe (ValueList Text)
datapointsToAlarm :: Maybe (Value Integer)
evaluationPeriods :: Value Integer
metricName :: Value Text
notificationEnabled :: Maybe (Value Bool)
notificationTriggers :: Maybe (ValueList Text)
threshold :: Value Double
treatMissingData :: Maybe (Value Text)
..}
instance Property "NotificationEnabled" Alarm where
  type PropertyType "NotificationEnabled" Alarm = Value Prelude.Bool
  set :: PropertyType "NotificationEnabled" Alarm -> Alarm -> Alarm
set PropertyType "NotificationEnabled" Alarm
newValue Alarm {Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
()
Value Double
Value Integer
Value Text
haddock_workaround_ :: Alarm -> ()
alarmName :: Alarm -> Value Text
comparisonOperator :: Alarm -> Value Text
contactProtocols :: Alarm -> Maybe (ValueList Text)
datapointsToAlarm :: Alarm -> Maybe (Value Integer)
evaluationPeriods :: Alarm -> Value Integer
metricName :: Alarm -> Value Text
monitoredResourceName :: Alarm -> Value Text
notificationEnabled :: Alarm -> Maybe (Value Bool)
notificationTriggers :: Alarm -> Maybe (ValueList Text)
threshold :: Alarm -> Value Double
treatMissingData :: Alarm -> Maybe (Value Text)
haddock_workaround_ :: ()
alarmName :: Value Text
comparisonOperator :: Value Text
contactProtocols :: Maybe (ValueList Text)
datapointsToAlarm :: Maybe (Value Integer)
evaluationPeriods :: Value Integer
metricName :: Value Text
monitoredResourceName :: Value Text
notificationEnabled :: Maybe (Value Bool)
notificationTriggers :: Maybe (ValueList Text)
threshold :: Value Double
treatMissingData :: Maybe (Value Text)
..}
    = Alarm {notificationEnabled :: Maybe (Value Bool)
notificationEnabled = Value Bool -> Maybe (Value Bool)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "NotificationEnabled" Alarm
Value Bool
newValue, Maybe (ValueList Text)
Maybe (Value Integer)
Maybe (Value Text)
()
Value Double
Value Integer
Value Text
haddock_workaround_ :: ()
alarmName :: Value Text
comparisonOperator :: Value Text
contactProtocols :: Maybe (ValueList Text)
datapointsToAlarm :: Maybe (Value Integer)
evaluationPeriods :: Value Integer
metricName :: Value Text
monitoredResourceName :: Value Text
notificationTriggers :: Maybe (ValueList Text)
threshold :: Value Double
treatMissingData :: Maybe (Value Text)
haddock_workaround_ :: ()
alarmName :: Value Text
comparisonOperator :: Value Text
contactProtocols :: Maybe (ValueList Text)
datapointsToAlarm :: Maybe (Value Integer)
evaluationPeriods :: Value Integer
metricName :: Value Text
monitoredResourceName :: Value Text
notificationTriggers :: Maybe (ValueList Text)
threshold :: Value Double
treatMissingData :: Maybe (Value Text)
..}
instance Property "NotificationTriggers" Alarm where
  type PropertyType "NotificationTriggers" Alarm = ValueList Prelude.Text
  set :: PropertyType "NotificationTriggers" Alarm -> Alarm -> Alarm
set PropertyType "NotificationTriggers" Alarm
newValue Alarm {Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
()
Value Double
Value Integer
Value Text
haddock_workaround_ :: Alarm -> ()
alarmName :: Alarm -> Value Text
comparisonOperator :: Alarm -> Value Text
contactProtocols :: Alarm -> Maybe (ValueList Text)
datapointsToAlarm :: Alarm -> Maybe (Value Integer)
evaluationPeriods :: Alarm -> Value Integer
metricName :: Alarm -> Value Text
monitoredResourceName :: Alarm -> Value Text
notificationEnabled :: Alarm -> Maybe (Value Bool)
notificationTriggers :: Alarm -> Maybe (ValueList Text)
threshold :: Alarm -> Value Double
treatMissingData :: Alarm -> Maybe (Value Text)
haddock_workaround_ :: ()
alarmName :: Value Text
comparisonOperator :: Value Text
contactProtocols :: Maybe (ValueList Text)
datapointsToAlarm :: Maybe (Value Integer)
evaluationPeriods :: Value Integer
metricName :: Value Text
monitoredResourceName :: Value Text
notificationEnabled :: Maybe (Value Bool)
notificationTriggers :: Maybe (ValueList Text)
threshold :: Value Double
treatMissingData :: Maybe (Value Text)
..}
    = Alarm {notificationTriggers :: Maybe (ValueList Text)
notificationTriggers = ValueList Text -> Maybe (ValueList Text)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "NotificationTriggers" Alarm
ValueList Text
newValue, Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
()
Value Double
Value Integer
Value Text
haddock_workaround_ :: ()
alarmName :: Value Text
comparisonOperator :: Value Text
contactProtocols :: Maybe (ValueList Text)
datapointsToAlarm :: Maybe (Value Integer)
evaluationPeriods :: Value Integer
metricName :: Value Text
monitoredResourceName :: Value Text
notificationEnabled :: Maybe (Value Bool)
threshold :: Value Double
treatMissingData :: Maybe (Value Text)
haddock_workaround_ :: ()
alarmName :: Value Text
comparisonOperator :: Value Text
contactProtocols :: Maybe (ValueList Text)
datapointsToAlarm :: Maybe (Value Integer)
evaluationPeriods :: Value Integer
metricName :: Value Text
monitoredResourceName :: Value Text
notificationEnabled :: Maybe (Value Bool)
threshold :: Value Double
treatMissingData :: Maybe (Value Text)
..}
instance Property "Threshold" Alarm where
  type PropertyType "Threshold" Alarm = Value Prelude.Double
  set :: PropertyType "Threshold" Alarm -> Alarm -> Alarm
set PropertyType "Threshold" Alarm
newValue Alarm {Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
()
Value Double
Value Integer
Value Text
haddock_workaround_ :: Alarm -> ()
alarmName :: Alarm -> Value Text
comparisonOperator :: Alarm -> Value Text
contactProtocols :: Alarm -> Maybe (ValueList Text)
datapointsToAlarm :: Alarm -> Maybe (Value Integer)
evaluationPeriods :: Alarm -> Value Integer
metricName :: Alarm -> Value Text
monitoredResourceName :: Alarm -> Value Text
notificationEnabled :: Alarm -> Maybe (Value Bool)
notificationTriggers :: Alarm -> Maybe (ValueList Text)
threshold :: Alarm -> Value Double
treatMissingData :: Alarm -> Maybe (Value Text)
haddock_workaround_ :: ()
alarmName :: Value Text
comparisonOperator :: Value Text
contactProtocols :: Maybe (ValueList Text)
datapointsToAlarm :: Maybe (Value Integer)
evaluationPeriods :: Value Integer
metricName :: Value Text
monitoredResourceName :: Value Text
notificationEnabled :: Maybe (Value Bool)
notificationTriggers :: Maybe (ValueList Text)
threshold :: Value Double
treatMissingData :: Maybe (Value Text)
..} = Alarm {threshold :: Value Double
threshold = PropertyType "Threshold" Alarm
Value Double
newValue, Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
()
Value Integer
Value Text
haddock_workaround_ :: ()
alarmName :: Value Text
comparisonOperator :: Value Text
contactProtocols :: Maybe (ValueList Text)
datapointsToAlarm :: Maybe (Value Integer)
evaluationPeriods :: Value Integer
metricName :: Value Text
monitoredResourceName :: Value Text
notificationEnabled :: Maybe (Value Bool)
notificationTriggers :: Maybe (ValueList Text)
treatMissingData :: Maybe (Value Text)
haddock_workaround_ :: ()
alarmName :: Value Text
comparisonOperator :: Value Text
contactProtocols :: Maybe (ValueList Text)
datapointsToAlarm :: Maybe (Value Integer)
evaluationPeriods :: Value Integer
metricName :: Value Text
monitoredResourceName :: Value Text
notificationEnabled :: Maybe (Value Bool)
notificationTriggers :: Maybe (ValueList Text)
treatMissingData :: Maybe (Value Text)
..}
instance Property "TreatMissingData" Alarm where
  type PropertyType "TreatMissingData" Alarm = Value Prelude.Text
  set :: PropertyType "TreatMissingData" Alarm -> Alarm -> Alarm
set PropertyType "TreatMissingData" Alarm
newValue Alarm {Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
()
Value Double
Value Integer
Value Text
haddock_workaround_ :: Alarm -> ()
alarmName :: Alarm -> Value Text
comparisonOperator :: Alarm -> Value Text
contactProtocols :: Alarm -> Maybe (ValueList Text)
datapointsToAlarm :: Alarm -> Maybe (Value Integer)
evaluationPeriods :: Alarm -> Value Integer
metricName :: Alarm -> Value Text
monitoredResourceName :: Alarm -> Value Text
notificationEnabled :: Alarm -> Maybe (Value Bool)
notificationTriggers :: Alarm -> Maybe (ValueList Text)
threshold :: Alarm -> Value Double
treatMissingData :: Alarm -> Maybe (Value Text)
haddock_workaround_ :: ()
alarmName :: Value Text
comparisonOperator :: Value Text
contactProtocols :: Maybe (ValueList Text)
datapointsToAlarm :: Maybe (Value Integer)
evaluationPeriods :: Value Integer
metricName :: Value Text
monitoredResourceName :: Value Text
notificationEnabled :: Maybe (Value Bool)
notificationTriggers :: Maybe (ValueList Text)
threshold :: Value Double
treatMissingData :: Maybe (Value Text)
..}
    = Alarm {treatMissingData :: Maybe (Value Text)
treatMissingData = Value Text -> Maybe (Value Text)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "TreatMissingData" Alarm
Value Text
newValue, Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
()
Value Double
Value Integer
Value Text
haddock_workaround_ :: ()
alarmName :: Value Text
comparisonOperator :: Value Text
contactProtocols :: Maybe (ValueList Text)
datapointsToAlarm :: Maybe (Value Integer)
evaluationPeriods :: Value Integer
metricName :: Value Text
monitoredResourceName :: Value Text
notificationEnabled :: Maybe (Value Bool)
notificationTriggers :: Maybe (ValueList Text)
threshold :: Value Double
haddock_workaround_ :: ()
alarmName :: Value Text
comparisonOperator :: Value Text
contactProtocols :: Maybe (ValueList Text)
datapointsToAlarm :: Maybe (Value Integer)
evaluationPeriods :: Value Integer
metricName :: Value Text
monitoredResourceName :: Value Text
notificationEnabled :: Maybe (Value Bool)
notificationTriggers :: Maybe (ValueList Text)
threshold :: Value Double
..}