{-# 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.FontConfiguration
-- 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.FontConfiguration 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.FontDecoration
import Amazonka.QuickSight.Types.FontSize
import Amazonka.QuickSight.Types.FontStyle
import Amazonka.QuickSight.Types.FontWeight

-- | Configures the display properties of the given text.
--
-- /See:/ 'newFontConfiguration' smart constructor.
data FontConfiguration = FontConfiguration'
  { -- | Determines the color of the text.
    FontConfiguration -> Maybe Text
fontColor :: Prelude.Maybe Prelude.Text,
    -- | Determines the appearance of decorative lines on the text.
    FontConfiguration -> Maybe FontDecoration
fontDecoration :: Prelude.Maybe FontDecoration,
    -- | The option that determines the text display size.
    FontConfiguration -> Maybe FontSize
fontSize :: Prelude.Maybe FontSize,
    -- | Determines the text display face that is inherited by the given font
    -- family.
    FontConfiguration -> Maybe FontStyle
fontStyle :: Prelude.Maybe FontStyle,
    -- | The option that determines the text display weight, or boldness.
    FontConfiguration -> Maybe FontWeight
fontWeight :: Prelude.Maybe FontWeight
  }
  deriving (FontConfiguration -> FontConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FontConfiguration -> FontConfiguration -> Bool
$c/= :: FontConfiguration -> FontConfiguration -> Bool
== :: FontConfiguration -> FontConfiguration -> Bool
$c== :: FontConfiguration -> FontConfiguration -> Bool
Prelude.Eq, ReadPrec [FontConfiguration]
ReadPrec FontConfiguration
Int -> ReadS FontConfiguration
ReadS [FontConfiguration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FontConfiguration]
$creadListPrec :: ReadPrec [FontConfiguration]
readPrec :: ReadPrec FontConfiguration
$creadPrec :: ReadPrec FontConfiguration
readList :: ReadS [FontConfiguration]
$creadList :: ReadS [FontConfiguration]
readsPrec :: Int -> ReadS FontConfiguration
$creadsPrec :: Int -> ReadS FontConfiguration
Prelude.Read, Int -> FontConfiguration -> ShowS
[FontConfiguration] -> ShowS
FontConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FontConfiguration] -> ShowS
$cshowList :: [FontConfiguration] -> ShowS
show :: FontConfiguration -> String
$cshow :: FontConfiguration -> String
showsPrec :: Int -> FontConfiguration -> ShowS
$cshowsPrec :: Int -> FontConfiguration -> ShowS
Prelude.Show, forall x. Rep FontConfiguration x -> FontConfiguration
forall x. FontConfiguration -> Rep FontConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FontConfiguration x -> FontConfiguration
$cfrom :: forall x. FontConfiguration -> Rep FontConfiguration x
Prelude.Generic)

-- |
-- Create a value of 'FontConfiguration' 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:
--
-- 'fontColor', 'fontConfiguration_fontColor' - Determines the color of the text.
--
-- 'fontDecoration', 'fontConfiguration_fontDecoration' - Determines the appearance of decorative lines on the text.
--
-- 'fontSize', 'fontConfiguration_fontSize' - The option that determines the text display size.
--
-- 'fontStyle', 'fontConfiguration_fontStyle' - Determines the text display face that is inherited by the given font
-- family.
--
-- 'fontWeight', 'fontConfiguration_fontWeight' - The option that determines the text display weight, or boldness.
newFontConfiguration ::
  FontConfiguration
newFontConfiguration :: FontConfiguration
newFontConfiguration =
  FontConfiguration'
    { $sel:fontColor:FontConfiguration' :: Maybe Text
fontColor = forall a. Maybe a
Prelude.Nothing,
      $sel:fontDecoration:FontConfiguration' :: Maybe FontDecoration
fontDecoration = forall a. Maybe a
Prelude.Nothing,
      $sel:fontSize:FontConfiguration' :: Maybe FontSize
fontSize = forall a. Maybe a
Prelude.Nothing,
      $sel:fontStyle:FontConfiguration' :: Maybe FontStyle
fontStyle = forall a. Maybe a
Prelude.Nothing,
      $sel:fontWeight:FontConfiguration' :: Maybe FontWeight
fontWeight = forall a. Maybe a
Prelude.Nothing
    }

