{-# 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.LegendOptions
-- 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.LegendOptions 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.LabelOptions
import Amazonka.QuickSight.Types.LegendPosition
import Amazonka.QuickSight.Types.Visibility

-- | The options for the legend setup of a visual.
--
-- /See:/ 'newLegendOptions' smart constructor.
data LegendOptions = LegendOptions'
  { -- | The height of the legend. If this value is omitted, a default height is
    -- used when rendering.
    LegendOptions -> Maybe Text
height :: Prelude.Maybe Prelude.Text,
    -- | The positions for the legend. Choose one of the following options:
    --
    -- -   @AUTO@
    --
    -- -   @RIGHT@
    --
    -- -   @BOTTOM@
    --
    -- -   @LEFT@
    LegendOptions -> Maybe LegendPosition
position :: Prelude.Maybe LegendPosition,
    -- | The custom title for the legend.
    LegendOptions -> Maybe LabelOptions
title :: Prelude.Maybe LabelOptions,
    -- | Determines whether or not the legend is visible.
    LegendOptions -> Maybe Visibility
visibility :: Prelude.Maybe Visibility,
    -- | The width of the legend. If this value is omitted, a default width is
    -- used when rendering.
    LegendOptions -> Maybe Text
width :: Prelude.Maybe Prelude.Text
  }
  deriving (LegendOptions -> LegendOptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LegendOptions -> LegendOptions -> Bool
$c/= :: LegendOptions -> LegendOptions -> Bool
== :: LegendOptions -> LegendOptions -> Bool
$c== :: LegendOptions -> LegendOptions -> Bool
Prelude.Eq, ReadPrec [LegendOptions]
ReadPrec LegendOptions
Int -> ReadS LegendOptions
ReadS [LegendOptions]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LegendOptions]
$creadListPrec :: ReadPrec [LegendOptions]
readPrec :: ReadPrec LegendOptions
$creadPrec :: ReadPrec LegendOptions
readList :: ReadS [LegendOptions]
$creadList :: ReadS [LegendOptions]
readsPrec :: Int -> ReadS LegendOptions
$creadsPrec :: Int -> ReadS LegendOptions
Prelude.Read, Int -> LegendOptions -> ShowS
[LegendOptions] -> ShowS
LegendOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LegendOptions] -> ShowS
$cshowList :: [LegendOptions] -> ShowS
show :: LegendOptions -> String
$cshow :: LegendOptions -> String
showsPrec :: Int -> LegendOptions -> ShowS
$cshowsPrec :: Int -> LegendOptions -> ShowS
Prelude.Show, forall x. Rep LegendOptions x -> LegendOptions
forall x. LegendOptions -> Rep LegendOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LegendOptions x -> LegendOptions
$cfrom :: forall x. LegendOptions -> Rep LegendOptions x
Prelude.Generic)

-- |
-- Create a value of 'LegendOptions' 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:
--
-- 'height', 'legendOptions_height' - The height of the legend. If this value is omitted, a default height is
-- used when rendering.
--
-- 'position', 'legendOptions_position' - The positions for the legend. Choose one of the following options:
--
-- -   @AUTO@
--
-- -   @RIGHT@
--
-- -   @BOTTOM@
--
-- -   @LEFT@
--
-- 'title', 'legendOptions_title' - The custom title for the legend.
--
-- 'visibility', 'legendOptions_visibility' - Determines whether or not the legend is visible.
--
-- 'width', 'legendOptions_width' - The width of the legend. If this value is omitted, a default width is
-- used when rendering.
newLegendOptions ::
  LegendOptions
newLegendOptions :: LegendOptions
newLegendOptions =
  LegendOptions'
    { $sel:height:LegendOptions' :: Maybe Text
height = forall a. Maybe a
Prelude.Nothing,
      $sel:position:LegendOptions' :: Maybe LegendPosition
position = forall a. Maybe a
Prelude.Nothing,
      $sel:title:LegendOptions' :: Maybe LabelOptions
title = forall a. Maybe a
Prelude.Nothing,
      $sel:visibility:LegendOptions' :: Maybe Visibility
visibility = forall a. Maybe a
Prelude.Nothing,
      $sel:width:LegendOptions' :: Maybe Text
width = forall a. Maybe a
Prelude.Nothing
    }

-- | The height of the legend. If this value is omitted, a default height is
-- used when rendering.
legendOptions_height :: Lens.Lens' LegendOptions (Prelude.Maybe Prelude.Text)
legendOptions_height :: Lens' LegendOptions (Maybe Text)
legendOptions_height = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LegendOptions' {Maybe Text
height :: Maybe Text
$sel:height:LegendOptions' :: LegendOptions -> Maybe Text
height} -> Maybe Text
height) (\s :: LegendOptions
s@LegendOptions' {} Maybe Text
a -> LegendOptions
s {$sel:height:LegendOptions' :: Maybe Text
height = Maybe Text
a} :: LegendOptions)

-- | The positions for the legend. Choose one of the following options:
--
-- -   @AUTO@
--
-- -   @RIGHT@
--
-- -   @BOTTOM@
--
-- -   @LEFT@
legendOptions_position :: Lens.Lens' LegendOptions (Prelude.Maybe LegendPosition)
legendOptions_position :: Lens' LegendOptions (Maybe LegendPosition)
legendOptions_position = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LegendOptions' {Maybe LegendPosition
position :: Maybe LegendPosition
$sel:position:LegendOptions' :: LegendOptions -> Maybe LegendPosition
position} -> Maybe LegendPosition
position) (\s :: LegendOptions
s@LegendOptions' {} Maybe LegendPosition
a -> LegendOptions
s {$sel:position:LegendOptions' :: Maybe LegendPosition
position = Maybe LegendPosition
a} :: LegendOptions)

