module Stratosphere.AppTest.TestCase.TestCaseLatestVersionProperty (
        TestCaseLatestVersionProperty(..), mkTestCaseLatestVersionProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import Stratosphere.ResourceProperties
import Stratosphere.Value
data TestCaseLatestVersionProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-apptest-testcase-testcaselatestversion.html>
    TestCaseLatestVersionProperty {TestCaseLatestVersionProperty -> ()
haddock_workaround_ :: (),
                                   -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-apptest-testcase-testcaselatestversion.html#cfn-apptest-testcase-testcaselatestversion-status>
                                   TestCaseLatestVersionProperty -> Value Text
status :: (Value Prelude.Text),
                                   -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-apptest-testcase-testcaselatestversion.html#cfn-apptest-testcase-testcaselatestversion-version>
                                   TestCaseLatestVersionProperty -> Value Double
version :: (Value Prelude.Double)}
  deriving stock (TestCaseLatestVersionProperty
-> TestCaseLatestVersionProperty -> Bool
(TestCaseLatestVersionProperty
 -> TestCaseLatestVersionProperty -> Bool)
-> (TestCaseLatestVersionProperty
    -> TestCaseLatestVersionProperty -> Bool)
-> Eq TestCaseLatestVersionProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TestCaseLatestVersionProperty
-> TestCaseLatestVersionProperty -> Bool
== :: TestCaseLatestVersionProperty
-> TestCaseLatestVersionProperty -> Bool
$c/= :: TestCaseLatestVersionProperty
-> TestCaseLatestVersionProperty -> Bool
/= :: TestCaseLatestVersionProperty
-> TestCaseLatestVersionProperty -> Bool
Prelude.Eq, Int -> TestCaseLatestVersionProperty -> ShowS
[TestCaseLatestVersionProperty] -> ShowS
TestCaseLatestVersionProperty -> String
(Int -> TestCaseLatestVersionProperty -> ShowS)
-> (TestCaseLatestVersionProperty -> String)
-> ([TestCaseLatestVersionProperty] -> ShowS)
-> Show TestCaseLatestVersionProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TestCaseLatestVersionProperty -> ShowS
showsPrec :: Int -> TestCaseLatestVersionProperty -> ShowS
$cshow :: TestCaseLatestVersionProperty -> String
show :: TestCaseLatestVersionProperty -> String
$cshowList :: [TestCaseLatestVersionProperty] -> ShowS
showList :: [TestCaseLatestVersionProperty] -> ShowS
Prelude.Show)
mkTestCaseLatestVersionProperty ::
  Value Prelude.Text
  -> Value Prelude.Double -> TestCaseLatestVersionProperty
mkTestCaseLatestVersionProperty :: Value Text -> Value Double -> TestCaseLatestVersionProperty
mkTestCaseLatestVersionProperty Value Text
status Value Double
version
  = TestCaseLatestVersionProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (), status :: Value Text
status = Value Text
status, version :: Value Double
version = Value Double
version}
instance ToResourceProperties TestCaseLatestVersionProperty where
  toResourceProperties :: TestCaseLatestVersionProperty -> ResourceProperties
toResourceProperties TestCaseLatestVersionProperty {()
Value Double
Value Text
haddock_workaround_ :: TestCaseLatestVersionProperty -> ()
status :: TestCaseLatestVersionProperty -> Value Text
version :: TestCaseLatestVersionProperty -> Value Double
haddock_workaround_ :: ()
status :: Value Text
version :: Value Double
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::AppTest::TestCase.TestCaseLatestVersion",
         supportsTags :: Bool
supportsTags = Bool
Prelude.False,
         properties :: Object
properties = [Key
"Status" 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
status, Key
"Version" 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
version]}
instance JSON.ToJSON TestCaseLatestVersionProperty where
  toJSON :: TestCaseLatestVersionProperty -> Value
toJSON TestCaseLatestVersionProperty {()
Value Double
Value Text
haddock_workaround_ :: TestCaseLatestVersionProperty -> ()
status :: TestCaseLatestVersionProperty -> Value Text
version :: TestCaseLatestVersionProperty -> Value Double
haddock_workaround_ :: ()
status :: Value Text
version :: Value Double
..}
    = [(Key, Value)] -> Value
JSON.object [Key
"Status" 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
status, Key
"Version" 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
version]
instance Property "Status" TestCaseLatestVersionProperty where
  type PropertyType "Status" TestCaseLatestVersionProperty = Value Prelude.Text
  set :: PropertyType "Status" TestCaseLatestVersionProperty
-> TestCaseLatestVersionProperty -> TestCaseLatestVersionProperty
set PropertyType "Status" TestCaseLatestVersionProperty
newValue TestCaseLatestVersionProperty {()
Value Double
Value Text
haddock_workaround_ :: TestCaseLatestVersionProperty -> ()
status :: TestCaseLatestVersionProperty -> Value Text
version :: TestCaseLatestVersionProperty -> Value Double
haddock_workaround_ :: ()
status :: Value Text
version :: Value Double
..}
    = TestCaseLatestVersionProperty {status :: Value Text
status = PropertyType "Status" TestCaseLatestVersionProperty
Value Text
newValue, ()
Value Double
haddock_workaround_ :: ()
version :: Value Double
haddock_workaround_ :: ()
version :: Value Double
..}
instance Property "Version" TestCaseLatestVersionProperty where
  type PropertyType "Version" TestCaseLatestVersionProperty = Value Prelude.Double
  set :: PropertyType "Version" TestCaseLatestVersionProperty
-> TestCaseLatestVersionProperty -> TestCaseLatestVersionProperty
set PropertyType "Version" TestCaseLatestVersionProperty
newValue TestCaseLatestVersionProperty {()
Value Double
Value Text
haddock_workaround_ :: TestCaseLatestVersionProperty -> ()
status :: TestCaseLatestVersionProperty -> Value Text
version :: TestCaseLatestVersionProperty -> Value Double
haddock_workaround_ :: ()
status :: Value Text
version :: Value Double
..}
    = TestCaseLatestVersionProperty {version :: Value Double
version = PropertyType "Version" TestCaseLatestVersionProperty
Value Double
newValue, ()
Value Text
haddock_workaround_ :: ()
status :: Value Text
haddock_workaround_ :: ()
status :: Value Text
..}