module Stratosphere.B2BI.Capability.EdiTypeProperty (
        module Exports, EdiTypeProperty(..), mkEdiTypeProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.B2BI.Capability.X12DetailsProperty as Exports
import Stratosphere.ResourceProperties
data EdiTypeProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-b2bi-capability-editype.html>
    EdiTypeProperty {EdiTypeProperty -> ()
haddock_workaround_ :: (),
                     -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-b2bi-capability-editype.html#cfn-b2bi-capability-editype-x12details>
                     EdiTypeProperty -> X12DetailsProperty
x12Details :: X12DetailsProperty}
  deriving stock (EdiTypeProperty -> EdiTypeProperty -> Bool
(EdiTypeProperty -> EdiTypeProperty -> Bool)
-> (EdiTypeProperty -> EdiTypeProperty -> Bool)
-> Eq EdiTypeProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EdiTypeProperty -> EdiTypeProperty -> Bool
== :: EdiTypeProperty -> EdiTypeProperty -> Bool
$c/= :: EdiTypeProperty -> EdiTypeProperty -> Bool
/= :: EdiTypeProperty -> EdiTypeProperty -> Bool
Prelude.Eq, Int -> EdiTypeProperty -> ShowS
[EdiTypeProperty] -> ShowS
EdiTypeProperty -> String
(Int -> EdiTypeProperty -> ShowS)
-> (EdiTypeProperty -> String)
-> ([EdiTypeProperty] -> ShowS)
-> Show EdiTypeProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EdiTypeProperty -> ShowS
showsPrec :: Int -> EdiTypeProperty -> ShowS
$cshow :: EdiTypeProperty -> String
show :: EdiTypeProperty -> String
$cshowList :: [EdiTypeProperty] -> ShowS
showList :: [EdiTypeProperty] -> ShowS
Prelude.Show)
mkEdiTypeProperty :: X12DetailsProperty -> EdiTypeProperty
mkEdiTypeProperty :: X12DetailsProperty -> EdiTypeProperty
mkEdiTypeProperty X12DetailsProperty
x12Details
  = EdiTypeProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (), x12Details :: X12DetailsProperty
x12Details = X12DetailsProperty
x12Details}
instance ToResourceProperties EdiTypeProperty where
  toResourceProperties :: EdiTypeProperty -> ResourceProperties
toResourceProperties EdiTypeProperty {()
X12DetailsProperty
haddock_workaround_ :: EdiTypeProperty -> ()
x12Details :: EdiTypeProperty -> X12DetailsProperty
haddock_workaround_ :: ()
x12Details :: X12DetailsProperty
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::B2BI::Capability.EdiType",
         supportsTags :: Bool
supportsTags = Bool
Prelude.False,
         properties :: Object
properties = [Key
"X12Details" Key -> X12DetailsProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= X12DetailsProperty
x12Details]}
instance JSON.ToJSON EdiTypeProperty where
  toJSON :: EdiTypeProperty -> Value
toJSON EdiTypeProperty {()
X12DetailsProperty
haddock_workaround_ :: EdiTypeProperty -> ()
x12Details :: EdiTypeProperty -> X12DetailsProperty
haddock_workaround_ :: ()
x12Details :: X12DetailsProperty
..}
    = [(Key, Value)] -> Value
JSON.object [Key
"X12Details" Key -> X12DetailsProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= X12DetailsProperty
x12Details]
instance Property "X12Details" EdiTypeProperty where
  type PropertyType "X12Details" EdiTypeProperty = X12DetailsProperty
  set :: PropertyType "X12Details" EdiTypeProperty
-> EdiTypeProperty -> EdiTypeProperty
set PropertyType "X12Details" EdiTypeProperty
newValue EdiTypeProperty {()
X12DetailsProperty
haddock_workaround_ :: EdiTypeProperty -> ()
x12Details :: EdiTypeProperty -> X12DetailsProperty
haddock_workaround_ :: ()
x12Details :: X12DetailsProperty
..}
    = EdiTypeProperty {x12Details :: X12DetailsProperty
x12Details = PropertyType "X12Details" EdiTypeProperty
X12DetailsProperty
newValue, ()
haddock_workaround_ :: ()
haddock_workaround_ :: ()
..}