-- | The custom title for the legend.
legendOptions_title :: Lens.Lens' LegendOptions (Prelude.Maybe LabelOptions)
legendOptions_title :: Lens' LegendOptions (Maybe LabelOptions)
legendOptions_title = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LegendOptions' {Maybe LabelOptions
title :: Maybe LabelOptions
$sel:title:LegendOptions' :: LegendOptions -> Maybe LabelOptions
title} -> Maybe LabelOptions
title) (\s :: LegendOptions
s@LegendOptions' {} Maybe LabelOptions
a -> LegendOptions
s {$sel:title:LegendOptions' :: Maybe LabelOptions
title = Maybe LabelOptions
a} :: LegendOptions)

-- | Determines whether or not the legend is visible.
legendOptions_visibility :: Lens.Lens' LegendOptions (Prelude.Maybe Visibility)
legendOptions_visibility :: Lens' LegendOptions (Maybe Visibility)
legendOptions_visibility = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LegendOptions' {Maybe Visibility
visibility :: Maybe Visibility
$sel:visibility:LegendOptions' :: LegendOptions -> Maybe Visibility
visibility} -> Maybe Visibility
visibility) (\s :: LegendOptions
s@LegendOptions' {} Maybe Visibility
a -> LegendOptions
s {$sel:visibility:LegendOptions' :: Maybe Visibility
visibility = Maybe Visibility
a} :: LegendOptions)

-- | The width of the legend. If this value is omitted, a default width is
-- used when rendering.
legendOptions_width :: Lens.Lens' LegendOptions (Prelude.Maybe Prelude.Text)
legendOptions_width :: Lens' LegendOptions (Maybe Text)
legendOptions_width = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LegendOptions' {Maybe Text
width :: Maybe Text
$sel:width:LegendOptions' :: LegendOptions -> Maybe Text
width} -> Maybe Text
width) (\s :: LegendOptions
s@LegendOptions' {} Maybe Text
a -> LegendOptions
s {$sel:width:LegendOptions' :: Maybe Text
width = Maybe Text
a} :: LegendOptions)

instance Data.FromJSON LegendOptions where
  parseJSON :: Value -> Parser LegendOptions
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"LegendOptions"
      ( \Object
x ->
          Maybe Text
-> Maybe LegendPosition
-> Maybe LabelOptions
-> Maybe Visibility
-> Maybe Text
-> LegendOptions
LegendOptions'
            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
"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
"Position")
            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")
            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")
            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
"Width")
      )

instance Prelude.Hashable LegendOptions where
  hashWithSalt :: Int -> LegendOptions -> Int
hashWithSalt Int
_salt LegendOptions' {Maybe Text
Maybe LegendPosition
Maybe Visibility
Maybe LabelOptions
width :: Maybe Text
visibility :: Maybe Visibility
title :: Maybe LabelOptions
position :: Maybe LegendPosition
height :: Maybe Text
$sel:width:LegendOptions' :: LegendOptions -> Maybe Text
$sel:visibility:LegendOptions' :: LegendOptions -> Maybe Visibility
$sel:title:LegendOptions' :: LegendOptions -> Maybe LabelOptions
$sel:position:LegendOptions' :: LegendOptions -> Maybe LegendPosition
$sel:height:LegendOptions' :: LegendOptions -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
height
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LegendPosition
position
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LabelOptions
title
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Visibility
visibility
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
width

instance Prelude.NFData LegendOptions where
  rnf :: LegendOptions -> ()
rnf LegendOptions' {Maybe Text
Maybe LegendPosition
Maybe Visibility
Maybe LabelOptions
width :: Maybe Text
visibility :: Maybe Visibility
title :: Maybe LabelOptions
position :: Maybe LegendPosition
height :: Maybe Text
$sel:width:LegendOptions' :: LegendOptions -> Maybe Text
$sel:visibility:LegendOptions' :: LegendOptions -> Maybe Visibility
$sel:title:LegendOptions' :: LegendOptions -> Maybe LabelOptions
$sel:position:LegendOptions' :: LegendOptions -> Maybe LegendPosition
$sel:height:LegendOptions' :: LegendOptions -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
height
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LegendPosition
position
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LabelOptions
title
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Visibility
visibility
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
width

instance Data.ToJSON LegendOptions where
  toJSON :: LegendOptions -> Value
toJSON LegendOptions' {Maybe Text
Maybe LegendPosition
Maybe Visibility
Maybe LabelOptions
width :: Maybe Text
visibility :: Maybe Visibility
title :: Maybe LabelOptions
position :: Maybe LegendPosition
height :: Maybe Text
$sel:width:LegendOptions' :: LegendOptions -> Maybe Text
$sel:visibility:LegendOptions' :: LegendOptions -> Maybe Visibility
$sel:title:LegendOptions' :: LegendOptions -> Maybe LabelOptions
$sel:position:LegendOptions' :: LegendOptions -> Maybe LegendPosition
$sel:height:LegendOptions' :: LegendOptions -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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 Text
height,
            (Key
"Position" 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 LegendPosition
position,
            (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 LabelOptions
title,
            (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,
            (Key
"Width" 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
width
          ]
      )