{-# 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.PanelConfiguration
-- 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.PanelConfiguration 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.PanelBorderStyle
import Amazonka.QuickSight.Types.PanelTitleOptions
import Amazonka.QuickSight.Types.Visibility

-- | A collection of options that configure how each panel displays in a
-- small multiples chart.
--
-- /See:/ 'newPanelConfiguration' smart constructor.
data PanelConfiguration = PanelConfiguration'
  { -- | Sets the background color for each panel.
    PanelConfiguration -> Maybe Text
backgroundColor :: Prelude.Maybe Prelude.Text,
    -- | Determines whether or not a background for each small multiples panel is
    -- rendered.
    PanelConfiguration -> Maybe Visibility
backgroundVisibility :: Prelude.Maybe Visibility,
    -- | Sets the line color of panel borders.
    PanelConfiguration -> Maybe Text
borderColor :: Prelude.Maybe Prelude.Text,
    -- | Sets the line style of panel borders.
    PanelConfiguration -> Maybe PanelBorderStyle
borderStyle :: Prelude.Maybe PanelBorderStyle,
    -- | Sets the line thickness of panel borders.
    PanelConfiguration -> Maybe Text
borderThickness :: Prelude.Maybe Prelude.Text,
    -- | Determines whether or not each panel displays a border.
    PanelConfiguration -> Maybe Visibility
borderVisibility :: Prelude.Maybe Visibility,
    -- | Sets the total amount of negative space to display between sibling
    -- panels.
    PanelConfiguration -> Maybe Text
gutterSpacing :: Prelude.Maybe Prelude.Text,
    -- | Determines whether or not negative space between sibling panels is
    -- rendered.
    PanelConfiguration -> Maybe Visibility
gutterVisibility :: Prelude.Maybe Visibility,
    -- | Configures the title display within each small multiples panel.
    PanelConfiguration -> Maybe PanelTitleOptions
title :: Prelude.Maybe PanelTitleOptions
  }
  deriving (PanelConfiguration -> PanelConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PanelConfiguration -> PanelConfiguration -> Bool
$c/= :: PanelConfiguration -> PanelConfiguration -> Bool
== :: PanelConfiguration -> PanelConfiguration -> Bool
$c== :: PanelConfiguration -> PanelConfiguration -> Bool
Prelude.Eq, ReadPrec [PanelConfiguration]
ReadPrec PanelConfiguration
Int -> ReadS PanelConfiguration
ReadS [PanelConfiguration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PanelConfiguration]
$creadListPrec :: ReadPrec [PanelConfiguration]
readPrec :: ReadPrec PanelConfiguration
$creadPrec :: ReadPrec PanelConfiguration
readList :: ReadS [PanelConfiguration]
$creadList :: ReadS [PanelConfiguration]
readsPrec :: Int -> ReadS PanelConfiguration
$creadsPrec :: Int -> ReadS PanelConfiguration
Prelude.Read, Int -> PanelConfiguration -> ShowS
[PanelConfiguration] -> ShowS
PanelConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PanelConfiguration] -> ShowS
$cshowList :: [PanelConfiguration] -> ShowS
show :: PanelConfiguration -> String
$cshow :: PanelConfiguration -> String
showsPrec :: Int -> PanelConfiguration -> ShowS
$cshowsPrec :: Int -> PanelConfiguration -> ShowS
Prelude.Show, forall x. Rep PanelConfiguration x -> PanelConfiguration
forall x. PanelConfiguration -> Rep PanelConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PanelConfiguration x -> PanelConfiguration
$cfrom :: forall x. PanelConfiguration -> Rep PanelConfiguration x
Prelude.Generic)

