module Stratosphere.QuickSight.Dashboard.WordCloudOptionsProperty (
        WordCloudOptionsProperty(..), mkWordCloudOptionsProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import Stratosphere.ResourceProperties
import Stratosphere.Value
data WordCloudOptionsProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-quicksight-dashboard-wordcloudoptions.html>
    WordCloudOptionsProperty {WordCloudOptionsProperty -> ()
haddock_workaround_ :: (),
                              -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-quicksight-dashboard-wordcloudoptions.html#cfn-quicksight-dashboard-wordcloudoptions-cloudlayout>
                              WordCloudOptionsProperty -> Maybe (Value Text)
cloudLayout :: (Prelude.Maybe (Value Prelude.Text)),
                              -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-quicksight-dashboard-wordcloudoptions.html#cfn-quicksight-dashboard-wordcloudoptions-maximumstringlength>
                              WordCloudOptionsProperty -> Maybe (Value Double)
maximumStringLength :: (Prelude.Maybe (Value Prelude.Double)),
                              -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-quicksight-dashboard-wordcloudoptions.html#cfn-quicksight-dashboard-wordcloudoptions-wordcasing>
                              WordCloudOptionsProperty -> Maybe (Value Text)
wordCasing :: (Prelude.Maybe (Value Prelude.Text)),
                              -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-quicksight-dashboard-wordcloudoptions.html#cfn-quicksight-dashboard-wordcloudoptions-wordorientation>
                              WordCloudOptionsProperty -> Maybe (Value Text)
wordOrientation :: (Prelude.Maybe (Value Prelude.Text)),
                              -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-quicksight-dashboard-wordcloudoptions.html#cfn-quicksight-dashboard-wordcloudoptions-wordpadding>
                              WordCloudOptionsProperty -> Maybe (Value Text)
wordPadding :: (Prelude.Maybe (Value Prelude.Text)),
                              -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-quicksight-dashboard-wordcloudoptions.html#cfn-quicksight-dashboard-wordcloudoptions-wordscaling>
                              WordCloudOptionsProperty -> Maybe (Value Text)
wordScaling :: (Prelude.Maybe (Value Prelude.Text))}
  deriving stock (WordCloudOptionsProperty -> WordCloudOptionsProperty -> Bool
(WordCloudOptionsProperty -> WordCloudOptionsProperty -> Bool)
-> (WordCloudOptionsProperty -> WordCloudOptionsProperty -> Bool)
-> Eq WordCloudOptionsProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WordCloudOptionsProperty -> WordCloudOptionsProperty -> Bool
== :: WordCloudOptionsProperty -> WordCloudOptionsProperty -> Bool
$c/= :: WordCloudOptionsProperty -> WordCloudOptionsProperty -> Bool
/= :: WordCloudOptionsProperty -> WordCloudOptionsProperty -> Bool
Prelude.Eq, Int -> WordCloudOptionsProperty -> ShowS
[WordCloudOptionsProperty] -> ShowS
WordCloudOptionsProperty -> String
(Int -> WordCloudOptionsProperty -> ShowS)
-> (WordCloudOptionsProperty -> String)
-> ([WordCloudOptionsProperty] -> ShowS)
-> Show WordCloudOptionsProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WordCloudOptionsProperty -> ShowS
showsPrec :: Int -> WordCloudOptionsProperty -> ShowS
$cshow :: WordCloudOptionsProperty -> String
show :: WordCloudOptionsProperty -> String
$cshowList :: [WordCloudOptionsProperty] -> ShowS
showList :: [WordCloudOptionsProperty] -> ShowS
Prelude.Show)
mkWordCloudOptionsProperty :: WordCloudOptionsProperty
mkWordCloudOptionsProperty :: WordCloudOptionsProperty
mkWordCloudOptionsProperty
  = WordCloudOptionsProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (), cloudLayout :: Maybe (Value Text)
cloudLayout = Maybe (Value Text)
forall a. Maybe a
Prelude.Nothing,
       maximumStringLength :: Maybe (Value Double)
maximumStringLength = Maybe (Value Double)
forall a. Maybe a
Prelude.Nothing,
       wordCasing :: Maybe (Value Text)
wordCasing = Maybe (Value Text)
forall a. Maybe a
Prelude.Nothing, wordOrientation :: Maybe (Value Text)
wordOrientation = Maybe (Value Text)
forall a. Maybe a
Prelude.Nothing,
       wordPadding :: Maybe (Value Text)
wordPadding = Maybe (Value Text)
forall a. Maybe a
Prelude.Nothing, wordScaling :: Maybe (Value Text)
wordScaling = Maybe (Value Text)
forall a. Maybe a
Prelude.Nothing}
instance ToResourceProperties WordCloudOptionsProperty where
  toResourceProperties :: WordCloudOptionsProperty -> ResourceProperties
