{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.QuickSight.Types.HeatMapConfiguration
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.QuickSight.Types.HeatMapConfiguration where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import Amazonka.QuickSight.Types.ChartAxisLabelOptions
import Amazonka.QuickSight.Types.ColorScale
import Amazonka.QuickSight.Types.DataLabelOptions
import Amazonka.QuickSight.Types.HeatMapFieldWells
import Amazonka.QuickSight.Types.HeatMapSortConfiguration
import Amazonka.QuickSight.Types.LegendOptions
import Amazonka.QuickSight.Types.TooltipOptions

-- | The configuration of a heat map.
--
-- /See:/ 'newHeatMapConfiguration' smart constructor.
data HeatMapConfiguration = HeatMapConfiguration'
  { -- | The color options (gradient color, point of divergence) in a heat map.
    HeatMapConfiguration -> Maybe ColorScale
colorScale :: Prelude.Maybe ColorScale,
    -- | The label options of the column that is displayed in a heat map.
    HeatMapConfiguration -> Maybe ChartAxisLabelOptions
columnLabelOptions :: Prelude.Maybe ChartAxisLabelOptions,
    -- | The options that determine if visual data labels are displayed.
    HeatMapConfiguration -> Maybe DataLabelOptions
dataLabels :: Prelude.Maybe DataLabelOptions,
    -- | The field wells of the visual.
    HeatMapConfiguration -> Maybe HeatMapFieldWells
fieldWells :: Prelude.Maybe HeatMapFieldWells,
    -- | The legend display setup of the visual.
    HeatMapConfiguration -> Maybe LegendOptions
legend :: Prelude.Maybe LegendOptions,
    -- | The label options of the row that is displayed in a @heat map@.
    HeatMapConfiguration -> Maybe ChartAxisLabelOptions
rowLabelOptions :: Prelude.Maybe ChartAxisLabelOptions,
    -- | The sort configuration of a heat map.
    HeatMapConfiguration -> Maybe HeatMapSortConfiguration
sortConfiguration :: Prelude.Maybe HeatMapSortConfiguration,
    -- | The tooltip display setup of the visual.
    HeatMapConfiguration -> Maybe TooltipOptions
tooltip :: Prelude.Maybe TooltipOptions
  }
  deriving (HeatMapConfiguration -> HeatMapConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HeatMapConfiguration -> HeatMapConfiguration -> Bool
$c/= :: HeatMapConfiguration -> HeatMapConfiguration -> Bool
== :: HeatMapConfiguration -> HeatMapConfiguration -> Bool
$c== :: HeatMapConfiguration -> HeatMapConfiguration -> Bool
Prelude.Eq, Int -> HeatMapConfiguration -> ShowS
[HeatMapConfiguration] -> ShowS
HeatMapConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HeatMapConfiguration] -> ShowS
$cshowList :: [HeatMapConfiguration] -> ShowS
show :: HeatMapConfiguration -> String
$cshow :: HeatMapConfiguration -> String
showsPrec :: Int -> HeatMapConfiguration -> ShowS
$cshowsPrec :: Int -> HeatMapConfiguration -> ShowS
Prelude.Show, forall x. Rep HeatMapConfiguration x -> HeatMapConfiguration
forall x. HeatMapConfiguration -> Rep HeatMapConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HeatMapConfiguration x -> HeatMapConfiguration
$cfrom :: forall x. HeatMapConfiguration -> Rep HeatMapConfiguration x
Prelude.Generic)

-- |
-- Create a value of 'HeatMapConfiguration' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'colorScale', 'heatMapConfiguration_colorScale' - The color options (gradient color, point of divergence) in a heat map.
--
-- 'columnLabelOptions', 'heatMapConfiguration_columnLabelOptions' - The label options of the column that is displayed in a heat map.
--
-- 'dataLabels', 'heatMapConfiguration_dataLabels' - The options that determine if visual data labels are displayed.
--
-- 'fieldWells', 'heatMapConfiguration_fieldWells' - The field wells of the visual.
--
-- 'legend', 'heatMapConfiguration_legend' - The legend display setup of the visual.
--
-- 'rowLabelOptions', 'heatMapConfiguration_rowLabelOptions' - The label options of the row that is displayed in a @heat map@.
--
-- 'sortConfiguration', 'heatMapConfiguration_sortConfiguration' - The sort configuration of a heat map.
--
-- 'tooltip', 'heatMapConfiguration_tooltip' - The tooltip display setup of the visual.
newHeatMapConfiguration ::
  HeatMapConfiguration
