module Stratosphere.QuickSight.Analysis.ColumnTooltipItemProperty (
        module Exports, ColumnTooltipItemProperty(..),
        mkColumnTooltipItemProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.QuickSight.Analysis.AggregationFunctionProperty as Exports
import {-# SOURCE #-} Stratosphere.QuickSight.Analysis.ColumnIdentifierProperty as Exports
import Stratosphere.ResourceProperties
import Stratosphere.Value
data ColumnTooltipItemProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-quicksight-analysis-columntooltipitem.html>
    ColumnTooltipItemProperty {ColumnTooltipItemProperty -> ()
haddock_workaround_ :: (),
                               -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-quicksight-analysis-columntooltipitem.html#cfn-quicksight-analysis-columntooltipitem-aggregation>
                               ColumnTooltipItemProperty -> Maybe AggregationFunctionProperty
aggregation :: (Prelude.Maybe AggregationFunctionProperty),
                               -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-quicksight-analysis-columntooltipitem.html#cfn-quicksight-analysis-columntooltipitem-column>
                               ColumnTooltipItemProperty -> ColumnIdentifierProperty
column :: ColumnIdentifierProperty,
                               -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-quicksight-analysis-columntooltipitem.html#cfn-quicksight-analysis-columntooltipitem-label>
                               ColumnTooltipItemProperty -> Maybe (Value Text)
label :: (Prelude.Maybe (Value Prelude.Text)),
                               -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-quicksight-analysis-columntooltipitem.html#cfn-quicksight-analysis-columntooltipitem-tooltiptarget>
                               ColumnTooltipItemProperty -> Maybe (Value Text)
tooltipTarget :: (Prelude.Maybe (Value Prelude.Text)),
                               -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-quicksight-analysis-columntooltipitem.html#cfn-quicksight-analysis-columntooltipitem-visibility>
                               ColumnTooltipItemProperty -> Maybe (Value Text)
visibility :: (Prelude.Maybe (Value Prelude.Text))}
  deriving stock (ColumnTooltipItemProperty -> ColumnTooltipItemProperty -> Bool
(ColumnTooltipItemProperty -> ColumnTooltipItemProperty -> Bool)
-> (ColumnTooltipItemProperty -> ColumnTooltipItemProperty -> Bool)
-> Eq ColumnTooltipItemProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ColumnTooltipItemProperty -> ColumnTooltipItemProperty -> Bool
== :: ColumnTooltipItemProperty -> ColumnTooltipItemProperty -> Bool
$c/= :: ColumnTooltipItemProperty -> ColumnTooltipItemProperty -> Bool
/= :: ColumnTooltipItemProperty -> ColumnTooltipItemProperty -> Bool
Prelude.Eq, Int -> ColumnTooltipItemProperty -> ShowS
[ColumnTooltipItemProperty] -> ShowS
ColumnTooltipItemProperty -> String
(Int -> ColumnTooltipItemProperty -> ShowS)
-> (ColumnTooltipItemProperty -> String)
-> ([ColumnTooltipItemProperty] -> ShowS)
-> Show ColumnTooltipItemProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ColumnTooltipItemProperty -> ShowS
showsPrec :: Int -> ColumnTooltipItemProperty -> ShowS
$cshow :: ColumnTooltipItemProperty -> String
show :: ColumnTooltipItemProperty -> String
$cshowList :: [ColumnTooltipItemProperty] -> ShowS
showList :: [ColumnTooltipItemProperty] -> ShowS
Prelude.Show)
mkColumnTooltipItemProperty ::
  ColumnIdentifierProperty -> ColumnTooltipItemProperty
mkColumnTooltipItemProperty :: ColumnIdentifierProperty -> ColumnTooltipItemProperty
mkColumnTooltipItemProperty ColumnIdentifierProperty
column
  = ColumnTooltipItemProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (), column :: ColumnIdentifierProperty
column = ColumnIdentifierProperty
column,
       aggregation :: Maybe AggregationFunctionProperty
aggregation = Maybe AggregationFunctionProperty
forall a. Maybe a
Prelude.Nothing, label :: Maybe (Value Text)
label = Maybe (Value Text)
forall a. Maybe a
Prelude.Nothing,
       tooltipTarget :: Maybe (Value Text)
tooltipTarget = Maybe (Value Text)
forall a. Maybe a
Prelude.Nothing, visibility :: Maybe (Value Text)
visibility = Maybe (Value Text)
forall a. Maybe a
Prelude.Nothing}
instance ToResourceProperties ColumnTooltipItemProperty where
  toResourceProperties :: ColumnTooltipItemProperty -> ResourceProperties
toResourceProperties ColumnTooltipItemProperty {Maybe (Value Text)
Maybe AggregationFunctionProperty
()
ColumnIdentifierProperty
haddock_workaround_ :: ColumnTooltipItemProperty -> ()
aggregation :: ColumnTooltipItemProperty -> Maybe AggregationFunctionProperty
column :: ColumnTooltipItemProperty -> ColumnIdentifierProperty
label :: ColumnTooltipItemProperty -> Maybe (Value Text)
tooltipTarget :: ColumnTooltipItemProperty -> Maybe (Value Text)
visibility :: ColumnTooltipItemProperty -> Maybe (Value Text)
haddock_workaround_ :: ()
aggregation :: Maybe AggregationFunctionProperty
column :: ColumnIdentifierProperty
label :: Maybe (Value Text)
tooltipTarget :: Maybe (Value Text)
visibility :: Maybe (Value Text)
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::QuickSight::Analysis.ColumnTooltipItem",
         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
"Column" Key -> ColumnIdentifierProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= ColumnIdentifierProperty
column]
                           ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
                              [Key -> AggregationFunctionProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"Aggregation" (AggregationFunctionProperty -> (Key, Value))
-> Maybe AggregationFunctionProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe AggregationFunctionProperty
aggregation,
                               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
"Label" (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)
label,
                               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
"TooltipTarget" (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)
tooltipTarget,
                               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
"Visibility" (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)
visibility]))}
instance JSON.ToJSON ColumnTooltipItemProperty where
  toJSON :: ColumnTooltipItemProperty -> Value
