module Stratosphere.SageMaker.EndpointConfig.ClarifyTextConfigProperty (
        ClarifyTextConfigProperty(..), mkClarifyTextConfigProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import Stratosphere.ResourceProperties
import Stratosphere.Value
data ClarifyTextConfigProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-sagemaker-endpointconfig-clarifytextconfig.html>
    ClarifyTextConfigProperty {ClarifyTextConfigProperty -> ()
haddock_workaround_ :: (),
                               -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-sagemaker-endpointconfig-clarifytextconfig.html#cfn-sagemaker-endpointconfig-clarifytextconfig-granularity>
                               ClarifyTextConfigProperty -> Value Text
granularity :: (Value Prelude.Text),
                               -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-sagemaker-endpointconfig-clarifytextconfig.html#cfn-sagemaker-endpointconfig-clarifytextconfig-language>
                               ClarifyTextConfigProperty -> Value Text
language :: (Value Prelude.Text)}
  deriving stock (ClarifyTextConfigProperty -> ClarifyTextConfigProperty -> Bool
(ClarifyTextConfigProperty -> ClarifyTextConfigProperty -> Bool)
-> (ClarifyTextConfigProperty -> ClarifyTextConfigProperty -> Bool)
-> Eq ClarifyTextConfigProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ClarifyTextConfigProperty -> ClarifyTextConfigProperty -> Bool
== :: ClarifyTextConfigProperty -> ClarifyTextConfigProperty -> Bool
$c/= :: ClarifyTextConfigProperty -> ClarifyTextConfigProperty -> Bool
/= :: ClarifyTextConfigProperty -> ClarifyTextConfigProperty -> Bool
Prelude.Eq, Int -> ClarifyTextConfigProperty -> ShowS
[ClarifyTextConfigProperty] -> ShowS
ClarifyTextConfigProperty -> String
(Int -> ClarifyTextConfigProperty -> ShowS)
-> (ClarifyTextConfigProperty -> String)
-> ([ClarifyTextConfigProperty] -> ShowS)
-> Show ClarifyTextConfigProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ClarifyTextConfigProperty -> ShowS
showsPrec :: Int -> ClarifyTextConfigProperty -> ShowS
$cshow :: ClarifyTextConfigProperty -> String
show :: ClarifyTextConfigProperty -> String
$cshowList :: [ClarifyTextConfigProperty] -> ShowS
showList :: [ClarifyTextConfigProperty] -> ShowS
Prelude.Show)
mkClarifyTextConfigProperty ::
  Value Prelude.Text
  -> Value Prelude.Text -> ClarifyTextConfigProperty
mkClarifyTextConfigProperty :: Value Text -> Value Text -> ClarifyTextConfigProperty
mkClarifyTextConfigProperty Value Text
granularity Value Text
language
  = ClarifyTextConfigProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (), granularity :: Value Text
granularity = Value Text
granularity,
       language :: Value Text
language = Value Text
language}
instance ToResourceProperties ClarifyTextConfigProperty where
  toResourceProperties :: ClarifyTextConfigProperty -> ResourceProperties
toResourceProperties ClarifyTextConfigProperty {()
Value Text
haddock_workaround_ :: ClarifyTextConfigProperty -> ()
granularity :: ClarifyTextConfigProperty -> Value Text
language :: ClarifyTextConfigProperty -> Value Text
haddock_workaround_ :: ()
granularity :: Value Text
language :: Value Text
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::SageMaker::EndpointConfig.ClarifyTextConfig",
         supportsTags :: Bool
supportsTags = Bool
Prelude.False,
         properties :: Object
properties = [Key
"Granularity" 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
granularity,
                       Key
"Language" 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
language]}
instance JSON.ToJSON ClarifyTextConfigProperty where
  toJSON :: ClarifyTextConfigProperty -> Value
toJSON ClarifyTextConfigProperty {()
Value Text
haddock_workaround_ :: ClarifyTextConfigProperty -> ()
granularity :: ClarifyTextConfigProperty -> Value Text
language :: ClarifyTextConfigProperty -> Value Text
haddock_workaround_ :: ()
granularity :: Value Text
language :: Value Text
..}
    = [(Key, Value)] -> Value
JSON.object
        [Key
"Granularity" 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
granularity, Key
"Language" 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
language]
instance Property "Granularity" ClarifyTextConfigProperty where
  type PropertyType "Granularity" ClarifyTextConfigProperty = Value Prelude.Text
  set :: PropertyType "Granularity" ClarifyTextConfigProperty
-> ClarifyTextConfigProperty -> ClarifyTextConfigProperty
set PropertyType "Granularity" ClarifyTextConfigProperty
newValue ClarifyTextConfigProperty {()
Value Text
haddock_workaround_ :: ClarifyTextConfigProperty -> ()
granularity :: ClarifyTextConfigProperty -> Value Text
language :: ClarifyTextConfigProperty -> Value Text
haddock_workaround_ :: ()
granularity :: Value Text
language :: Value Text
..}
    = ClarifyTextConfigProperty {granularity :: Value Text
granularity = PropertyType "Granularity" ClarifyTextConfigProperty
Value Text
newValue, ()
Value Text
haddock_workaround_ :: ()
language :: Value Text
haddock_workaround_ :: ()
language :: Value Text
..}
instance Property "Language" ClarifyTextConfigProperty where
  type PropertyType "Language" ClarifyTextConfigProperty = Value Prelude.Text
  set :: PropertyType "Language" ClarifyTextConfigProperty
-> ClarifyTextConfigProperty -> ClarifyTextConfigProperty
set PropertyType "Language" ClarifyTextConfigProperty
newValue ClarifyTextConfigProperty {()
Value Text
haddock_workaround_ :: ClarifyTextConfigProperty -> ()
granularity :: ClarifyTextConfigProperty -> Value Text
language :: ClarifyTextConfigProperty -> Value Text
haddock_workaround_ :: ()
granularity :: Value Text
language :: Value Text
..}
    = ClarifyTextConfigProperty {language :: Value Text
language = PropertyType "Language" ClarifyTextConfigProperty
Value Text
newValue, ()
Value Text
haddock_workaround_ :: ()
granularity :: Value Text
haddock_workaround_ :: ()
granularity :: Value Text
..}