{-# 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.TooltipOptions
-- 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.TooltipOptions 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.FieldBasedTooltip
import Amazonka.QuickSight.Types.SelectedTooltipType
import Amazonka.QuickSight.Types.Visibility

-- | The display options for the visual tooltip.
--
-- /See:/ 'newTooltipOptions' smart constructor.
data TooltipOptions = TooltipOptions'
  { -- | The setup for the detailed tooltip. The tooltip setup is always saved.
    -- The display type is decided based on the tooltip type.
    TooltipOptions -> Maybe FieldBasedTooltip
fieldBasedTooltip :: Prelude.Maybe FieldBasedTooltip,
    -- | The selected type for the tooltip. Choose one of the following options:
    --
    -- -   @BASIC@: A basic tooltip.
    --
    -- -   @DETAILED@: A detailed tooltip.
    TooltipOptions -> Maybe SelectedTooltipType
selectedTooltipType :: Prelude.Maybe SelectedTooltipType,
    -- | Determines whether or not the tooltip is visible.
    TooltipOptions -> Maybe Visibility
tooltipVisibility :: Prelude.Maybe Visibility
  }
  deriving (TooltipOptions -> TooltipOptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TooltipOptions -> TooltipOptions -> Bool
$c/= :: TooltipOptions -> TooltipOptions -> Bool
== :: TooltipOptions -> TooltipOptions -> Bool
$c== :: TooltipOptions -> TooltipOptions -> Bool
Prelude.Eq, ReadPrec [TooltipOptions]
ReadPrec TooltipOptions
Int -> ReadS TooltipOptions
ReadS [TooltipOptions]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TooltipOptions]
$creadListPrec :: ReadPrec [TooltipOptions]
readPrec :: ReadPrec TooltipOptions
$creadPrec :: ReadPrec TooltipOptions
readList :: ReadS [TooltipOptions]
$creadList :: ReadS [TooltipOptions]
readsPrec :: Int -> ReadS TooltipOptions
$creadsPrec :: Int -> ReadS TooltipOptions
Prelude.Read, Int -> TooltipOptions -> ShowS
[TooltipOptions] -> ShowS
TooltipOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TooltipOptions] -> ShowS
$cshowList :: [TooltipOptions] -> ShowS
show :: TooltipOptions -> String
$cshow :: TooltipOptions -> String
showsPrec :: Int -> TooltipOptions -> ShowS
$cshowsPrec :: Int -> TooltipOptions -> ShowS
Prelude.Show, forall x. Rep TooltipOptions x -> TooltipOptions
forall x. TooltipOptions -> Rep TooltipOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TooltipOptions x -> TooltipOptions
$cfrom :: forall x. TooltipOptions -> Rep TooltipOptions x
Prelude.Generic)

-- |
-- Create a value of 'TooltipOptions' 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:
--
-- 'fieldBasedTooltip', 'tooltipOptions_fieldBasedTooltip' - The setup for the detailed tooltip. The tooltip setup is always saved.
-- The display type is decided based on the tooltip type.
--
-- 'selectedTooltipType', 'tooltipOptions_selectedTooltipType' - The selected type for the tooltip. Choose one of the following options:
--
-- -   @BASIC@: A basic tooltip.
--
-- -   @DETAILED@: A detailed tooltip.
--
-- 'tooltipVisibility', 'tooltipOptions_tooltipVisibility' - Determines whether or not the tooltip is visible.
newTooltipOptions ::
  TooltipOptions
newTooltipOptions :: TooltipOptions
newTooltipOptions =
  TooltipOptions'
    { $sel:fieldBasedTooltip:TooltipOptions' :: Maybe FieldBasedTooltip
fieldBasedTooltip =
        forall a. Maybe a
Prelude.Nothing,
      $sel:selectedTooltipType:TooltipOptions' :: Maybe SelectedTooltipType
selectedTooltipType = forall a. Maybe a
Prelude.Nothing,
      $sel:tooltipVisibility:TooltipOptions' :: Maybe Visibility
tooltipVisibility = forall a. Maybe a
Prelude.Nothing
    }

-- | The setup for the detailed tooltip. The tooltip setup is always saved.
-- The display type is decided based on the tooltip type.
tooltipOptions_fieldBasedTooltip :: Lens.Lens' TooltipOptions (Prelude.Maybe FieldBasedTooltip)
tooltipOptions_fieldBasedTooltip :: Lens' TooltipOptions (Maybe FieldBasedTooltip)
tooltipOptions_fieldBasedTooltip = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TooltipOptions' {Maybe FieldBasedTooltip
fieldBasedTooltip :: Maybe FieldBasedTooltip
$sel:fieldBasedTooltip:TooltipOptions' :: TooltipOptions -> Maybe FieldBasedTooltip
fieldBasedTooltip} -> Maybe FieldBasedTooltip
fieldBasedTooltip) (\s :: TooltipOptions
s@TooltipOptions' {} Maybe FieldBasedTooltip
a -> TooltipOptions
s {$sel:fieldBasedTooltip:TooltipOptions' :: Maybe FieldBasedTooltip
fieldBasedTooltip = Maybe FieldBasedTooltip
a} :: TooltipOptions)