toJSON ColumnTooltipItemProperty {Maybe (Value Text)
Maybe AggregationFunctionProperty
()
ColumnIdentifierProperty
haddock_workaround_ :: ColumnTooltipItemProperty -> ()
aggregation :: ColumnTooltipItemProperty -> Maybe AggregationFunctionProperty
column :: ColumnTooltipItemProperty -> ColumnIdentifierProperty
label :: ColumnTooltipItemProperty -> Maybe (Value Text)
tooltipTarget :: ColumnTooltipItemProperty -> Maybe (Value Text)
visibility :: ColumnTooltipItemProperty -> Maybe (Value Text)
haddock_workaround_ :: ()
aggregation :: Maybe AggregationFunctionProperty
column :: ColumnIdentifierProperty
label :: Maybe (Value Text)
tooltipTarget :: Maybe (Value Text)
visibility :: Maybe (Value Text)
..}
    = [(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
"Column" Key -> ColumnIdentifierProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= ColumnIdentifierProperty
column]
              ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
                 [Key -> AggregationFunctionProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"Aggregation" (AggregationFunctionProperty -> (Key, Value))
-> Maybe AggregationFunctionProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe AggregationFunctionProperty
aggregation,
                  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
"Label" (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)
label,
                  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
"TooltipTarget" (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)
tooltipTarget,
                  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
"Visibility" (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)
visibility])))
instance Property "Aggregation" ColumnTooltipItemProperty where
  type PropertyType "Aggregation" ColumnTooltipItemProperty = AggregationFunctionProperty
  set :: PropertyType "Aggregation" ColumnTooltipItemProperty
-> ColumnTooltipItemProperty -> ColumnTooltipItemProperty
set PropertyType "Aggregation" ColumnTooltipItemProperty
newValue ColumnTooltipItemProperty {Maybe (Value Text)
Maybe AggregationFunctionProperty
()
ColumnIdentifierProperty
haddock_workaround_ :: ColumnTooltipItemProperty -> ()
aggregation :: ColumnTooltipItemProperty -> Maybe AggregationFunctionProperty
column :: ColumnTooltipItemProperty -> ColumnIdentifierProperty
label :: ColumnTooltipItemProperty -> Maybe (Value Text)
tooltipTarget :: ColumnTooltipItemProperty -> Maybe (Value Text)
visibility :: ColumnTooltipItemProperty -> Maybe (Value Text)
haddock_workaround_ :: ()
aggregation :: Maybe AggregationFunctionProperty
column :: ColumnIdentifierProperty
label :: Maybe (Value Text)
tooltipTarget :: Maybe (Value Text)
visibility :: Maybe (Value Text)
..}
    = ColumnTooltipItemProperty
        {aggregation :: Maybe AggregationFunctionProperty
aggregation = AggregationFunctionProperty -> Maybe AggregationFunctionProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "Aggregation" ColumnTooltipItemProperty
AggregationFunctionProperty
newValue, Maybe (Value Text)
()
ColumnIdentifierProperty
haddock_workaround_ :: ()
column :: ColumnIdentifierProperty
label :: Maybe (Value Text)
tooltipTarget :: Maybe (Value Text)
visibility :: Maybe (Value Text)
haddock_workaround_ :: ()
column :: ColumnIdentifierProperty
label :: Maybe (Value Text)
tooltipTarget :: Maybe (Value Text)
visibility :: Maybe (Value Text)
..}
instance Property "Column" ColumnTooltipItemProperty where
  type PropertyType "Column" ColumnTooltipItemProperty = ColumnIdentifierProperty
  set :: PropertyType "Column" ColumnTooltipItemProperty