-- | Determines the color of the text.
fontConfiguration_fontColor :: Lens.Lens' FontConfiguration (Prelude.Maybe Prelude.Text)
fontConfiguration_fontColor :: Lens' FontConfiguration (Maybe Text)
fontConfiguration_fontColor = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FontConfiguration' {Maybe Text
fontColor :: Maybe Text
$sel:fontColor:FontConfiguration' :: FontConfiguration -> Maybe Text
fontColor} -> Maybe Text
fontColor) (\s :: FontConfiguration
s@FontConfiguration' {} Maybe Text
a -> FontConfiguration
s {$sel:fontColor:FontConfiguration' :: Maybe Text
fontColor = Maybe Text
a} :: FontConfiguration)

-- | Determines the appearance of decorative lines on the text.
fontConfiguration_fontDecoration :: Lens.Lens' FontConfiguration (Prelude.Maybe FontDecoration)
fontConfiguration_fontDecoration :: Lens' FontConfiguration (Maybe FontDecoration)
fontConfiguration_fontDecoration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FontConfiguration' {Maybe FontDecoration
fontDecoration :: Maybe FontDecoration
$sel:fontDecoration:FontConfiguration' :: FontConfiguration -> Maybe FontDecoration
fontDecoration} -> Maybe FontDecoration
fontDecoration) (\s :: FontConfiguration
s@FontConfiguration' {} Maybe FontDecoration
a -> FontConfiguration
s {$sel:fontDecoration:FontConfiguration' :: Maybe FontDecoration
fontDecoration = Maybe FontDecoration
a} :: FontConfiguration)

-- | The option that determines the text display size.
fontConfiguration_fontSize :: Lens.Lens' FontConfiguration (Prelude.Maybe FontSize)
fontConfiguration_fontSize :: Lens' FontConfiguration (Maybe FontSize)
fontConfiguration_fontSize = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FontConfiguration' {Maybe FontSize
fontSize :: Maybe FontSize
$sel:fontSize:FontConfiguration' :: FontConfiguration -> Maybe FontSize
fontSize} -> Maybe FontSize
fontSize) (\s :: FontConfiguration
s@FontConfiguration' {} Maybe FontSize
a -> FontConfiguration
s {$sel:fontSize:FontConfiguration' :: Maybe FontSize
fontSize = Maybe FontSize
a} :: FontConfiguration)

-- | Determines the text display face that is inherited by the given font
-- family.
fontConfiguration_fontStyle :: Lens.Lens' FontConfiguration (Prelude.Maybe FontStyle)
fontConfiguration_fontStyle :: Lens' FontConfiguration (Maybe FontStyle)
fontConfiguration_fontStyle = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FontConfiguration' {Maybe FontStyle
fontStyle :: Maybe FontStyle
$sel:fontStyle:FontConfiguration' :: FontConfiguration -> Maybe FontStyle
fontStyle} -> Maybe FontStyle
fontStyle) (\s :: FontConfiguration
s@FontConfiguration' {} Maybe FontStyle
a -> FontConfiguration
s {$sel:fontStyle:FontConfiguration' :: Maybe FontStyle
fontStyle = Maybe FontStyle
a} :: FontConfiguration)

-- | The option that determines the text display weight, or boldness.
fontConfiguration_fontWeight :: Lens.Lens' FontConfiguration (Prelude.Maybe FontWeight)
fontConfiguration_fontWeight :: Lens' FontConfiguration (Maybe FontWeight)
fontConfiguration_fontWeight = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FontConfiguration' {Maybe FontWeight
fontWeight :: Maybe FontWeight
$sel:fontWeight:FontConfiguration' :: FontConfiguration -> Maybe FontWeight
fontWeight} -> Maybe FontWeight
fontWeight) (\s :: FontConfiguration
s@FontConfiguration' {} Maybe FontWeight
a -> FontConfiguration
s {$sel:fontWeight:FontConfiguration' :: Maybe FontWeight
fontWeight = Maybe FontWeight
a} :: FontConfiguration)

