{-# 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.WordCloudOptions
-- 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.WordCloudOptions 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.WordCloudCloudLayout
import Amazonka.QuickSight.Types.WordCloudWordCasing
import Amazonka.QuickSight.Types.WordCloudWordOrientation
import Amazonka.QuickSight.Types.WordCloudWordPadding
import Amazonka.QuickSight.Types.WordCloudWordScaling

-- | The word cloud options for a word cloud visual.
--
-- /See:/ 'newWordCloudOptions' smart constructor.
data WordCloudOptions = WordCloudOptions'
  { -- | The cloud layout options (fluid, normal) of a word cloud.
    WordCloudOptions -> Maybe WordCloudCloudLayout
cloudLayout :: Prelude.Maybe WordCloudCloudLayout,
    -- | The length limit of each word from 1-100.
    WordCloudOptions -> Maybe Natural
maximumStringLength :: Prelude.Maybe Prelude.Natural,
    -- | The word casing options (lower_case, existing_case) for the words in a
    -- word cloud.
    WordCloudOptions -> Maybe WordCloudWordCasing
wordCasing :: Prelude.Maybe WordCloudWordCasing,
    -- | The word orientation options (horizontal, horizontal_and_vertical) for
    -- the words in a word cloud.
    WordCloudOptions -> Maybe WordCloudWordOrientation
wordOrientation :: Prelude.Maybe WordCloudWordOrientation,
    -- | The word padding options (none, small, medium, large) for the words in a
    -- word cloud.
    WordCloudOptions -> Maybe WordCloudWordPadding
wordPadding :: Prelude.Maybe WordCloudWordPadding,
    -- | The word scaling options (emphasize, normal) for the words in a word
    -- cloud.
    WordCloudOptions -> Maybe WordCloudWordScaling
wordScaling :: Prelude.Maybe WordCloudWordScaling
  }
  deriving (WordCloudOptions -> WordCloudOptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WordCloudOptions -> WordCloudOptions -> Bool
$c/= :: WordCloudOptions -> WordCloudOptions -> Bool
== :: WordCloudOptions -> WordCloudOptions -> Bool
$c== :: WordCloudOptions -> WordCloudOptions -> Bool
Prelude.Eq, ReadPrec [WordCloudOptions]
ReadPrec WordCloudOptions
Int -> ReadS WordCloudOptions
ReadS [WordCloudOptions]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WordCloudOptions]
$creadListPrec :: ReadPrec [WordCloudOptions]
readPrec :: ReadPrec WordCloudOptions
$creadPrec :: ReadPrec WordCloudOptions
readList :: ReadS [WordCloudOptions]
$creadList :: ReadS [WordCloudOptions]
readsPrec :: Int -> ReadS WordCloudOptions
$creadsPrec :: Int -> ReadS WordCloudOptions
Prelude.Read, Int -> WordCloudOptions -> ShowS
[WordCloudOptions] -> ShowS
WordCloudOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WordCloudOptions] -> ShowS
$cshowList :: [WordCloudOptions] -> ShowS
show :: WordCloudOptions -> String
$cshow :: WordCloudOptions -> String
showsPrec :: Int -> WordCloudOptions -> ShowS
$cshowsPrec :: Int -> WordCloudOptions -> ShowS
Prelude.Show, forall x. Rep WordCloudOptions x -> WordCloudOptions
forall x. WordCloudOptions -> Rep WordCloudOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WordCloudOptions x -> WordCloudOptions
$cfrom :: forall x. WordCloudOptions -> Rep WordCloudOptions x
Prelude.Generic)

-- |
-- Create a value of 'WordCloudOptions' 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:
--
-- 'cloudLayout', 'wordCloudOptions_cloudLayout' - The cloud layout options (fluid, normal) of a word cloud.
--
-- 'maximumStringLength', 'wordCloudOptions_maximumStringLength' - The length limit of each word from 1-100.
--
-- 'wordCasing', 'wordCloudOptions_wordCasing' - The word casing options (lower_case, existing_case) for the words in a
-- word cloud.
--
-- 'wordOrientation', 'wordCloudOptions_wordOrientation' - The word orientation options (horizontal, horizontal_and_vertical) for
-- the words in a word cloud.
--
-- 'wordPadding', 'wordCloudOptions_wordPadding' - The word padding options (none, small, medium, large) for the words in a
-- word cloud.
--
-- 'wordScaling', 'wordCloudOptions_wordScaling' - The word scaling options (emphasize, normal) for the words in a word
-- cloud.
newWordCloudOptions ::
  WordCloudOptions
