module Stratosphere.QuickSight.Template.TableFieldLinkConfigurationProperty (
module Exports, TableFieldLinkConfigurationProperty(..),
mkTableFieldLinkConfigurationProperty
) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.QuickSight.Template.TableFieldLinkContentConfigurationProperty as Exports
import Stratosphere.ResourceProperties
import Stratosphere.Value
data TableFieldLinkConfigurationProperty
=
TableFieldLinkConfigurationProperty {TableFieldLinkConfigurationProperty -> ()
haddock_workaround_ :: (),
TableFieldLinkConfigurationProperty
-> TableFieldLinkContentConfigurationProperty
content :: TableFieldLinkContentConfigurationProperty,
TableFieldLinkConfigurationProperty -> Value Text
target :: (Value Prelude.Text)}
deriving stock (TableFieldLinkConfigurationProperty
-> TableFieldLinkConfigurationProperty -> Bool
(TableFieldLinkConfigurationProperty
-> TableFieldLinkConfigurationProperty -> Bool)
-> (TableFieldLinkConfigurationProperty
-> TableFieldLinkConfigurationProperty -> Bool)
-> Eq TableFieldLinkConfigurationProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TableFieldLinkConfigurationProperty
-> TableFieldLinkConfigurationProperty -> Bool
== :: TableFieldLinkConfigurationProperty
-> TableFieldLinkConfigurationProperty -> Bool
$c/= :: TableFieldLinkConfigurationProperty
-> TableFieldLinkConfigurationProperty -> Bool
/= :: TableFieldLinkConfigurationProperty
-> TableFieldLinkConfigurationProperty -> Bool
Prelude.Eq, Int -> TableFieldLinkConfigurationProperty -> ShowS
[TableFieldLinkConfigurationProperty] -> ShowS
TableFieldLinkConfigurationProperty -> String
(Int -> TableFieldLinkConfigurationProperty -> ShowS)
-> (TableFieldLinkConfigurationProperty -> String)
-> ([TableFieldLinkConfigurationProperty] -> ShowS)
-> Show TableFieldLinkConfigurationProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TableFieldLinkConfigurationProperty -> ShowS
showsPrec :: Int -> TableFieldLinkConfigurationProperty -> ShowS
$cshow :: TableFieldLinkConfigurationProperty -> String
show :: TableFieldLinkConfigurationProperty -> String
$cshowList :: [TableFieldLinkConfigurationProperty] -> ShowS
showList :: [TableFieldLinkConfigurationProperty] -> ShowS
Prelude.Show)
mkTableFieldLinkConfigurationProperty ::
TableFieldLinkContentConfigurationProperty
-> Value Prelude.Text -> TableFieldLinkConfigurationProperty
mkTableFieldLinkConfigurationProperty :: TableFieldLinkContentConfigurationProperty
-> Value Text -> TableFieldLinkConfigurationProperty
mkTableFieldLinkConfigurationProperty TableFieldLinkContentConfigurationProperty
content Value Text
target
= TableFieldLinkConfigurationProperty
{haddock_workaround_ :: ()
haddock_workaround_ = (), content :: TableFieldLinkContentConfigurationProperty
content = TableFieldLinkContentConfigurationProperty
content, target :: Value Text
target = Value Text
target}
instance ToResourceProperties TableFieldLinkConfigurationProperty where
toResourceProperties :: TableFieldLinkConfigurationProperty -> ResourceProperties
toResourceProperties TableFieldLinkConfigurationProperty {()
Value Text
TableFieldLinkContentConfigurationProperty
haddock_workaround_ :: TableFieldLinkConfigurationProperty -> ()
content :: TableFieldLinkConfigurationProperty
-> TableFieldLinkContentConfigurationProperty
target :: TableFieldLinkConfigurationProperty -> Value Text
haddock_workaround_ :: ()
content :: TableFieldLinkContentConfigurationProperty
target :: Value Text
..}
= ResourceProperties
{awsType :: Text
awsType = Text
"AWS::QuickSight::Template.TableFieldLinkConfiguration",
supportsTags :: Bool
supportsTags = Bool
Prelude.False,
properties :: Object
properties = [Key
"Content" Key -> TableFieldLinkContentConfigurationProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= TableFieldLinkContentConfigurationProperty
content, Key
"Target" 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
target]}
instance JSON.ToJSON TableFieldLinkConfigurationProperty where
toJSON :: TableFieldLinkConfigurationProperty -> Value
toJSON TableFieldLinkConfigurationProperty {()
Value Text
TableFieldLinkContentConfigurationProperty
haddock_workaround_ :: TableFieldLinkConfigurationProperty -> ()
content :: TableFieldLinkConfigurationProperty
-> TableFieldLinkContentConfigurationProperty
target :: TableFieldLinkConfigurationProperty -> Value Text
haddock_workaround_ :: ()
content :: TableFieldLinkContentConfigurationProperty
target :: Value Text
..}
= [(Key, Value)] -> Value
JSON.object [Key
"Content" Key -> TableFieldLinkContentConfigurationProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= TableFieldLinkContentConfigurationProperty
content, Key
"Target" 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
target]
instance Property "Content" TableFieldLinkConfigurationProperty where
type PropertyType "Content" TableFieldLinkConfigurationProperty = TableFieldLinkContentConfigurationProperty
set :: PropertyType "Content" TableFieldLinkConfigurationProperty
-> TableFieldLinkConfigurationProperty
-> TableFieldLinkConfigurationProperty
set PropertyType "Content" TableFieldLinkConfigurationProperty
newValue TableFieldLinkConfigurationProperty {()
Value Text
TableFieldLinkContentConfigurationProperty
haddock_workaround_ :: TableFieldLinkConfigurationProperty -> ()
content :: TableFieldLinkConfigurationProperty
-> TableFieldLinkContentConfigurationProperty
target :: TableFieldLinkConfigurationProperty -> Value Text
haddock_workaround_ :: ()
content :: TableFieldLinkContentConfigurationProperty
target :: Value Text
..}
= TableFieldLinkConfigurationProperty {content :: TableFieldLinkContentConfigurationProperty
content = PropertyType "Content" TableFieldLinkConfigurationProperty
TableFieldLinkContentConfigurationProperty
newValue, ()
Value Text
haddock_workaround_ :: ()
target :: Value Text
haddock_workaround_ :: ()
target :: Value Text
..}
instance Property "Target" TableFieldLinkConfigurationProperty where
type PropertyType "Target" TableFieldLinkConfigurationProperty = Value Prelude.Text
set :: PropertyType "Target" TableFieldLinkConfigurationProperty
-> TableFieldLinkConfigurationProperty
-> TableFieldLinkConfigurationProperty
set PropertyType "Target" TableFieldLinkConfigurationProperty
newValue TableFieldLinkConfigurationProperty {()
Value Text
TableFieldLinkContentConfigurationProperty
haddock_workaround_ :: TableFieldLinkConfigurationProperty -> ()
content :: TableFieldLinkConfigurationProperty
-> TableFieldLinkContentConfigurationProperty
target :: TableFieldLinkConfigurationProperty -> Value Text
haddock_workaround_ :: ()
content :: TableFieldLinkContentConfigurationProperty
target :: Value Text
..}
= TableFieldLinkConfigurationProperty {target :: Value Text
target = PropertyType "Target" TableFieldLinkConfigurationProperty
Value Text
newValue, ()
TableFieldLinkContentConfigurationProperty
haddock_workaround_ :: ()
content :: TableFieldLinkContentConfigurationProperty
haddock_workaround_ :: ()
content :: TableFieldLinkContentConfigurationProperty
..}