newHeatMapConfiguration :: HeatMapConfiguration
newHeatMapConfiguration =
  HeatMapConfiguration'
    { $sel:colorScale:HeatMapConfiguration' :: Maybe ColorScale
colorScale = forall a. Maybe a
Prelude.Nothing,
      $sel:columnLabelOptions:HeatMapConfiguration' :: Maybe ChartAxisLabelOptions
columnLabelOptions = forall a. Maybe a
Prelude.Nothing,
      $sel:dataLabels:HeatMapConfiguration' :: Maybe DataLabelOptions
dataLabels = forall a. Maybe a
Prelude.Nothing,
      $sel:fieldWells:HeatMapConfiguration' :: Maybe HeatMapFieldWells
fieldWells = forall a. Maybe a
Prelude.Nothing,
      $sel:legend:HeatMapConfiguration' :: Maybe LegendOptions
legend = forall a. Maybe a
Prelude.Nothing,
      $sel:rowLabelOptions:HeatMapConfiguration' :: Maybe ChartAxisLabelOptions
rowLabelOptions = forall a. Maybe a
Prelude.Nothing,
      $sel:sortConfiguration:HeatMapConfiguration' :: Maybe HeatMapSortConfiguration
sortConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:tooltip:HeatMapConfiguration' :: Maybe TooltipOptions
tooltip = forall a. Maybe a
Prelude.Nothing
    }

-- | The color options (gradient color, point of divergence) in a heat map.
heatMapConfiguration_colorScale :: Lens.Lens' HeatMapConfiguration (Prelude.Maybe ColorScale)
heatMapConfiguration_colorScale :: Lens' HeatMapConfiguration (Maybe ColorScale)
heatMapConfiguration_colorScale = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HeatMapConfiguration' {Maybe ColorScale
colorScale :: Maybe ColorScale
$sel:colorScale:HeatMapConfiguration' :: HeatMapConfiguration -> Maybe ColorScale
colorScale} -> Maybe ColorScale
colorScale) (\s :: HeatMapConfiguration
s@HeatMapConfiguration' {} Maybe ColorScale
a -> HeatMapConfiguration
s {$sel:colorScale:HeatMapConfiguration' :: Maybe ColorScale
colorScale = Maybe ColorScale
a} :: HeatMapConfiguration)

-- | The label options of the column that is displayed in a heat map.
heatMapConfiguration_columnLabelOptions :: Lens.Lens' HeatMapConfiguration (Prelude.Maybe ChartAxisLabelOptions)
heatMapConfiguration_columnLabelOptions :: Lens' HeatMapConfiguration (Maybe ChartAxisLabelOptions)
heatMapConfiguration_columnLabelOptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HeatMapConfiguration' {Maybe ChartAxisLabelOptions
columnLabelOptions :: Maybe ChartAxisLabelOptions
$sel:columnLabelOptions:HeatMapConfiguration' :: HeatMapConfiguration -> Maybe ChartAxisLabelOptions
columnLabelOptions} -> Maybe ChartAxisLabelOptions
columnLabelOptions) (\s :: HeatMapConfiguration
s@HeatMapConfiguration' {} Maybe ChartAxisLabelOptions
a -> HeatMapConfiguration
s {$sel:columnLabelOptions:HeatMapConfiguration' :: Maybe ChartAxisLabelOptions
columnLabelOptions = Maybe ChartAxisLabelOptions
a} :: HeatMapConfiguration)

-- | The options that determine if visual data labels are displayed.
heatMapConfiguration_dataLabels :: Lens.Lens' HeatMapConfiguration (Prelude.Maybe DataLabelOptions)
heatMapConfiguration_dataLabels :: Lens' HeatMapConfiguration (Maybe DataLabelOptions)
heatMapConfiguration_dataLabels = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HeatMapConfiguration' {Maybe DataLabelOptions
dataLabels :: Maybe DataLabelOptions
$sel:dataLabels:HeatMapConfiguration' :: HeatMapConfiguration -> Maybe DataLabelOptions
dataLabels} -> Maybe DataLabelOptions
dataLabels) (\s :: HeatMapConfiguration
s@HeatMapConfiguration' {} Maybe DataLabelOptions
a -> HeatMapConfiguration
s {$sel:dataLabels:HeatMapConfiguration' :: Maybe DataLabelOptions
dataLabels = Maybe DataLabelOptions
a} :: HeatMapConfiguration)

