{-# 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.PivotTotalOptions
-- 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.PivotTotalOptions 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.TableCellStyle
import Amazonka.QuickSight.Types.TableTotalsPlacement
import Amazonka.QuickSight.Types.TableTotalsScrollStatus
import Amazonka.QuickSight.Types.Visibility

-- | The optional configuration of totals cells in a @PivotTableVisual@.
--
-- /See:/ 'newPivotTotalOptions' smart constructor.
data PivotTotalOptions = PivotTotalOptions'
  { -- | The custom label string for the total cells.
    PivotTotalOptions -> Maybe Text
customLabel :: Prelude.Maybe Prelude.Text,
    -- | The cell styling options for the total of header cells.
    PivotTotalOptions -> Maybe TableCellStyle
metricHeaderCellStyle :: Prelude.Maybe TableCellStyle,
    -- | The placement (start, end) for the total cells.
    PivotTotalOptions -> Maybe TableTotalsPlacement
placement :: Prelude.Maybe TableTotalsPlacement,
    -- | The scroll status (pinned, scrolled) for the total cells.
    PivotTotalOptions -> Maybe TableTotalsScrollStatus
scrollStatus :: Prelude.Maybe TableTotalsScrollStatus,
    -- | The cell styling options for the total cells.
    PivotTotalOptions -> Maybe TableCellStyle
totalCellStyle :: Prelude.Maybe TableCellStyle,
    -- | The visibility configuration for the total cells.
    PivotTotalOptions -> Maybe Visibility
totalsVisibility :: Prelude.Maybe Visibility,
    -- | The cell styling options for the totals of value cells.
    PivotTotalOptions -> Maybe TableCellStyle
valueCellStyle :: Prelude.Maybe TableCellStyle
  }
  deriving (PivotTotalOptions -> PivotTotalOptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PivotTotalOptions -> PivotTotalOptions -> Bool
$c/= :: PivotTotalOptions -> PivotTotalOptions -> Bool
== :: PivotTotalOptions -> PivotTotalOptions -> Bool
$c== :: PivotTotalOptions -> PivotTotalOptions -> Bool
Prelude.Eq, ReadPrec [PivotTotalOptions]
ReadPrec PivotTotalOptions
Int -> ReadS PivotTotalOptions
ReadS [PivotTotalOptions]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PivotTotalOptions]
$creadListPrec :: ReadPrec [PivotTotalOptions]
readPrec :: ReadPrec PivotTotalOptions
$creadPrec :: ReadPrec PivotTotalOptions
readList :: ReadS [PivotTotalOptions]
$creadList :: ReadS [PivotTotalOptions]
readsPrec :: Int -> ReadS PivotTotalOptions
$creadsPrec :: Int -> ReadS PivotTotalOptions
Prelude.Read, Int -> PivotTotalOptions -> ShowS
[PivotTotalOptions] -> ShowS
PivotTotalOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PivotTotalOptions] -> ShowS
$cshowList :: [PivotTotalOptions] -> ShowS
show :: PivotTotalOptions -> String
$cshow :: PivotTotalOptions -> String
showsPrec :: Int -> PivotTotalOptions -> ShowS
$cshowsPrec :: Int -> PivotTotalOptions -> ShowS
Prelude.Show, forall x. Rep PivotTotalOptions x -> PivotTotalOptions
forall x. PivotTotalOptions -> Rep PivotTotalOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PivotTotalOptions x -> PivotTotalOptions
$cfrom :: forall x. PivotTotalOptions -> Rep PivotTotalOptions x
Prelude.Generic)

-- |
-- Create a value of 'PivotTotalOptions' 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:
--
-- 'customLabel', 'pivotTotalOptions_customLabel' - The custom label string for the total cells.
--
-- 'metricHeaderCellStyle', 'pivotTotalOptions_metricHeaderCellStyle' - The cell styling options for the total of header cells.
--
-- 'placement', 'pivotTotalOptions_placement' - The placement (start, end) for the total cells.
--
-- 'scrollStatus', 'pivotTotalOptions_scrollStatus' - The scroll status (pinned, scrolled) for the total cells.
--
-- 'totalCellStyle', 'pivotTotalOptions_totalCellStyle' - The cell styling options for the total cells.
--
-- 'totalsVisibility', 'pivotTotalOptions_totalsVisibility' - The visibility configuration for the total cells.
--
-- 'valueCellStyle', 'pivotTotalOptions_valueCellStyle' - The cell styling options for the totals of value cells.
newPivotTotalOptions ::
  PivotTotalOptions
