{-# 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.TableCellStyle
-- 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.TableCellStyle 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.FontConfiguration
import Amazonka.QuickSight.Types.GlobalTableBorderOptions
import Amazonka.QuickSight.Types.HorizontalTextAlignment
import Amazonka.QuickSight.Types.TextWrap
import Amazonka.QuickSight.Types.VerticalTextAlignment
import Amazonka.QuickSight.Types.Visibility

-- | The table cell style for a cell in pivot table or table visual.
--
-- /See:/ 'newTableCellStyle' smart constructor.
data TableCellStyle = TableCellStyle'
  { -- | The background color for the table cells.
    TableCellStyle -> Maybe Text
backgroundColor :: Prelude.Maybe Prelude.Text,
    -- | The borders for the table cells.
    TableCellStyle -> Maybe GlobalTableBorderOptions
border :: Prelude.Maybe GlobalTableBorderOptions,
    -- | The font configuration of the table cells.
    TableCellStyle -> Maybe FontConfiguration
fontConfiguration :: Prelude.Maybe FontConfiguration,
    -- | The height color for the table cells.
    TableCellStyle -> Maybe Natural
height :: Prelude.Maybe Prelude.Natural,
    -- | The horizontal text alignment (left, center, right, auto) for the table
    -- cells.
    TableCellStyle -> Maybe HorizontalTextAlignment
horizontalTextAlignment :: Prelude.Maybe HorizontalTextAlignment,
    -- | The text wrap (none, wrap) for the table cells.
    TableCellStyle -> Maybe TextWrap
textWrap :: Prelude.Maybe TextWrap,
    -- | The vertical text alignment (top, middle, bottom) for the table cells.
    TableCellStyle -> Maybe VerticalTextAlignment
verticalTextAlignment :: Prelude.Maybe VerticalTextAlignment,
    -- | The visibility of the table cells.
    TableCellStyle -> Maybe Visibility
visibility :: Prelude.Maybe Visibility
  }
  deriving (TableCellStyle -> TableCellStyle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TableCellStyle -> TableCellStyle -> Bool
$c/= :: TableCellStyle -> TableCellStyle -> Bool
== :: TableCellStyle -> TableCellStyle -> Bool
$c== :: TableCellStyle -> TableCellStyle -> Bool
Prelude.Eq, ReadPrec [TableCellStyle]
ReadPrec TableCellStyle
Int -> ReadS TableCellStyle
ReadS [TableCellStyle]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TableCellStyle]
$creadListPrec :: ReadPrec [TableCellStyle]
readPrec :: ReadPrec TableCellStyle
$creadPrec :: ReadPrec TableCellStyle
readList :: ReadS [TableCellStyle]
$creadList :: ReadS [TableCellStyle]
readsPrec :: Int -> ReadS TableCellStyle
$creadsPrec :: Int -> ReadS TableCellStyle
Prelude.Read, Int -> TableCellStyle -> ShowS
[TableCellStyle] -> ShowS
TableCellStyle -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TableCellStyle] -> ShowS
$cshowList :: [TableCellStyle] -> ShowS
show :: TableCellStyle -> String
$cshow :: TableCellStyle -> String
showsPrec :: Int -> TableCellStyle -> ShowS
$cshowsPrec :: Int -> TableCellStyle -> ShowS
Prelude.Show, forall x. Rep TableCellStyle x -> TableCellStyle
forall x. TableCellStyle -> Rep TableCellStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TableCellStyle x -> TableCellStyle
$cfrom :: forall x. TableCellStyle -> Rep TableCellStyle x
Prelude.Generic)

-- |
-- Create a value of 'TableCellStyle' 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:
--
-- 'backgroundColor', 'tableCellStyle_backgroundColor' - The background color for the table cells.
--
-- 'border', 'tableCellStyle_border' - The borders for the table cells.
--
-- 'fontConfiguration', 'tableCellStyle_fontConfiguration' - The font configuration of the table cells.
--
-- 'height', 'tableCellStyle_height' - The height color for the table cells.
--
-- 'horizontalTextAlignment', 'tableCellStyle_horizontalTextAlignment' - The horizontal text alignment (left, center, right, auto) for the table
-- cells.
--
-- 'textWrap', 'tableCellStyle_textWrap' - The text wrap (none, wrap) for the table cells.
--
-- 'verticalTextAlignment', 'tableCellStyle_verticalTextAlignment' - The vertical text alignment (top, middle, bottom) for the table cells.
--
-- 'visibility', 'tableCellStyle_visibility' - The visibility of the table cells.
newTableCellStyle ::
  TableCellStyle