-- | The field wells of the visual.
heatMapConfiguration_fieldWells :: Lens.Lens' HeatMapConfiguration (Prelude.Maybe HeatMapFieldWells)
heatMapConfiguration_fieldWells :: Lens' HeatMapConfiguration (Maybe HeatMapFieldWells)
heatMapConfiguration_fieldWells = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HeatMapConfiguration' {Maybe HeatMapFieldWells
fieldWells :: Maybe HeatMapFieldWells
$sel:fieldWells:HeatMapConfiguration' :: HeatMapConfiguration -> Maybe HeatMapFieldWells
fieldWells} -> Maybe HeatMapFieldWells
fieldWells) (\s :: HeatMapConfiguration
s@HeatMapConfiguration' {} Maybe HeatMapFieldWells
a -> HeatMapConfiguration
s {$sel:fieldWells:HeatMapConfiguration' :: Maybe HeatMapFieldWells
fieldWells = Maybe HeatMapFieldWells
a} :: HeatMapConfiguration)

-- | The legend display setup of the visual.
heatMapConfiguration_legend :: Lens.Lens' HeatMapConfiguration (Prelude.Maybe LegendOptions)
heatMapConfiguration_legend :: Lens' HeatMapConfiguration (Maybe LegendOptions)
heatMapConfiguration_legend = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HeatMapConfiguration' {Maybe LegendOptions
legend :: Maybe LegendOptions
$sel:legend:HeatMapConfiguration' :: HeatMapConfiguration -> Maybe LegendOptions
legend} -> Maybe LegendOptions
legend) (\s :: HeatMapConfiguration
s@HeatMapConfiguration' {} Maybe LegendOptions
a -> HeatMapConfiguration
s {$sel:legend:HeatMapConfiguration' :: Maybe LegendOptions
legend = Maybe LegendOptions
a} :: HeatMapConfiguration)

-- | The label options of the row that is displayed in a @heat map@.
heatMapConfiguration_rowLabelOptions :: Lens.Lens' HeatMapConfiguration (Prelude.Maybe ChartAxisLabelOptions)
heatMapConfiguration_rowLabelOptions :: Lens' HeatMapConfiguration (Maybe ChartAxisLabelOptions)
heatMapConfiguration_rowLabelOptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HeatMapConfiguration' {Maybe ChartAxisLabelOptions
rowLabelOptions :: Maybe ChartAxisLabelOptions
$sel:rowLabelOptions:HeatMapConfiguration' :: HeatMapConfiguration -> Maybe ChartAxisLabelOptions
rowLabelOptions} -> Maybe ChartAxisLabelOptions
rowLabelOptions) (\s :: HeatMapConfiguration
s@HeatMapConfiguration' {} Maybe ChartAxisLabelOptions
a -> HeatMapConfiguration
s {$sel:rowLabelOptions:HeatMapConfiguration' :: Maybe ChartAxisLabelOptions
rowLabelOptions = Maybe ChartAxisLabelOptions
a} :: HeatMapConfiguration)

-- | The sort configuration of a heat map.
heatMapConfiguration_sortConfiguration :: Lens.Lens' HeatMapConfiguration (Prelude.Maybe HeatMapSortConfiguration)
heatMapConfiguration_sortConfiguration :: Lens' HeatMapConfiguration (Maybe HeatMapSortConfiguration)
heatMapConfiguration_sortConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HeatMapConfiguration' {Maybe HeatMapSortConfiguration
sortConfiguration :: Maybe HeatMapSortConfiguration
$sel:sortConfiguration:HeatMapConfiguration' :: HeatMapConfiguration -> Maybe HeatMapSortConfiguration
sortConfiguration} -> Maybe HeatMapSortConfiguration
sortConfiguration) (\s :: HeatMapConfiguration
s@HeatMapConfiguration' {} Maybe HeatMapSortConfiguration
a -> HeatMapConfiguration
s {$sel:sortConfiguration:HeatMapConfiguration' :: Maybe HeatMapSortConfiguration
sortConfiguration = Maybe HeatMapSortConfiguration
a} :: HeatMapConfiguration)

