module Stratosphere.KendraRanking.ExecutionPlan.CapacityUnitsConfigurationProperty (
        CapacityUnitsConfigurationProperty(..),
        mkCapacityUnitsConfigurationProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import Stratosphere.ResourceProperties
import Stratosphere.Value
data CapacityUnitsConfigurationProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-kendraranking-executionplan-capacityunitsconfiguration.html>
    CapacityUnitsConfigurationProperty {CapacityUnitsConfigurationProperty -> ()
haddock_workaround_ :: (),
                                        -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-kendraranking-executionplan-capacityunitsconfiguration.html#cfn-kendraranking-executionplan-capacityunitsconfiguration-rescorecapacityunits>
                                        CapacityUnitsConfigurationProperty -> Value Integer
rescoreCapacityUnits :: (Value Prelude.Integer)}
  deriving stock (CapacityUnitsConfigurationProperty
-> CapacityUnitsConfigurationProperty -> Bool
(CapacityUnitsConfigurationProperty
 -> CapacityUnitsConfigurationProperty -> Bool)
-> (CapacityUnitsConfigurationProperty
    -> CapacityUnitsConfigurationProperty -> Bool)
-> Eq CapacityUnitsConfigurationProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CapacityUnitsConfigurationProperty
-> CapacityUnitsConfigurationProperty -> Bool
== :: CapacityUnitsConfigurationProperty
-> CapacityUnitsConfigurationProperty -> Bool
$c/= :: CapacityUnitsConfigurationProperty
-> CapacityUnitsConfigurationProperty -> Bool
/= :: CapacityUnitsConfigurationProperty
-> CapacityUnitsConfigurationProperty -> Bool
Prelude.Eq, Int -> CapacityUnitsConfigurationProperty -> ShowS
[CapacityUnitsConfigurationProperty] -> ShowS
CapacityUnitsConfigurationProperty -> String
(Int -> CapacityUnitsConfigurationProperty -> ShowS)
-> (CapacityUnitsConfigurationProperty -> String)
-> ([CapacityUnitsConfigurationProperty] -> ShowS)
-> Show CapacityUnitsConfigurationProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CapacityUnitsConfigurationProperty -> ShowS
showsPrec :: Int -> CapacityUnitsConfigurationProperty -> ShowS
$cshow :: CapacityUnitsConfigurationProperty -> String
show :: CapacityUnitsConfigurationProperty -> String
$cshowList :: [CapacityUnitsConfigurationProperty] -> ShowS
showList :: [CapacityUnitsConfigurationProperty] -> ShowS
Prelude.Show)
mkCapacityUnitsConfigurationProperty ::
  Value Prelude.Integer -> CapacityUnitsConfigurationProperty
mkCapacityUnitsConfigurationProperty :: Value Integer -> CapacityUnitsConfigurationProperty
mkCapacityUnitsConfigurationProperty Value Integer
rescoreCapacityUnits
  = CapacityUnitsConfigurationProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (),
       rescoreCapacityUnits :: Value Integer
rescoreCapacityUnits = Value Integer
rescoreCapacityUnits}
instance ToResourceProperties CapacityUnitsConfigurationProperty where
  toResourceProperties :: CapacityUnitsConfigurationProperty -> ResourceProperties
toResourceProperties CapacityUnitsConfigurationProperty {()
Value Integer
haddock_workaround_ :: CapacityUnitsConfigurationProperty -> ()
rescoreCapacityUnits :: CapacityUnitsConfigurationProperty -> Value Integer
haddock_workaround_ :: ()
rescoreCapacityUnits :: Value Integer
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::KendraRanking::ExecutionPlan.CapacityUnitsConfiguration",
         supportsTags :: Bool
supportsTags = Bool
Prelude.False,
         properties :: Object
properties = [Key
"RescoreCapacityUnits" Key -> Value Integer -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= Value Integer
rescoreCapacityUnits]}
instance JSON.ToJSON CapacityUnitsConfigurationProperty where
  toJSON :: CapacityUnitsConfigurationProperty -> Value
toJSON CapacityUnitsConfigurationProperty {()
Value Integer
haddock_workaround_ :: CapacityUnitsConfigurationProperty -> ()
rescoreCapacityUnits :: CapacityUnitsConfigurationProperty -> Value Integer
haddock_workaround_ :: ()
rescoreCapacityUnits :: Value Integer
..}
    = [(Key, Value)] -> Value
JSON.object [Key
"RescoreCapacityUnits" Key -> Value Integer -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= Value Integer
rescoreCapacityUnits]
instance Property "RescoreCapacityUnits" CapacityUnitsConfigurationProperty where
  type PropertyType "RescoreCapacityUnits" CapacityUnitsConfigurationProperty = Value Prelude.Integer
  set :: PropertyType
  "RescoreCapacityUnits" CapacityUnitsConfigurationProperty
-> CapacityUnitsConfigurationProperty
-> CapacityUnitsConfigurationProperty
set PropertyType
  "RescoreCapacityUnits" CapacityUnitsConfigurationProperty
newValue CapacityUnitsConfigurationProperty {()
Value Integer
haddock_workaround_ :: CapacityUnitsConfigurationProperty -> ()
rescoreCapacityUnits :: CapacityUnitsConfigurationProperty -> Value Integer
haddock_workaround_ :: ()
rescoreCapacityUnits :: Value Integer
..}
    = CapacityUnitsConfigurationProperty
        {rescoreCapacityUnits :: Value Integer
rescoreCapacityUnits = PropertyType
  "RescoreCapacityUnits" CapacityUnitsConfigurationProperty
Value Integer
newValue, ()
haddock_workaround_ :: ()
haddock_workaround_ :: ()
..}