newWordCloudOptions :: WordCloudOptions
newWordCloudOptions =
  WordCloudOptions'
    { $sel:cloudLayout:WordCloudOptions' :: Maybe WordCloudCloudLayout
cloudLayout = forall a. Maybe a
Prelude.Nothing,
      $sel:maximumStringLength:WordCloudOptions' :: Maybe Natural
maximumStringLength = forall a. Maybe a
Prelude.Nothing,
      $sel:wordCasing:WordCloudOptions' :: Maybe WordCloudWordCasing
wordCasing = forall a. Maybe a
Prelude.Nothing,
      $sel:wordOrientation:WordCloudOptions' :: Maybe WordCloudWordOrientation
wordOrientation = forall a. Maybe a
Prelude.Nothing,
      $sel:wordPadding:WordCloudOptions' :: Maybe WordCloudWordPadding
wordPadding = forall a. Maybe a
Prelude.Nothing,
      $sel:wordScaling:WordCloudOptions' :: Maybe WordCloudWordScaling
wordScaling = forall a. Maybe a
Prelude.Nothing
    }

-- | The cloud layout options (fluid, normal) of a word cloud.
wordCloudOptions_cloudLayout :: Lens.Lens' WordCloudOptions (Prelude.Maybe WordCloudCloudLayout)
wordCloudOptions_cloudLayout :: Lens' WordCloudOptions (Maybe WordCloudCloudLayout)
wordCloudOptions_cloudLayout = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\WordCloudOptions' {Maybe WordCloudCloudLayout
cloudLayout :: Maybe WordCloudCloudLayout
$sel:cloudLayout:WordCloudOptions' :: WordCloudOptions -> Maybe WordCloudCloudLayout
cloudLayout} -> Maybe WordCloudCloudLayout
cloudLayout) (\s :: WordCloudOptions
s@WordCloudOptions' {} Maybe WordCloudCloudLayout
a -> WordCloudOptions
s {$sel:cloudLayout:WordCloudOptions' :: Maybe WordCloudCloudLayout
cloudLayout = Maybe WordCloudCloudLayout
a} :: WordCloudOptions)

-- | The length limit of each word from 1-100.
wordCloudOptions_maximumStringLength :: Lens.Lens' WordCloudOptions (Prelude.Maybe Prelude.Natural)
wordCloudOptions_maximumStringLength :: Lens' WordCloudOptions (Maybe Natural)
wordCloudOptions_maximumStringLength = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\WordCloudOptions' {Maybe Natural
maximumStringLength :: Maybe Natural
$sel:maximumStringLength:WordCloudOptions' :: WordCloudOptions -> Maybe Natural
maximumStringLength} -> Maybe Natural
maximumStringLength) (\s :: WordCloudOptions
s@WordCloudOptions' {} Maybe Natural
a -> WordCloudOptions
s {$sel:maximumStringLength:WordCloudOptions' :: Maybe Natural
maximumStringLength = Maybe Natural
a} :: WordCloudOptions)

-- | The word casing options (lower_case, existing_case) for the words in a
-- word cloud.
wordCloudOptions_wordCasing :: Lens.Lens' WordCloudOptions (Prelude.Maybe WordCloudWordCasing)
wordCloudOptions_wordCasing :: Lens' WordCloudOptions (Maybe WordCloudWordCasing)
wordCloudOptions_wordCasing = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\WordCloudOptions' {Maybe WordCloudWordCasing
wordCasing :: Maybe WordCloudWordCasing
$sel:wordCasing:WordCloudOptions' :: WordCloudOptions -> Maybe WordCloudWordCasing
wordCasing} -> Maybe WordCloudWordCasing
wordCasing) (\s :: WordCloudOptions
s@WordCloudOptions' {} Maybe WordCloudWordCasing
a -> WordCloudOptions
s {$sel:wordCasing:WordCloudOptions' :: Maybe WordCloudWordCasing
wordCasing = Maybe WordCloudWordCasing
a} :: WordCloudOptions)