newTableCellStyle :: TableCellStyle
newTableCellStyle =
  TableCellStyle'
    { $sel:backgroundColor:TableCellStyle' :: Maybe Text
backgroundColor = forall a. Maybe a
Prelude.Nothing,
      $sel:border:TableCellStyle' :: Maybe GlobalTableBorderOptions
border = forall a. Maybe a
Prelude.Nothing,
      $sel:fontConfiguration:TableCellStyle' :: Maybe FontConfiguration
fontConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:height:TableCellStyle' :: Maybe Natural
height = forall a. Maybe a
Prelude.Nothing,
      $sel:horizontalTextAlignment:TableCellStyle' :: Maybe HorizontalTextAlignment
horizontalTextAlignment = forall a. Maybe a
Prelude.Nothing,
      $sel:textWrap:TableCellStyle' :: Maybe TextWrap
textWrap = forall a. Maybe a
Prelude.Nothing,
      $sel:verticalTextAlignment:TableCellStyle' :: Maybe VerticalTextAlignment
verticalTextAlignment = forall a. Maybe a
Prelude.Nothing,
      $sel:visibility:TableCellStyle' :: Maybe Visibility
visibility = forall a. Maybe a
Prelude.Nothing
    }

-- | The background color for the table cells.
tableCellStyle_backgroundColor :: Lens.Lens' TableCellStyle (Prelude.Maybe Prelude.Text)
tableCellStyle_backgroundColor :: Lens' TableCellStyle (Maybe Text)
tableCellStyle_backgroundColor = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TableCellStyle' {Maybe Text
backgroundColor :: Maybe Text
$sel:backgroundColor:TableCellStyle' :: TableCellStyle -> Maybe Text
backgroundColor} -> Maybe Text
backgroundColor) (\s :: TableCellStyle
s@TableCellStyle' {} Maybe Text
a -> TableCellStyle
s {$sel:backgroundColor:TableCellStyle' :: Maybe Text
backgroundColor = Maybe Text
a} :: TableCellStyle)

-- | The borders for the table cells.
tableCellStyle_border :: Lens.Lens' TableCellStyle (Prelude.Maybe GlobalTableBorderOptions)
tableCellStyle_border :: Lens' TableCellStyle (Maybe GlobalTableBorderOptions)
tableCellStyle_border = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TableCellStyle' {Maybe GlobalTableBorderOptions
border :: Maybe GlobalTableBorderOptions
$sel:border:TableCellStyle' :: TableCellStyle -> Maybe GlobalTableBorderOptions
border} -> Maybe GlobalTableBorderOptions
border) (\s :: TableCellStyle
s@TableCellStyle' {} Maybe GlobalTableBorderOptions
a -> TableCellStyle
s {$sel:border:TableCellStyle' :: Maybe GlobalTableBorderOptions
border = Maybe GlobalTableBorderOptions
a} :: TableCellStyle)

-- | The font configuration of the table cells.
tableCellStyle_fontConfiguration :: Lens.Lens' TableCellStyle (Prelude.Maybe FontConfiguration)
tableCellStyle_fontConfiguration :: Lens' TableCellStyle (Maybe FontConfiguration)
tableCellStyle_fontConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TableCellStyle' {Maybe FontConfiguration
fontConfiguration :: Maybe FontConfiguration
$sel:fontConfiguration:TableCellStyle' :: TableCellStyle -> Maybe FontConfiguration
fontConfiguration} -> Maybe FontConfiguration
fontConfiguration) (\s :: TableCellStyle
s@TableCellStyle' {} Maybe FontConfiguration
a -> TableCellStyle
s {$sel:fontConfiguration:TableCellStyle' :: Maybe FontConfiguration
fontConfiguration = Maybe FontConfiguration
a} :: TableCellStyle)

-- | The height color for the table cells.
tableCellStyle_height :: Lens.Lens' TableCellStyle (Prelude.Maybe Prelude.Natural)
tableCellStyle_height :: Lens' TableCellStyle (Maybe Natural)
tableCellStyle_height = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TableCellStyle' {Maybe Natural
height :: Maybe Natural
$sel:height:TableCellStyle' :: TableCellStyle -> Maybe Natural
height} -> Maybe Natural
height) (\s :: TableCellStyle
s@TableCellStyle' {} Maybe Natural
a -> TableCellStyle
s {$sel:height:TableCellStyle' :: Maybe Natural
height = Maybe Natural
a} :: TableCellStyle)

-- | The horizontal text alignment (left, center, right, auto) for the table
-- cells.
tableCellStyle_horizontalTextAlignment :: Lens.Lens' TableCellStyle (Prelude.Maybe HorizontalTextAlignment)
tableCellStyle_horizontalTextAlignment :: Lens' TableCellStyle (Maybe HorizontalTextAlignment)
tableCellStyle_horizontalTextAlignment = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TableCellStyle' {Maybe HorizontalTextAlignment
horizontalTextAlignment :: Maybe HorizontalTextAlignment
$sel:horizontalTextAlignment:TableCellStyle' :: TableCellStyle -> Maybe HorizontalTextAlignment
horizontalTextAlignment} -> Maybe HorizontalTextAlignment
horizontalTextAlignment) (\s :: TableCellStyle
s@TableCellStyle' {} Maybe HorizontalTextAlignment
a -> TableCellStyle
s {$sel:horizontalTextAlignment:TableCellStyle' :: Maybe HorizontalTextAlignment
horizontalTextAlignment = Maybe HorizontalTextAlignment
a} :: TableCellStyle)

