module Stratosphere.Connect.EvaluationForm.EvaluationFormNumericQuestionPropertiesProperty (
        module Exports,
        EvaluationFormNumericQuestionPropertiesProperty(..),
        mkEvaluationFormNumericQuestionPropertiesProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.Connect.EvaluationForm.EvaluationFormNumericQuestionAutomationProperty as Exports
import {-# SOURCE #-} Stratosphere.Connect.EvaluationForm.EvaluationFormNumericQuestionOptionProperty as Exports
import Stratosphere.ResourceProperties
import Stratosphere.Value
data EvaluationFormNumericQuestionPropertiesProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-connect-evaluationform-evaluationformnumericquestionproperties.html>
    EvaluationFormNumericQuestionPropertiesProperty {EvaluationFormNumericQuestionPropertiesProperty -> ()
haddock_workaround_ :: (),
                                                     -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-connect-evaluationform-evaluationformnumericquestionproperties.html#cfn-connect-evaluationform-evaluationformnumericquestionproperties-automation>
                                                     EvaluationFormNumericQuestionPropertiesProperty
-> Maybe EvaluationFormNumericQuestionAutomationProperty
automation :: (Prelude.Maybe EvaluationFormNumericQuestionAutomationProperty),
                                                     -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-connect-evaluationform-evaluationformnumericquestionproperties.html#cfn-connect-evaluationform-evaluationformnumericquestionproperties-maxvalue>
                                                     EvaluationFormNumericQuestionPropertiesProperty -> Value Integer
maxValue :: (Value Prelude.Integer),
                                                     -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-connect-evaluationform-evaluationformnumericquestionproperties.html#cfn-connect-evaluationform-evaluationformnumericquestionproperties-minvalue>
                                                     EvaluationFormNumericQuestionPropertiesProperty -> Value Integer
minValue :: (Value Prelude.Integer),
                                                     -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-connect-evaluationform-evaluationformnumericquestionproperties.html#cfn-connect-evaluationform-evaluationformnumericquestionproperties-options>
                                                     EvaluationFormNumericQuestionPropertiesProperty
-> Maybe [EvaluationFormNumericQuestionOptionProperty]
options :: (Prelude.Maybe [EvaluationFormNumericQuestionOptionProperty])}
  deriving stock (EvaluationFormNumericQuestionPropertiesProperty
-> EvaluationFormNumericQuestionPropertiesProperty -> Bool
(EvaluationFormNumericQuestionPropertiesProperty
 -> EvaluationFormNumericQuestionPropertiesProperty -> Bool)
-> (EvaluationFormNumericQuestionPropertiesProperty
    -> EvaluationFormNumericQuestionPropertiesProperty -> Bool)
-> Eq EvaluationFormNumericQuestionPropertiesProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EvaluationFormNumericQuestionPropertiesProperty
-> EvaluationFormNumericQuestionPropertiesProperty -> Bool
== :: EvaluationFormNumericQuestionPropertiesProperty
-> EvaluationFormNumericQuestionPropertiesProperty -> Bool
$c/= :: EvaluationFormNumericQuestionPropertiesProperty
-> EvaluationFormNumericQuestionPropertiesProperty -> Bool
/= :: EvaluationFormNumericQuestionPropertiesProperty
-> EvaluationFormNumericQuestionPropertiesProperty -> Bool
Prelude.Eq, Int -> EvaluationFormNumericQuestionPropertiesProperty -> ShowS
[EvaluationFormNumericQuestionPropertiesProperty] -> ShowS
EvaluationFormNumericQuestionPropertiesProperty -> String
(Int -> EvaluationFormNumericQuestionPropertiesProperty -> ShowS)
-> (EvaluationFormNumericQuestionPropertiesProperty -> String)
-> ([EvaluationFormNumericQuestionPropertiesProperty] -> ShowS)
-> Show EvaluationFormNumericQuestionPropertiesProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EvaluationFormNumericQuestionPropertiesProperty -> ShowS
showsPrec :: Int -> EvaluationFormNumericQuestionPropertiesProperty -> ShowS
$cshow :: EvaluationFormNumericQuestionPropertiesProperty -> String
show :: EvaluationFormNumericQuestionPropertiesProperty -> String
$cshowList :: [EvaluationFormNumericQuestionPropertiesProperty] -> ShowS
showList :: [EvaluationFormNumericQuestionPropertiesProperty] -> ShowS
Prelude.Show)
mkEvaluationFormNumericQuestionPropertiesProperty ::
  Value Prelude.Integer
  -> Value Prelude.Integer
     -> EvaluationFormNumericQuestionPropertiesProperty
mkEvaluationFormNumericQuestionPropertiesProperty :: Value Integer
-> Value Integer -> EvaluationFormNumericQuestionPropertiesProperty
mkEvaluationFormNumericQuestionPropertiesProperty Value Integer
maxValue Value Integer
minValue
  = EvaluationFormNumericQuestionPropertiesProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (), maxValue :: Value Integer
maxValue = Value Integer
maxValue,
       minValue :: Value Integer
minValue = Value Integer
minValue, automation :: Maybe EvaluationFormNumericQuestionAutomationProperty
automation = Maybe EvaluationFormNumericQuestionAutomationProperty
forall a. Maybe a
Prelude.Nothing,
       options :: Maybe [EvaluationFormNumericQuestionOptionProperty]
options = Maybe [EvaluationFormNumericQuestionOptionProperty]
forall a. Maybe a
Prelude.Nothing}
instance ToResourceProperties EvaluationFormNumericQuestionPropertiesProperty where
  toResourceProperties :: EvaluationFormNumericQuestionPropertiesProperty
-> ResourceProperties
toResourceProperties
    EvaluationFormNumericQuestionPropertiesProperty {Maybe [EvaluationFormNumericQuestionOptionProperty]
Maybe EvaluationFormNumericQuestionAutomationProperty
()
Value Integer
haddock_workaround_ :: EvaluationFormNumericQuestionPropertiesProperty -> ()
automation :: EvaluationFormNumericQuestionPropertiesProperty
-> Maybe EvaluationFormNumericQuestionAutomationProperty
maxValue :: EvaluationFormNumericQuestionPropertiesProperty -> Value Integer
minValue :: EvaluationFormNumericQuestionPropertiesProperty -> Value Integer
options :: EvaluationFormNumericQuestionPropertiesProperty
-> Maybe [EvaluationFormNumericQuestionOptionProperty]
haddock_workaround_ :: ()
automation :: Maybe EvaluationFormNumericQuestionAutomationProperty
maxValue :: Value Integer
minValue :: Value Integer
options :: Maybe [EvaluationFormNumericQuestionOptionProperty]
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::Connect::EvaluationForm.EvaluationFormNumericQuestionProperties",
         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
"MaxValue" 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
maxValue, Key
"MinValue" 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
minValue]
                           ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
                              [Key
-> EvaluationFormNumericQuestionAutomationProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"Automation" (EvaluationFormNumericQuestionAutomationProperty -> (Key, Value))
-> Maybe EvaluationFormNumericQuestionAutomationProperty
-> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe EvaluationFormNumericQuestionAutomationProperty
automation,
                               Key
-> [EvaluationFormNumericQuestionOptionProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"Options" ([EvaluationFormNumericQuestionOptionProperty] -> (Key, Value))
-> Maybe [EvaluationFormNumericQuestionOptionProperty]
-> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [EvaluationFormNumericQuestionOptionProperty]
options]))}
instance JSON.ToJSON EvaluationFormNumericQuestionPropertiesProperty where
  toJSON :: EvaluationFormNumericQuestionPropertiesProperty -> Value
