module Stratosphere.ResourceAttributes.ResourceSignal where

import Stratosphere.Prelude
import Stratosphere.Property
import Stratosphere.Value

import qualified Data.Aeson as JSON

-- | Full data type definition for ResourceSignal. See 'mkResourceSignal' for a
-- more convenient constructor.
data ResourceSignal = ResourceSignal
  { ResourceSignal -> Maybe (Value Integer)
count   :: Maybe (Value Integer)
  , ResourceSignal -> Maybe (Value Text)
timeout :: Maybe (Value Text)
  }
  deriving (Int -> ResourceSignal -> ShowS
[ResourceSignal] -> ShowS
ResourceSignal -> String
(Int -> ResourceSignal -> ShowS)
-> (ResourceSignal -> String)
-> ([ResourceSignal] -> ShowS)
-> Show ResourceSignal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ResourceSignal -> ShowS
showsPrec :: Int -> ResourceSignal -> ShowS
$cshow :: ResourceSignal -> String
show :: ResourceSignal -> String
$cshowList :: [ResourceSignal] -> ShowS
showList :: [ResourceSignal] -> ShowS
Show, ResourceSignal -> ResourceSignal -> Bool
(ResourceSignal -> ResourceSignal -> Bool)
-> (ResourceSignal -> ResourceSignal -> Bool) -> Eq ResourceSignal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ResourceSignal -> ResourceSignal -> Bool
== :: ResourceSignal -> ResourceSignal -> Bool
$c/= :: ResourceSignal -> ResourceSignal -> Bool
/= :: ResourceSignal -> ResourceSignal -> Bool
Eq)

instance JSON.ToJSON ResourceSignal where
  toJSON :: ResourceSignal -> Value
toJSON ResourceSignal{Maybe (Value Integer)
Maybe (Value Text)
count :: ResourceSignal -> Maybe (Value Integer)
timeout :: ResourceSignal -> Maybe (Value Text)
count :: Maybe (Value Integer)
timeout :: Maybe (Value Text)
..}
    = [Pair] -> Value
JSON.object
    ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes
    [ (Value Integer -> Pair) -> Maybe (Value Integer) -> Maybe Pair
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Key
"Count",) (Value -> Pair)
-> (Value Integer -> Value) -> Value Integer -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value Integer -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON) Maybe (Value Integer)
count
    , (Value Text -> Pair) -> Maybe (Value Text) -> Maybe Pair
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Key
"Timeout",) (Value -> Pair) -> (Value Text -> Value) -> Value Text -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value Text -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON) Maybe (Value Text)
timeout
    ]

instance Property "Count" ResourceSignal where
  type PropertyType "Count" ResourceSignal = Value Integer
  set :: PropertyType "Count" ResourceSignal
-> ResourceSignal -> ResourceSignal
set PropertyType "Count" ResourceSignal
newValue ResourceSignal{Maybe (Value Integer)
Maybe (Value Text)
count :: ResourceSignal -> Maybe (Value Integer)
timeout :: ResourceSignal -> Maybe (Value Text)
count :: Maybe (Value Integer)
timeout :: Maybe (Value Text)
..} = ResourceSignal{count :: Maybe (Value Integer)
count = Value Integer -> Maybe (Value Integer)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PropertyType "Count" ResourceSignal
Value Integer
newValue, Maybe (Value Text)
timeout :: Maybe (Value Text)
timeout :: Maybe (Value Text)
..}

instance Property "Timeout" ResourceSignal where
  type PropertyType "Timeout" ResourceSignal = Value Text
  set :: PropertyType "Timeout" ResourceSignal
-> ResourceSignal -> ResourceSignal
set PropertyType "Timeout" ResourceSignal
newValue ResourceSignal{Maybe (Value Integer)
Maybe (Value Text)
count :: ResourceSignal -> Maybe (Value Integer)
timeout :: ResourceSignal -> Maybe (Value Text)
count :: Maybe (Value Integer)
timeout :: Maybe (Value Text)
..} = ResourceSignal{timeout :: Maybe (Value Text)
timeout = Value Text -> Maybe (Value Text)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PropertyType "Timeout" ResourceSignal
Value Text
newValue, Maybe (Value Integer)
count :: Maybe (Value Integer)
count :: Maybe (Value Integer)
..}

-- | Constructor for 'ResourceSignal' containing required fields as arguments.
mkResourceSignal :: ResourceSignal
mkResourceSignal :: ResourceSignal
mkResourceSignal
  = ResourceSignal
  { count :: Maybe (Value Integer)
count   = Maybe (Value Integer)
forall a. Maybe a
Nothing
  , timeout :: Maybe (Value Text)
timeout = Maybe (Value Text)
forall a. Maybe a
Nothing
  }