-- | The text wrap (none, wrap) for the table cells.
tableCellStyle_textWrap :: Lens.Lens' TableCellStyle (Prelude.Maybe TextWrap)
tableCellStyle_textWrap :: Lens' TableCellStyle (Maybe TextWrap)
tableCellStyle_textWrap = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TableCellStyle' {Maybe TextWrap
textWrap :: Maybe TextWrap
$sel:textWrap:TableCellStyle' :: TableCellStyle -> Maybe TextWrap
textWrap} -> Maybe TextWrap
textWrap) (\s :: TableCellStyle
s@TableCellStyle' {} Maybe TextWrap
a -> TableCellStyle
s {$sel:textWrap:TableCellStyle' :: Maybe TextWrap
textWrap = Maybe TextWrap
a} :: TableCellStyle)

-- | The vertical text alignment (top, middle, bottom) for the table cells.
tableCellStyle_verticalTextAlignment :: Lens.Lens' TableCellStyle (Prelude.Maybe VerticalTextAlignment)
tableCellStyle_verticalTextAlignment :: Lens' TableCellStyle (Maybe VerticalTextAlignment)
tableCellStyle_verticalTextAlignment = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TableCellStyle' {Maybe VerticalTextAlignment
verticalTextAlignment :: Maybe VerticalTextAlignment
$sel:verticalTextAlignment:TableCellStyle' :: TableCellStyle -> Maybe VerticalTextAlignment
verticalTextAlignment} -> Maybe VerticalTextAlignment
verticalTextAlignment) (\s :: TableCellStyle
s@TableCellStyle' {} Maybe VerticalTextAlignment
a -> TableCellStyle
s {$sel:verticalTextAlignment:TableCellStyle' :: Maybe VerticalTextAlignment
verticalTextAlignment = Maybe VerticalTextAlignment
a} :: TableCellStyle)

-- | The visibility of the table cells.
tableCellStyle_visibility :: Lens.Lens' TableCellStyle (Prelude.Maybe Visibility)
tableCellStyle_visibility :: Lens' TableCellStyle (Maybe Visibility)
tableCellStyle_visibility = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TableCellStyle' {Maybe Visibility
visibility :: Maybe Visibility
$sel:visibility:TableCellStyle' :: TableCellStyle -> Maybe Visibility
visibility} -> Maybe Visibility
visibility) (\s :: TableCellStyle
s@TableCellStyle' {} Maybe Visibility
a -> TableCellStyle
s {$sel:visibility:TableCellStyle' :: Maybe Visibility
visibility = Maybe Visibility
a} :: TableCellStyle)

instance Data.FromJSON TableCellStyle where
  parseJSON :: Value -> Parser TableCellStyle
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"TableCellStyle"
      ( \Object
x ->
          Maybe Text
-> Maybe GlobalTableBorderOptions
-> Maybe FontConfiguration
-> Maybe Natural
-> Maybe HorizontalTextAlignment
-> Maybe TextWrap
-> Maybe VerticalTextAlignment
-> Maybe Visibility
-> TableCellStyle
TableCellStyle'
            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
"BackgroundColor")
            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
"Border")
            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
"FontConfiguration")
            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
"Height")
            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
"HorizontalTextAlignment")
            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
"TextWrap")
            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
"VerticalTextAlignment")
            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
"Visibility")
      )

instance Prelude.Hashable TableCellStyle where
  hashWithSalt :: Int -> TableCellStyle -> Int
hashWithSalt Int
_salt TableCellStyle' {Maybe Natural
Maybe Text
Maybe HorizontalTextAlignment
Maybe FontConfiguration
Maybe GlobalTableBorderOptions
Maybe TextWrap
Maybe VerticalTextAlignment
Maybe Visibility
visibility :: Maybe Visibility
verticalTextAlignment :: Maybe VerticalTextAlignment
textWrap :: Maybe TextWrap
horizontalTextAlignment :: Maybe HorizontalTextAlignment
height :: Maybe Natural
fontConfiguration :: Maybe FontConfiguration
border :: Maybe GlobalTableBorderOptions
backgroundColor :: Maybe Text
$sel:visibility:TableCellStyle' :: TableCellStyle -> Maybe Visibility
$sel:verticalTextAlignment:TableCellStyle' :: TableCellStyle -> Maybe VerticalTextAlignment
$sel:textWrap:TableCellStyle' :: TableCellStyle -> Maybe TextWrap
$sel:horizontalTextAlignment:TableCellStyle' :: TableCellStyle -> Maybe HorizontalTextAlignment
$sel:height:TableCellStyle' :: TableCellStyle -> Maybe Natural
$sel:fontConfiguration:TableCellStyle' :: TableCellStyle -> Maybe FontConfiguration
$sel:border:TableCellStyle' :: TableCellStyle -> Maybe GlobalTableBorderOptions
$sel:backgroundColor:TableCellStyle' :: TableCellStyle -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
backgroundColor
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe GlobalTableBorderOptions
border
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe FontConfiguration
fontConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
height
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HorizontalTextAlignment
horizontalTextAlignment
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TextWrap
textWrap
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe VerticalTextAlignment
verticalTextAlignment
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Visibility
visibility

