module Stratosphere.IoTEvents.DetectorModel.OnInputProperty (
        module Exports, OnInputProperty(..), mkOnInputProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.IoTEvents.DetectorModel.EventProperty as Exports
import {-# SOURCE #-} Stratosphere.IoTEvents.DetectorModel.TransitionEventProperty as Exports
import Stratosphere.ResourceProperties
data OnInputProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-iotevents-detectormodel-oninput.html>
    OnInputProperty {OnInputProperty -> ()
haddock_workaround_ :: (),
                     -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-iotevents-detectormodel-oninput.html#cfn-iotevents-detectormodel-oninput-events>
                     OnInputProperty -> Maybe [EventProperty]
events :: (Prelude.Maybe [EventProperty]),
                     -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-iotevents-detectormodel-oninput.html#cfn-iotevents-detectormodel-oninput-transitionevents>
                     OnInputProperty -> Maybe [TransitionEventProperty]
transitionEvents :: (Prelude.Maybe [TransitionEventProperty])}
  deriving stock (OnInputProperty -> OnInputProperty -> Bool
(OnInputProperty -> OnInputProperty -> Bool)
-> (OnInputProperty -> OnInputProperty -> Bool)
-> Eq OnInputProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OnInputProperty -> OnInputProperty -> Bool
== :: OnInputProperty -> OnInputProperty -> Bool
$c/= :: OnInputProperty -> OnInputProperty -> Bool
/= :: OnInputProperty -> OnInputProperty -> Bool
Prelude.Eq, Int -> OnInputProperty -> ShowS
[OnInputProperty] -> ShowS
OnInputProperty -> String
(Int -> OnInputProperty -> ShowS)
-> (OnInputProperty -> String)
-> ([OnInputProperty] -> ShowS)
-> Show OnInputProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OnInputProperty -> ShowS
showsPrec :: Int -> OnInputProperty -> ShowS
$cshow :: OnInputProperty -> String
show :: OnInputProperty -> String
$cshowList :: [OnInputProperty] -> ShowS
showList :: [OnInputProperty] -> ShowS
Prelude.Show)
mkOnInputProperty :: OnInputProperty
mkOnInputProperty :: OnInputProperty
mkOnInputProperty
  = OnInputProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (), events :: Maybe [EventProperty]
events = Maybe [EventProperty]
forall a. Maybe a
Prelude.Nothing,
       transitionEvents :: Maybe [TransitionEventProperty]
transitionEvents = Maybe [TransitionEventProperty]
forall a. Maybe a
Prelude.Nothing}
instance ToResourceProperties OnInputProperty where
  toResourceProperties :: OnInputProperty -> ResourceProperties
toResourceProperties OnInputProperty {Maybe [EventProperty]
Maybe [TransitionEventProperty]
()
haddock_workaround_ :: OnInputProperty -> ()
events :: OnInputProperty -> Maybe [EventProperty]
transitionEvents :: OnInputProperty -> Maybe [TransitionEventProperty]
haddock_workaround_ :: ()
events :: Maybe [EventProperty]
transitionEvents :: Maybe [TransitionEventProperty]
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::IoTEvents::DetectorModel.OnInput",
         supportsTags :: Bool
supportsTags = Bool
Prelude.False,
         properties :: Object
properties = [Item Object] -> Object
forall l. IsList l => [Item l] -> l
Prelude.fromList
                        ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
                           [Key -> [EventProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"Events" ([EventProperty] -> (Key, Value))
-> Maybe [EventProperty] -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [EventProperty]
events,
                            Key -> [TransitionEventProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"TransitionEvents" ([TransitionEventProperty] -> (Key, Value))
-> Maybe [TransitionEventProperty] -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [TransitionEventProperty]
transitionEvents])}
instance JSON.ToJSON OnInputProperty where
  toJSON :: OnInputProperty -> Value
toJSON OnInputProperty {Maybe [EventProperty]
Maybe [TransitionEventProperty]
()
haddock_workaround_ :: OnInputProperty -> ()
events :: OnInputProperty -> Maybe [EventProperty]
transitionEvents :: OnInputProperty -> Maybe [TransitionEventProperty]
haddock_workaround_ :: ()
events :: Maybe [EventProperty]
transitionEvents :: Maybe [TransitionEventProperty]
..}
    = [(Key, Value)] -> Value
JSON.object
        ([Item [(Key, Value)]] -> [(Key, Value)]
forall l. IsList l => [Item l] -> l
Prelude.fromList
           ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
              [Key -> [EventProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"Events" ([EventProperty] -> (Key, Value))
-> Maybe [EventProperty] -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [EventProperty]
events,
               Key -> [TransitionEventProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"TransitionEvents" ([TransitionEventProperty] -> (Key, Value))
-> Maybe [TransitionEventProperty] -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [TransitionEventProperty]
transitionEvents]))
instance Property "Events" OnInputProperty where
  type PropertyType "Events" OnInputProperty = [EventProperty]
  set :: PropertyType "Events" OnInputProperty
-> OnInputProperty -> OnInputProperty
set PropertyType "Events" OnInputProperty
newValue OnInputProperty {Maybe [EventProperty]
Maybe [TransitionEventProperty]
()
haddock_workaround_ :: OnInputProperty -> ()
events :: OnInputProperty -> Maybe [EventProperty]
transitionEvents :: OnInputProperty -> Maybe [TransitionEventProperty]
haddock_workaround_ :: ()
events :: Maybe [EventProperty]
transitionEvents :: Maybe [TransitionEventProperty]
..}
    = OnInputProperty {events :: Maybe [EventProperty]
events = [EventProperty] -> Maybe [EventProperty]
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure [EventProperty]
PropertyType "Events" OnInputProperty
newValue, Maybe [TransitionEventProperty]
()
haddock_workaround_ :: ()
transitionEvents :: Maybe [TransitionEventProperty]
haddock_workaround_ :: ()
transitionEvents :: Maybe [TransitionEventProperty]
..}
instance Property "TransitionEvents" OnInputProperty where
  type PropertyType "TransitionEvents" OnInputProperty = [TransitionEventProperty]
  set :: PropertyType "TransitionEvents" OnInputProperty
-> OnInputProperty -> OnInputProperty
set PropertyType "TransitionEvents" OnInputProperty
newValue OnInputProperty {Maybe [EventProperty]
Maybe [TransitionEventProperty]
()
haddock_workaround_ :: OnInputProperty -> ()
events :: OnInputProperty -> Maybe [EventProperty]
transitionEvents :: OnInputProperty -> Maybe [TransitionEventProperty]
haddock_workaround_ :: ()
events :: Maybe [EventProperty]
transitionEvents :: Maybe [TransitionEventProperty]
..}
    = OnInputProperty {transitionEvents :: Maybe [TransitionEventProperty]
transitionEvents = [TransitionEventProperty] -> Maybe [TransitionEventProperty]
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure [TransitionEventProperty]
PropertyType "TransitionEvents" OnInputProperty
newValue, Maybe [EventProperty]
()
haddock_workaround_ :: ()
events :: Maybe [EventProperty]
haddock_workaround_ :: ()
events :: Maybe [EventProperty]
..}