module Stratosphere.Cassandra.Type (
        module Exports, Type(..), mkType
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.Cassandra.Type.FieldProperty as Exports
import Stratosphere.ResourceProperties
import Stratosphere.Value
data Type
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-cassandra-type.html>
    Type {Type -> ()
haddock_workaround_ :: (),
          -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-cassandra-type.html#cfn-cassandra-type-fields>
          Type -> [FieldProperty]
fields :: [FieldProperty],
          -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-cassandra-type.html#cfn-cassandra-type-keyspacename>
          Type -> Value Text
keyspaceName :: (Value Prelude.Text),
          -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-cassandra-type.html#cfn-cassandra-type-typename>
          Type -> Value Text
typeName :: (Value Prelude.Text)}
  deriving stock (Type -> Type -> Bool
(Type -> Type -> Bool) -> (Type -> Type -> Bool) -> Eq Type
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Type -> Type -> Bool
== :: Type -> Type -> Bool
$c/= :: Type -> Type -> Bool
/= :: Type -> Type -> Bool
Prelude.Eq, Int -> Type -> ShowS
[Type] -> ShowS
Type -> String
(Int -> Type -> ShowS)
-> (Type -> String) -> ([Type] -> ShowS) -> Show Type
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Type -> ShowS
showsPrec :: Int -> Type -> ShowS
$cshow :: Type -> String
show :: Type -> String
$cshowList :: [Type] -> ShowS
showList :: [Type] -> ShowS
Prelude.Show)
mkType ::
  [FieldProperty] -> Value Prelude.Text -> Value Prelude.Text -> Type
mkType :: [FieldProperty] -> Value Text -> Value Text -> Type
mkType [FieldProperty]
fields Value Text
keyspaceName Value Text
typeName
  = Type
      {haddock_workaround_ :: ()
haddock_workaround_ = (), fields :: [FieldProperty]
fields = [FieldProperty]
fields,
       keyspaceName :: Value Text
keyspaceName = Value Text
keyspaceName, typeName :: Value Text
typeName = Value Text
typeName}
instance ToResourceProperties Type where
  toResourceProperties :: Type -> ResourceProperties
toResourceProperties Type {[FieldProperty]
()
Value Text
haddock_workaround_ :: Type -> ()
fields :: Type -> [FieldProperty]
keyspaceName :: Type -> Value Text
typeName :: Type -> Value Text
haddock_workaround_ :: ()
fields :: [FieldProperty]
keyspaceName :: Value Text
typeName :: Value Text
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::Cassandra::Type", supportsTags :: Bool
supportsTags = Bool
Prelude.False,
         properties :: Object
properties = [Key
"Fields" Key -> [FieldProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= [FieldProperty]
fields,
                       Key
"KeyspaceName" 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
keyspaceName, 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]}
instance JSON.ToJSON Type where
  toJSON :: Type -> Value
toJSON Type {[FieldProperty]
()
Value Text
haddock_workaround_ :: Type -> ()
fields :: Type -> [FieldProperty]
keyspaceName :: Type -> Value Text
typeName :: Type -> Value Text
haddock_workaround_ :: ()
fields :: [FieldProperty]
keyspaceName :: Value Text
typeName :: Value Text
..}
    = [(Key, Value)] -> Value
JSON.object
        [Key
"Fields" Key -> [FieldProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= [FieldProperty]
fields, Key
"KeyspaceName" 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
keyspaceName,
         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]
instance Property "Fields" Type where
  type PropertyType "Fields" Type = [FieldProperty]
  set :: PropertyType "Fields" Type -> Type -> Type
set PropertyType "Fields" Type
newValue Type {[FieldProperty]
()
Value Text
haddock_workaround_ :: Type -> ()
fields :: Type -> [FieldProperty]
keyspaceName :: Type -> Value Text
typeName :: Type -> Value Text
haddock_workaround_ :: ()
fields :: [FieldProperty]
keyspaceName :: Value Text
typeName :: Value Text
..} = Type {fields :: [FieldProperty]
fields = [FieldProperty]
PropertyType "Fields" Type
newValue, ()
Value Text
haddock_workaround_ :: ()
keyspaceName :: Value Text
typeName :: Value Text
haddock_workaround_ :: ()
keyspaceName :: Value Text
typeName :: Value Text
..}
instance Property "KeyspaceName" Type where
  type PropertyType "KeyspaceName" Type = Value Prelude.Text
  set :: PropertyType "KeyspaceName" Type -> Type -> Type
set PropertyType "KeyspaceName" Type
newValue Type {[FieldProperty]
()
Value Text
haddock_workaround_ :: Type -> ()
fields :: Type -> [FieldProperty]
keyspaceName :: Type -> Value Text
typeName :: Type -> Value Text
haddock_workaround_ :: ()
fields :: [FieldProperty]
keyspaceName :: Value Text
typeName :: Value Text
..} = Type {keyspaceName :: Value Text
keyspaceName = PropertyType "KeyspaceName" Type
Value Text
newValue, [FieldProperty]
()
Value Text
haddock_workaround_ :: ()
fields :: [FieldProperty]
typeName :: Value Text
haddock_workaround_ :: ()
fields :: [FieldProperty]
typeName :: Value Text
..}
instance Property "TypeName" Type where
  type PropertyType "TypeName" Type = Value Prelude.Text
  set :: PropertyType "TypeName" Type -> Type -> Type
set PropertyType "TypeName" Type
newValue Type {[FieldProperty]
()
Value Text
haddock_workaround_ :: Type -> ()
fields :: Type -> [FieldProperty]
keyspaceName :: Type -> Value Text
typeName :: Type -> Value Text
haddock_workaround_ :: ()
fields :: [FieldProperty]
keyspaceName :: Value Text
typeName :: Value Text
..} = Type {typeName :: Value Text
typeName = PropertyType "TypeName" Type
Value Text
newValue, [FieldProperty]
()
Value Text
haddock_workaround_ :: ()
fields :: [FieldProperty]
keyspaceName :: Value Text
haddock_workaround_ :: ()
fields :: [FieldProperty]
keyspaceName :: Value Text
..}