newPivotTotalOptions :: PivotTotalOptions
newPivotTotalOptions =
  PivotTotalOptions'
    { $sel:customLabel:PivotTotalOptions' :: Maybe Text
customLabel = forall a. Maybe a
Prelude.Nothing,
      $sel:metricHeaderCellStyle:PivotTotalOptions' :: Maybe TableCellStyle
metricHeaderCellStyle = forall a. Maybe a
Prelude.Nothing,
      $sel:placement:PivotTotalOptions' :: Maybe TableTotalsPlacement
placement = forall a. Maybe a
Prelude.Nothing,
      $sel:scrollStatus:PivotTotalOptions' :: Maybe TableTotalsScrollStatus
scrollStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:totalCellStyle:PivotTotalOptions' :: Maybe TableCellStyle
totalCellStyle = forall a. Maybe a
Prelude.Nothing,
      $sel:totalsVisibility:PivotTotalOptions' :: Maybe Visibility
totalsVisibility = forall a. Maybe a
Prelude.Nothing,
      $sel:valueCellStyle:PivotTotalOptions' :: Maybe TableCellStyle
valueCellStyle = forall a. Maybe a
Prelude.Nothing
    }

-- | The custom label string for the total cells.
pivotTotalOptions_customLabel :: Lens.Lens' PivotTotalOptions (Prelude.Maybe Prelude.Text)
pivotTotalOptions_customLabel :: Lens' PivotTotalOptions (Maybe Text)
pivotTotalOptions_customLabel = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PivotTotalOptions' {Maybe Text
customLabel :: Maybe Text
$sel:customLabel:PivotTotalOptions' :: PivotTotalOptions -> Maybe Text
customLabel} -> Maybe Text
customLabel) (\s :: PivotTotalOptions
s@PivotTotalOptions' {} Maybe Text
a -> PivotTotalOptions
s {$sel:customLabel:PivotTotalOptions' :: Maybe Text
customLabel = Maybe Text
a} :: PivotTotalOptions)

-- | The cell styling options for the total of header cells.
pivotTotalOptions_metricHeaderCellStyle :: Lens.Lens' PivotTotalOptions (Prelude.Maybe TableCellStyle)
pivotTotalOptions_metricHeaderCellStyle :: Lens' PivotTotalOptions (Maybe TableCellStyle)
pivotTotalOptions_metricHeaderCellStyle = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PivotTotalOptions' {Maybe TableCellStyle
metricHeaderCellStyle :: Maybe TableCellStyle
$sel:metricHeaderCellStyle:PivotTotalOptions' :: PivotTotalOptions -> Maybe TableCellStyle
metricHeaderCellStyle} -> Maybe TableCellStyle
metricHeaderCellStyle) (\s :: PivotTotalOptions
s@PivotTotalOptions' {} Maybe TableCellStyle
a -> PivotTotalOptions
s {$sel:metricHeaderCellStyle:PivotTotalOptions' :: Maybe TableCellStyle
metricHeaderCellStyle = Maybe TableCellStyle
a} :: PivotTotalOptions)

-- | The placement (start, end) for the total cells.
pivotTotalOptions_placement :: Lens.Lens' PivotTotalOptions (Prelude.Maybe TableTotalsPlacement)
pivotTotalOptions_placement :: Lens' PivotTotalOptions (Maybe TableTotalsPlacement)
pivotTotalOptions_placement = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PivotTotalOptions' {Maybe TableTotalsPlacement
placement :: Maybe TableTotalsPlacement
$sel:placement:PivotTotalOptions' :: PivotTotalOptions -> Maybe TableTotalsPlacement
placement} -> Maybe TableTotalsPlacement
placement) (\s :: PivotTotalOptions
s@PivotTotalOptions' {} Maybe TableTotalsPlacement
a -> PivotTotalOptions
s {$sel:placement:PivotTotalOptions' :: Maybe TableTotalsPlacement
placement = Maybe TableTotalsPlacement
a} :: PivotTotalOptions)

-- | The scroll status (pinned, scrolled) for the total cells.
pivotTotalOptions_scrollStatus :: Lens.Lens' PivotTotalOptions (Prelude.Maybe TableTotalsScrollStatus)
pivotTotalOptions_scrollStatus :: Lens' PivotTotalOptions (Maybe TableTotalsScrollStatus)
pivotTotalOptions_scrollStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PivotTotalOptions' {Maybe TableTotalsScrollStatus
scrollStatus :: Maybe TableTotalsScrollStatus
$sel:scrollStatus:PivotTotalOptions' :: PivotTotalOptions -> Maybe TableTotalsScrollStatus
scrollStatus} -> Maybe TableTotalsScrollStatus
scrollStatus) (\s :: PivotTotalOptions
s@PivotTotalOptions' {} Maybe TableTotalsScrollStatus
a -> PivotTotalOptions
s {$sel:scrollStatus:PivotTotalOptions' :: Maybe TableTotalsScrollStatus
scrollStatus = Maybe TableTotalsScrollStatus
a} :: PivotTotalOptions)