-- |
-- Create a value of 'PanelConfiguration' 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', 'panelConfiguration_backgroundColor' - Sets the background color for each panel.
--
-- 'backgroundVisibility', 'panelConfiguration_backgroundVisibility' - Determines whether or not a background for each small multiples panel is
-- rendered.
--
-- 'borderColor', 'panelConfiguration_borderColor' - Sets the line color of panel borders.
--
-- 'borderStyle', 'panelConfiguration_borderStyle' - Sets the line style of panel borders.
--
-- 'borderThickness', 'panelConfiguration_borderThickness' - Sets the line thickness of panel borders.
--
-- 'borderVisibility', 'panelConfiguration_borderVisibility' - Determines whether or not each panel displays a border.
--
-- 'gutterSpacing', 'panelConfiguration_gutterSpacing' - Sets the total amount of negative space to display between sibling
-- panels.
--
-- 'gutterVisibility', 'panelConfiguration_gutterVisibility' - Determines whether or not negative space between sibling panels is
-- rendered.
--
-- 'title', 'panelConfiguration_title' - Configures the title display within each small multiples panel.
newPanelConfiguration ::
  PanelConfiguration
newPanelConfiguration :: PanelConfiguration
newPanelConfiguration =
  PanelConfiguration'
    { $sel:backgroundColor:PanelConfiguration' :: Maybe Text
backgroundColor =
        forall a. Maybe a
Prelude.Nothing,
      $sel:backgroundVisibility:PanelConfiguration' :: Maybe Visibility
backgroundVisibility = forall a. Maybe a
Prelude.Nothing,
      $sel:borderColor:PanelConfiguration' :: Maybe Text
borderColor = forall a. Maybe a
Prelude.Nothing,
      $sel:borderStyle:PanelConfiguration' :: Maybe PanelBorderStyle
borderStyle = forall a. Maybe a
Prelude.Nothing,
      $sel:borderThickness:PanelConfiguration' :: Maybe Text
borderThickness = forall a. Maybe a
Prelude.Nothing,
      $sel:borderVisibility:PanelConfiguration' :: Maybe Visibility
borderVisibility = forall a. Maybe a
Prelude.Nothing,
      $sel:gutterSpacing:PanelConfiguration' :: Maybe Text
gutterSpacing = forall a. Maybe a
Prelude.Nothing,
      $sel:gutterVisibility:PanelConfiguration' :: Maybe Visibility
gutterVisibility = forall a. Maybe a
Prelude.Nothing,
      $sel:title:PanelConfiguration' :: Maybe PanelTitleOptions
title = forall a. Maybe a
Prelude.Nothing
    }

-- | Sets the background color for each panel.
panelConfiguration_backgroundColor :: Lens.Lens' PanelConfiguration (Prelude.Maybe Prelude.Text)
panelConfiguration_backgroundColor :: Lens' PanelConfiguration (Maybe Text)
panelConfiguration_backgroundColor = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PanelConfiguration' {Maybe Text
backgroundColor :: Maybe Text
$sel:backgroundColor:PanelConfiguration' :: PanelConfiguration -> Maybe Text
backgroundColor} -> Maybe Text
backgroundColor) (\s :: PanelConfiguration
s@PanelConfiguration' {} Maybe Text
a -> PanelConfiguration
s {$sel:backgroundColor:PanelConfiguration' :: Maybe Text
backgroundColor = Maybe Text
a} :: PanelConfiguration)

-- | Determines whether or not a background for each small multiples panel is
-- rendered.
panelConfiguration_backgroundVisibility :: Lens.Lens' PanelConfiguration (Prelude.Maybe Visibility)
panelConfiguration_backgroundVisibility :: Lens' PanelConfiguration (Maybe Visibility)
panelConfiguration_backgroundVisibility = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PanelConfiguration' {Maybe Visibility
backgroundVisibility :: Maybe Visibility
$sel:backgroundVisibility:PanelConfiguration' :: PanelConfiguration -> Maybe Visibility
backgroundVisibility} -> Maybe Visibility
backgroundVisibility) (\s :: PanelConfiguration
s@PanelConfiguration' {} Maybe Visibility
a -> PanelConfiguration
s {$sel:backgroundVisibility:PanelConfiguration' :: Maybe Visibility
backgroundVisibility = Maybe Visibility
a} :: PanelConfiguration)