-- | The tooltip display setup of the visual.
heatMapConfiguration_tooltip :: Lens.Lens' HeatMapConfiguration (Prelude.Maybe TooltipOptions)
heatMapConfiguration_tooltip :: Lens' HeatMapConfiguration (Maybe TooltipOptions)
heatMapConfiguration_tooltip = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HeatMapConfiguration' {Maybe TooltipOptions
tooltip :: Maybe TooltipOptions
$sel:tooltip:HeatMapConfiguration' :: HeatMapConfiguration -> Maybe TooltipOptions
tooltip} -> Maybe TooltipOptions
tooltip) (\s :: HeatMapConfiguration
s@HeatMapConfiguration' {} Maybe TooltipOptions
a -> HeatMapConfiguration
s {$sel:tooltip:HeatMapConfiguration' :: Maybe TooltipOptions
tooltip = Maybe TooltipOptions
a} :: HeatMapConfiguration)

instance Data.FromJSON HeatMapConfiguration where
  parseJSON :: Value -> Parser HeatMapConfiguration
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"HeatMapConfiguration"
      ( \Object
x ->
          Maybe ColorScale
-> Maybe ChartAxisLabelOptions
-> Maybe DataLabelOptions
-> Maybe HeatMapFieldWells
-> Maybe LegendOptions
-> Maybe ChartAxisLabelOptions
-> Maybe HeatMapSortConfiguration
-> Maybe TooltipOptions
-> HeatMapConfiguration
HeatMapConfiguration'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"ColorScale")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"ColumnLabelOptions")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"DataLabels")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"FieldWells")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Legend")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"RowLabelOptions")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"SortConfiguration")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Tooltip")
      )

instance Prelude.Hashable HeatMapConfiguration where
  hashWithSalt :: Int -> HeatMapConfiguration -> Int
hashWithSalt Int
_salt HeatMapConfiguration' {Maybe ColorScale
Maybe HeatMapSortConfiguration
Maybe HeatMapFieldWells
Maybe LegendOptions
Maybe DataLabelOptions
Maybe TooltipOptions
Maybe ChartAxisLabelOptions
tooltip :: Maybe TooltipOptions
sortConfiguration :: Maybe HeatMapSortConfiguration
rowLabelOptions :: Maybe ChartAxisLabelOptions
legend :: Maybe LegendOptions
fieldWells :: Maybe HeatMapFieldWells
dataLabels :: Maybe DataLabelOptions
columnLabelOptions :: Maybe ChartAxisLabelOptions
colorScale :: Maybe ColorScale
$sel:tooltip:HeatMapConfiguration' :: HeatMapConfiguration -> Maybe TooltipOptions
$sel:sortConfiguration:HeatMapConfiguration' :: HeatMapConfiguration -> Maybe HeatMapSortConfiguration
$sel:rowLabelOptions:HeatMapConfiguration' :: HeatMapConfiguration -> Maybe ChartAxisLabelOptions
$sel:legend:HeatMapConfiguration' :: HeatMapConfiguration -> Maybe LegendOptions
$sel:fieldWells:HeatMapConfiguration' :: HeatMapConfiguration -> Maybe HeatMapFieldWells
$sel:dataLabels:HeatMapConfiguration' :: HeatMapConfiguration -> Maybe DataLabelOptions
$sel:columnLabelOptions:HeatMapConfiguration' :: HeatMapConfiguration -> Maybe ChartAxisLabelOptions
$sel:colorScale:HeatMapConfiguration' :: HeatMapConfiguration -> Maybe ColorScale
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ColorScale
colorScale
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ChartAxisLabelOptions
columnLabelOptions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DataLabelOptions
dataLabels
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HeatMapFieldWells
fieldWells
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LegendOptions
legend
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ChartAxisLabelOptions
rowLabelOptions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HeatMapSortConfiguration
sortConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TooltipOptions
tooltip

instance Prelude.NFData HeatMapConfiguration where
  rnf :: HeatMapConfiguration -> ()