toResourceProperties WordCloudOptionsProperty {Maybe (Value Double)
Maybe (Value Text)
()
haddock_workaround_ :: WordCloudOptionsProperty -> ()
cloudLayout :: WordCloudOptionsProperty -> Maybe (Value Text)
maximumStringLength :: WordCloudOptionsProperty -> Maybe (Value Double)
wordCasing :: WordCloudOptionsProperty -> Maybe (Value Text)
wordOrientation :: WordCloudOptionsProperty -> Maybe (Value Text)
wordPadding :: WordCloudOptionsProperty -> Maybe (Value Text)
wordScaling :: WordCloudOptionsProperty -> Maybe (Value Text)
haddock_workaround_ :: ()
cloudLayout :: Maybe (Value Text)
maximumStringLength :: Maybe (Value Double)
wordCasing :: Maybe (Value Text)
wordOrientation :: Maybe (Value Text)
wordPadding :: Maybe (Value Text)
wordScaling :: Maybe (Value Text)
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::QuickSight::Dashboard.WordCloudOptions",
         supportsTags :: Bool
supportsTags = Bool
Prelude.False,
         properties :: Object
properties = [Item Object] -> Object
forall l. IsList l => [Item l] -> l
Prelude.fromList
                        ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
                           [Key -> Value Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"CloudLayout" (Value Text -> (Key, Value))
-> Maybe (Value Text) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Text)
cloudLayout,
                            Key -> Value Double -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"MaximumStringLength" (Value Double -> (Key, Value))
-> Maybe (Value Double) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Double)
maximumStringLength,
                            Key -> Value Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"WordCasing" (Value Text -> (Key, Value))
-> Maybe (Value Text) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Text)
wordCasing,
                            Key -> Value Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"WordOrientation" (Value Text -> (Key, Value))
-> Maybe (Value Text) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Text)
wordOrientation,
                            Key -> Value Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"WordPadding" (Value Text -> (Key, Value))
-> Maybe (Value Text) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Text)
wordPadding,
                            Key -> Value Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"WordScaling" (Value Text -> (Key, Value))
-> Maybe (Value Text) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Text)
wordScaling])}
instance JSON.ToJSON WordCloudOptionsProperty where
  toJSON :: WordCloudOptionsProperty -> Value
toJSON WordCloudOptionsProperty {Maybe (Value Double)
Maybe (Value Text)
()
haddock_workaround_ :: WordCloudOptionsProperty -> ()
cloudLayout :: WordCloudOptionsProperty -> Maybe (Value Text)
maximumStringLength :: WordCloudOptionsProperty -> Maybe (Value Double)
wordCasing :: WordCloudOptionsProperty -> Maybe (Value Text)
wordOrientation :: WordCloudOptionsProperty -> Maybe (Value Text)
wordPadding :: WordCloudOptionsProperty -> Maybe (Value Text)
wordScaling :: WordCloudOptionsProperty -> Maybe (Value Text)
haddock_workaround_ :: ()
cloudLayout :: Maybe (Value Text)
maximumStringLength :: Maybe (Value Double)
wordCasing :: Maybe (Value Text)
wordOrientation :: Maybe (Value Text)
wordPadding :: Maybe (Value Text)
wordScaling :: Maybe (Value Text)
..}
    = [(Key, Value)] -> Value
JSON.object
        ([Item [(Key, Value)]] -> [(Key, Value)]
forall l. IsList l => [Item l] -> l
Prelude.fromList
           ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
              [Key -> Value Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"CloudLayout" (Value Text -> (Key, Value))
-> Maybe (Value Text) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Text)
cloudLayout,
               Key -> Value Double -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"MaximumStringLength" (Value Double -> (Key, Value))
-> Maybe (Value Double) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Double)
maximumStringLength,
               Key -> Value Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"WordCasing" (Value Text -> (Key, Value))
-> Maybe (Value Text) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Text)
wordCasing,
               Key -> Value Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"WordOrientation" (Value Text -> (Key, Value))
-> Maybe (Value Text) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Text)
wordOrientation,
               Key -> Value Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"WordPadding" (Value Text -> (Key, Value))