-- | The selected type for the tooltip. Choose one of the following options:
--
-- -   @BASIC@: A basic tooltip.
--
-- -   @DETAILED@: A detailed tooltip.
tooltipOptions_selectedTooltipType :: Lens.Lens' TooltipOptions (Prelude.Maybe SelectedTooltipType)
tooltipOptions_selectedTooltipType :: Lens' TooltipOptions (Maybe SelectedTooltipType)
tooltipOptions_selectedTooltipType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TooltipOptions' {Maybe SelectedTooltipType
selectedTooltipType :: Maybe SelectedTooltipType
$sel:selectedTooltipType:TooltipOptions' :: TooltipOptions -> Maybe SelectedTooltipType
selectedTooltipType} -> Maybe SelectedTooltipType
selectedTooltipType) (\s :: TooltipOptions
s@TooltipOptions' {} Maybe SelectedTooltipType
a -> TooltipOptions
s {$sel:selectedTooltipType:TooltipOptions' :: Maybe SelectedTooltipType
selectedTooltipType = Maybe SelectedTooltipType
a} :: TooltipOptions)

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

instance Data.FromJSON TooltipOptions where
  parseJSON :: Value -> Parser TooltipOptions
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"TooltipOptions"
      ( \Object
x ->
          Maybe FieldBasedTooltip
-> Maybe SelectedTooltipType -> Maybe Visibility -> TooltipOptions
TooltipOptions'
            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
"FieldBasedTooltip")
            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
"SelectedTooltipType")
            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
"TooltipVisibility")
      )

instance Prelude.Hashable TooltipOptions where
  hashWithSalt :: Int -> TooltipOptions -> Int
hashWithSalt Int
_salt TooltipOptions' {Maybe SelectedTooltipType
Maybe Visibility
Maybe FieldBasedTooltip
tooltipVisibility :: Maybe Visibility
selectedTooltipType :: Maybe SelectedTooltipType
fieldBasedTooltip :: Maybe FieldBasedTooltip
$sel:tooltipVisibility:TooltipOptions' :: TooltipOptions -> Maybe Visibility
$sel:selectedTooltipType:TooltipOptions' :: TooltipOptions -> Maybe SelectedTooltipType
$sel:fieldBasedTooltip:TooltipOptions' :: TooltipOptions -> Maybe FieldBasedTooltip
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe FieldBasedTooltip
fieldBasedTooltip
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SelectedTooltipType
selectedTooltipType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Visibility
tooltipVisibility

instance Prelude.NFData TooltipOptions where
  rnf :: TooltipOptions -> ()
rnf TooltipOptions' {Maybe SelectedTooltipType
Maybe Visibility
Maybe FieldBasedTooltip
tooltipVisibility :: Maybe Visibility
selectedTooltipType :: Maybe SelectedTooltipType
fieldBasedTooltip :: Maybe FieldBasedTooltip
$sel:tooltipVisibility:TooltipOptions' :: TooltipOptions -> Maybe Visibility
$sel:selectedTooltipType:TooltipOptions' :: TooltipOptions -> Maybe SelectedTooltipType
$sel:fieldBasedTooltip:TooltipOptions' :: TooltipOptions -> Maybe FieldBasedTooltip
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe FieldBasedTooltip
fieldBasedTooltip
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SelectedTooltipType
selectedTooltipType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Visibility
tooltipVisibility

instance Data.ToJSON TooltipOptions where
  toJSON :: TooltipOptions -> Value
toJSON TooltipOptions' {Maybe SelectedTooltipType
Maybe Visibility
Maybe FieldBasedTooltip
tooltipVisibility :: Maybe Visibility
selectedTooltipType :: Maybe SelectedTooltipType
fieldBasedTooltip :: Maybe FieldBasedTooltip
$sel:tooltipVisibility:TooltipOptions' :: TooltipOptions -> Maybe Visibility
$sel:selectedTooltipType:TooltipOptions' :: TooltipOptions -> Maybe SelectedTooltipType
$sel:fieldBasedTooltip:TooltipOptions' :: TooltipOptions -> Maybe FieldBasedTooltip
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"FieldBasedTooltip" 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 FieldBasedTooltip
fieldBasedTooltip,
            (Key
"SelectedTooltipType" 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 SelectedTooltipType
selectedTooltipType,
            (Key
"TooltipVisibility" 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
tooltipVisibility
          ]
      )