module Stratosphere.SageMaker.EndpointConfig.ClarifyExplainerConfigProperty (
        module Exports, ClarifyExplainerConfigProperty(..),
        mkClarifyExplainerConfigProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.SageMaker.EndpointConfig.ClarifyInferenceConfigProperty as Exports
import {-# SOURCE #-} Stratosphere.SageMaker.EndpointConfig.ClarifyShapConfigProperty as Exports
import Stratosphere.ResourceProperties
import Stratosphere.Value
data ClarifyExplainerConfigProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-sagemaker-endpointconfig-clarifyexplainerconfig.html>
    ClarifyExplainerConfigProperty {ClarifyExplainerConfigProperty -> ()
haddock_workaround_ :: (),
                                    -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-sagemaker-endpointconfig-clarifyexplainerconfig.html#cfn-sagemaker-endpointconfig-clarifyexplainerconfig-enableexplanations>
                                    ClarifyExplainerConfigProperty -> Maybe (Value Text)
enableExplanations :: (Prelude.Maybe (Value Prelude.Text)),
                                    -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-sagemaker-endpointconfig-clarifyexplainerconfig.html#cfn-sagemaker-endpointconfig-clarifyexplainerconfig-inferenceconfig>
                                    ClarifyExplainerConfigProperty
-> Maybe ClarifyInferenceConfigProperty
inferenceConfig :: (Prelude.Maybe ClarifyInferenceConfigProperty),
                                    -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-sagemaker-endpointconfig-clarifyexplainerconfig.html#cfn-sagemaker-endpointconfig-clarifyexplainerconfig-shapconfig>
                                    ClarifyExplainerConfigProperty -> ClarifyShapConfigProperty
shapConfig :: ClarifyShapConfigProperty}
  deriving stock (ClarifyExplainerConfigProperty
-> ClarifyExplainerConfigProperty -> Bool
(ClarifyExplainerConfigProperty
 -> ClarifyExplainerConfigProperty -> Bool)
-> (ClarifyExplainerConfigProperty
    -> ClarifyExplainerConfigProperty -> Bool)
-> Eq ClarifyExplainerConfigProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ClarifyExplainerConfigProperty
-> ClarifyExplainerConfigProperty -> Bool
== :: ClarifyExplainerConfigProperty
-> ClarifyExplainerConfigProperty -> Bool
$c/= :: ClarifyExplainerConfigProperty
-> ClarifyExplainerConfigProperty -> Bool
/= :: ClarifyExplainerConfigProperty
-> ClarifyExplainerConfigProperty -> Bool
Prelude.Eq, Int -> ClarifyExplainerConfigProperty -> ShowS
[ClarifyExplainerConfigProperty] -> ShowS
ClarifyExplainerConfigProperty -> String
(Int -> ClarifyExplainerConfigProperty -> ShowS)
-> (ClarifyExplainerConfigProperty -> String)
-> ([ClarifyExplainerConfigProperty] -> ShowS)
-> Show ClarifyExplainerConfigProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ClarifyExplainerConfigProperty -> ShowS
showsPrec :: Int -> ClarifyExplainerConfigProperty -> ShowS
$cshow :: ClarifyExplainerConfigProperty -> String
show :: ClarifyExplainerConfigProperty -> String
$cshowList :: [ClarifyExplainerConfigProperty] -> ShowS
showList :: [ClarifyExplainerConfigProperty] -> ShowS
Prelude.Show)
mkClarifyExplainerConfigProperty ::
  ClarifyShapConfigProperty -> ClarifyExplainerConfigProperty
mkClarifyExplainerConfigProperty :: ClarifyShapConfigProperty -> ClarifyExplainerConfigProperty
mkClarifyExplainerConfigProperty ClarifyShapConfigProperty
shapConfig
  = ClarifyExplainerConfigProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (), shapConfig :: ClarifyShapConfigProperty
shapConfig = ClarifyShapConfigProperty
shapConfig,
       enableExplanations :: Maybe (Value Text)
enableExplanations = Maybe (Value Text)
forall a. Maybe a
Prelude.Nothing,
       inferenceConfig :: Maybe ClarifyInferenceConfigProperty
inferenceConfig = Maybe ClarifyInferenceConfigProperty
forall a. Maybe a
Prelude.Nothing}
instance ToResourceProperties ClarifyExplainerConfigProperty where
  toResourceProperties :: ClarifyExplainerConfigProperty -> ResourceProperties
toResourceProperties ClarifyExplainerConfigProperty {Maybe (Value Text)
Maybe ClarifyInferenceConfigProperty
()
ClarifyShapConfigProperty
haddock_workaround_ :: ClarifyExplainerConfigProperty -> ()
enableExplanations :: ClarifyExplainerConfigProperty -> Maybe (Value Text)
inferenceConfig :: ClarifyExplainerConfigProperty
-> Maybe ClarifyInferenceConfigProperty
shapConfig :: ClarifyExplainerConfigProperty -> ClarifyShapConfigProperty
haddock_workaround_ :: ()
enableExplanations :: Maybe (Value Text)
inferenceConfig :: Maybe ClarifyInferenceConfigProperty
shapConfig :: ClarifyShapConfigProperty
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::SageMaker::EndpointConfig.ClarifyExplainerConfig",
         supportsTags :: Bool
supportsTags = Bool
Prelude.False,
         properties :: Object
properties = [Item Object] -> Object
forall l. IsList l => [Item l] -> l
Prelude.fromList
                        ([(Key, Value)] -> [(Key, Value)] -> [(Key, Value)]
forall a. Semigroup a => a -> a -> a
(Prelude.<>)
                           [Key
"ShapConfig" Key -> ClarifyShapConfigProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= ClarifyShapConfigProperty
shapConfig]
                           ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
                              [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..=) Key
"EnableExplanations" (Value Text -> (Key, Value))
-> Maybe (Value Text) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Text)
enableExplanations,
                               Key -> ClarifyInferenceConfigProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"InferenceConfig" (ClarifyInferenceConfigProperty -> (Key, Value))
-> Maybe ClarifyInferenceConfigProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe ClarifyInferenceConfigProperty
inferenceConfig]))}
instance JSON.ToJSON ClarifyExplainerConfigProperty where
  toJSON :: ClarifyExplainerConfigProperty -> Value