-> Maybe (Value Text) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Text)
wordPadding,
               Key -> Value Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"WordScaling" (Value Text -> (Key, Value))
-> Maybe (Value Text) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Text)
wordScaling]))
instance Property "CloudLayout" WordCloudOptionsProperty where
  type PropertyType "CloudLayout" WordCloudOptionsProperty = Value Prelude.Text
  set :: PropertyType "CloudLayout" WordCloudOptionsProperty
-> WordCloudOptionsProperty -> WordCloudOptionsProperty
set PropertyType "CloudLayout" WordCloudOptionsProperty
newValue WordCloudOptionsProperty {Maybe (Value Double)
Maybe (Value Text)
()
haddock_workaround_ :: WordCloudOptionsProperty -> ()
cloudLayout :: WordCloudOptionsProperty -> Maybe (Value Text)
maximumStringLength :: WordCloudOptionsProperty -> Maybe (Value Double)
wordCasing :: WordCloudOptionsProperty -> Maybe (Value Text)
wordOrientation :: WordCloudOptionsProperty -> Maybe (Value Text)
wordPadding :: WordCloudOptionsProperty -> Maybe (Value Text)
wordScaling :: WordCloudOptionsProperty -> Maybe (Value Text)
haddock_workaround_ :: ()
cloudLayout :: Maybe (Value Text)
maximumStringLength :: Maybe (Value Double)
wordCasing :: Maybe (Value Text)
wordOrientation :: Maybe (Value Text)
wordPadding :: Maybe (Value Text)
wordScaling :: Maybe (Value Text)
..}
    = WordCloudOptionsProperty
        {cloudLayout :: Maybe (Value Text)
cloudLayout = Value Text -> Maybe (Value Text)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "CloudLayout" WordCloudOptionsProperty
Value Text
newValue, Maybe (Value Double)
Maybe (Value Text)
()
haddock_workaround_ :: ()
maximumStringLength :: Maybe (Value Double)
wordCasing :: Maybe (Value Text)
wordOrientation :: Maybe (Value Text)
wordPadding :: Maybe (Value Text)
wordScaling :: Maybe (Value Text)
haddock_workaround_ :: ()
maximumStringLength :: Maybe (Value Double)
wordCasing :: Maybe (Value Text)
wordOrientation :: Maybe (Value Text)
wordPadding :: Maybe (Value Text)
wordScaling :: Maybe (Value Text)
..}
instance Property "MaximumStringLength" WordCloudOptionsProperty where
  type PropertyType "MaximumStringLength" WordCloudOptionsProperty = Value Prelude.Double
  set :: PropertyType "MaximumStringLength" WordCloudOptionsProperty
-> WordCloudOptionsProperty -> WordCloudOptionsProperty
set PropertyType "MaximumStringLength" WordCloudOptionsProperty
newValue WordCloudOptionsProperty {Maybe (Value Double)
Maybe (Value Text)
()
haddock_workaround_ :: WordCloudOptionsProperty -> ()
cloudLayout :: WordCloudOptionsProperty -> Maybe (Value Text)
maximumStringLength :: WordCloudOptionsProperty -> Maybe (Value Double)
wordCasing :: WordCloudOptionsProperty -> Maybe (Value Text)
wordOrientation :: WordCloudOptionsProperty -> Maybe (Value Text)
wordPadding :: WordCloudOptionsProperty -> Maybe (Value Text)
wordScaling :: WordCloudOptionsProperty -> Maybe (Value Text)
haddock_workaround_ :: ()
cloudLayout :: Maybe (Value Text)
maximumStringLength :: Maybe (Value Double)
wordCasing :: Maybe (Value Text)
wordOrientation :: Maybe (Value Text)
wordPadding :: Maybe (Value Text)
wordScaling :: Maybe (Value Text)
..}
    = WordCloudOptionsProperty
        {maximumStringLength :: Maybe (Value Double)
maximumStringLength = Value Double -> Maybe (Value Double)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "MaximumStringLength" WordCloudOptionsProperty
Value Double
newValue, Maybe (Value Text)
()
haddock_workaround_ :: ()
cloudLayout :: Maybe (Value Text)
wordCasing :: Maybe (Value Text)
wordOrientation :: Maybe (Value Text)
wordPadding :: Maybe (Value Text)
wordScaling :: Maybe (Value Text)
haddock_workaround_ :: ()
cloudLayout :: Maybe (Value Text)
wordCasing :: Maybe (Value Text)
wordOrientation :: Maybe (Value Text)
wordPadding :: Maybe (Value Text)
wordScaling :: Maybe (Value Text)
..}
instance Property "WordCasing" WordCloudOptionsProperty where
  type PropertyType "WordCasing" WordCloudOptionsProperty = Value Prelude.Text
  set :: PropertyType "WordCasing" WordCloudOptionsProperty