instance Prelude.NFData TableCellStyle where
  rnf :: TableCellStyle -> ()
rnf TableCellStyle' {Maybe Natural
Maybe Text
Maybe HorizontalTextAlignment
Maybe FontConfiguration
Maybe GlobalTableBorderOptions
Maybe TextWrap
Maybe VerticalTextAlignment
Maybe Visibility
visibility :: Maybe Visibility
verticalTextAlignment :: Maybe VerticalTextAlignment
textWrap :: Maybe TextWrap
horizontalTextAlignment :: Maybe HorizontalTextAlignment
height :: Maybe Natural
fontConfiguration :: Maybe FontConfiguration
border :: Maybe GlobalTableBorderOptions
backgroundColor :: Maybe Text
$sel:visibility:TableCellStyle' :: TableCellStyle -> Maybe Visibility
$sel:verticalTextAlignment:TableCellStyle' :: TableCellStyle -> Maybe VerticalTextAlignment
$sel:textWrap:TableCellStyle' :: TableCellStyle -> Maybe TextWrap
$sel:horizontalTextAlignment:TableCellStyle' :: TableCellStyle -> Maybe HorizontalTextAlignment
$sel:height:TableCellStyle' :: TableCellStyle -> Maybe Natural
$sel:fontConfiguration:TableCellStyle' :: TableCellStyle -> Maybe FontConfiguration
$sel:border:TableCellStyle' :: TableCellStyle -> Maybe GlobalTableBorderOptions
$sel:backgroundColor:TableCellStyle' :: TableCellStyle -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
backgroundColor
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe GlobalTableBorderOptions
border
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe FontConfiguration
fontConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
height
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe HorizontalTextAlignment
horizontalTextAlignment
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TextWrap
textWrap
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe VerticalTextAlignment
verticalTextAlignment
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Visibility
visibility

instance Data.ToJSON TableCellStyle where
  toJSON :: TableCellStyle -> Value
toJSON TableCellStyle' {Maybe Natural
Maybe Text
Maybe HorizontalTextAlignment
Maybe FontConfiguration
Maybe GlobalTableBorderOptions
Maybe TextWrap
Maybe VerticalTextAlignment
Maybe Visibility
visibility :: Maybe Visibility
verticalTextAlignment :: Maybe VerticalTextAlignment
textWrap :: Maybe TextWrap
horizontalTextAlignment :: Maybe HorizontalTextAlignment
height :: Maybe Natural
fontConfiguration :: Maybe FontConfiguration
border :: Maybe GlobalTableBorderOptions
backgroundColor :: Maybe Text
$sel:visibility:TableCellStyle' :: TableCellStyle -> Maybe Visibility
$sel:verticalTextAlignment:TableCellStyle' :: TableCellStyle -> Maybe VerticalTextAlignment
$sel:textWrap:TableCellStyle' :: TableCellStyle -> Maybe TextWrap
$sel:horizontalTextAlignment:TableCellStyle' :: TableCellStyle -> Maybe HorizontalTextAlignment
$sel:height:TableCellStyle' :: TableCellStyle -> Maybe Natural
$sel:fontConfiguration:TableCellStyle' :: TableCellStyle -> Maybe FontConfiguration
$sel:border:TableCellStyle' :: TableCellStyle -> Maybe GlobalTableBorderOptions
$sel:backgroundColor:TableCellStyle' :: TableCellStyle -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"BackgroundColor" 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
backgroundColor,
            (Key
"Border" 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 GlobalTableBorderOptions
border,
            (Key
"FontConfiguration" 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 FontConfiguration
fontConfiguration,
            (Key
"Height" 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 Natural
height,
            (Key
"HorizontalTextAlignment" 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 HorizontalTextAlignment
horizontalTextAlignment,
            (Key
"TextWrap" 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 TextWrap
textWrap,
            (Key
"VerticalTextAlignment" 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 VerticalTextAlignment
verticalTextAlignment,
            (Key
"Visibility" 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
visibility
          ]
      )