-- | The word orientation options (horizontal, horizontal_and_vertical) for
-- the words in a word cloud.
wordCloudOptions_wordOrientation :: Lens.Lens' WordCloudOptions (Prelude.Maybe WordCloudWordOrientation)
wordCloudOptions_wordOrientation :: Lens' WordCloudOptions (Maybe WordCloudWordOrientation)
wordCloudOptions_wordOrientation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\WordCloudOptions' {Maybe WordCloudWordOrientation
wordOrientation :: Maybe WordCloudWordOrientation
$sel:wordOrientation:WordCloudOptions' :: WordCloudOptions -> Maybe WordCloudWordOrientation
wordOrientation} -> Maybe WordCloudWordOrientation
wordOrientation) (\s :: WordCloudOptions
s@WordCloudOptions' {} Maybe WordCloudWordOrientation
a -> WordCloudOptions
s {$sel:wordOrientation:WordCloudOptions' :: Maybe WordCloudWordOrientation
wordOrientation = Maybe WordCloudWordOrientation
a} :: WordCloudOptions)

-- | The word padding options (none, small, medium, large) for the words in a
-- word cloud.
wordCloudOptions_wordPadding :: Lens.Lens' WordCloudOptions (Prelude.Maybe WordCloudWordPadding)
wordCloudOptions_wordPadding :: Lens' WordCloudOptions (Maybe WordCloudWordPadding)
wordCloudOptions_wordPadding = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\WordCloudOptions' {Maybe WordCloudWordPadding
wordPadding :: Maybe WordCloudWordPadding
$sel:wordPadding:WordCloudOptions' :: WordCloudOptions -> Maybe WordCloudWordPadding
wordPadding} -> Maybe WordCloudWordPadding
wordPadding) (\s :: WordCloudOptions
s@WordCloudOptions' {} Maybe WordCloudWordPadding
a -> WordCloudOptions
s {$sel:wordPadding:WordCloudOptions' :: Maybe WordCloudWordPadding
wordPadding = Maybe WordCloudWordPadding
a} :: WordCloudOptions)

-- | The word scaling options (emphasize, normal) for the words in a word
-- cloud.
wordCloudOptions_wordScaling :: Lens.Lens' WordCloudOptions (Prelude.Maybe WordCloudWordScaling)
wordCloudOptions_wordScaling :: Lens' WordCloudOptions (Maybe WordCloudWordScaling)
wordCloudOptions_wordScaling = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\WordCloudOptions' {Maybe WordCloudWordScaling
wordScaling :: Maybe WordCloudWordScaling
$sel:wordScaling:WordCloudOptions' :: WordCloudOptions -> Maybe WordCloudWordScaling
wordScaling} -> Maybe WordCloudWordScaling
wordScaling) (\s :: WordCloudOptions
s@WordCloudOptions' {} Maybe WordCloudWordScaling
a -> WordCloudOptions
s {$sel:wordScaling:WordCloudOptions' :: Maybe WordCloudWordScaling
wordScaling = Maybe WordCloudWordScaling
a} :: WordCloudOptions)

instance Data.FromJSON WordCloudOptions where
  parseJSON :: Value -> Parser WordCloudOptions
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"WordCloudOptions"
      ( \Object
x ->
          Maybe WordCloudCloudLayout
-> Maybe Natural
-> Maybe WordCloudWordCasing
-> Maybe WordCloudWordOrientation
-> Maybe WordCloudWordPadding
-> Maybe WordCloudWordScaling
-> WordCloudOptions
WordCloudOptions'
            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
"CloudLayout")
            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
"MaximumStringLength")
            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
"WordCasing")
            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
"WordOrientation")
            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
"WordPadding")
            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
"WordScaling")
      )

instance Prelude.Hashable WordCloudOptions where
  hashWithSalt :: Int -> WordCloudOptions -> Int