toJSON ClarifyExplainerConfigProperty {Maybe (Value Text)
Maybe ClarifyInferenceConfigProperty
()
ClarifyShapConfigProperty
haddock_workaround_ :: ClarifyExplainerConfigProperty -> ()
enableExplanations :: ClarifyExplainerConfigProperty -> Maybe (Value Text)
inferenceConfig :: ClarifyExplainerConfigProperty
-> Maybe ClarifyInferenceConfigProperty
shapConfig :: ClarifyExplainerConfigProperty -> ClarifyShapConfigProperty
haddock_workaround_ :: ()
enableExplanations :: Maybe (Value Text)
inferenceConfig :: Maybe ClarifyInferenceConfigProperty
shapConfig :: ClarifyShapConfigProperty
..}
    = [(Key, Value)] -> Value
JSON.object
        ([Item [(Key, Value)]] -> [(Key, Value)]
forall l. IsList l => [Item l] -> l
Prelude.fromList
           ([(Key, Value)] -> [(Key, Value)] -> [(Key, Value)]
forall a. Semigroup a => a -> a -> a
(Prelude.<>)
              [Key
"ShapConfig" Key -> ClarifyShapConfigProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= ClarifyShapConfigProperty
shapConfig]
              ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
                 [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..=) Key
"EnableExplanations" (Value Text -> (Key, Value))
-> Maybe (Value Text) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Text)
enableExplanations,
                  Key -> ClarifyInferenceConfigProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"InferenceConfig" (ClarifyInferenceConfigProperty -> (Key, Value))
-> Maybe ClarifyInferenceConfigProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe ClarifyInferenceConfigProperty
inferenceConfig])))
instance Property "EnableExplanations" ClarifyExplainerConfigProperty where
  type PropertyType "EnableExplanations" ClarifyExplainerConfigProperty = Value Prelude.Text
  set :: PropertyType "EnableExplanations" ClarifyExplainerConfigProperty