instance Data.FromJSON FontConfiguration where
  parseJSON :: Value -> Parser FontConfiguration
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"FontConfiguration"
      ( \Object
x ->
          Maybe Text
-> Maybe FontDecoration
-> Maybe FontSize
-> Maybe FontStyle
-> Maybe FontWeight
-> FontConfiguration
FontConfiguration'
            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
"FontColor")
            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
"FontDecoration")
            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
"FontSize")
            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
"FontStyle")
            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
"FontWeight")
      )

instance Prelude.Hashable FontConfiguration where
  hashWithSalt :: Int -> FontConfiguration -> Int
hashWithSalt Int
_salt FontConfiguration' {Maybe Text
Maybe FontDecoration
Maybe FontStyle
Maybe FontWeight
Maybe FontSize
fontWeight :: Maybe FontWeight
fontStyle :: Maybe FontStyle
fontSize :: Maybe FontSize
fontDecoration :: Maybe FontDecoration
fontColor :: Maybe Text
$sel:fontWeight:FontConfiguration' :: FontConfiguration -> Maybe FontWeight
$sel:fontStyle:FontConfiguration' :: FontConfiguration -> Maybe FontStyle
$sel:fontSize:FontConfiguration' :: FontConfiguration -> Maybe FontSize
$sel:fontDecoration:FontConfiguration' :: FontConfiguration -> Maybe FontDecoration
$sel:fontColor:FontConfiguration' :: FontConfiguration -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
fontColor
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe FontDecoration
fontDecoration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe FontSize
fontSize
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe FontStyle
fontStyle
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe FontWeight
fontWeight

instance Prelude.NFData FontConfiguration where
  rnf :: FontConfiguration -> ()
rnf FontConfiguration' {Maybe Text
Maybe FontDecoration
Maybe FontStyle
Maybe FontWeight
Maybe FontSize
fontWeight :: Maybe FontWeight
fontStyle :: Maybe FontStyle
fontSize :: Maybe FontSize
fontDecoration :: Maybe FontDecoration
fontColor :: Maybe Text
$sel:fontWeight:FontConfiguration' :: FontConfiguration -> Maybe FontWeight
$sel:fontStyle:FontConfiguration' :: FontConfiguration -> Maybe FontStyle
$sel:fontSize:FontConfiguration' :: FontConfiguration -> Maybe FontSize
$sel:fontDecoration:FontConfiguration' :: FontConfiguration -> Maybe FontDecoration
$sel:fontColor:FontConfiguration' :: FontConfiguration -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
fontColor
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe FontDecoration
fontDecoration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe FontSize
fontSize
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe FontStyle
fontStyle
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe FontWeight
fontWeight

instance Data.ToJSON FontConfiguration where
  toJSON :: FontConfiguration -> Value
toJSON FontConfiguration' {Maybe Text
Maybe FontDecoration
Maybe FontStyle
Maybe FontWeight
Maybe FontSize
fontWeight :: Maybe FontWeight
fontStyle :: Maybe FontStyle
fontSize :: Maybe FontSize
fontDecoration :: Maybe FontDecoration
fontColor :: Maybe Text
$sel:fontWeight:FontConfiguration' :: FontConfiguration -> Maybe FontWeight
$sel:fontStyle:FontConfiguration' :: FontConfiguration -> Maybe FontStyle
$sel:fontSize:FontConfiguration' :: FontConfiguration -> Maybe FontSize
$sel:fontDecoration:FontConfiguration' :: FontConfiguration -> Maybe FontDecoration
$sel:fontColor:FontConfiguration' :: FontConfiguration -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"FontColor" 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
fontColor,
            (Key
"FontDecoration" 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 FontDecoration
fontDecoration,
            (Key
"FontSize" 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 FontSize
fontSize,
            (Key
"FontStyle" 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 FontStyle
fontStyle,
            (Key
"FontWeight" 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 FontWeight
fontWeight
          ]
      )