toJSON EvaluationFormNumericQuestionPropertiesProperty {Maybe [EvaluationFormNumericQuestionOptionProperty]
Maybe EvaluationFormNumericQuestionAutomationProperty
()
Value Integer
haddock_workaround_ :: EvaluationFormNumericQuestionPropertiesProperty -> ()
automation :: EvaluationFormNumericQuestionPropertiesProperty
-> Maybe EvaluationFormNumericQuestionAutomationProperty
maxValue :: EvaluationFormNumericQuestionPropertiesProperty -> Value Integer
minValue :: EvaluationFormNumericQuestionPropertiesProperty -> Value Integer
options :: EvaluationFormNumericQuestionPropertiesProperty
-> Maybe [EvaluationFormNumericQuestionOptionProperty]
haddock_workaround_ :: ()
automation :: Maybe EvaluationFormNumericQuestionAutomationProperty
maxValue :: Value Integer
minValue :: Value Integer
options :: Maybe [EvaluationFormNumericQuestionOptionProperty]
..}
    = [(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
"MaxValue" 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
maxValue, Key
"MinValue" 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
minValue]
              ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
                 [Key
-> EvaluationFormNumericQuestionAutomationProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"Automation" (EvaluationFormNumericQuestionAutomationProperty -> (Key, Value))
-> Maybe EvaluationFormNumericQuestionAutomationProperty
-> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe EvaluationFormNumericQuestionAutomationProperty
automation,
                  Key
-> [EvaluationFormNumericQuestionOptionProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"Options" ([EvaluationFormNumericQuestionOptionProperty] -> (Key, Value))
-> Maybe [EvaluationFormNumericQuestionOptionProperty]
-> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [EvaluationFormNumericQuestionOptionProperty]
options])))
instance Property "Automation" EvaluationFormNumericQuestionPropertiesProperty where
  type PropertyType "Automation" EvaluationFormNumericQuestionPropertiesProperty = EvaluationFormNumericQuestionAutomationProperty
  set :: PropertyType
  "Automation" EvaluationFormNumericQuestionPropertiesProperty