-> WordCloudOptionsProperty -> WordCloudOptionsProperty
set PropertyType "WordCasing" WordCloudOptionsProperty
newValue WordCloudOptionsProperty {Maybe (Value Double)
Maybe (Value Text)
()
haddock_workaround_ :: WordCloudOptionsProperty -> ()
cloudLayout :: WordCloudOptionsProperty -> Maybe (Value Text)
maximumStringLength :: WordCloudOptionsProperty -> Maybe (Value Double)
wordCasing :: WordCloudOptionsProperty -> Maybe (Value Text)
wordOrientation :: WordCloudOptionsProperty -> Maybe (Value Text)
wordPadding :: WordCloudOptionsProperty -> Maybe (Value Text)
wordScaling :: WordCloudOptionsProperty -> Maybe (Value Text)
haddock_workaround_ :: ()
cloudLayout :: Maybe (Value Text)
maximumStringLength :: Maybe (Value Double)
wordCasing :: Maybe (Value Text)
wordOrientation :: Maybe (Value Text)
wordPadding :: Maybe (Value Text)
wordScaling :: Maybe (Value Text)
..}
    = WordCloudOptionsProperty {wordCasing :: Maybe (Value Text)
wordCasing = Value Text -> Maybe (Value Text)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "WordCasing" WordCloudOptionsProperty
Value Text
newValue, Maybe (Value Double)
Maybe (Value Text)
()
haddock_workaround_ :: ()
cloudLayout :: Maybe (Value Text)
maximumStringLength :: Maybe (Value Double)
wordOrientation :: Maybe (Value Text)
wordPadding :: Maybe (Value Text)
wordScaling :: Maybe (Value Text)
haddock_workaround_ :: ()
cloudLayout :: Maybe (Value Text)
maximumStringLength :: Maybe (Value Double)
wordOrientation :: Maybe (Value Text)
wordPadding :: Maybe (Value Text)
wordScaling :: Maybe (Value Text)
..}
instance Property "WordOrientation" WordCloudOptionsProperty where
  type PropertyType "WordOrientation" WordCloudOptionsProperty = Value Prelude.Text
  set :: PropertyType "WordOrientation" WordCloudOptionsProperty
-> WordCloudOptionsProperty -> WordCloudOptionsProperty
set PropertyType "WordOrientation" WordCloudOptionsProperty
newValue WordCloudOptionsProperty {Maybe (Value Double)
Maybe (Value Text)
()
haddock_workaround_ :: WordCloudOptionsProperty -> ()
cloudLayout :: WordCloudOptionsProperty -> Maybe (Value Text)
maximumStringLength :: WordCloudOptionsProperty -> Maybe (Value Double)
wordCasing :: WordCloudOptionsProperty -> Maybe (Value Text)
wordOrientation :: WordCloudOptionsProperty -> Maybe (Value Text)
wordPadding :: WordCloudOptionsProperty -> Maybe (Value Text)
wordScaling :: WordCloudOptionsProperty -> Maybe (Value Text)
haddock_workaround_ :: ()
cloudLayout :: Maybe (Value Text)
maximumStringLength :: Maybe (Value Double)
wordCasing :: Maybe (Value Text)
wordOrientation :: Maybe (Value Text)
wordPadding :: Maybe (Value Text)
wordScaling :: Maybe (Value Text)
..}
    = WordCloudOptionsProperty
        {wordOrientation :: Maybe (Value Text)
wordOrientation = Value Text -> Maybe (Value Text)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "WordOrientation" WordCloudOptionsProperty
Value Text
newValue, Maybe (Value Double)
Maybe (Value Text)
()
haddock_workaround_ :: ()
cloudLayout :: Maybe (Value Text)
maximumStringLength :: Maybe (Value Double)
wordCasing :: Maybe (Value Text)
wordPadding :: Maybe (Value Text)
wordScaling :: Maybe (Value Text)
haddock_workaround_ :: ()
cloudLayout :: Maybe (Value Text)
maximumStringLength :: Maybe (Value Double)
wordCasing :: Maybe (Value Text)
wordPadding :: Maybe (Value Text)
wordScaling :: Maybe (Value Text)
..}
instance Property "WordPadding" WordCloudOptionsProperty where
  type PropertyType "WordPadding" WordCloudOptionsProperty = Value Prelude.Text
  set :: PropertyType "WordPadding" WordCloudOptionsProperty