-- | Sets the line color of panel borders.
panelConfiguration_borderColor :: Lens.Lens' PanelConfiguration (Prelude.Maybe Prelude.Text)
panelConfiguration_borderColor :: Lens' PanelConfiguration (Maybe Text)
panelConfiguration_borderColor = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PanelConfiguration' {Maybe Text
borderColor :: Maybe Text
$sel:borderColor:PanelConfiguration' :: PanelConfiguration -> Maybe Text
borderColor} -> Maybe Text
borderColor) (\s :: PanelConfiguration
s@PanelConfiguration' {} Maybe Text
a -> PanelConfiguration
s {$sel:borderColor:PanelConfiguration' :: Maybe Text
borderColor = Maybe Text
a} :: PanelConfiguration)

-- | Sets the line style of panel borders.
panelConfiguration_borderStyle :: Lens.Lens' PanelConfiguration (Prelude.Maybe PanelBorderStyle)
panelConfiguration_borderStyle :: Lens' PanelConfiguration (Maybe PanelBorderStyle)
panelConfiguration_borderStyle = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PanelConfiguration' {Maybe PanelBorderStyle
borderStyle :: Maybe PanelBorderStyle
$sel:borderStyle:PanelConfiguration' :: PanelConfiguration -> Maybe PanelBorderStyle
borderStyle} -> Maybe PanelBorderStyle
borderStyle) (\s :: PanelConfiguration
s@PanelConfiguration' {} Maybe PanelBorderStyle
a -> PanelConfiguration
s {$sel:borderStyle:PanelConfiguration' :: Maybe PanelBorderStyle
borderStyle = Maybe PanelBorderStyle
a} :: PanelConfiguration)

-- | Sets the line thickness of panel borders.
panelConfiguration_borderThickness :: Lens.Lens' PanelConfiguration (Prelude.Maybe Prelude.Text)
panelConfiguration_borderThickness :: Lens' PanelConfiguration (Maybe Text)
panelConfiguration_borderThickness = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PanelConfiguration' {Maybe Text
borderThickness :: Maybe Text
$sel:borderThickness:PanelConfiguration' :: PanelConfiguration -> Maybe Text
borderThickness} -> Maybe Text
borderThickness) (\s :: PanelConfiguration
s@PanelConfiguration' {} Maybe Text
a -> PanelConfiguration
s {$sel:borderThickness:PanelConfiguration' :: Maybe Text
borderThickness = Maybe Text
a} :: PanelConfiguration)

-- | Determines whether or not each panel displays a border.
panelConfiguration_borderVisibility :: Lens.Lens' PanelConfiguration (Prelude.Maybe Visibility)
panelConfiguration_borderVisibility :: Lens' PanelConfiguration (Maybe Visibility)
panelConfiguration_borderVisibility = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PanelConfiguration' {Maybe Visibility
borderVisibility :: Maybe Visibility
$sel:borderVisibility:PanelConfiguration' :: PanelConfiguration -> Maybe Visibility
borderVisibility} -> Maybe Visibility
borderVisibility) (\s :: PanelConfiguration
s@PanelConfiguration' {} Maybe Visibility
a -> PanelConfiguration
s {$sel:borderVisibility:PanelConfiguration' :: Maybe Visibility
borderVisibility = Maybe Visibility
a} :: PanelConfiguration)

-- | Sets the total amount of negative space to display between sibling
-- panels.
panelConfiguration_gutterSpacing :: Lens.Lens' PanelConfiguration (Prelude.Maybe Prelude.Text)
panelConfiguration_gutterSpacing :: Lens' PanelConfiguration (Maybe Text)
panelConfiguration_gutterSpacing = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PanelConfiguration' {Maybe Text
gutterSpacing :: Maybe Text
$sel:gutterSpacing:PanelConfiguration' :: PanelConfiguration -> Maybe Text
gutterSpacing} -> Maybe Text
gutterSpacing) (\s :: PanelConfiguration
s@PanelConfiguration' {} Maybe Text
a -> PanelConfiguration
s {$sel:gutterSpacing:PanelConfiguration' :: Maybe Text
gutterSpacing = Maybe Text
a} :: PanelConfiguration)