-> EvaluationFormNumericQuestionPropertiesProperty
-> EvaluationFormNumericQuestionPropertiesProperty
set PropertyType
  "Automation" EvaluationFormNumericQuestionPropertiesProperty
newValue EvaluationFormNumericQuestionPropertiesProperty {Maybe [EvaluationFormNumericQuestionOptionProperty]
Maybe EvaluationFormNumericQuestionAutomationProperty
()
Value Integer
haddock_workaround_ :: EvaluationFormNumericQuestionPropertiesProperty -> ()
automation :: EvaluationFormNumericQuestionPropertiesProperty
-> Maybe EvaluationFormNumericQuestionAutomationProperty
maxValue :: EvaluationFormNumericQuestionPropertiesProperty -> Value Integer
minValue :: EvaluationFormNumericQuestionPropertiesProperty -> Value Integer
options :: EvaluationFormNumericQuestionPropertiesProperty
-> Maybe [EvaluationFormNumericQuestionOptionProperty]
haddock_workaround_ :: ()
automation :: Maybe EvaluationFormNumericQuestionAutomationProperty
maxValue :: Value Integer
minValue :: Value Integer
options :: Maybe [EvaluationFormNumericQuestionOptionProperty]
..}
    = EvaluationFormNumericQuestionPropertiesProperty
        {automation :: Maybe EvaluationFormNumericQuestionAutomationProperty
automation = EvaluationFormNumericQuestionAutomationProperty
-> Maybe EvaluationFormNumericQuestionAutomationProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType
  "Automation" EvaluationFormNumericQuestionPropertiesProperty
EvaluationFormNumericQuestionAutomationProperty
newValue, Maybe [EvaluationFormNumericQuestionOptionProperty]
()
Value Integer
haddock_workaround_ :: ()
maxValue :: Value Integer
minValue :: Value Integer
options :: Maybe [EvaluationFormNumericQuestionOptionProperty]
haddock_workaround_ :: ()
maxValue :: Value Integer
minValue :: Value Integer
options :: Maybe [EvaluationFormNumericQuestionOptionProperty]
..}
instance Property "MaxValue" EvaluationFormNumericQuestionPropertiesProperty where
  type PropertyType "MaxValue" EvaluationFormNumericQuestionPropertiesProperty = Value Prelude.Integer
  set :: PropertyType
  "MaxValue" EvaluationFormNumericQuestionPropertiesProperty
-> EvaluationFormNumericQuestionPropertiesProperty
-> EvaluationFormNumericQuestionPropertiesProperty
set PropertyType
  "MaxValue" EvaluationFormNumericQuestionPropertiesProperty
newValue EvaluationFormNumericQuestionPropertiesProperty {Maybe [EvaluationFormNumericQuestionOptionProperty]
Maybe EvaluationFormNumericQuestionAutomationProperty
()
Value Integer
haddock_workaround_ :: EvaluationFormNumericQuestionPropertiesProperty -> ()
automation :: EvaluationFormNumericQuestionPropertiesProperty
-> Maybe EvaluationFormNumericQuestionAutomationProperty
maxValue :: EvaluationFormNumericQuestionPropertiesProperty -> Value Integer
minValue :: EvaluationFormNumericQuestionPropertiesProperty -> Value Integer
options :: EvaluationFormNumericQuestionPropertiesProperty
-> Maybe [EvaluationFormNumericQuestionOptionProperty]
haddock_workaround_ :: ()
automation :: Maybe EvaluationFormNumericQuestionAutomationProperty
maxValue :: Value Integer
minValue :: Value Integer
options :: Maybe [EvaluationFormNumericQuestionOptionProperty]
..}
    = EvaluationFormNumericQuestionPropertiesProperty
        {maxValue :: Value Integer
maxValue = PropertyType
  "MaxValue" EvaluationFormNumericQuestionPropertiesProperty
Value Integer
newValue, Maybe [EvaluationFormNumericQuestionOptionProperty]
Maybe EvaluationFormNumericQuestionAutomationProperty
()
Value Integer
haddock_workaround_ :: ()
automation :: Maybe EvaluationFormNumericQuestionAutomationProperty
minValue :: Value Integer
options :: Maybe [EvaluationFormNumericQuestionOptionProperty]
haddock_workaround_ :: ()
automation :: Maybe EvaluationFormNumericQuestionAutomationProperty
minValue :: Value Integer
options :: Maybe [EvaluationFormNumericQuestionOptionProperty]
..}
instance Property "MinValue" EvaluationFormNumericQuestionPropertiesProperty where
  type PropertyType "MinValue" EvaluationFormNumericQuestionPropertiesProperty = Value Prelude.Integer
  set :: PropertyType
  "MinValue" EvaluationFormNumericQuestionPropertiesProperty