-> ColumnTooltipItemProperty -> ColumnTooltipItemProperty
set PropertyType "Column" ColumnTooltipItemProperty
newValue ColumnTooltipItemProperty {Maybe (Value Text)
Maybe AggregationFunctionProperty
()
ColumnIdentifierProperty
haddock_workaround_ :: ColumnTooltipItemProperty -> ()
aggregation :: ColumnTooltipItemProperty -> Maybe AggregationFunctionProperty
column :: ColumnTooltipItemProperty -> ColumnIdentifierProperty
label :: ColumnTooltipItemProperty -> Maybe (Value Text)
tooltipTarget :: ColumnTooltipItemProperty -> Maybe (Value Text)
visibility :: ColumnTooltipItemProperty -> Maybe (Value Text)
haddock_workaround_ :: ()
aggregation :: Maybe AggregationFunctionProperty
column :: ColumnIdentifierProperty
label :: Maybe (Value Text)
tooltipTarget :: Maybe (Value Text)
visibility :: Maybe (Value Text)
..}
    = ColumnTooltipItemProperty {column :: ColumnIdentifierProperty
column = PropertyType "Column" ColumnTooltipItemProperty
ColumnIdentifierProperty
newValue, Maybe (Value Text)
Maybe AggregationFunctionProperty
()
haddock_workaround_ :: ()
aggregation :: Maybe AggregationFunctionProperty
label :: Maybe (Value Text)
tooltipTarget :: Maybe (Value Text)
visibility :: Maybe (Value Text)
haddock_workaround_ :: ()
aggregation :: Maybe AggregationFunctionProperty
label :: Maybe (Value Text)
tooltipTarget :: Maybe (Value Text)
visibility :: Maybe (Value Text)
..}
instance Property "Label" ColumnTooltipItemProperty where
  type PropertyType "Label" ColumnTooltipItemProperty = Value Prelude.Text
  set :: PropertyType "Label" ColumnTooltipItemProperty
-> ColumnTooltipItemProperty -> ColumnTooltipItemProperty
set PropertyType "Label" ColumnTooltipItemProperty
newValue ColumnTooltipItemProperty {Maybe (Value Text)
Maybe AggregationFunctionProperty
()
ColumnIdentifierProperty
haddock_workaround_ :: ColumnTooltipItemProperty -> ()
aggregation :: ColumnTooltipItemProperty -> Maybe AggregationFunctionProperty
column :: ColumnTooltipItemProperty -> ColumnIdentifierProperty
label :: ColumnTooltipItemProperty -> Maybe (Value Text)
tooltipTarget :: ColumnTooltipItemProperty -> Maybe (Value Text)
visibility :: ColumnTooltipItemProperty -> Maybe (Value Text)
haddock_workaround_ :: ()
aggregation :: Maybe AggregationFunctionProperty
column :: ColumnIdentifierProperty
label :: Maybe (Value Text)
tooltipTarget :: Maybe (Value Text)
visibility :: Maybe (Value Text)
..}
    = ColumnTooltipItemProperty {label :: Maybe (Value Text)
label = Value Text -> Maybe (Value Text)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "Label" ColumnTooltipItemProperty
Value Text
newValue, Maybe (Value Text)
Maybe AggregationFunctionProperty
()
ColumnIdentifierProperty
haddock_workaround_ :: ()
aggregation :: Maybe AggregationFunctionProperty
column :: ColumnIdentifierProperty
tooltipTarget :: Maybe (Value Text)
visibility :: Maybe (Value Text)
haddock_workaround_ :: ()
aggregation :: Maybe AggregationFunctionProperty
column :: ColumnIdentifierProperty
tooltipTarget :: Maybe (Value Text)
visibility :: Maybe (Value Text)
..}
instance Property "TooltipTarget" ColumnTooltipItemProperty where
  type PropertyType "TooltipTarget" ColumnTooltipItemProperty = Value Prelude.Text
  set :: PropertyType "TooltipTarget" ColumnTooltipItemProperty