-- | The cell styling options for the total cells.
pivotTotalOptions_totalCellStyle :: Lens.Lens' PivotTotalOptions (Prelude.Maybe TableCellStyle)
pivotTotalOptions_totalCellStyle :: Lens' PivotTotalOptions (Maybe TableCellStyle)
pivotTotalOptions_totalCellStyle = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PivotTotalOptions' {Maybe TableCellStyle
totalCellStyle :: Maybe TableCellStyle
$sel:totalCellStyle:PivotTotalOptions' :: PivotTotalOptions -> Maybe TableCellStyle
totalCellStyle} -> Maybe TableCellStyle
totalCellStyle) (\s :: PivotTotalOptions
s@PivotTotalOptions' {} Maybe TableCellStyle
a -> PivotTotalOptions
s {$sel:totalCellStyle:PivotTotalOptions' :: Maybe TableCellStyle
totalCellStyle = Maybe TableCellStyle
a} :: PivotTotalOptions)

-- | The visibility configuration for the total cells.
pivotTotalOptions_totalsVisibility :: Lens.Lens' PivotTotalOptions (Prelude.Maybe Visibility)
pivotTotalOptions_totalsVisibility :: Lens' PivotTotalOptions (Maybe Visibility)
pivotTotalOptions_totalsVisibility = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PivotTotalOptions' {Maybe Visibility
totalsVisibility :: Maybe Visibility
$sel:totalsVisibility:PivotTotalOptions' :: PivotTotalOptions -> Maybe Visibility
totalsVisibility} -> Maybe Visibility
totalsVisibility) (\s :: PivotTotalOptions
s@PivotTotalOptions' {} Maybe Visibility
a -> PivotTotalOptions
s {$sel:totalsVisibility:PivotTotalOptions' :: Maybe Visibility
totalsVisibility = Maybe Visibility
a} :: PivotTotalOptions)

-- | The cell styling options for the totals of value cells.
pivotTotalOptions_valueCellStyle :: Lens.Lens' PivotTotalOptions (Prelude.Maybe TableCellStyle)
pivotTotalOptions_valueCellStyle :: Lens' PivotTotalOptions (Maybe TableCellStyle)
pivotTotalOptions_valueCellStyle = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PivotTotalOptions' {Maybe TableCellStyle
valueCellStyle :: Maybe TableCellStyle
$sel:valueCellStyle:PivotTotalOptions' :: PivotTotalOptions -> Maybe TableCellStyle
valueCellStyle} -> Maybe TableCellStyle
valueCellStyle) (\s :: PivotTotalOptions
s@PivotTotalOptions' {} Maybe TableCellStyle
a -> PivotTotalOptions
s {$sel:valueCellStyle:PivotTotalOptions' :: Maybe TableCellStyle
valueCellStyle = Maybe TableCellStyle
a} :: PivotTotalOptions)

instance Data.FromJSON PivotTotalOptions where
  parseJSON :: Value -> Parser PivotTotalOptions
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"PivotTotalOptions"
      ( \Object
x ->
          Maybe Text
-> Maybe TableCellStyle
-> Maybe TableTotalsPlacement
-> Maybe TableTotalsScrollStatus
-> Maybe TableCellStyle
-> Maybe Visibility
-> Maybe TableCellStyle
-> PivotTotalOptions
PivotTotalOptions'
            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
"CustomLabel")
            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
"MetricHeaderCellStyle")
            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
"Placement")
            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
"ScrollStatus")
            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
"TotalCellStyle")
            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
"TotalsVisibility")
            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
"ValueCellStyle")
      )

instance Prelude.Hashable PivotTotalOptions where
  hashWithSalt :: Int -> PivotTotalOptions -> Int