-> EvaluationFormNumericQuestionPropertiesProperty
-> EvaluationFormNumericQuestionPropertiesProperty
set PropertyType
  "MinValue" EvaluationFormNumericQuestionPropertiesProperty
newValue EvaluationFormNumericQuestionPropertiesProperty {Maybe [EvaluationFormNumericQuestionOptionProperty]
Maybe EvaluationFormNumericQuestionAutomationProperty
()
Value Integer
haddock_workaround_ :: EvaluationFormNumericQuestionPropertiesProperty -> ()
automation :: EvaluationFormNumericQuestionPropertiesProperty
-> Maybe EvaluationFormNumericQuestionAutomationProperty
maxValue :: EvaluationFormNumericQuestionPropertiesProperty -> Value Integer
minValue :: EvaluationFormNumericQuestionPropertiesProperty -> Value Integer
options :: EvaluationFormNumericQuestionPropertiesProperty
-> Maybe [EvaluationFormNumericQuestionOptionProperty]
haddock_workaround_ :: ()
automation :: Maybe EvaluationFormNumericQuestionAutomationProperty
maxValue :: Value Integer
minValue :: Value Integer
options :: Maybe [EvaluationFormNumericQuestionOptionProperty]
..}
    = EvaluationFormNumericQuestionPropertiesProperty
        {minValue :: Value Integer
minValue = PropertyType
  "MinValue" EvaluationFormNumericQuestionPropertiesProperty
Value Integer
newValue, Maybe [EvaluationFormNumericQuestionOptionProperty]
Maybe EvaluationFormNumericQuestionAutomationProperty
()
Value Integer
haddock_workaround_ :: ()
automation :: Maybe EvaluationFormNumericQuestionAutomationProperty
maxValue :: Value Integer
options :: Maybe [EvaluationFormNumericQuestionOptionProperty]
haddock_workaround_ :: ()
automation :: Maybe EvaluationFormNumericQuestionAutomationProperty
maxValue :: Value Integer
options :: Maybe [EvaluationFormNumericQuestionOptionProperty]
..}
instance Property "Options" EvaluationFormNumericQuestionPropertiesProperty where
  type PropertyType "Options" EvaluationFormNumericQuestionPropertiesProperty = [EvaluationFormNumericQuestionOptionProperty]
  set :: PropertyType
  "Options" EvaluationFormNumericQuestionPropertiesProperty
-> EvaluationFormNumericQuestionPropertiesProperty
-> EvaluationFormNumericQuestionPropertiesProperty
set PropertyType
  "Options" EvaluationFormNumericQuestionPropertiesProperty
newValue EvaluationFormNumericQuestionPropertiesProperty {Maybe [EvaluationFormNumericQuestionOptionProperty]
Maybe EvaluationFormNumericQuestionAutomationProperty
()
Value Integer
haddock_workaround_ :: EvaluationFormNumericQuestionPropertiesProperty -> ()
automation :: EvaluationFormNumericQuestionPropertiesProperty
-> Maybe EvaluationFormNumericQuestionAutomationProperty
maxValue :: EvaluationFormNumericQuestionPropertiesProperty -> Value Integer
minValue :: EvaluationFormNumericQuestionPropertiesProperty -> Value Integer
options :: EvaluationFormNumericQuestionPropertiesProperty
-> Maybe [EvaluationFormNumericQuestionOptionProperty]
haddock_workaround_ :: ()
automation :: Maybe EvaluationFormNumericQuestionAutomationProperty
maxValue :: Value Integer
minValue :: Value Integer
options :: Maybe [EvaluationFormNumericQuestionOptionProperty]
..}
    = EvaluationFormNumericQuestionPropertiesProperty
        {options :: Maybe [EvaluationFormNumericQuestionOptionProperty]
options = [EvaluationFormNumericQuestionOptionProperty]
-> Maybe [EvaluationFormNumericQuestionOptionProperty]
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure [EvaluationFormNumericQuestionOptionProperty]
PropertyType
  "Options" EvaluationFormNumericQuestionPropertiesProperty
newValue, Maybe EvaluationFormNumericQuestionAutomationProperty
()
Value Integer
haddock_workaround_ :: ()
automation :: Maybe EvaluationFormNumericQuestionAutomationProperty
maxValue :: Value Integer
minValue :: Value Integer
haddock_workaround_ :: ()
automation :: Maybe EvaluationFormNumericQuestionAutomationProperty
maxValue :: Value Integer
minValue :: Value Integer
..}