-> ColumnTooltipItemProperty -> ColumnTooltipItemProperty
set PropertyType "TooltipTarget" ColumnTooltipItemProperty
newValue ColumnTooltipItemProperty {Maybe (Value Text)
Maybe AggregationFunctionProperty
()
ColumnIdentifierProperty
haddock_workaround_ :: ColumnTooltipItemProperty -> ()
aggregation :: ColumnTooltipItemProperty -> Maybe AggregationFunctionProperty
column :: ColumnTooltipItemProperty -> ColumnIdentifierProperty
label :: ColumnTooltipItemProperty -> Maybe (Value Text)
tooltipTarget :: ColumnTooltipItemProperty -> Maybe (Value Text)
visibility :: ColumnTooltipItemProperty -> Maybe (Value Text)
haddock_workaround_ :: ()
aggregation :: Maybe AggregationFunctionProperty
column :: ColumnIdentifierProperty
label :: Maybe (Value Text)
tooltipTarget :: Maybe (Value Text)
visibility :: Maybe (Value Text)
..}
    = ColumnTooltipItemProperty
        {tooltipTarget :: Maybe (Value Text)
tooltipTarget = Value Text -> Maybe (Value Text)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "TooltipTarget" ColumnTooltipItemProperty
Value Text
newValue, Maybe (Value Text)
Maybe AggregationFunctionProperty
()
ColumnIdentifierProperty
haddock_workaround_ :: ()
aggregation :: Maybe AggregationFunctionProperty
column :: ColumnIdentifierProperty
label :: Maybe (Value Text)
visibility :: Maybe (Value Text)
haddock_workaround_ :: ()
aggregation :: Maybe AggregationFunctionProperty
column :: ColumnIdentifierProperty
label :: Maybe (Value Text)
visibility :: Maybe (Value Text)
..}
instance Property "Visibility" ColumnTooltipItemProperty where
  type PropertyType "Visibility" ColumnTooltipItemProperty = Value Prelude.Text
  set :: PropertyType "Visibility" ColumnTooltipItemProperty
-> ColumnTooltipItemProperty -> ColumnTooltipItemProperty
set PropertyType "Visibility" ColumnTooltipItemProperty
newValue ColumnTooltipItemProperty {Maybe (Value Text)
Maybe AggregationFunctionProperty
()
ColumnIdentifierProperty
haddock_workaround_ :: ColumnTooltipItemProperty -> ()
aggregation :: ColumnTooltipItemProperty -> Maybe AggregationFunctionProperty
column :: ColumnTooltipItemProperty -> ColumnIdentifierProperty
label :: ColumnTooltipItemProperty -> Maybe (Value Text)
tooltipTarget :: ColumnTooltipItemProperty -> Maybe (Value Text)
visibility :: ColumnTooltipItemProperty -> Maybe (Value Text)
haddock_workaround_ :: ()
aggregation :: Maybe AggregationFunctionProperty
column :: ColumnIdentifierProperty
label :: Maybe (Value Text)
tooltipTarget :: Maybe (Value Text)
visibility :: Maybe (Value Text)
..}
    = ColumnTooltipItemProperty
        {visibility :: Maybe (Value Text)
visibility = Value Text -> Maybe (Value Text)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "Visibility" ColumnTooltipItemProperty
Value Text
newValue, Maybe (Value Text)
Maybe AggregationFunctionProperty
()
ColumnIdentifierProperty
haddock_workaround_ :: ()
aggregation :: Maybe AggregationFunctionProperty
column :: ColumnIdentifierProperty
label :: Maybe (Value Text)
tooltipTarget :: Maybe (Value Text)
haddock_workaround_ :: ()
aggregation :: Maybe AggregationFunctionProperty
column :: ColumnIdentifierProperty
label :: Maybe (Value Text)
tooltipTarget :: Maybe (Value Text)
..}