-> WordCloudOptionsProperty -> WordCloudOptionsProperty
set PropertyType "WordPadding" WordCloudOptionsProperty
newValue WordCloudOptionsProperty {Maybe (Value Double)
Maybe (Value Text)
()
haddock_workaround_ :: WordCloudOptionsProperty -> ()
cloudLayout :: WordCloudOptionsProperty -> Maybe (Value Text)
maximumStringLength :: WordCloudOptionsProperty -> Maybe (Value Double)
wordCasing :: WordCloudOptionsProperty -> Maybe (Value Text)
wordOrientation :: WordCloudOptionsProperty -> Maybe (Value Text)
wordPadding :: WordCloudOptionsProperty -> Maybe (Value Text)
wordScaling :: WordCloudOptionsProperty -> Maybe (Value Text)
haddock_workaround_ :: ()
cloudLayout :: Maybe (Value Text)
maximumStringLength :: Maybe (Value Double)
wordCasing :: Maybe (Value Text)
wordOrientation :: Maybe (Value Text)
wordPadding :: Maybe (Value Text)
wordScaling :: Maybe (Value Text)
..}
    = WordCloudOptionsProperty
        {wordPadding :: Maybe (Value Text)
wordPadding = Value Text -> Maybe (Value Text)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "WordPadding" WordCloudOptionsProperty
Value Text
newValue, Maybe (Value Double)
Maybe (Value Text)
()
haddock_workaround_ :: ()
cloudLayout :: Maybe (Value Text)
maximumStringLength :: Maybe (Value Double)
wordCasing :: Maybe (Value Text)
wordOrientation :: Maybe (Value Text)
wordScaling :: Maybe (Value Text)
haddock_workaround_ :: ()
cloudLayout :: Maybe (Value Text)
maximumStringLength :: Maybe (Value Double)
wordCasing :: Maybe (Value Text)
wordOrientation :: Maybe (Value Text)
wordScaling :: Maybe (Value Text)
..}
instance Property "WordScaling" WordCloudOptionsProperty where
  type PropertyType "WordScaling" WordCloudOptionsProperty = Value Prelude.Text
  set :: PropertyType "WordScaling" WordCloudOptionsProperty
-> WordCloudOptionsProperty -> WordCloudOptionsProperty
set PropertyType "WordScaling" WordCloudOptionsProperty
newValue WordCloudOptionsProperty {Maybe (Value Double)
Maybe (Value Text)
()
haddock_workaround_ :: WordCloudOptionsProperty -> ()
cloudLayout :: WordCloudOptionsProperty -> Maybe (Value Text)
maximumStringLength :: WordCloudOptionsProperty -> Maybe (Value Double)
wordCasing :: WordCloudOptionsProperty -> Maybe (Value Text)
wordOrientation :: WordCloudOptionsProperty -> Maybe (Value Text)
wordPadding :: WordCloudOptionsProperty -> Maybe (Value Text)
wordScaling :: WordCloudOptionsProperty -> Maybe (Value Text)
haddock_workaround_ :: ()
cloudLayout :: Maybe (Value Text)
maximumStringLength :: Maybe (Value Double)
wordCasing :: Maybe (Value Text)
wordOrientation :: Maybe (Value Text)
wordPadding :: Maybe (Value Text)
wordScaling :: Maybe (Value Text)
..}
    = WordCloudOptionsProperty
        {wordScaling :: Maybe (Value Text)
wordScaling = Value Text -> Maybe (Value Text)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "WordScaling" WordCloudOptionsProperty
Value Text
newValue, Maybe (Value Double)
Maybe (Value Text)
()
haddock_workaround_ :: ()
cloudLayout :: Maybe (Value Text)
maximumStringLength :: Maybe (Value Double)
wordCasing :: Maybe (Value Text)
wordOrientation :: Maybe (Value Text)
wordPadding :: Maybe (Value Text)
haddock_workaround_ :: ()
cloudLayout :: Maybe (Value Text)
maximumStringLength :: Maybe (Value Double)
wordCasing :: Maybe (Value Text)
wordOrientation :: Maybe (Value Text)
wordPadding :: Maybe (Value Text)
..}