hashWithSalt Int
_salt WordCloudOptions' {Maybe Natural
Maybe WordCloudCloudLayout
Maybe WordCloudWordCasing
Maybe WordCloudWordOrientation
Maybe WordCloudWordPadding
Maybe WordCloudWordScaling
wordScaling :: Maybe WordCloudWordScaling
wordPadding :: Maybe WordCloudWordPadding
wordOrientation :: Maybe WordCloudWordOrientation
wordCasing :: Maybe WordCloudWordCasing
maximumStringLength :: Maybe Natural
cloudLayout :: Maybe WordCloudCloudLayout
$sel:wordScaling:WordCloudOptions' :: WordCloudOptions -> Maybe WordCloudWordScaling
$sel:wordPadding:WordCloudOptions' :: WordCloudOptions -> Maybe WordCloudWordPadding
$sel:wordOrientation:WordCloudOptions' :: WordCloudOptions -> Maybe WordCloudWordOrientation
$sel:wordCasing:WordCloudOptions' :: WordCloudOptions -> Maybe WordCloudWordCasing
$sel:maximumStringLength:WordCloudOptions' :: WordCloudOptions -> Maybe Natural
$sel:cloudLayout:WordCloudOptions' :: WordCloudOptions -> Maybe WordCloudCloudLayout
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe WordCloudCloudLayout
cloudLayout
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maximumStringLength
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe WordCloudWordCasing
wordCasing
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe WordCloudWordOrientation
wordOrientation
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe WordCloudWordPadding
wordPadding
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe WordCloudWordScaling
wordScaling

instance Prelude.NFData WordCloudOptions where
  rnf :: WordCloudOptions -> ()
rnf WordCloudOptions' {Maybe Natural
Maybe WordCloudCloudLayout
Maybe WordCloudWordCasing
Maybe WordCloudWordOrientation
Maybe WordCloudWordPadding
Maybe WordCloudWordScaling
wordScaling :: Maybe WordCloudWordScaling
wordPadding :: Maybe WordCloudWordPadding
wordOrientation :: Maybe WordCloudWordOrientation
wordCasing :: Maybe WordCloudWordCasing
maximumStringLength :: Maybe Natural
cloudLayout :: Maybe WordCloudCloudLayout
$sel:wordScaling:WordCloudOptions' :: WordCloudOptions -> Maybe WordCloudWordScaling
$sel:wordPadding:WordCloudOptions' :: WordCloudOptions -> Maybe WordCloudWordPadding
$sel:wordOrientation:WordCloudOptions' :: WordCloudOptions -> Maybe WordCloudWordOrientation
$sel:wordCasing:WordCloudOptions' :: WordCloudOptions -> Maybe WordCloudWordCasing
$sel:maximumStringLength:WordCloudOptions' :: WordCloudOptions -> Maybe Natural
$sel:cloudLayout:WordCloudOptions' :: WordCloudOptions -> Maybe WordCloudCloudLayout
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe WordCloudCloudLayout
cloudLayout
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maximumStringLength
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe WordCloudWordCasing
wordCasing
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe WordCloudWordOrientation
wordOrientation
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe WordCloudWordPadding
wordPadding
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe WordCloudWordScaling
wordScaling

instance Data.ToJSON WordCloudOptions where
  toJSON :: WordCloudOptions -> Value
toJSON WordCloudOptions' {Maybe Natural
Maybe WordCloudCloudLayout
Maybe WordCloudWordCasing
Maybe WordCloudWordOrientation
Maybe WordCloudWordPadding
Maybe WordCloudWordScaling
wordScaling :: Maybe WordCloudWordScaling
wordPadding :: Maybe WordCloudWordPadding
wordOrientation :: Maybe WordCloudWordOrientation
wordCasing :: Maybe WordCloudWordCasing
maximumStringLength :: Maybe Natural
cloudLayout :: Maybe WordCloudCloudLayout
$sel:wordScaling:WordCloudOptions' :: WordCloudOptions -> Maybe WordCloudWordScaling
$sel:wordPadding:WordCloudOptions' :: WordCloudOptions -> Maybe WordCloudWordPadding
$sel:wordOrientation:WordCloudOptions' :: WordCloudOptions -> Maybe WordCloudWordOrientation
$sel:wordCasing:WordCloudOptions' :: WordCloudOptions -> Maybe WordCloudWordCasing
$sel:maximumStringLength:WordCloudOptions' :: WordCloudOptions -> Maybe Natural
$sel:cloudLayout:WordCloudOptions' :: WordCloudOptions -> Maybe WordCloudCloudLayout
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"CloudLayout" 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 WordCloudCloudLayout
cloudLayout,
            (Key
"MaximumStringLength" 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
maximumStringLength,
            (Key
"WordCasing" 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 WordCloudWordCasing
wordCasing,
            (Key
"WordOrientation" 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 WordCloudWordOrientation
wordOrientation,
            (Key
"WordPadding" 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 WordCloudWordPadding
wordPadding,
            (Key
"WordScaling" 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 WordCloudWordScaling
wordScaling
          ]
      )