-- | Determines whether or not negative space between sibling panels is
-- rendered.
panelConfiguration_gutterVisibility :: Lens.Lens' PanelConfiguration (Prelude.Maybe Visibility)
panelConfiguration_gutterVisibility :: Lens' PanelConfiguration (Maybe Visibility)
panelConfiguration_gutterVisibility = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PanelConfiguration' {Maybe Visibility
gutterVisibility :: Maybe Visibility
$sel:gutterVisibility:PanelConfiguration' :: PanelConfiguration -> Maybe Visibility
gutterVisibility} -> Maybe Visibility
gutterVisibility) (\s :: PanelConfiguration
s@PanelConfiguration' {} Maybe Visibility
a -> PanelConfiguration
s {$sel:gutterVisibility:PanelConfiguration' :: Maybe Visibility
gutterVisibility = Maybe Visibility
a} :: PanelConfiguration)

-- | Configures the title display within each small multiples panel.
panelConfiguration_title :: Lens.Lens' PanelConfiguration (Prelude.Maybe PanelTitleOptions)
panelConfiguration_title :: Lens' PanelConfiguration (Maybe PanelTitleOptions)
panelConfiguration_title = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PanelConfiguration' {Maybe PanelTitleOptions
title :: Maybe PanelTitleOptions
$sel:title:PanelConfiguration' :: PanelConfiguration -> Maybe PanelTitleOptions
title} -> Maybe PanelTitleOptions
title) (\s :: PanelConfiguration
s@PanelConfiguration' {} Maybe PanelTitleOptions
a -> PanelConfiguration
s {$sel:title:PanelConfiguration' :: Maybe PanelTitleOptions
title = Maybe PanelTitleOptions
a} :: PanelConfiguration)

instance Data.FromJSON PanelConfiguration where
  parseJSON :: Value -> Parser PanelConfiguration
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"PanelConfiguration"
      ( \Object
x ->
          Maybe Text
-> Maybe Visibility
-> Maybe Text
-> Maybe PanelBorderStyle
-> Maybe Text
-> Maybe Visibility
-> Maybe Text
-> Maybe Visibility
-> Maybe PanelTitleOptions
-> PanelConfiguration
PanelConfiguration'
            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
"BackgroundVisibility")
            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
"BorderColor")
            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
"BorderStyle")
            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
"BorderThickness")
            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
"BorderVisibility")
            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
"GutterSpacing")
            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
"GutterVisibility")
            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
"Title")
      )

instance Prelude.Hashable PanelConfiguration where
  hashWithSalt :: Int -> PanelConfiguration -> Int
hashWithSalt Int
_salt PanelConfiguration' {Maybe Text
Maybe PanelBorderStyle
Maybe Visibility
Maybe PanelTitleOptions
title :: Maybe PanelTitleOptions
gutterVisibility :: Maybe Visibility
gutterSpacing :: Maybe Text
borderVisibility :: Maybe Visibility
borderThickness :: Maybe Text
borderStyle :: Maybe PanelBorderStyle
borderColor :: Maybe Text
backgroundVisibility :: Maybe Visibility
backgroundColor :: Maybe Text
$sel:title:PanelConfiguration' :: PanelConfiguration -> Maybe PanelTitleOptions
$sel:gutterVisibility:PanelConfiguration' :: PanelConfiguration -> Maybe Visibility
$sel:gutterSpacing:PanelConfiguration' :: PanelConfiguration -> Maybe Text
$sel:borderVisibility:PanelConfiguration' :: PanelConfiguration -> Maybe Visibility
$sel:borderThickness:PanelConfiguration' :: PanelConfiguration -> Maybe Text
$sel:borderStyle:PanelConfiguration' :: PanelConfiguration -> Maybe PanelBorderStyle
$sel:borderColor:PanelConfiguration' :: PanelConfiguration -> Maybe Text
$sel:backgroundVisibility:PanelConfiguration' :: PanelConfiguration -> Maybe Visibility
$sel:backgroundColor:PanelConfiguration' :: PanelConfiguration -> 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 Visibility
backgroundVisibility
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
borderColor
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe PanelBorderStyle
borderStyle
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
borderThickness
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Visibility
borderVisibility
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
gutterSpacing
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Visibility
gutterVisibility
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe PanelTitleOptions
title

