module Stratosphere.Lex.Bot.CustomVocabularyProperty (
        module Exports, CustomVocabularyProperty(..),
        mkCustomVocabularyProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.Lex.Bot.CustomVocabularyItemProperty as Exports
import Stratosphere.ResourceProperties
data CustomVocabularyProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-lex-bot-customvocabulary.html>
    CustomVocabularyProperty {CustomVocabularyProperty -> ()
haddock_workaround_ :: (),
                              -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-lex-bot-customvocabulary.html#cfn-lex-bot-customvocabulary-customvocabularyitems>
                              CustomVocabularyProperty -> [CustomVocabularyItemProperty]
customVocabularyItems :: [CustomVocabularyItemProperty]}
  deriving stock (CustomVocabularyProperty -> CustomVocabularyProperty -> Bool
(CustomVocabularyProperty -> CustomVocabularyProperty -> Bool)
-> (CustomVocabularyProperty -> CustomVocabularyProperty -> Bool)
-> Eq CustomVocabularyProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CustomVocabularyProperty -> CustomVocabularyProperty -> Bool
== :: CustomVocabularyProperty -> CustomVocabularyProperty -> Bool
$c/= :: CustomVocabularyProperty -> CustomVocabularyProperty -> Bool
/= :: CustomVocabularyProperty -> CustomVocabularyProperty -> Bool
Prelude.Eq, Int -> CustomVocabularyProperty -> ShowS
[CustomVocabularyProperty] -> ShowS
CustomVocabularyProperty -> String
(Int -> CustomVocabularyProperty -> ShowS)
-> (CustomVocabularyProperty -> String)
-> ([CustomVocabularyProperty] -> ShowS)
-> Show CustomVocabularyProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CustomVocabularyProperty -> ShowS
showsPrec :: Int -> CustomVocabularyProperty -> ShowS
$cshow :: CustomVocabularyProperty -> String
show :: CustomVocabularyProperty -> String
$cshowList :: [CustomVocabularyProperty] -> ShowS
showList :: [CustomVocabularyProperty] -> ShowS
Prelude.Show)
mkCustomVocabularyProperty ::
  [CustomVocabularyItemProperty] -> CustomVocabularyProperty
mkCustomVocabularyProperty :: [CustomVocabularyItemProperty] -> CustomVocabularyProperty
mkCustomVocabularyProperty [CustomVocabularyItemProperty]
customVocabularyItems
  = CustomVocabularyProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (),
       customVocabularyItems :: [CustomVocabularyItemProperty]
customVocabularyItems = [CustomVocabularyItemProperty]
customVocabularyItems}
instance ToResourceProperties CustomVocabularyProperty where
  toResourceProperties :: CustomVocabularyProperty -> ResourceProperties
toResourceProperties CustomVocabularyProperty {[CustomVocabularyItemProperty]
()
haddock_workaround_ :: CustomVocabularyProperty -> ()
customVocabularyItems :: CustomVocabularyProperty -> [CustomVocabularyItemProperty]
haddock_workaround_ :: ()
customVocabularyItems :: [CustomVocabularyItemProperty]
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::Lex::Bot.CustomVocabulary",
         supportsTags :: Bool
supportsTags = Bool
Prelude.False,
         properties :: Object
properties = [Key
"CustomVocabularyItems"
                         Key -> [CustomVocabularyItemProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= [CustomVocabularyItemProperty]
customVocabularyItems]}
instance JSON.ToJSON CustomVocabularyProperty where
  toJSON :: CustomVocabularyProperty -> Value
toJSON CustomVocabularyProperty {[CustomVocabularyItemProperty]
()
haddock_workaround_ :: CustomVocabularyProperty -> ()
customVocabularyItems :: CustomVocabularyProperty -> [CustomVocabularyItemProperty]
haddock_workaround_ :: ()
customVocabularyItems :: [CustomVocabularyItemProperty]
..}
    = [(Key, Value)] -> Value
JSON.object
        [Key
"CustomVocabularyItems" Key -> [CustomVocabularyItemProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= [CustomVocabularyItemProperty]
customVocabularyItems]
instance Property "CustomVocabularyItems" CustomVocabularyProperty where
  type PropertyType "CustomVocabularyItems" CustomVocabularyProperty = [CustomVocabularyItemProperty]
  set :: PropertyType "CustomVocabularyItems" CustomVocabularyProperty
-> CustomVocabularyProperty -> CustomVocabularyProperty
set PropertyType "CustomVocabularyItems" CustomVocabularyProperty
newValue CustomVocabularyProperty {[CustomVocabularyItemProperty]
()
haddock_workaround_ :: CustomVocabularyProperty -> ()
customVocabularyItems :: CustomVocabularyProperty -> [CustomVocabularyItemProperty]
haddock_workaround_ :: ()
customVocabularyItems :: [CustomVocabularyItemProperty]
..}
    = CustomVocabularyProperty {customVocabularyItems :: [CustomVocabularyItemProperty]
customVocabularyItems = [CustomVocabularyItemProperty]
PropertyType "CustomVocabularyItems" CustomVocabularyProperty
newValue, ()
haddock_workaround_ :: ()
haddock_workaround_ :: ()
..}