rnf HeatMapConfiguration' {Maybe ColorScale
Maybe HeatMapSortConfiguration
Maybe HeatMapFieldWells
Maybe LegendOptions
Maybe DataLabelOptions
Maybe TooltipOptions
Maybe ChartAxisLabelOptions
tooltip :: Maybe TooltipOptions
sortConfiguration :: Maybe HeatMapSortConfiguration
rowLabelOptions :: Maybe ChartAxisLabelOptions
legend :: Maybe LegendOptions
fieldWells :: Maybe HeatMapFieldWells
dataLabels :: Maybe DataLabelOptions
columnLabelOptions :: Maybe ChartAxisLabelOptions
colorScale :: Maybe ColorScale
$sel:tooltip:HeatMapConfiguration' :: HeatMapConfiguration -> Maybe TooltipOptions
$sel:sortConfiguration:HeatMapConfiguration' :: HeatMapConfiguration -> Maybe HeatMapSortConfiguration
$sel:rowLabelOptions:HeatMapConfiguration' :: HeatMapConfiguration -> Maybe ChartAxisLabelOptions
$sel:legend:HeatMapConfiguration' :: HeatMapConfiguration -> Maybe LegendOptions
$sel:fieldWells:HeatMapConfiguration' :: HeatMapConfiguration -> Maybe HeatMapFieldWells
$sel:dataLabels:HeatMapConfiguration' :: HeatMapConfiguration -> Maybe DataLabelOptions
$sel:columnLabelOptions:HeatMapConfiguration' :: HeatMapConfiguration -> Maybe ChartAxisLabelOptions
$sel:colorScale:HeatMapConfiguration' :: HeatMapConfiguration -> Maybe ColorScale
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ColorScale
colorScale
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ChartAxisLabelOptions
columnLabelOptions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DataLabelOptions
dataLabels
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe HeatMapFieldWells
fieldWells
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LegendOptions
legend
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ChartAxisLabelOptions
rowLabelOptions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe HeatMapSortConfiguration
sortConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TooltipOptions
tooltip

instance Data.ToJSON HeatMapConfiguration where
  toJSON :: HeatMapConfiguration -> Value
toJSON HeatMapConfiguration' {Maybe ColorScale
Maybe HeatMapSortConfiguration
Maybe HeatMapFieldWells
Maybe LegendOptions
Maybe DataLabelOptions
Maybe TooltipOptions
Maybe ChartAxisLabelOptions
tooltip :: Maybe TooltipOptions
sortConfiguration :: Maybe HeatMapSortConfiguration
rowLabelOptions :: Maybe ChartAxisLabelOptions
legend :: Maybe LegendOptions
fieldWells :: Maybe HeatMapFieldWells
dataLabels :: Maybe DataLabelOptions
columnLabelOptions :: Maybe ChartAxisLabelOptions
colorScale :: Maybe ColorScale
$sel:tooltip:HeatMapConfiguration' :: HeatMapConfiguration -> Maybe TooltipOptions
$sel:sortConfiguration:HeatMapConfiguration' :: HeatMapConfiguration -> Maybe HeatMapSortConfiguration
$sel:rowLabelOptions:HeatMapConfiguration' :: HeatMapConfiguration -> Maybe ChartAxisLabelOptions
$sel:legend:HeatMapConfiguration' :: HeatMapConfiguration -> Maybe LegendOptions
$sel:fieldWells:HeatMapConfiguration' :: HeatMapConfiguration -> Maybe HeatMapFieldWells
$sel:dataLabels:HeatMapConfiguration' :: HeatMapConfiguration -> Maybe DataLabelOptions
$sel:columnLabelOptions:HeatMapConfiguration' :: HeatMapConfiguration -> Maybe ChartAxisLabelOptions
$sel:colorScale:HeatMapConfiguration' :: HeatMapConfiguration -> Maybe ColorScale
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ColorScale" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe ColorScale
colorScale,
            (Key
"ColumnLabelOptions" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe ChartAxisLabelOptions
columnLabelOptions,
            (Key
"DataLabels" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe DataLabelOptions
dataLabels,
            (Key
"FieldWells" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe HeatMapFieldWells
fieldWells,
            (Key
"Legend" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe LegendOptions
legend,
            (Key
"RowLabelOptions" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe ChartAxisLabelOptions
rowLabelOptions,
            (Key
"SortConfiguration" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe HeatMapSortConfiguration
sortConfiguration,
            (Key
"Tooltip" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe TooltipOptions
tooltip
          ]
      )