instance Prelude.NFData PanelConfiguration where
  rnf :: PanelConfiguration -> ()
rnf PanelConfiguration' {Maybe Text
Maybe PanelBorderStyle
Maybe Visibility
Maybe PanelTitleOptions
title :: Maybe PanelTitleOptions
gutterVisibility :: Maybe Visibility
gutterSpacing :: Maybe Text
borderVisibility :: Maybe Visibility
borderThickness :: Maybe Text
borderStyle :: Maybe PanelBorderStyle
borderColor :: Maybe Text
backgroundVisibility :: Maybe Visibility
backgroundColor :: Maybe Text
$sel:title:PanelConfiguration' :: PanelConfiguration -> Maybe PanelTitleOptions
$sel:gutterVisibility:PanelConfiguration' :: PanelConfiguration -> Maybe Visibility
$sel:gutterSpacing:PanelConfiguration' :: PanelConfiguration -> Maybe Text
$sel:borderVisibility:PanelConfiguration' :: PanelConfiguration -> Maybe Visibility
$sel:borderThickness:PanelConfiguration' :: PanelConfiguration -> Maybe Text
$sel:borderStyle:PanelConfiguration' :: PanelConfiguration -> Maybe PanelBorderStyle
$sel:borderColor:PanelConfiguration' :: PanelConfiguration -> Maybe Text
$sel:backgroundVisibility:PanelConfiguration' :: PanelConfiguration -> Maybe Visibility
$sel:backgroundColor:PanelConfiguration' :: PanelConfiguration -> 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 Visibility
backgroundVisibility
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
borderColor
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe PanelBorderStyle
borderStyle
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
borderThickness
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Visibility
borderVisibility
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
gutterSpacing
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Visibility
gutterVisibility
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe PanelTitleOptions
title

instance Data.ToJSON PanelConfiguration where
  toJSON :: PanelConfiguration -> Value
toJSON PanelConfiguration' {Maybe Text
Maybe PanelBorderStyle
Maybe Visibility
Maybe PanelTitleOptions
title :: Maybe PanelTitleOptions
gutterVisibility :: Maybe Visibility
gutterSpacing :: Maybe Text
borderVisibility :: Maybe Visibility
borderThickness :: Maybe Text
borderStyle :: Maybe PanelBorderStyle
borderColor :: Maybe Text
backgroundVisibility :: Maybe Visibility
backgroundColor :: Maybe Text
$sel:title:PanelConfiguration' :: PanelConfiguration -> Maybe PanelTitleOptions
$sel:gutterVisibility:PanelConfiguration' :: PanelConfiguration -> Maybe Visibility
$sel:gutterSpacing:PanelConfiguration' :: PanelConfiguration -> Maybe Text
$sel:borderVisibility:PanelConfiguration' :: PanelConfiguration -> Maybe Visibility
$sel:borderThickness:PanelConfiguration' :: PanelConfiguration -> Maybe Text
$sel:borderStyle:PanelConfiguration' :: PanelConfiguration -> Maybe PanelBorderStyle
$sel:borderColor:PanelConfiguration' :: PanelConfiguration -> Maybe Text
$sel:backgroundVisibility:PanelConfiguration' :: PanelConfiguration -> Maybe Visibility
$sel:backgroundColor:PanelConfiguration' :: PanelConfiguration -> 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
"BackgroundVisibility" 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
backgroundVisibility,
            (Key
"BorderColor" 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
borderColor,
            (Key
"BorderStyle" 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 PanelBorderStyle
borderStyle,
            (Key
"BorderThickness" 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
borderThickness,
            (Key
"BorderVisibility" 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
borderVisibility,
            (Key
"GutterSpacing" 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
gutterSpacing,
            (Key
"GutterVisibility" 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
gutterVisibility,
            (Key
"Title" 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 PanelTitleOptions
title
          ]
      )