-> ClarifyExplainerConfigProperty -> ClarifyExplainerConfigProperty
set PropertyType "EnableExplanations" ClarifyExplainerConfigProperty
newValue ClarifyExplainerConfigProperty {Maybe (Value Text)
Maybe ClarifyInferenceConfigProperty
()
ClarifyShapConfigProperty
haddock_workaround_ :: ClarifyExplainerConfigProperty -> ()
enableExplanations :: ClarifyExplainerConfigProperty -> Maybe (Value Text)
inferenceConfig :: ClarifyExplainerConfigProperty
-> Maybe ClarifyInferenceConfigProperty
shapConfig :: ClarifyExplainerConfigProperty -> ClarifyShapConfigProperty
haddock_workaround_ :: ()
enableExplanations :: Maybe (Value Text)
inferenceConfig :: Maybe ClarifyInferenceConfigProperty
shapConfig :: ClarifyShapConfigProperty
..}
    = ClarifyExplainerConfigProperty
        {enableExplanations :: Maybe (Value Text)
enableExplanations = Value Text -> Maybe (Value Text)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "EnableExplanations" ClarifyExplainerConfigProperty
Value Text
newValue, Maybe ClarifyInferenceConfigProperty
()
ClarifyShapConfigProperty
haddock_workaround_ :: ()
inferenceConfig :: Maybe ClarifyInferenceConfigProperty
shapConfig :: ClarifyShapConfigProperty
haddock_workaround_ :: ()
inferenceConfig :: Maybe ClarifyInferenceConfigProperty
shapConfig :: ClarifyShapConfigProperty
..}
instance Property "InferenceConfig" ClarifyExplainerConfigProperty where
  type PropertyType "InferenceConfig" ClarifyExplainerConfigProperty = ClarifyInferenceConfigProperty
  set :: PropertyType "InferenceConfig" ClarifyExplainerConfigProperty
-> ClarifyExplainerConfigProperty -> ClarifyExplainerConfigProperty
set PropertyType "InferenceConfig" ClarifyExplainerConfigProperty
newValue ClarifyExplainerConfigProperty {Maybe (Value Text)
Maybe ClarifyInferenceConfigProperty
()
ClarifyShapConfigProperty
haddock_workaround_ :: ClarifyExplainerConfigProperty -> ()
enableExplanations :: ClarifyExplainerConfigProperty -> Maybe (Value Text)
inferenceConfig :: ClarifyExplainerConfigProperty
-> Maybe ClarifyInferenceConfigProperty
shapConfig :: ClarifyExplainerConfigProperty -> ClarifyShapConfigProperty
haddock_workaround_ :: ()
enableExplanations :: Maybe (Value Text)
inferenceConfig :: Maybe ClarifyInferenceConfigProperty
shapConfig :: ClarifyShapConfigProperty
..}
    = ClarifyExplainerConfigProperty
        {inferenceConfig :: Maybe ClarifyInferenceConfigProperty
inferenceConfig = ClarifyInferenceConfigProperty
-> Maybe ClarifyInferenceConfigProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "InferenceConfig" ClarifyExplainerConfigProperty
ClarifyInferenceConfigProperty
newValue, Maybe (Value Text)
()
ClarifyShapConfigProperty
haddock_workaround_ :: ()
enableExplanations :: Maybe (Value Text)
shapConfig :: ClarifyShapConfigProperty
haddock_workaround_ :: ()
enableExplanations :: Maybe (Value Text)
shapConfig :: ClarifyShapConfigProperty
..}
instance Property "ShapConfig" ClarifyExplainerConfigProperty where
  type PropertyType "ShapConfig" ClarifyExplainerConfigProperty = ClarifyShapConfigProperty
  set :: PropertyType "ShapConfig" ClarifyExplainerConfigProperty
-> ClarifyExplainerConfigProperty -> ClarifyExplainerConfigProperty
set PropertyType "ShapConfig" ClarifyExplainerConfigProperty
newValue ClarifyExplainerConfigProperty {Maybe (Value Text)
Maybe ClarifyInferenceConfigProperty
()
ClarifyShapConfigProperty
haddock_workaround_ :: ClarifyExplainerConfigProperty -> ()
enableExplanations :: ClarifyExplainerConfigProperty -> Maybe (Value Text)
inferenceConfig :: ClarifyExplainerConfigProperty
-> Maybe ClarifyInferenceConfigProperty
shapConfig :: ClarifyExplainerConfigProperty -> ClarifyShapConfigProperty
haddock_workaround_ :: ()
enableExplanations :: Maybe (Value Text)
inferenceConfig :: Maybe ClarifyInferenceConfigProperty
shapConfig :: ClarifyShapConfigProperty
..}
    = ClarifyExplainerConfigProperty {shapConfig :: ClarifyShapConfigProperty
shapConfig = PropertyType "ShapConfig" ClarifyExplainerConfigProperty
ClarifyShapConfigProperty
newValue, Maybe (Value Text)
Maybe ClarifyInferenceConfigProperty
()
haddock_workaround_ :: ()
enableExplanations :: Maybe (Value Text)
inferenceConfig :: Maybe ClarifyInferenceConfigProperty
haddock_workaround_ :: ()
enableExplanations :: Maybe (Value Text)
inferenceConfig :: Maybe ClarifyInferenceConfigProperty
..}