hashWithSalt Int
_salt PivotTotalOptions' {Maybe Text
Maybe TableTotalsPlacement
Maybe TableTotalsScrollStatus
Maybe Visibility
Maybe TableCellStyle
valueCellStyle :: Maybe TableCellStyle
totalsVisibility :: Maybe Visibility
totalCellStyle :: Maybe TableCellStyle
scrollStatus :: Maybe TableTotalsScrollStatus
placement :: Maybe TableTotalsPlacement
metricHeaderCellStyle :: Maybe TableCellStyle
customLabel :: Maybe Text
$sel:valueCellStyle:PivotTotalOptions' :: PivotTotalOptions -> Maybe TableCellStyle
$sel:totalsVisibility:PivotTotalOptions' :: PivotTotalOptions -> Maybe Visibility
$sel:totalCellStyle:PivotTotalOptions' :: PivotTotalOptions -> Maybe TableCellStyle
$sel:scrollStatus:PivotTotalOptions' :: PivotTotalOptions -> Maybe TableTotalsScrollStatus
$sel:placement:PivotTotalOptions' :: PivotTotalOptions -> Maybe TableTotalsPlacement
$sel:metricHeaderCellStyle:PivotTotalOptions' :: PivotTotalOptions -> Maybe TableCellStyle
$sel:customLabel:PivotTotalOptions' :: PivotTotalOptions -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
customLabel
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TableCellStyle
metricHeaderCellStyle
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TableTotalsPlacement
placement
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TableTotalsScrollStatus
scrollStatus
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TableCellStyle
totalCellStyle
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Visibility
totalsVisibility
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TableCellStyle
valueCellStyle

instance Prelude.NFData PivotTotalOptions where
  rnf :: PivotTotalOptions -> ()
rnf PivotTotalOptions' {Maybe Text
Maybe TableTotalsPlacement
Maybe TableTotalsScrollStatus
Maybe Visibility
Maybe TableCellStyle
valueCellStyle :: Maybe TableCellStyle
totalsVisibility :: Maybe Visibility
totalCellStyle :: Maybe TableCellStyle
scrollStatus :: Maybe TableTotalsScrollStatus
placement :: Maybe TableTotalsPlacement
metricHeaderCellStyle :: Maybe TableCellStyle
customLabel :: Maybe Text
$sel:valueCellStyle:PivotTotalOptions' :: PivotTotalOptions -> Maybe TableCellStyle
$sel:totalsVisibility:PivotTotalOptions' :: PivotTotalOptions -> Maybe Visibility
$sel:totalCellStyle:PivotTotalOptions' :: PivotTotalOptions -> Maybe TableCellStyle
$sel:scrollStatus:PivotTotalOptions' :: PivotTotalOptions -> Maybe TableTotalsScrollStatus
$sel:placement:PivotTotalOptions' :: PivotTotalOptions -> Maybe TableTotalsPlacement
$sel:metricHeaderCellStyle:PivotTotalOptions' :: PivotTotalOptions -> Maybe TableCellStyle
$sel:customLabel:PivotTotalOptions' :: PivotTotalOptions -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
customLabel
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TableCellStyle
metricHeaderCellStyle
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TableTotalsPlacement
placement
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TableTotalsScrollStatus
scrollStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TableCellStyle
totalCellStyle
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Visibility
totalsVisibility
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TableCellStyle
valueCellStyle

instance Data.ToJSON PivotTotalOptions where
  toJSON :: PivotTotalOptions -> Value
toJSON PivotTotalOptions' {Maybe Text
Maybe TableTotalsPlacement
Maybe TableTotalsScrollStatus
Maybe Visibility
Maybe TableCellStyle
valueCellStyle :: Maybe TableCellStyle
totalsVisibility :: Maybe Visibility
totalCellStyle :: Maybe TableCellStyle
scrollStatus :: Maybe TableTotalsScrollStatus
placement :: Maybe TableTotalsPlacement
metricHeaderCellStyle :: Maybe TableCellStyle
customLabel :: Maybe Text
$sel:valueCellStyle:PivotTotalOptions' :: PivotTotalOptions -> Maybe TableCellStyle
$sel:totalsVisibility:PivotTotalOptions' :: PivotTotalOptions -> Maybe Visibility
$sel:totalCellStyle:PivotTotalOptions' :: PivotTotalOptions -> Maybe TableCellStyle
$sel:scrollStatus:PivotTotalOptions' :: PivotTotalOptions -> Maybe TableTotalsScrollStatus
$sel:placement:PivotTotalOptions' :: PivotTotalOptions -> Maybe TableTotalsPlacement
$sel:metricHeaderCellStyle:PivotTotalOptions' :: PivotTotalOptions -> Maybe TableCellStyle
$sel:customLabel:PivotTotalOptions' :: PivotTotalOptions -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"CustomLabel" 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 Text
customLabel,
            (Key
"MetricHeaderCellStyle" 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 TableCellStyle
metricHeaderCellStyle,
            (Key
"Placement" 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 TableTotalsPlacement
placement,
            (Key
"ScrollStatus" 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 TableTotalsScrollStatus
scrollStatus,
            (Key
"TotalCellStyle" 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 TableCellStyle
totalCellStyle,
            (Key
"TotalsVisibility" 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 Visibility
totalsVisibility,
            (Key
"ValueCellStyle" 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 TableCellStyle
valueCellStyle
          ]
      )