module Stratosphere.SageMaker.EndpointConfig.ClarifyShapConfigProperty (
module Exports, ClarifyShapConfigProperty(..),
mkClarifyShapConfigProperty
) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.SageMaker.EndpointConfig.ClarifyShapBaselineConfigProperty as Exports
import {-# SOURCE #-} Stratosphere.SageMaker.EndpointConfig.ClarifyTextConfigProperty as Exports
import Stratosphere.ResourceProperties
import Stratosphere.Value
data ClarifyShapConfigProperty
=
ClarifyShapConfigProperty {ClarifyShapConfigProperty -> ()
haddock_workaround_ :: (),
ClarifyShapConfigProperty -> Maybe (Value Integer)
numberOfSamples :: (Prelude.Maybe (Value Prelude.Integer)),
ClarifyShapConfigProperty -> Maybe (Value Integer)
seed :: (Prelude.Maybe (Value Prelude.Integer)),
ClarifyShapConfigProperty -> ClarifyShapBaselineConfigProperty
shapBaselineConfig :: ClarifyShapBaselineConfigProperty,
ClarifyShapConfigProperty -> Maybe ClarifyTextConfigProperty
textConfig :: (Prelude.Maybe ClarifyTextConfigProperty),
ClarifyShapConfigProperty -> Maybe (Value Bool)
useLogit :: (Prelude.Maybe (Value Prelude.Bool))}
deriving stock (ClarifyShapConfigProperty -> ClarifyShapConfigProperty -> Bool
(ClarifyShapConfigProperty -> ClarifyShapConfigProperty -> Bool)
-> (ClarifyShapConfigProperty -> ClarifyShapConfigProperty -> Bool)
-> Eq ClarifyShapConfigProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ClarifyShapConfigProperty -> ClarifyShapConfigProperty -> Bool
== :: ClarifyShapConfigProperty -> ClarifyShapConfigProperty -> Bool
$c/= :: ClarifyShapConfigProperty -> ClarifyShapConfigProperty -> Bool
/= :: ClarifyShapConfigProperty -> ClarifyShapConfigProperty -> Bool
Prelude.Eq, Int -> ClarifyShapConfigProperty -> ShowS
[ClarifyShapConfigProperty] -> ShowS
ClarifyShapConfigProperty -> String
(Int -> ClarifyShapConfigProperty -> ShowS)
-> (ClarifyShapConfigProperty -> String)
-> ([ClarifyShapConfigProperty] -> ShowS)
-> Show ClarifyShapConfigProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ClarifyShapConfigProperty -> ShowS
showsPrec :: Int -> ClarifyShapConfigProperty -> ShowS
$cshow :: ClarifyShapConfigProperty -> String
show :: ClarifyShapConfigProperty -> String
$cshowList :: [ClarifyShapConfigProperty] -> ShowS
showList :: [ClarifyShapConfigProperty] -> ShowS
Prelude.Show)
mkClarifyShapConfigProperty ::
ClarifyShapBaselineConfigProperty -> ClarifyShapConfigProperty
mkClarifyShapConfigProperty :: ClarifyShapBaselineConfigProperty -> ClarifyShapConfigProperty
mkClarifyShapConfigProperty ClarifyShapBaselineConfigProperty
shapBaselineConfig
= ClarifyShapConfigProperty
{haddock_workaround_ :: ()
haddock_workaround_ = (), shapBaselineConfig :: ClarifyShapBaselineConfigProperty
shapBaselineConfig = ClarifyShapBaselineConfigProperty
shapBaselineConfig,
numberOfSamples :: Maybe (Value Integer)
numberOfSamples = Maybe (Value Integer)
forall a. Maybe a
Prelude.Nothing, seed :: Maybe (Value Integer)
seed = Maybe (Value Integer)
forall a. Maybe a
Prelude.Nothing,
textConfig :: Maybe ClarifyTextConfigProperty
textConfig = Maybe ClarifyTextConfigProperty
forall a. Maybe a
Prelude.Nothing, useLogit :: Maybe (Value Bool)
useLogit = Maybe (Value Bool)
forall a. Maybe a
Prelude.Nothing}
instance ToResourceProperties ClarifyShapConfigProperty where
toResourceProperties :: ClarifyShapConfigProperty -> ResourceProperties
toResourceProperties ClarifyShapConfigProperty {Maybe (Value Bool)
Maybe (Value Integer)
Maybe ClarifyTextConfigProperty
()
ClarifyShapBaselineConfigProperty
haddock_workaround_ :: ClarifyShapConfigProperty -> ()
numberOfSamples :: ClarifyShapConfigProperty -> Maybe (Value Integer)
seed :: ClarifyShapConfigProperty -> Maybe (Value Integer)
shapBaselineConfig :: ClarifyShapConfigProperty -> ClarifyShapBaselineConfigProperty
textConfig :: ClarifyShapConfigProperty -> Maybe ClarifyTextConfigProperty
useLogit :: ClarifyShapConfigProperty -> Maybe (Value Bool)
haddock_workaround_ :: ()
numberOfSamples :: Maybe (Value Integer)
seed :: Maybe (Value Integer)
shapBaselineConfig :: ClarifyShapBaselineConfigProperty
textConfig :: Maybe ClarifyTextConfigProperty
useLogit :: Maybe (Value Bool)
..}
= ResourceProperties
{awsType :: Text
awsType = Text
"AWS::SageMaker::EndpointConfig.ClarifyShapConfig",
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
"ShapBaselineConfig" Key -> ClarifyShapBaselineConfigProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= ClarifyShapBaselineConfigProperty
shapBaselineConfig]
([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
[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..=) Key
"NumberOfSamples" (Value Integer -> (Key, Value))
-> Maybe (Value Integer) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Integer)
numberOfSamples,
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..=) Key
"Seed" (Value Integer -> (Key, Value))
-> Maybe (Value Integer) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Integer)
seed,
Key -> ClarifyTextConfigProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"TextConfig" (ClarifyTextConfigProperty -> (Key, Value))
-> Maybe ClarifyTextConfigProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe ClarifyTextConfigProperty
textConfig,
Key -> Value Bool -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"UseLogit" (Value Bool -> (Key, Value))
-> Maybe (Value Bool) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Bool)
useLogit]))}
instance JSON.ToJSON ClarifyShapConfigProperty where
toJSON :: ClarifyShapConfigProperty -> Value
toJSON ClarifyShapConfigProperty {Maybe (Value Bool)
Maybe (Value Integer)
Maybe ClarifyTextConfigProperty
()
ClarifyShapBaselineConfigProperty
haddock_workaround_ :: ClarifyShapConfigProperty -> ()
numberOfSamples :: ClarifyShapConfigProperty -> Maybe (Value Integer)
seed :: ClarifyShapConfigProperty -> Maybe (Value Integer)
shapBaselineConfig :: ClarifyShapConfigProperty -> ClarifyShapBaselineConfigProperty
textConfig :: ClarifyShapConfigProperty -> Maybe ClarifyTextConfigProperty
useLogit :: ClarifyShapConfigProperty -> Maybe (Value Bool)
haddock_workaround_ :: ()
numberOfSamples :: Maybe (Value Integer)
seed :: Maybe (Value Integer)
shapBaselineConfig :: ClarifyShapBaselineConfigProperty
textConfig :: Maybe ClarifyTextConfigProperty
useLogit :: Maybe (Value Bool)
..}
= [(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
"ShapBaselineConfig" Key -> ClarifyShapBaselineConfigProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= ClarifyShapBaselineConfigProperty
shapBaselineConfig]
([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
[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..=) Key
"NumberOfSamples" (Value Integer -> (Key, Value))
-> Maybe (Value Integer) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Integer)
numberOfSamples,
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..=) Key
"Seed" (Value Integer -> (Key, Value))
-> Maybe (Value Integer) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Integer)
seed,
Key -> ClarifyTextConfigProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"TextConfig" (ClarifyTextConfigProperty -> (Key, Value))
-> Maybe ClarifyTextConfigProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe ClarifyTextConfigProperty
textConfig,
Key -> Value Bool -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"UseLogit" (Value Bool -> (Key, Value))
-> Maybe (Value Bool) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Bool)
useLogit])))
instance Property "NumberOfSamples" ClarifyShapConfigProperty where
type PropertyType "NumberOfSamples" ClarifyShapConfigProperty = Value Prelude.Integer
set :: PropertyType "NumberOfSamples" ClarifyShapConfigProperty
-> ClarifyShapConfigProperty -> ClarifyShapConfigProperty
set PropertyType "NumberOfSamples" ClarifyShapConfigProperty
newValue ClarifyShapConfigProperty {Maybe (Value Bool)
Maybe (Value Integer)
Maybe ClarifyTextConfigProperty
()
ClarifyShapBaselineConfigProperty
haddock_workaround_ :: ClarifyShapConfigProperty -> ()
numberOfSamples :: ClarifyShapConfigProperty -> Maybe (Value Integer)
seed :: ClarifyShapConfigProperty -> Maybe (Value Integer)
shapBaselineConfig :: ClarifyShapConfigProperty -> ClarifyShapBaselineConfigProperty
textConfig :: ClarifyShapConfigProperty -> Maybe ClarifyTextConfigProperty
useLogit :: ClarifyShapConfigProperty -> Maybe (Value Bool)
haddock_workaround_ :: ()
numberOfSamples :: Maybe (Value Integer)
seed :: Maybe (Value Integer)
shapBaselineConfig :: ClarifyShapBaselineConfigProperty
textConfig :: Maybe ClarifyTextConfigProperty
useLogit :: Maybe (Value Bool)
..}
= ClarifyShapConfigProperty
{numberOfSamples :: Maybe (Value Integer)
numberOfSamples = Value Integer -> Maybe (Value Integer)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "NumberOfSamples" ClarifyShapConfigProperty
Value Integer
newValue, Maybe (Value Bool)
Maybe (Value Integer)
Maybe ClarifyTextConfigProperty
()
ClarifyShapBaselineConfigProperty
haddock_workaround_ :: ()
seed :: Maybe (Value Integer)
shapBaselineConfig :: ClarifyShapBaselineConfigProperty
textConfig :: Maybe ClarifyTextConfigProperty
useLogit :: Maybe (Value Bool)
haddock_workaround_ :: ()
seed :: Maybe (Value Integer)
shapBaselineConfig :: ClarifyShapBaselineConfigProperty
textConfig :: Maybe ClarifyTextConfigProperty
useLogit :: Maybe (Value Bool)
..}
instance Property "Seed" ClarifyShapConfigProperty where
type PropertyType "Seed" ClarifyShapConfigProperty = Value Prelude.Integer
set :: PropertyType "Seed" ClarifyShapConfigProperty
-> ClarifyShapConfigProperty -> ClarifyShapConfigProperty
set PropertyType "Seed" ClarifyShapConfigProperty
newValue ClarifyShapConfigProperty {Maybe (Value Bool)
Maybe (Value Integer)
Maybe ClarifyTextConfigProperty
()
ClarifyShapBaselineConfigProperty
haddock_workaround_ :: ClarifyShapConfigProperty -> ()
numberOfSamples :: ClarifyShapConfigProperty -> Maybe (Value Integer)
seed :: ClarifyShapConfigProperty -> Maybe (Value Integer)
shapBaselineConfig :: ClarifyShapConfigProperty -> ClarifyShapBaselineConfigProperty
textConfig :: ClarifyShapConfigProperty -> Maybe ClarifyTextConfigProperty
useLogit :: ClarifyShapConfigProperty -> Maybe (Value Bool)
haddock_workaround_ :: ()
numberOfSamples :: Maybe (Value Integer)
seed :: Maybe (Value Integer)
shapBaselineConfig :: ClarifyShapBaselineConfigProperty
textConfig :: Maybe ClarifyTextConfigProperty
useLogit :: Maybe (Value Bool)
..}
= ClarifyShapConfigProperty {seed :: Maybe (Value Integer)
seed = Value Integer -> Maybe (Value Integer)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "Seed" ClarifyShapConfigProperty
Value Integer
newValue, Maybe (Value Bool)
Maybe (Value Integer)
Maybe ClarifyTextConfigProperty
()
ClarifyShapBaselineConfigProperty
haddock_workaround_ :: ()
numberOfSamples :: Maybe (Value Integer)
shapBaselineConfig :: ClarifyShapBaselineConfigProperty
textConfig :: Maybe ClarifyTextConfigProperty
useLogit :: Maybe (Value Bool)
haddock_workaround_ :: ()
numberOfSamples :: Maybe (Value Integer)
shapBaselineConfig :: ClarifyShapBaselineConfigProperty
textConfig :: Maybe ClarifyTextConfigProperty
useLogit :: Maybe (Value Bool)
..}
instance Property "ShapBaselineConfig" ClarifyShapConfigProperty where
type PropertyType "ShapBaselineConfig" ClarifyShapConfigProperty = ClarifyShapBaselineConfigProperty
set :: PropertyType "ShapBaselineConfig" ClarifyShapConfigProperty
-> ClarifyShapConfigProperty -> ClarifyShapConfigProperty
set PropertyType "ShapBaselineConfig" ClarifyShapConfigProperty
newValue ClarifyShapConfigProperty {Maybe (Value Bool)
Maybe (Value Integer)
Maybe ClarifyTextConfigProperty
()
ClarifyShapBaselineConfigProperty
haddock_workaround_ :: ClarifyShapConfigProperty -> ()
numberOfSamples :: ClarifyShapConfigProperty -> Maybe (Value Integer)
seed :: ClarifyShapConfigProperty -> Maybe (Value Integer)
shapBaselineConfig :: ClarifyShapConfigProperty -> ClarifyShapBaselineConfigProperty
textConfig :: ClarifyShapConfigProperty -> Maybe ClarifyTextConfigProperty
useLogit :: ClarifyShapConfigProperty -> Maybe (Value Bool)
haddock_workaround_ :: ()
numberOfSamples :: Maybe (Value Integer)
seed :: Maybe (Value Integer)
shapBaselineConfig :: ClarifyShapBaselineConfigProperty
textConfig :: Maybe ClarifyTextConfigProperty
useLogit :: Maybe (Value Bool)
..}
= ClarifyShapConfigProperty {shapBaselineConfig :: ClarifyShapBaselineConfigProperty
shapBaselineConfig = PropertyType "ShapBaselineConfig" ClarifyShapConfigProperty
ClarifyShapBaselineConfigProperty
newValue, Maybe (Value Bool)
Maybe (Value Integer)
Maybe ClarifyTextConfigProperty
()
haddock_workaround_ :: ()
numberOfSamples :: Maybe (Value Integer)
seed :: Maybe (Value Integer)
textConfig :: Maybe ClarifyTextConfigProperty
useLogit :: Maybe (Value Bool)
haddock_workaround_ :: ()
numberOfSamples :: Maybe (Value Integer)
seed :: Maybe (Value Integer)
textConfig :: Maybe ClarifyTextConfigProperty
useLogit :: Maybe (Value Bool)
..}
instance Property "TextConfig" ClarifyShapConfigProperty where
type PropertyType "TextConfig" ClarifyShapConfigProperty = ClarifyTextConfigProperty
set :: PropertyType "TextConfig" ClarifyShapConfigProperty
-> ClarifyShapConfigProperty -> ClarifyShapConfigProperty
set PropertyType "TextConfig" ClarifyShapConfigProperty
newValue ClarifyShapConfigProperty {Maybe (Value Bool)
Maybe (Value Integer)
Maybe ClarifyTextConfigProperty
()
ClarifyShapBaselineConfigProperty
haddock_workaround_ :: ClarifyShapConfigProperty -> ()
numberOfSamples :: ClarifyShapConfigProperty -> Maybe (Value Integer)
seed :: ClarifyShapConfigProperty -> Maybe (Value Integer)
shapBaselineConfig :: ClarifyShapConfigProperty -> ClarifyShapBaselineConfigProperty
textConfig :: ClarifyShapConfigProperty -> Maybe ClarifyTextConfigProperty
useLogit :: ClarifyShapConfigProperty -> Maybe (Value Bool)
haddock_workaround_ :: ()
numberOfSamples :: Maybe (Value Integer)
seed :: Maybe (Value Integer)
shapBaselineConfig :: ClarifyShapBaselineConfigProperty
textConfig :: Maybe ClarifyTextConfigProperty
useLogit :: Maybe (Value Bool)
..}
= ClarifyShapConfigProperty
{textConfig :: Maybe ClarifyTextConfigProperty
textConfig = ClarifyTextConfigProperty -> Maybe ClarifyTextConfigProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "TextConfig" ClarifyShapConfigProperty
ClarifyTextConfigProperty
newValue, Maybe (Value Bool)
Maybe (Value Integer)
()
ClarifyShapBaselineConfigProperty
haddock_workaround_ :: ()
numberOfSamples :: Maybe (Value Integer)
seed :: Maybe (Value Integer)
shapBaselineConfig :: ClarifyShapBaselineConfigProperty
useLogit :: Maybe (Value Bool)
haddock_workaround_ :: ()
numberOfSamples :: Maybe (Value Integer)
seed :: Maybe (Value Integer)
shapBaselineConfig :: ClarifyShapBaselineConfigProperty
useLogit :: Maybe (Value Bool)
..}
instance Property "UseLogit" ClarifyShapConfigProperty where
type PropertyType "UseLogit" ClarifyShapConfigProperty = Value Prelude.Bool
set :: PropertyType "UseLogit" ClarifyShapConfigProperty
-> ClarifyShapConfigProperty -> ClarifyShapConfigProperty
set PropertyType "UseLogit" ClarifyShapConfigProperty
newValue ClarifyShapConfigProperty {Maybe (Value Bool)
Maybe (Value Integer)
Maybe ClarifyTextConfigProperty
()
ClarifyShapBaselineConfigProperty
haddock_workaround_ :: ClarifyShapConfigProperty -> ()
numberOfSamples :: ClarifyShapConfigProperty -> Maybe (Value Integer)
seed :: ClarifyShapConfigProperty -> Maybe (Value Integer)
shapBaselineConfig :: ClarifyShapConfigProperty -> ClarifyShapBaselineConfigProperty
textConfig :: ClarifyShapConfigProperty -> Maybe ClarifyTextConfigProperty
useLogit :: ClarifyShapConfigProperty -> Maybe (Value Bool)
haddock_workaround_ :: ()
numberOfSamples :: Maybe (Value Integer)
seed :: Maybe (Value Integer)
shapBaselineConfig :: ClarifyShapBaselineConfigProperty
textConfig :: Maybe ClarifyTextConfigProperty
useLogit :: Maybe (Value Bool)
..}
= ClarifyShapConfigProperty {useLogit :: Maybe (Value Bool)
useLogit = Value Bool -> Maybe (Value Bool)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "UseLogit" ClarifyShapConfigProperty
Value Bool
newValue, Maybe (Value Integer)
Maybe ClarifyTextConfigProperty
()
ClarifyShapBaselineConfigProperty
haddock_workaround_ :: ()
numberOfSamples :: Maybe (Value Integer)
seed :: Maybe (Value Integer)
shapBaselineConfig :: ClarifyShapBaselineConfigProperty
textConfig :: Maybe ClarifyTextConfigProperty
haddock_workaround_ :: ()
numberOfSamples :: Maybe (Value Integer)
seed :: Maybe (Value Integer)
shapBaselineConfig :: ClarifyShapBaselineConfigProperty
textConfig :: Maybe ClarifyTextConfigProperty
..}