{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}

{-|
Module      : Graphics.Vega.VegaLite.Configuration
Copyright   : (c) Douglas Burke, 2018-2021
License     : BSD3

Maintainer  : dburke.gw@gmail.com
Stability   : unstable
Portability : CPP, OverloadedStrings

Top-level configuration options. As this can configure most
of a visualization, it needs to import most of the other
modules.

-}

module Graphics.Vega.VegaLite.Configuration
       ( ConfigurationProperty(..)
       , FieldTitleProperty(..)

       , ViewConfig(..)
       , CompositionConfig(..)
       , ScaleConfig(..)
       , RangeConfig(..)
       , AxisConfig(..)
       , AxisChoice(..)
       , LegendConfig(..)
       , TitleConfig(..)

       , TitleFrame(..)

       , configuration
       , title

       ) where


import qualified Data.Aeson as A

import qualified Data.Text as T

import Data.Aeson ((.=), object)
import Data.Aeson.Types (Pair)

#if !(MIN_VERSION_base(4, 12, 0))
import Data.Monoid ((<>))
#endif

import Graphics.Vega.VegaLite.Core
  ( AxisProperty
  , axisProperty
  , schemeProperty
  )
import Graphics.Vega.VegaLite.Foundation
  ( Angle
  , Color
  , StyleLabel
  , CompositionAlignment
  , DashStyle
  , DashOffset
  , APosition
  , FontWeight
  , Opacity
  , Orientation
  , OverlapStrategy
  , Side
  , StrokeCap
  , StrokeJoin
  , Symbol
  , HAlign
  , VAlign
  , BandAlign
  , Padding
  , Autosize
  , ZIndex
  , HeaderProperty
  , ViewBackground
  , Cursor
  , fromT
  , fromColor
  , fromDS
  , splitOnNewline
  , header_
  , anchorLabel
  , fontWeightSpec
  , orientationSpec
  , hAlignLabel
  , vAlignLabel
  , bandAlignLabel
  , strokeCapLabel
  , strokeJoinLabel
  , sideLabel
  , overlapStrategyLabel
  , symbolLabel
  , compositionAlignmentSpec
  , paddingSpec
  , autosizeProperty
  , viewBackgroundSpec
  , cursorLabel
  , (.=~), toObject
  )
import Graphics.Vega.VegaLite.Geometry
  ( ProjectionProperty
  , projectionProperty
  )
import Graphics.Vega.VegaLite.Legend
  ( LegendLayout
  , LegendOrientation
  , legendOrientLabel
  , legendLayoutSpec
  )
import Graphics.Vega.VegaLite.Mark
  ( MarkProperty
  , oldMprops_
  )
import Graphics.Vega.VegaLite.Scale
  ( ScaleNice
  , scaleNiceSpec
  )
import Graphics.Vega.VegaLite.Selection
  ( Selection
  , SelectionProperty
  , selectionProperties
  , selectionLabel
  )
import Graphics.Vega.VegaLite.Specification
  ( VLSpec
  , VLProperty(VLTitle)
  , ConfigureSpec(..)
  , BuildConfigureSpecs
  , LabelledSpec
  , PropertySpec
  )


{-|

Type of configuration property to customise. See the
<https://vega.github.io/vega-lite/docs/config.html Vega-Lite documentation>
for details. There are multiple ways to configure the properties
of an axis, as discussed in the Vega-Lite
<https://vega.github.io/vega-lite/docs/axis.html#config axis configuration>
documentation.

Used by 'configuration'.

In @version 0.7.0.0@, the 'AxisBand' , 'AxisDiscrete', 'AxisPoint',
'AxisQuantitative', and 'AxisTemporal' were changed to accept an
additional argument ('AxisChoice'), to define which axis the configuration
should be applied to.

In @version 0.6.0.0@:

- the @Autosize@, @Background@, @CountTitle@, @FieldTitle@, @Legend@,
  @NumberFormat@, @Padding@, @Projection@, @Range@, @Scale@.
  @TimeFormat@, and @View@
  constructors have been deprecated, and should be replaced by
  'AutosizeStyle', 'BackgroundStyle', 'CountTitleStyle', 'FieldTitleStyle',
  'LegendStyle', 'NumberFormatStyle', 'PaddingStyle', 'ProjectionStyle',
  'RangeStyle', 'ScaleStyle', 'TimeFormatStyle', and 'ViewStyle'
  respectively. The axis configuration options have not been updated
  to this system.

- new constructors have been added: 'AxisDiscrete', 'AxisPoint',
  'AxisQuantitative', 'AxisTemporal', 'BoxplotStyle', 'ErrorBandStyle',
  'ErrorBarStyle', 'HeaderColumnStyle', 'HeaderFacetStyle', 'HeaderRowStyle',
  'ImageStyle', and 'RepeatStyle'.

- 'ConcatStyle' and 'FacetStyle' now take a common type, 'CompositionConfig',
  rather than @ConcatConfig@ and @FacetStyle@.

In @version 0.5.0.0@:

- the @RemoveInvalid@ constructor was removed, as
the new 'Graphics.Vega.VegaLite.MRemoveInvalid' constructor for the
'MarkProperty' type should be used instead
(so @'configuration' (RemoveInvalid b)@ changes to
@'configuration' ('Graphics.Vega.VegaLite.MarkStyle' ['Graphics.Vega.VegaLite.MRemoveInvalid' b])@.

- the @Stack@ constructor (which was called @StackProperty@ prior
  to version @0.4.0.0@) was removed.

-}

{-# DEPRECATED Autosize "Please change Autosize to AutosizeStyle" #-}
{-# DEPRECATED Background "Please change Background to BackgroundStyle" #-}
{-# DEPRECATED CountTitle "Please change CountTitle to CountTitleStyle" #-}
{-# DEPRECATED FieldTitle "Please change FieldTitle to FieldTitleStyle" #-}
{-# DEPRECATED Legend "Please change Legend to LegendStyle" #-}
{-# DEPRECATED NumberFormat "Please change NumberFormat to NumberFormatStyle" #-}
{-# DEPRECATED Padding "Please change Padding to PaddingStyle" #-}
{-# DEPRECATED Projection "Please change Projection to ProjectionStyle" #-}
{-# DEPRECATED Range "Please change Range to RangeStyle" #-}
{-# DEPRECATED Scale "Please change Scale to ScaleStyle" #-}
{-# DEPRECATED TimeFormat "Please change TimeFormat to TimeFormatStyle" #-}
{-# DEPRECATED View "Please change View to ViewStyle" #-}

{-# DEPRECATED NamedStyle "Please change Legend to MarkNamedStyles" #-}
{-# DEPRECATED NamedStyles "Please change Legend to MarkNamedStyles" #-}

data ConfigurationProperty
    = ArcStyle [MarkProperty]
      -- ^ The default appearance of arc marks.
      --
      --   @since 0.9.0.0
    | AreaStyle [MarkProperty]
      -- ^ The default appearance of area marks.
    | AriaStyle Bool
      -- ^ A boolean flag indicating if ARIA default attributes should be included for
      --   marks and guides (SVG output only). If False, the \"aria-hidden\"
      --   attribute will be set for all guides, removing them from the ARIA accessibility
      --   tree and Vega-Lite will not generate default descriptions for marks.
      --
      --   __Default value:__ True
      --
      --   @since 0.9.0.0
    | AutosizeStyle [Autosize]
      -- ^ The default sizing of visualizations.
      --
      --   This was renamed from @Autosize@ in @0.6.0.0@.
      --
      --   @since 0.6.0.0
    | Axis [AxisConfig]
      -- ^ The default appearance of axes.
    | AxisBand AxisChoice [AxisConfig]
      -- ^ The default appearance of axes with band scaling.
      --
      --   See also 'AxisDiscrete'.
    | AxisBottom [AxisConfig]
      -- ^ The default appearance of the bottom-side axes.
    | AxisDiscrete AxisChoice [AxisConfig]
      -- ^ The default appearance of axes with point or band scales.
      --
      --   See also 'AxisBand' and 'AxisPoint'.
      --
      --   @since 0.6.0.0
    | AxisLeft [AxisConfig]
      -- ^ The default appearance of the left-side axes.
    | AxisPoint AxisChoice [AxisConfig]
      -- ^ The default appearance of axes with point scales.
      --
      --   See also 'AxisDiscrete'.
      --
      --   @since 0.6.0.0
    | AxisQuantitative AxisChoice [AxisConfig]
      -- ^ The default appearance of quantitative axes.
      --
      --   @since 0.6.0.0
    | AxisRight [AxisConfig]
      -- ^ The default appearance of the right-side axes.
    | AxisTemporal AxisChoice [AxisConfig]
      -- ^ The default appearance of temporal axes.
      --
      --   @since 0.6.0.0
    | AxisTop [AxisConfig]
      -- ^ The default appearance of the top-side axes.
    | AxisX [AxisConfig]
      -- ^ The default appearance of the X axes.
    | AxisY [AxisConfig]
      -- ^ The default appearance of the Y axes.
    | AxisNamedStyles [(StyleLabel, [AxisProperty])]
      -- ^  Assign a set of axis styles to a label. These labels can then be referred
      --    to when configuring an axis with 'Graphics.Vega.VegaLite.AxStyle' and
      --    'AStyle'.
      --
      --   To customize the style for guides (axes, headers, and legends), Vega-Lite
      --   includes the following built-in style names:
      --
      --    - \"guide-label\": style for axis, legend, and header labels
      --    - \"guide-title\": style for axis, legend, and header titles
      --    - \"group-label\": styles for chart titles
      --    - \"group-subtitle\"
      --
      --   @since 0.6.0.0
    | BackgroundStyle Color
      -- ^ The default background color of visualizations.
      --
      --   This was changed to use the @Color@ type alias in version @0.5.0.0@.
      --
      --   This was renamed from @Background@ in @0.6.0.0@.
      --
      --   @since 0.6.0.0
    | BarStyle [MarkProperty]
      -- ^ The default appearance of bar marks.
    | BoxplotStyle [MarkProperty]
      -- ^ The default appearance for box plots.
      --
      --   @since 0.6.0.0
    | CircleStyle [MarkProperty]
      -- ^ The default appearance of circle marks.
    | ConcatStyle [CompositionConfig]
      -- ^ The default appearance for all concatenation and repeat view
      --   composition operators ('Graphics.Vega.VegaLite.vlConcat',
      --   'Graphics.Vega.VegaLite.hConcat', 'Graphics.Vega.VegaLite.vConcat',
      --   and 'Graphics.Vega.VegaLite.repeat`).
      --
      --   In @0.6.0.0@ this was changed from accepting @ConcatConfig@ to
      --   'CompositionConfig'.
      --
      --   Vega-Lite 4.8 changed this field to also control repeat-view
      --   operators (which previously had used @RepeatStyle@).
      --
      --   @since 0.4.0.0
    | CountTitleStyle T.Text
      -- ^ The default axis and legend title for count fields. The default is
      --   @"Count of Records"@.
      --
      --   This was renamed from @CountTitle@ in @0.6.0.0@.
      --
      --   @since 0.6.0.0
    | CustomFormatStyle Bool
      -- ^ Allow the \"formatType\" property for text marks and guides to accept a custom
      --   formatter function registered as a
      --   [Vega Expression](https://vega.github.io/vega-lite/docs/compile.html#format-type).
      --
      --   @since 0.9.0.0
    | ErrorBandStyle [MarkProperty]
      -- ^ The default appearance for error bands.
      --
      --   @since 0.6.0.0
    | ErrorBarStyle [MarkProperty]
      -- ^ The default appearance for error bars.
      --
      --   @since 0.6.0.0
    | FacetStyle [CompositionConfig]
      -- ^ The default appearance of facet layouts.
      --
      --   In @0.6.0.0@ this was changed from accepting @FacetConfig@ to
      --   'CompositionConfig'.
      --
      --   @since 0.4.0.0
    | FieldTitleStyle FieldTitleProperty
      -- ^ The default title-generation style for fields.
      --
      --   This was renamed from @FieldTitle@ in @0.6.0.0@.
      --
      --   @since 0.6.0.0
    | FontStyle T.Text
      -- ^ The default font for all text marks, titles, and labels.
      --
      --   The naming scheme used here is somewhat unfortunate, as this
      --   is for the name of the font (such as @\"serif\"@ or
      --   @\"Comic Sans MS\"@), not the font-style.
      --
      --   @since 0.6.0.0
    | GeoshapeStyle [MarkProperty]
      -- ^ The default appearance of geoshape marks.
      --
      --   @since 0.4.0.0
    | HeaderStyle [HeaderProperty]
      -- ^ The default appearance of all headers.
      --
      --   @since 0.4.0.0
    | HeaderColumnStyle [HeaderProperty]
      -- ^ The default appearance for column headers.
      --
      --   @since 0.6.0.0
    | HeaderFacetStyle [HeaderProperty]
      -- ^ The default appearance for non-row and non-column facet headers.
      --
      --   @since 0.6.0.0
    | HeaderRowStyle [HeaderProperty]
      -- ^ The default appearance for row headers.
      --
      --   @since 0.6.0.0
    | ImageStyle [MarkProperty]
      -- ^ The default appearance for images.
      --
      --   @since 0.6.0.0
    | LegendStyle [LegendConfig]
      -- ^ The default appearance of legends.
      --
      --   This was renamed from @Legend@ in @0.6.0.0@.
      --
      --   @since 0.6.0.0
    | LineStyle [MarkProperty]
      -- ^ The default appearance of line marks.
    | LineBreakStyle T.Text
      -- ^ The delimiter, such as a newline character, upon which to break text
      --   strings into multiple lines. This can be over-ridden by mark or style configuration
      --   settings.
      --
      --   Added in Vega-Lite 4.6.0.
      --
      --   @since 0.7.0.0
    | MarkStyle [MarkProperty]
      -- ^ The default mark appearance.
    | MarkNamedStyles [(StyleLabel, [MarkProperty])]
      -- ^  Assign a set of mark styles to a label. These labels can then be referred
      --    to when configuring a mark, such as with 'TStyle'.
      --
      --   @since 0.6.0.0
    | NumberFormatStyle T.Text
      -- ^ The default number formatting for axis and text labels, using
      --   [D3's number format pattern](https://github.com/d3/d3-format#locale_format).
      --
      --   As an example @NumberFormatStyle "s"@ will use SI units.
      --
      --   This was renamed from @NumberFormat@ in @0.6.0.0@.
      --
      --   @since 0.6.0.0
    | PaddingStyle Padding
      -- ^ The default padding in pixels from the edge of the of visualization
      --   to the data rectangle.
      --
      --   This was renamed from @Padding@ in @0.6.0.0@.
      --
      --   @since 0.6.0.0
    | PointStyle [MarkProperty]
      -- ^ The default appearance of point marks.
    | ProjectionStyle [ProjectionProperty]
      -- ^ The default style of map projections.
      --
      --   This was renamed from @Projection@ in @0.6.0.0@.
      --
      --   @since 0.6.0.0
    | RangeStyle [RangeConfig]
      -- ^ The default range properties used when scaling.
      --
      --   This was renamed from @Range@ in @0.6.0.0@.
      --
      --   @since 0.6.0.0
    | RectStyle [MarkProperty]
      -- ^ The default appearance of rectangle marks.
    | RepeatStyle [CompositionConfig]  -- TODO: remove
      -- ^ The default appearance for the 'Graphics.Vega.VegaLite.repeat` operator.
      --
      --   Support for this setting was removed in Vega-Lite 4.8. This
      --   constructor is currently still supported, but will be removed
      --   in a future release. The 'ConcatStyle' option should be
      --   used instead.
      --
      --   @since 0.6.0.0
    | RuleStyle [MarkProperty]
      -- ^ The default appearance of rule marks.
    | ScaleStyle [ScaleConfig]
      -- ^ The default properties used when scaling.
      --
      --   This was renamed from @Scale@ in @0.6.0.0@.
      --
      --   @since 0.6.0.0
    | SelectionStyle [(Selection, [SelectionProperty])]
      -- ^ The default appearance of selection marks.
    | SquareStyle [MarkProperty]
      -- ^  the default appearance of square marks
    | TextStyle [MarkProperty]
      -- ^ The default appearance of text marks.
    | TickStyle [MarkProperty]
      -- ^ The default appearance of tick marks.
    | TimeFormatStyle T.Text
      -- ^ The default time format for raw time values (without time units)
      --   in text marks, legend labels, and header labels. This does /not/
      --   control the appearance of axis labels.
      --
      --   The default is @\"%b %d, %Y\"@.
      --
      --   This was renamed from @TimeFormat@ in @0.6.0.0@.
      --
      --   @since 0.6.0.0
    | TitleStyle [TitleConfig]
      -- ^ The default appearance of visualization titles.
    | TrailStyle [MarkProperty]
      -- ^ The default style of trail marks.
      --
      --   @since 0.4.0.0
    | ViewStyle [ViewConfig]
      -- ^ The default properties for
      --   [single view plots](https://vega.github.io/vega-lite/docs/spec.html#single).
      --
      --   This was renamed from @View@ in @0.6.0.0@.
      --
      --   @since 0.6.0.0
    | Autosize [Autosize]
      -- ^ As of version @0.6.0.0@ this is deprecated and 'AutosizeStyle' should be used
      --   instead.
    | Background Color
      -- ^ As of version @0.6.0.0@ this is deprecated and 'BackgroundStyle' should be used
      --   instead.
    | CountTitle T.Text
      -- ^ As of version @0.6.0.0@ this is deprecated and 'CountTitleStyle' should be used
      --   instead.
    | FieldTitle FieldTitleProperty
      -- ^ As of version @0.6.0.0@ this is deprecated and 'FieldTitleStyle' should be used
      --   instead.
    | Legend [LegendConfig]
      -- ^ As of version @0.6.0.0@ this is deprecated and 'LegendStyle' should be used
      --   instead.
    | NumberFormat T.Text
      -- ^ As of version @0.6.0.0@ this is deprecated and 'NumberFormatStyle' should be used
      --   instead.
    | Padding Padding
      -- ^ As of version @0.6.0.0@ this is deprecated and 'PaddingStyle' should be used
      --   instead.
    | Projection [ProjectionProperty]
      -- ^ As of version @0.6.0.0@ this is deprecated and 'ProjectionStyle' should be used
      --   instead.
    | Range [RangeConfig]
      -- ^ As of version @0.6.0.0@ this is deprecated and 'RangeStyle' should be used
      --   instead.
    | Scale [ScaleConfig]
      -- ^ As of version @0.6.0.0@ this is deprecated and 'ScaleStyle' should be used
      --   instead.
    | TimeFormat T.Text
      -- ^ As of version @0.6.0.0@ this is deprecated and 'TimeFormatStyle' should be used
      --   instead.
    | View [ViewConfig]
      -- ^ As of version @0.6.0.0@ this is deprecated and 'ViewStyle' should be used
      --   instead.
    | NamedStyle StyleLabel [MarkProperty]
      -- ^ As of version @0.6.0.0@ this is deprecated and 'MarkNamedStyles' should be
      --   used instead.
    | NamedStyles [(StyleLabel, [MarkProperty])]
      -- ^ As of version @0.6.0.0@ this is deprecated and 'MarkNamedStyles' should be
      --   used instead.


-- | Which axis should the configuration be applied to?
--
--   Added in Vega-Lite 4.7.0.
--
--   @since 0.7.0.0
data AxisChoice
  = AxXY
    -- ^ Apply the configuration to both axes.
    --
    --   This was the default behavior prior to @0.7.0.0@.
  | AxX
    -- ^ Select the X axis.
  | AxY
    -- ^ Select the Y axis.


toAxis :: T.Text -> [AxisConfig] -> LabelledSpec
toAxis :: Text -> [AxisConfig] -> LabelledSpec
toAxis Text
lbl [AxisConfig]
acs = (Text
"axis" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
lbl) Text -> Value -> LabelledSpec
forall a. ToJSON a => Text -> a -> LabelledSpec
.=~ [Pair] -> Value
object ((AxisConfig -> Pair) -> [AxisConfig] -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
map AxisConfig -> Pair
axisConfigProperty [AxisConfig]
acs)

toAxisChoice :: AxisChoice -> T.Text -> [AxisConfig] -> LabelledSpec
toAxisChoice :: AxisChoice -> Text -> [AxisConfig] -> LabelledSpec
toAxisChoice AxisChoice
AxXY Text
lbl = Text -> [AxisConfig] -> LabelledSpec
toAxis Text
lbl
toAxisChoice AxisChoice
AxX Text
lbl = Text -> [AxisConfig] -> LabelledSpec
toAxis (Text
"X" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
lbl)
toAxisChoice AxisChoice
AxY Text
lbl = Text -> [AxisConfig] -> LabelledSpec
toAxis (Text
"Y" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
lbl)

aprops_ :: T.Text -> [AxisProperty] -> LabelledSpec
aprops_ :: Text -> [AxisProperty] -> LabelledSpec
aprops_ Text
f [AxisProperty]
mps = Text
f Text -> Value -> LabelledSpec
forall a. ToJSON a => Text -> a -> LabelledSpec
.=~ [Pair] -> Value
object ((AxisProperty -> Pair) -> [AxisProperty] -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
map AxisProperty -> Pair
axisProperty [AxisProperty]
mps)

-- easier to turn into a ConfigSpec in config than here
configProperty :: ConfigurationProperty -> LabelledSpec
configProperty :: ConfigurationProperty -> LabelledSpec
configProperty (ArcStyle [MarkProperty]
mps) = Text -> [MarkProperty] -> LabelledSpec
oldMprops_ Text
"arc" [MarkProperty]
mps
configProperty (AreaStyle [MarkProperty]
mps) = Text -> [MarkProperty] -> LabelledSpec
oldMprops_ Text
"area" [MarkProperty]
mps
configProperty (AriaStyle Bool
b) = Text
"aria" Text -> Bool -> LabelledSpec
forall a. ToJSON a => Text -> a -> LabelledSpec
.=~ Bool
b
configProperty (AutosizeStyle [Autosize]
aus) = Text
"autosize" Text -> Value -> LabelledSpec
forall a. ToJSON a => Text -> a -> LabelledSpec
.=~ [Pair] -> Value
object ((Autosize -> Pair) -> [Autosize] -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
map Autosize -> Pair
autosizeProperty [Autosize]
aus)
configProperty (Axis [AxisConfig]
acs) = Text -> [AxisConfig] -> LabelledSpec
toAxis Text
"" [AxisConfig]
acs
configProperty (AxisBand AxisChoice
c [AxisConfig]
acs) = AxisChoice -> Text -> [AxisConfig] -> LabelledSpec
toAxisChoice AxisChoice
c Text
"Band" [AxisConfig]
acs
configProperty (AxisBottom [AxisConfig]
acs) = Text -> [AxisConfig] -> LabelledSpec
toAxis Text
"Bottom" [AxisConfig]
acs
configProperty (AxisDiscrete AxisChoice
c [AxisConfig]
acs) = AxisChoice -> Text -> [AxisConfig] -> LabelledSpec
toAxisChoice AxisChoice
c Text
"Discrete" [AxisConfig]
acs
configProperty (AxisLeft [AxisConfig]
acs) = Text -> [AxisConfig] -> LabelledSpec
toAxis Text
"Left" [AxisConfig]
acs
configProperty (AxisPoint AxisChoice
c [AxisConfig]
acs) = AxisChoice -> Text -> [AxisConfig] -> LabelledSpec
toAxisChoice AxisChoice
c Text
"Point" [AxisConfig]
acs
configProperty (AxisQuantitative AxisChoice
c [AxisConfig]
acs) = AxisChoice -> Text -> [AxisConfig] -> LabelledSpec
toAxisChoice AxisChoice
c Text
"Quantitative" [AxisConfig]
acs
configProperty (AxisRight [AxisConfig]
acs) = Text -> [AxisConfig] -> LabelledSpec
toAxis Text
"Right" [AxisConfig]
acs
configProperty (AxisTemporal AxisChoice
c [AxisConfig]
acs) = AxisChoice -> Text -> [AxisConfig] -> LabelledSpec
toAxisChoice AxisChoice
c Text
"Temporal" [AxisConfig]
acs
configProperty (AxisTop [AxisConfig]
acs) = Text -> [AxisConfig] -> LabelledSpec
toAxis Text
"Top" [AxisConfig]
acs
configProperty (AxisX [AxisConfig]
acs) = Text -> [AxisConfig] -> LabelledSpec
toAxis Text
"X" [AxisConfig]
acs
configProperty (AxisY [AxisConfig]
acs) = Text -> [AxisConfig] -> LabelledSpec
toAxis Text
"Y" [AxisConfig]
acs

-- configProperty (AxisNamedStyles [(nme, mps)]) = "style" .=~ object [aprops_ nme mps]
configProperty (AxisNamedStyles [(Text, [AxisProperty])]
styles) =
  let toStyle :: (Text, [AxisProperty]) -> LabelledSpec
toStyle = (Text -> [AxisProperty] -> LabelledSpec)
-> (Text, [AxisProperty]) -> LabelledSpec
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> [AxisProperty] -> LabelledSpec
aprops_
  in Text
"style" Text -> Value -> LabelledSpec
forall a. ToJSON a => Text -> a -> LabelledSpec
.=~ [LabelledSpec] -> Value
toObject (((Text, [AxisProperty]) -> LabelledSpec)
-> [(Text, [AxisProperty])] -> [LabelledSpec]
forall a b. (a -> b) -> [a] -> [b]
map (Text, [AxisProperty]) -> LabelledSpec
toStyle [(Text, [AxisProperty])]
styles)

configProperty (BackgroundStyle Text
bg) = Text
"background" Text -> Text -> LabelledSpec
forall a. ToJSON a => Text -> a -> LabelledSpec
.=~ Text
bg
configProperty (BarStyle [MarkProperty]
mps) = Text -> [MarkProperty] -> LabelledSpec
oldMprops_ Text
"bar" [MarkProperty]
mps
configProperty (BoxplotStyle [MarkProperty]
mps) = Text -> [MarkProperty] -> LabelledSpec
oldMprops_ Text
"boxplot" [MarkProperty]
mps
configProperty (CircleStyle [MarkProperty]
mps) = Text -> [MarkProperty] -> LabelledSpec
oldMprops_ Text
"circle" [MarkProperty]
mps
configProperty (ConcatStyle [CompositionConfig]
cps) = Text
"concat" Text -> Value -> LabelledSpec
forall a. ToJSON a => Text -> a -> LabelledSpec
.=~ [Pair] -> Value
object ((CompositionConfig -> Pair) -> [CompositionConfig] -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
map CompositionConfig -> Pair
compConfigProperty [CompositionConfig]
cps)
configProperty (CountTitleStyle Text
ttl) = Text
"countTitle" Text -> Text -> LabelledSpec
forall a. ToJSON a => Text -> a -> LabelledSpec
.=~ Text
ttl
configProperty (CustomFormatStyle Bool
b) = Text
"customFormatTypes" Text -> Bool -> LabelledSpec
forall a. ToJSON a => Text -> a -> LabelledSpec
.=~ Bool
b
configProperty (ErrorBandStyle [MarkProperty]
mps) = Text -> [MarkProperty] -> LabelledSpec
oldMprops_ Text
"errorband" [MarkProperty]
mps
configProperty (ErrorBarStyle [MarkProperty]
mps) = Text -> [MarkProperty] -> LabelledSpec
oldMprops_ Text
"errorbar" [MarkProperty]
mps
configProperty (FacetStyle [CompositionConfig]
cps) = Text
"facet" Text -> Value -> LabelledSpec
forall a. ToJSON a => Text -> a -> LabelledSpec
.=~ [Pair] -> Value
object ((CompositionConfig -> Pair) -> [CompositionConfig] -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
map CompositionConfig -> Pair
compConfigProperty [CompositionConfig]
cps)
configProperty (FieldTitleStyle FieldTitleProperty
ftp) = Text
"fieldTitle" Text -> Text -> LabelledSpec
forall a. ToJSON a => Text -> a -> LabelledSpec
.=~ FieldTitleProperty -> Text
fieldTitleLabel FieldTitleProperty
ftp
configProperty (FontStyle Text
font) = Text
"font" Text -> Text -> LabelledSpec
forall a. ToJSON a => Text -> a -> LabelledSpec
.=~ Text
font
configProperty (GeoshapeStyle [MarkProperty]
mps) = Text -> [MarkProperty] -> LabelledSpec
oldMprops_ Text
"geoshape" [MarkProperty]
mps
configProperty (HeaderStyle [HeaderProperty]
hps) = Text -> [HeaderProperty] -> LabelledSpec
header_ Text
"" [HeaderProperty]
hps
configProperty (HeaderColumnStyle [HeaderProperty]
hps) = Text -> [HeaderProperty] -> LabelledSpec
header_ Text
"Column" [HeaderProperty]
hps
configProperty (HeaderFacetStyle [HeaderProperty]
hps) = Text -> [HeaderProperty] -> LabelledSpec
header_ Text
"Facet" [HeaderProperty]
hps
configProperty (HeaderRowStyle [HeaderProperty]
hps) = Text -> [HeaderProperty] -> LabelledSpec
header_ Text
"Row" [HeaderProperty]
hps
configProperty (ImageStyle [MarkProperty]
mps) = Text -> [MarkProperty] -> LabelledSpec
oldMprops_ Text
"image" [MarkProperty]
mps
configProperty (LegendStyle [LegendConfig]
lcs) = Text
"legend" Text -> Value -> LabelledSpec
forall a. ToJSON a => Text -> a -> LabelledSpec
.=~ [Pair] -> Value
object ((LegendConfig -> Pair) -> [LegendConfig] -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
map LegendConfig -> Pair
legendConfigProperty [LegendConfig]
lcs)
configProperty (LineStyle [MarkProperty]
mps) = Text -> [MarkProperty] -> LabelledSpec
oldMprops_ Text
"line" [MarkProperty]
mps

configProperty (LineBreakStyle Text
s) = Text
"lineBreak" Text -> Text -> LabelledSpec
forall a. ToJSON a => Text -> a -> LabelledSpec
.=~ Text
s

configProperty (MarkStyle [MarkProperty]
mps) = Text -> [MarkProperty] -> LabelledSpec
oldMprops_ Text
"mark" [MarkProperty]
mps
-- configProperty (MarkNamedStyles [(nme, mps)]) = "style" .=~ object [mprops_ nme mps]
configProperty (MarkNamedStyles [(Text, [MarkProperty])]
styles) =
  let toStyle :: (Text, [MarkProperty]) -> LabelledSpec
toStyle = (Text -> [MarkProperty] -> LabelledSpec)
-> (Text, [MarkProperty]) -> LabelledSpec
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> [MarkProperty] -> LabelledSpec
oldMprops_
  in Text
"style" Text -> Value -> LabelledSpec
forall a. ToJSON a => Text -> a -> LabelledSpec
.=~ [LabelledSpec] -> Value
toObject (((Text, [MarkProperty]) -> LabelledSpec)
-> [(Text, [MarkProperty])] -> [LabelledSpec]
forall a b. (a -> b) -> [a] -> [b]
map (Text, [MarkProperty]) -> LabelledSpec
toStyle [(Text, [MarkProperty])]
styles)

configProperty (NumberFormatStyle Text
fmt) = Text
"numberFormat" Text -> Text -> LabelledSpec
forall a. ToJSON a => Text -> a -> LabelledSpec
.=~ Text
fmt
configProperty (PaddingStyle Padding
pad) = Text
"padding" Text -> Value -> LabelledSpec
forall a. ToJSON a => Text -> a -> LabelledSpec
.=~ Padding -> Value
paddingSpec Padding
pad
configProperty (PointStyle [MarkProperty]
mps) = Text -> [MarkProperty] -> LabelledSpec
oldMprops_ Text
"point" [MarkProperty]
mps
configProperty (ProjectionStyle [ProjectionProperty]
pps) = Text
"projection" Text -> Value -> LabelledSpec
forall a. ToJSON a => Text -> a -> LabelledSpec
.=~ [Pair] -> Value
object ((ProjectionProperty -> Pair) -> [ProjectionProperty] -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
map ProjectionProperty -> Pair
projectionProperty [ProjectionProperty]
pps)
configProperty (RangeStyle [RangeConfig]
rcs) = Text
"range" Text -> Value -> LabelledSpec
forall a. ToJSON a => Text -> a -> LabelledSpec
.=~ [Pair] -> Value
object ((RangeConfig -> Pair) -> [RangeConfig] -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
map RangeConfig -> Pair
rangeConfigProperty [RangeConfig]
rcs)
configProperty (RectStyle [MarkProperty]
mps) = Text -> [MarkProperty] -> LabelledSpec
oldMprops_ Text
"rect" [MarkProperty]
mps
configProperty (RepeatStyle [CompositionConfig]
cps) = Text
"repeat" Text -> Value -> LabelledSpec
forall a. ToJSON a => Text -> a -> LabelledSpec
.=~ [Pair] -> Value
object ((CompositionConfig -> Pair) -> [CompositionConfig] -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
map CompositionConfig -> Pair
compConfigProperty [CompositionConfig]
cps)
configProperty (RuleStyle [MarkProperty]
mps) = Text -> [MarkProperty] -> LabelledSpec
oldMprops_ Text
"rule" [MarkProperty]
mps
configProperty (ScaleStyle [ScaleConfig]
scs) = [ScaleConfig] -> LabelledSpec
scaleConfig_ [ScaleConfig]
scs
configProperty (SelectionStyle [(Selection, [SelectionProperty])]
selConfig) =
  let selProp :: (Selection, t SelectionProperty) -> LabelledSpec
selProp (Selection
sel, t SelectionProperty
sps) = Selection -> Text
selectionLabel Selection
sel Text -> Value -> LabelledSpec
forall a. ToJSON a => Text -> a -> LabelledSpec
.=~ [Pair] -> Value
object ((SelectionProperty -> [Pair]) -> t SelectionProperty -> [Pair]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SelectionProperty -> [Pair]
selectionProperties t SelectionProperty
sps)
  in Text
"selection" Text -> Value -> LabelledSpec
forall a. ToJSON a => Text -> a -> LabelledSpec
.=~ [LabelledSpec] -> Value
toObject (((Selection, [SelectionProperty]) -> LabelledSpec)
-> [(Selection, [SelectionProperty])] -> [LabelledSpec]
forall a b. (a -> b) -> [a] -> [b]
map (Selection, [SelectionProperty]) -> LabelledSpec
forall (t :: * -> *).
Foldable t =>
(Selection, t SelectionProperty) -> LabelledSpec
selProp [(Selection, [SelectionProperty])]
selConfig)
configProperty (SquareStyle [MarkProperty]
mps) = Text -> [MarkProperty] -> LabelledSpec
oldMprops_ Text
"square" [MarkProperty]
mps
configProperty (TextStyle [MarkProperty]
mps) = Text -> [MarkProperty] -> LabelledSpec
oldMprops_ Text
"text" [MarkProperty]
mps
configProperty (TickStyle [MarkProperty]
mps) = Text -> [MarkProperty] -> LabelledSpec
oldMprops_ Text
"tick" [MarkProperty]
mps
configProperty (TimeFormatStyle Text
fmt) = Text
"timeFormat" Text -> Text -> LabelledSpec
forall a. ToJSON a => Text -> a -> LabelledSpec
.=~ Text
fmt
configProperty (TitleStyle [TitleConfig]
tcs) = Text
"title" Text -> Value -> LabelledSpec
forall a. ToJSON a => Text -> a -> LabelledSpec
.=~ [Pair] -> Value
object ((TitleConfig -> Pair) -> [TitleConfig] -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
map TitleConfig -> Pair
titleConfigSpec [TitleConfig]
tcs)
configProperty (TrailStyle [MarkProperty]
mps) = Text -> [MarkProperty] -> LabelledSpec
oldMprops_ Text
"trail" [MarkProperty]
mps
configProperty (ViewStyle [ViewConfig]
vcs) = Text
"view" Text -> Value -> LabelledSpec
forall a. ToJSON a => Text -> a -> LabelledSpec
.=~ [Pair] -> Value
object ((ViewConfig -> [Pair]) -> [ViewConfig] -> [Pair]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ViewConfig -> [Pair]
viewConfigProperties [ViewConfig]
vcs)

-- deprecated aliases
configProperty (Autosize [Autosize]
aus) = Text
"autosize" Text -> Value -> LabelledSpec
forall a. ToJSON a => Text -> a -> LabelledSpec
.=~ [Pair] -> Value
object ((Autosize -> Pair) -> [Autosize] -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
map Autosize -> Pair
autosizeProperty [Autosize]
aus)
configProperty (Background Text
bg) = Text
"background" Text -> Text -> LabelledSpec
forall a. ToJSON a => Text -> a -> LabelledSpec
.=~ Text
bg
configProperty (CountTitle Text
ttl) = Text
"countTitle" Text -> Text -> LabelledSpec
forall a. ToJSON a => Text -> a -> LabelledSpec
.=~ Text
ttl
configProperty (FieldTitle FieldTitleProperty
ftp) = Text
"fieldTitle" Text -> Text -> LabelledSpec
forall a. ToJSON a => Text -> a -> LabelledSpec
.=~ FieldTitleProperty -> Text
fieldTitleLabel FieldTitleProperty
ftp
configProperty (Legend [LegendConfig]
lcs) = Text
"legend" Text -> Value -> LabelledSpec
forall a. ToJSON a => Text -> a -> LabelledSpec
.=~ [Pair] -> Value
object ((LegendConfig -> Pair) -> [LegendConfig] -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
map LegendConfig -> Pair
legendConfigProperty [LegendConfig]
lcs)
configProperty (NumberFormat Text
fmt) = Text
"numberFormat" Text -> Text -> LabelledSpec
forall a. ToJSON a => Text -> a -> LabelledSpec
.=~ Text
fmt
configProperty (Padding Padding
pad) = Text
"padding" Text -> Value -> LabelledSpec
forall a. ToJSON a => Text -> a -> LabelledSpec
.=~ Padding -> Value
paddingSpec Padding
pad
configProperty (Projection [ProjectionProperty]
pps) = Text
"projection" Text -> Value -> LabelledSpec
forall a. ToJSON a => Text -> a -> LabelledSpec
.=~ [Pair] -> Value
object ((ProjectionProperty -> Pair) -> [ProjectionProperty] -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
map ProjectionProperty -> Pair
projectionProperty [ProjectionProperty]
pps)
configProperty (Range [RangeConfig]
rcs) = Text
"range" Text -> Value -> LabelledSpec
forall a. ToJSON a => Text -> a -> LabelledSpec
.=~ [Pair] -> Value
object ((RangeConfig -> Pair) -> [RangeConfig] -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
map RangeConfig -> Pair
rangeConfigProperty [RangeConfig]
rcs)
configProperty (Scale [ScaleConfig]
scs) = [ScaleConfig] -> LabelledSpec
scaleConfig_ [ScaleConfig]
scs
configProperty (TimeFormat Text
fmt) = Text
"timeFormat" Text -> Text -> LabelledSpec
forall a. ToJSON a => Text -> a -> LabelledSpec
.=~ Text
fmt
configProperty (View [ViewConfig]
vcs) = Text
"view" Text -> Value -> LabelledSpec
forall a. ToJSON a => Text -> a -> LabelledSpec
.=~ [Pair] -> Value
object ((ViewConfig -> [Pair]) -> [ViewConfig] -> [Pair]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ViewConfig -> [Pair]
viewConfigProperties [ViewConfig]
vcs)

configProperty (NamedStyle Text
nme [MarkProperty]
mps) = Text
"style" Text -> Value -> LabelledSpec
forall a. ToJSON a => Text -> a -> LabelledSpec
.=~ [LabelledSpec] -> Value
toObject [Text -> [MarkProperty] -> LabelledSpec
oldMprops_ Text
nme [MarkProperty]
mps]
configProperty (NamedStyles [(Text, [MarkProperty])]
styles) =
  let toStyle :: (Text, [MarkProperty]) -> LabelledSpec
toStyle = (Text -> [MarkProperty] -> LabelledSpec)
-> (Text, [MarkProperty]) -> LabelledSpec
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> [MarkProperty] -> LabelledSpec
oldMprops_
  in Text
"style" Text -> Value -> LabelledSpec
forall a. ToJSON a => Text -> a -> LabelledSpec
.=~ [LabelledSpec] -> Value
toObject (((Text, [MarkProperty]) -> LabelledSpec)
-> [(Text, [MarkProperty])] -> [LabelledSpec]
forall a b. (a -> b) -> [a] -> [b]
map (Text, [MarkProperty]) -> LabelledSpec
toStyle [(Text, [MarkProperty])]
styles)

{-|

Scale configuration property. These are used to configure all scales
with 'ScaleStyle'. For more details see the
<https://vega.github.io/vega-lite/docs/scale.html#scale-config Vega-Lite documentation>.

Version @0.5.0.0@ removed the @SCRangeStep@ and @SCTextXRangeStep@
constructors. The new 'ViewStep' constructor of 'ViewConfig' should
be used instead.
-}

data ScaleConfig
    = SCBandPaddingInner Double
      -- ^ Default inner padding for x and y band-ordinal scales.
    | SCBandPaddingOuter Double
      -- ^ Default outer padding for x and y band-ordinal scales.
    | SCBarBandPaddingInner Double
      -- ^ Default inner padding for x and y band-ordinal scales of 'Graphics.Vega.VegaLite.Bar' marks.
      --
      --   @since 0.4.0.0
    | SCBarBandPaddingOuter Double
      -- ^ Default outer padding for x and y band-ordinal scales of 'Graphics.Vega.VegaLite.Bar' marks.
      --
      --   @since 0.4.0.0
    | SCRectBandPaddingInner Double
      -- ^ Default inner padding for x and y band-ordinal scales of 'Graphics.Vega.VegaLite.Rect' marks.
      --
      --   @since 0.4.0.0
    | SCRectBandPaddingOuter Double
      -- ^ Default outer padding for x and y band-ordinal scales of 'Graphics.Vega.VegaLite.Rect' marks.
      --
      --   @since 0.4.0.0
    | SCClamp Bool
      -- ^ Whether or not by default values that exceed the data domain are clamped to
      --   the min/max range value.
    | SCMaxBandSize Double
      -- ^ Default maximum value for mapping quantitative fields to a bar's
      --   size/bandSize.
    | SCMinBandSize Double
      -- ^ Default minimum value for mapping quantitative fields to a bar's
      --   size/bandSize.
    | SCMaxFontSize Double
      -- ^ Default maximum value for mapping a quantitative field to a text
      --   mark's size.
    | SCMinFontSize Double
      -- ^ Default minimum value for mapping a quantitative field to a text
      --   mark's size.
    | SCMaxOpacity Opacity
      -- ^ Default maximum opacity for mapping a field to opacity.
    | SCMinOpacity Opacity
      -- ^ Default minimum opacity for mapping a field to opacity.
    | SCMaxSize Double
      -- ^ Default maximum size for point-based scales.
    | SCMinSize Double
      -- ^ Default minimum size for point-based scales.
    | SCMaxStrokeWidth Double
      -- ^ Default maximum stroke width for rule, line and trail marks.
    | SCMinStrokeWidth Double
      -- ^ Default minimum stroke width for rule, line and trail marks.
    | SCPointPadding Double
      -- ^ Default padding for point-ordinal scales.
    | SCRound Bool
      -- ^ Are numeric values are rounded to integers when scaling? Useful
      --   for snapping to the pixel grid.
    | SCUseUnaggregatedDomain Bool
      -- ^ Whether or not to use the source data range before aggregation.
    | SCXReverse Bool
      -- ^ Reverse the X scale (useful for right-to-left charts).
      --
      --   @since 0.6.0.0

scaleConfig_ :: [ScaleConfig] -> LabelledSpec
-- scaleConfig_ [] = "scale" .= A.Null  -- not sure here
scaleConfig_ :: [ScaleConfig] -> LabelledSpec
scaleConfig_ [ScaleConfig]
scs = Text
"scale" Text -> Value -> LabelledSpec
forall a. ToJSON a => Text -> a -> LabelledSpec
.=~ [Pair] -> Value
object ((ScaleConfig -> Pair) -> [ScaleConfig] -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
map ScaleConfig -> Pair
scaleConfigProperty [ScaleConfig]
scs)


-- | Indicates the style in which field names are displayed.

data FieldTitleProperty
    = Verbal
      -- ^ Creates \"Sum of field\", \"Year of date\", \"field (binned)\", etc.
    | Function
      -- ^ Creates \"SUM(field)\", \"YEAR(date)\", \"BIN(field)\", etc.
    | Plain
      -- ^ Just use the field name without any extra text.


fieldTitleLabel :: FieldTitleProperty -> T.Text
fieldTitleLabel :: FieldTitleProperty -> Text
fieldTitleLabel FieldTitleProperty
Verbal = Text
"verbal"
fieldTitleLabel FieldTitleProperty
Function = Text
"functional"
fieldTitleLabel FieldTitleProperty
Plain = Text
"plain"


{-|

Legend configuration options, set with the 'LegendStyle' constructor.
For more detail see the
<https://vega.github.io/vega-lite/docs/legend.html#config Vega-Lite documentation>.

In @0.9.0.0@ the 'LeTickCountTime' constructor was added.

In @0.8.0.0@ the @LeTitle@ constructor was removed as there is no way
to set the default text for a legend title in Vega-Lite ('LeNoTitle'
remains as this is used to turn off legend titles).

In @0.6.0.0@ the following constructors were added (all from Vega-Lite 4.0):
'LeSymbolLimit', 'LeTickCount', 'LeTitleLineHeight', and
'LeUnselectedOpacity'.

In @0.5.0.0@ the @LeShortTimeLabels@ constructor was removed (Vega-Lite 4.0).

This data type has seen significant changes in the @0.4.0.0@ release:

- the @EntryPadding@, @GradientHeight@, @GradientLabelBaseline@, @GradientWidth@
  and @SymbolColor@ constructors were removed;

- the constructors were removed;

- the remaining constructors that did not begin with @Le@ were renamed (for
  example @Orient@ was changed to 'LeOrient');

- and new constructors were added.

-}

-- based on schema 3.3.0 #/definitions/LegendConfig

data LegendConfig
    = LeAria Bool
      -- ^ A boolean flag indicating if
      --   [ARIA attributes](https://developer.mozilla.org/en-US/docs/Web/Accessibility/ARIA)
      --   should be included (SVG output only).
      --
      --   If False, the \"aria-hidden\" attribute will be set on the output SVG group,
      --   removing the legend from the ARIA accessibility tree.
      --
      --   __Default value:__ True
      --
      --   @since 0.9.0.0
    | LeAriaDescription T.Text
      -- ^ A text description of this legend for
      --   [ARIA accessibility](https://developer.mozilla.org/en-US/docs/Web/Accessibility/ARIA)
      --   (SVG output only).
      --
      --   If the 'LeAria' property is true, for SVG output the
      --   [\"aria-label\" attribute](https://developer.mozilla.org/en-US/docs/Web/Accessibility/ARIA/ARIA_Techniques/Using_the_aria-label_attribute)
      --   will be set to this description.
      --
      --   If the description is unspecified it will be automatically generated.
      --
      --   @since 0.9.0.0
    | LeClipHeight Double
      -- ^ The height in pixels at which to clip symbol legend entries.
      --
      --   @since 0.4.0.0
    | LeColumnPadding Double
      -- ^ The horizontal padding, in pixels, between symbol legend entries.
      --
      --   @since 0.4.0.0
    | LeColumns Int
      -- ^ The number of columns in which to arrange symbol legend entries. A value
      --   of @0@ or lower indicates a single row with one column per entry.
      --
      --   @since 0.4.0.0
    | LeCornerRadius Double
      -- ^ The corner radius for the full legend.
    | LeDirection Orientation
      -- ^ The direction for the legend.
      --
      --   @since 0.8.0.0
    | LeDisable Bool
      -- ^ Disable the legend by default?
      --
      --   Added in Vega-Lite 4.8.
      --
      --   @since 0.8.0.0
    | LeFillColor Color
      -- ^ The background fill color for the full legend.
    | LeGradientDirection Orientation
      -- ^ The default direction for gradient legends.
      --
      --   @since 0.4.0.0
    | LeGradientHorizontalMaxLength Double
      -- ^ The maximum legend length for a horizontal gradient.
      --
      --   @since 0.4.0.0
    | LeGradientHorizontalMinLength Double
      -- ^ The minimum legend length for a horizontal gradient.
      --
      --   @since 0.4.0.0
    | LeGradientLabelLimit Double
      -- ^ The maximum allowed length, in pixels, of color-ramp gradient labels.
    | LeGradientLabelOffset Double
      -- ^ The vertical offset in pixels for color-ramp gradient labels.
    | LeGradientLength Double
      -- ^ The length in pixels of the primary axis of a color gradient.
      --   See also 'LeGradientThickness'.
      --
      --   @since 0.4.0.0
    | LeGradientOpacity Opacity
      -- ^ The opacity of the color gradient.
      --
      --   @since 0.4.0.0
    | LeGradientStrokeColor Color
      -- ^ The color of the gradient stroke.
    | LeGradientStrokeWidth Double
      -- ^ The width of the gradient stroke, in pixels.
    | LeGradientThickness Double
      -- ^ The thickness in pixels of the color gradient. See also 'LeGradientLength'.
      --
      --   @since 0.4.0.0
    | LeGradientVerticalMaxLength Double
      -- ^ The maximum legend length for a vertical gradient.
      --
      --   @since 0.4.0.0
    | LeGradientVerticalMinLength Double
      -- ^ The minimum legend length for a vertical gradient.
      --
      --   @since 0.4.0.0
    | LeGridAlign CompositionAlignment
      -- ^ The alignment to apply to symbol legends rows and columns.
      --
      --    @since 0.4.0.0
    | LeLabelAlign HAlign
      -- ^ The alignment of the legend label.
    | LeLabelBaseline VAlign
      -- ^ The position of the baseline of the legend label.
    | LeLabelColor Color
      -- ^ The color of the legend label.
    | LeLabelFont T.Text
      -- ^ The font of the legend label.
    | LeLabelFontSize Double
      -- ^ The font of the legend label.
    | LeLabelFontStyle T.Text
      -- ^ The font style of the legend label.
      --
      --   @since 0.4.0.0
    | LeLabelFontWeight FontWeight
      -- ^ The font weight of the legend label.
      --
      --   @since 0.4.0.0
    | LeLabelLimit Double
      -- ^ The maxumum allowed pixel width of the legend label.
    | LeLabelOffset Double
      -- ^ The offset of the legend label.
    | LeLabelOpacity Opacity
      -- ^ The opacity of the legend label.
      --
      --   @since 0.4.0.0
    | LeLabelOverlap OverlapStrategy
      -- ^ How to resolve overlap of labels in gradient legends.
      --
      --   @since 0.4.0.0
    | LeLabelPadding Double
      -- ^ The passing in pixels between the legend and legend labels.
      --
      --   @since 0.4.0.0
    | LeLabelSeparation Double
      -- ^ The minimum separation between label bounding boxes for them
      --   to be considered non-overlapping (ignored if 'Graphics.Vega.VegaLite.ONone' is the
      --   chosen overlap strategy).
      --
      --   @since 0.4.0.0
    | LeLayout [LegendLayout]  -- TODO: schema for this is odd; check it is meaningful
      -- ^ Layout parameters for the legend orient group.
      --
      --   It is not clear if this is used in Vega Lite 4.2 or later.
      --
      --   @since 0.4.0.0
     | LeLeX Double
      -- ^ Custom x position for a legend with orientation 'Graphics.Vega.VegaLite.LONone'.
      --
      --   @since 0.4.0.0
     | LeLeY Double
      -- ^ Custom y position for a legend with orientation 'Graphics.Vega.VegaLite.LONone'.
      --
      --   @since 0.4.0.0
    | LeOffset Double
      -- ^ The offset in pixels between the legend and the data rectangle
      --   and axes.
    | LeOrient LegendOrientation
      -- ^ The orientation of the legend, which determines how the legend is positioned
      --   within the scene.
    | LePadding Double
      -- ^ The padding between the border and content of the legend group.
    | LeRowPadding Double
      -- ^ The vertical padding in pixels between symbol legend entries.
      --
      --   @since 0.4.0.0
    | LeStrokeColor Color
      -- ^ The border stoke color for the full legend.
    | LeStrokeDash DashStyle
      -- ^ The border stroke dash pattern for the full legend.
    | LeStrokeWidth Double
      -- ^ The border stroke width for the full legend.
    | LeSymbolBaseFillColor Color
      -- ^ The fill color for legend symbols. This is only applied if
      --   there is no \"fill\" scale color encoding for the legend.
      --
      --   @since 0.4.0.0
    | LeSymbolBaseStrokeColor Color
      -- ^ The stroke color for legend symbols. This is only applied if
      --   there is no \"fill\" scale color encoding for the legend.
      --
      --   @since 0.4.0.0
    | LeSymbolDash DashStyle
      -- ^ The pattern for dashed symbol strokes.
      --
      --   @since 0.4.0.0
    | LeSymbolDashOffset DashOffset
      -- ^ The offset at which to start drawing the symbol dash pattern.
      --
      --   @since 0.4.0.0
    | LeSymbolDirection Orientation
      -- ^ The default direction for symbol legends.
      --
      --   @since 0.4.0.0
    | LeSymbolFillColor Color
      -- ^ The color of the legend symbol.
      --
      --   @since 0.4.0.0
    | LeSymbolLimit Int  -- it may be that negative entries allow you to say "drop last 2"
      -- ^ The maximum number of allowed entries for a symbol legend. Any additional entries
      --   will be dropped.
      --
      --   @since 0.6.0.0
    | LeSymbolOffset Double
      -- ^ The horizontal pixel offset for legend symbols.
      --
      --   @since 0.4.0.0
    | LeSymbolOpacity Opacity
      -- ^ The opacity of the legend symbols.
      --
      --   @since 0.4.0.0
    | LeSymbolSize Double
      -- ^ The size of the legend symbol, in pixels.
    | LeSymbolStrokeColor Color
      -- ^ The stroke color for legend symbols.
      --
      --   @since 0.4.0.0
    | LeSymbolStrokeWidth Double
      -- ^ The width of the symbol's stroke.
    | LeSymbolType Symbol
      -- ^ The default shape type for legend symbols.
    | LeTickCount Int
      -- ^ The desired number of tick values for quantitative legends.
      --
      --   The 'LeTickCountTime' option can instead be used for \"time\"
      --   or \"utc\" scales.
      --
      --   @since 0.6.0.0
    | LeTickCountTime ScaleNice
      -- ^ A specialised version of 'LeTickCount' for \"time\" and \"utc\"
      --   time scales.
      --
      --   The 'Graphics.Vega.VegaLite.IsNice' and 'Graphics.Vega.VegaLte.NTickCount'
      --   options should not be used as they generate invalid VegaLite.
      --
      --   @since 0.9.0.0
    | LeNoTitle
      -- ^ Do not add a title for the legend.
      --
      --   @since 0.4.0.0
    | LeTitleAlign HAlign
      -- ^ The horizontal text alignment for legend titles.
    | LeTitleAnchor APosition
      -- ^ The text anchor position for legend titles.
      --
      --   @since 0.4.0.0
    | LeTitleBaseline VAlign
      -- ^ The vertical text alignment for legend titles.
    | LeTitleColor Color
      -- ^ The color of the legend title.
    | LeTitleFont T.Text
      -- ^ The font of the legend title.
    | LeTitleFontSize Double
      -- ^ The font size of the legend title.
    | LeTitleFontStyle T.Text
      -- ^ The font style for the legend title.
      --
      --   @since 0.4.0.0
    | LeTitleFontWeight FontWeight
      -- ^ The font weight of the legend title.
    | LeTitleLimit Double
      -- ^ The maxmimum pixel width of the legend title.
    | LeTitleLineHeight Double
      -- ^ The line height, in pixels, for multi-line title text.
      --
      --   @since 0.6.0.0
    | LeTitleOpacity Opacity
      -- ^ The opacity of the legend title.
      --
      --   @since 0.4.0.0
    | LeTitleOrient Side
      -- ^ The orientation of the legend title.
      --
      --   @since 0.4.0.0
    | LeTitlePadding Double
      -- ^ The padding, in pixels, between title and legend.
    | LeUnselectedOpacity Opacity
      -- ^ The opacity of unselected legend entries.
      --
      --   The default is 0.35.
      --
      --   @since 0.6.0.0
    | LeZIndex ZIndex
      -- ^ The z-index indicating the layering of the legend group relative
      --   to the other axis, mark, and legend groups.
      --
      --   @since 0.9.0.0

legendConfigProperty :: LegendConfig -> Pair
legendConfigProperty :: LegendConfig -> Pair
legendConfigProperty (LeAria Bool
b) = Key
"bool" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
b
legendConfigProperty (LeAriaDescription Text
t) = Key
"description" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
t
legendConfigProperty (LeClipHeight Double
x) = Key
"clipHeight" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
legendConfigProperty (LeColumnPadding Double
x) = Key
"columnPadding" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
legendConfigProperty (LeColumns Int
n) = Key
"columns" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
n
legendConfigProperty (LeCornerRadius Double
x) = Key
"cornerRadius" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
legendConfigProperty (LeDirection Orientation
o) = Key
"direction" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Orientation -> Value
orientationSpec Orientation
o
legendConfigProperty (LeDisable Bool
b) = Key
"disable" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
b
legendConfigProperty (LeFillColor Text
s) = Key
"fillColor" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
fromColor Text
s
legendConfigProperty (LeGradientDirection Orientation
o) = Key
"gradientDirection" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Orientation -> Value
orientationSpec Orientation
o
legendConfigProperty (LeGradientHorizontalMaxLength Double
x) = Key
"gradientHorizontalMaxLength" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
legendConfigProperty (LeGradientHorizontalMinLength Double
x) = Key
"gradientHorizontalMinLength" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
legendConfigProperty (LeGradientLabelLimit Double
x) = Key
"gradientLabelLimit" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
legendConfigProperty (LeGradientLabelOffset Double
x) = Key
"gradientLabelOffset" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
legendConfigProperty (LeGradientLength Double
x) = Key
"gradientLength" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
legendConfigProperty (LeGradientOpacity Double
x) = Key
"gradientOpacity" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
legendConfigProperty (LeGradientStrokeColor Text
s) = Key
"gradientStrokeColor" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
fromColor Text
s
legendConfigProperty (LeGradientStrokeWidth Double
x) = Key
"gradientStrokeWidth" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
legendConfigProperty (LeGradientThickness Double
x) = Key
"gradientThickness" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
legendConfigProperty (LeGradientVerticalMaxLength Double
x) = Key
"gradientVerticalMaxLength" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
legendConfigProperty (LeGradientVerticalMinLength Double
x) = Key
"gradientVerticalMinLength" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
legendConfigProperty (LeGridAlign CompositionAlignment
ga) = Key
"gridAlign" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= CompositionAlignment -> Value
compositionAlignmentSpec CompositionAlignment
ga
legendConfigProperty (LeLabelAlign HAlign
ha) = Key
"labelAlign" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= HAlign -> Text
hAlignLabel HAlign
ha
legendConfigProperty (LeLabelBaseline VAlign
va) = Key
"labelBaseline" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= VAlign -> Text
vAlignLabel VAlign
va
legendConfigProperty (LeLabelColor Text
s) = Key
"labelColor" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
fromColor Text
s
legendConfigProperty (LeLabelFont Text
s) = Key
"labelFont" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
s
legendConfigProperty (LeLabelFontSize Double
x) = Key
"labelFontSize" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
legendConfigProperty (LeLabelFontStyle Text
s) = Key
"labelFontStyle" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
s
legendConfigProperty (LeLabelFontWeight FontWeight
fw) = Key
"labelFontWeight" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= FontWeight -> Value
fontWeightSpec FontWeight
fw
legendConfigProperty (LeLabelLimit Double
x) = Key
"labelLimit" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
legendConfigProperty (LeLabelOffset Double
x) = Key
"labelOffset" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
legendConfigProperty (LeLabelOpacity Double
x) = Key
"labelOpacity" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
legendConfigProperty (LeLabelOverlap OverlapStrategy
olap) = Key
"labelOverlap" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= OverlapStrategy -> Value
overlapStrategyLabel OverlapStrategy
olap
legendConfigProperty (LeLabelPadding Double
x) = Key
"labelPadding" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
legendConfigProperty (LeLabelSeparation Double
x) = Key
"labelSeparation" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
legendConfigProperty (LeLayout [LegendLayout]
ll) = Key
"layout" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object ((LegendLayout -> Pair) -> [LegendLayout] -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
map LegendLayout -> Pair
legendLayoutSpec [LegendLayout]
ll)
legendConfigProperty (LeLeX Double
x) = Key
"legendX" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
legendConfigProperty (LeLeY Double
x) = Key
"legendY" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
legendConfigProperty (LeOffset Double
x) = Key
"offset" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
legendConfigProperty (LeOrient LegendOrientation
orl) = Key
"orient" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LegendOrientation -> Text
legendOrientLabel LegendOrientation
orl
legendConfigProperty (LePadding Double
x) = Key
"padding" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
legendConfigProperty (LeRowPadding Double
x) = Key
"rowPadding" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
legendConfigProperty (LeStrokeColor Text
s) = Key
"strokeColor" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
fromColor Text
s
legendConfigProperty (LeStrokeDash DashStyle
xs) = Key
"strokeDash" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DashStyle -> Value
fromDS DashStyle
xs
legendConfigProperty (LeStrokeWidth Double
x) = Key
"strokeWidth" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
legendConfigProperty (LeSymbolBaseFillColor Text
s) = Key
"symbolBaseFillColor" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
fromColor Text
s
legendConfigProperty (LeSymbolBaseStrokeColor Text
s) = Key
"symbolBaseStrokeColor" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
fromColor Text
s
legendConfigProperty (LeSymbolDash DashStyle
xs) = Key
"symbolDash" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DashStyle -> Value
fromDS DashStyle
xs
legendConfigProperty (LeSymbolDashOffset Double
x) = Key
"symbolDashOffset" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
legendConfigProperty (LeSymbolDirection Orientation
o) = Key
"symbolDirection" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Orientation -> Value
orientationSpec Orientation
o
legendConfigProperty (LeSymbolFillColor Text
s) = Key
"symbolFillColor" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
fromColor Text
s
legendConfigProperty (LeSymbolLimit Int
n) = Key
"symbolLimit" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
n
legendConfigProperty (LeSymbolOffset Double
x) = Key
"symbolOffset" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
legendConfigProperty (LeSymbolOpacity Double
x) = Key
"symbolOpacity" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
legendConfigProperty (LeSymbolSize Double
x) = Key
"symbolSize" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
legendConfigProperty (LeSymbolStrokeColor Text
s) = Key
"symbolStrokeColor" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
fromColor Text
s
legendConfigProperty (LeSymbolStrokeWidth Double
x) = Key
"symbolStrokeWidth" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
legendConfigProperty (LeSymbolType Symbol
s) = Key
"symbolType" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Symbol -> Text
symbolLabel Symbol
s
legendConfigProperty (LeTickCount Int
n) = Key
"tickCount" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
n
legendConfigProperty (LeTickCountTime ScaleNice
sn) = Key
"tickCount" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ScaleNice -> Value
scaleNiceSpec ScaleNice
sn
legendConfigProperty LegendConfig
LeNoTitle = Key
"title" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
A.Null
legendConfigProperty (LeTitleAlign HAlign
ha) = Key
"titleAlign" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= HAlign -> Text
hAlignLabel HAlign
ha
legendConfigProperty (LeTitleAnchor APosition
anc) = Key
"titleAnchor" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= APosition -> Text
anchorLabel APosition
anc
legendConfigProperty (LeTitleBaseline VAlign
va) = Key
"titleBaseline" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= VAlign -> Text
vAlignLabel VAlign
va
legendConfigProperty (LeTitleColor Text
s) = Key
"titleColor" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
fromColor Text
s
legendConfigProperty (LeTitleFont Text
s) = Key
"titleFont" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
s
legendConfigProperty (LeTitleFontSize Double
x) = Key
"titleFontSize" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
legendConfigProperty (LeTitleFontStyle Text
s) = Key
"titleFontStyle" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
s
legendConfigProperty (LeTitleFontWeight FontWeight
fw) = Key
"titleFontWeight" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= FontWeight -> Value
fontWeightSpec FontWeight
fw
legendConfigProperty (LeTitleLimit Double
x) = Key
"titleLimit" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
legendConfigProperty (LeTitleLineHeight Double
x) = Key
"titleLineHeight" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
legendConfigProperty (LeTitleOpacity Double
x) = Key
"titleOpacity" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
legendConfigProperty (LeTitleOrient Side
orient) = Key
"titleOrient" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Side -> Text
sideLabel Side
orient
legendConfigProperty (LeTitlePadding Double
x) = Key
"titlePadding" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
legendConfigProperty (LeUnselectedOpacity Double
x) = Key
"unselectedOpacity" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
legendConfigProperty (LeZIndex ZIndex
z) = Key
"zindex" Key -> ZIndex -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ZIndex
z


{-|

Properties for customising the colors of a range. The parameter should be a
named color scheme such as @\"accent\"@ or @\"purpleorange-11\"@. For details see the
<https://vega.github.io/vega/docs/schemes/#scheme-properties Vega-Lite documentation>.

Used by 'RangeStyle'.

-}
data RangeConfig
    = RCategory T.Text
    | RDiverging T.Text
    | RHeatmap T.Text
    | ROrdinal T.Text
    | RRamp T.Text
    | RSymbol T.Text


rangeConfigProperty :: RangeConfig -> Pair
rangeConfigProperty :: RangeConfig -> Pair
rangeConfigProperty RangeConfig
rangeCfg =
  let (Key
l, Text
n) = case RangeConfig
rangeCfg of
        RCategory Text
nme -> (Key
"category", Text
nme)
        RDiverging Text
nme -> (Key
"diverging", Text
nme)
        RHeatmap Text
nme -> (Key
"heatmap", Text
nme)
        ROrdinal Text
nme -> (Key
"ordinal", Text
nme)
        RRamp Text
nme -> (Key
"ramp", Text
nme)
        RSymbol Text
nme -> (Key
"symbol", Text
nme)

  in Key
l Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [Text -> DashStyle -> Pair
schemeProperty Text
n []]


scaleConfigProperty :: ScaleConfig -> Pair
scaleConfigProperty :: ScaleConfig -> Pair
scaleConfigProperty (SCBandPaddingInner Double
x) = Key
"bandPaddingInner" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
scaleConfigProperty (SCBandPaddingOuter Double
x) = Key
"bandPaddingOuter" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
scaleConfigProperty (SCBarBandPaddingInner Double
x) = Key
"barBandPaddingInner" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
scaleConfigProperty (SCBarBandPaddingOuter Double
x) = Key
"barBandPaddingOuter" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
scaleConfigProperty (SCRectBandPaddingInner Double
x) = Key
"rectBandPaddingInner" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
scaleConfigProperty (SCRectBandPaddingOuter Double
x) = Key
"rectBandPaddingOuter" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
scaleConfigProperty (SCClamp Bool
b) = Key
"clamp" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
b
scaleConfigProperty (SCMaxBandSize Double
x) = Key
"maxBandSize" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
scaleConfigProperty (SCMinBandSize Double
x) = Key
"minBandSize" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
scaleConfigProperty (SCMaxFontSize Double
x) = Key
"maxFontSize" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
scaleConfigProperty (SCMinFontSize Double
x) = Key
"minFontSize" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
scaleConfigProperty (SCMaxOpacity Double
x) = Key
"maxOpacity" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
scaleConfigProperty (SCMinOpacity Double
x) = Key
"minOpacity" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
scaleConfigProperty (SCMaxSize Double
x) = Key
"maxSize" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
scaleConfigProperty (SCMinSize Double
x) = Key
"minSize" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
scaleConfigProperty (SCMaxStrokeWidth Double
x) = Key
"maxStrokeWidth" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
scaleConfigProperty (SCMinStrokeWidth Double
x) = Key
"minStrokeWidth" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
scaleConfigProperty (SCPointPadding Double
x) = Key
"pointPadding" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
scaleConfigProperty (SCRound Bool
b) = Key
"round" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
b
scaleConfigProperty (SCUseUnaggregatedDomain Bool
b) = Key
"useUnaggregatedDomain" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
b
scaleConfigProperty (SCXReverse Bool
b) = Key
"xReverse" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
b


{-|

View configuration property. These are used to configure the style of a single
view within a visualization (via 'ViewStyle') such as its size and default fill and stroke colors.
For further details see the
<https://vega.github.io/vega-lite/docs/spec.html#config Vega-Lite documentation>.

In version @0.6.0.0@ the constructors that used to take an optional color,
namely 'ViewFill' and 'ViewStroke', were split out, so that they
now take a 'Color' argument and new constructors - 'ViewNoFill' and
'ViewNoStroke' - were added to replace the @Nothing@ versions.

In version @0.5.0.0@ the @ViewWidth@ and @ViewHeight@ constructors have
been deprecated, and replaced by
'ViewContinuousWidth', 'ViewContinuousHeight',
'ViewDiscreteWidth', and 'ViewDiscreteHeight'. The 'ViewBackgroundStyle'
constructor has been added.

This type has been changed in the @0.4.0.0@ release to use a consistent
naming scheme for the constructors (everything starts with @View@). Prior to
this release only @ViewWidth@ and @ViewHeight@ were named this way. There
are also five new constructors.

-}

-- based on schema 3.3.0 #/definitions/ViewConfig

{-# DEPRECATED ViewWidth "Please change ViewWidth to ViewContinuousWidth" #-}
{-# DEPRECATED ViewHeight "Please change ViewHeight to ViewContinuousHeight" #-}
data ViewConfig
    = ViewBackgroundStyle [ViewBackground]
      -- ^ The default single-view style.
      --
      --   @since 0.5.0.0
    | ViewClip Bool
      -- ^ Should the view be clipped?
    | ViewContinuousWidth Double
      -- ^ The default width of single views when the
      --   visualization has a continuous x field.
      --
      --   @since 0.5.0.0
    | ViewContinuousHeight Double
      -- ^ The default height of single views when the
      --   visualization has a continuous y field.
      --
      --   @since 0.5.0.0
    | ViewCornerRadius Double
      -- ^ The radius, in pixels, of rounded rectangle corners.
      --
      --   The default is @0@.
      --
      --   @since 0.4.0.0
    | ViewCursor Cursor
      -- ^ The default cursor for single views.
      --
      --   @since 0.6.0.0
    | ViewDiscreteWidth Double
      -- ^ The default width of single views when the
      --   visualization has a discrete x field.
      --
      --   @since 0.5.0.0
    | ViewDiscreteHeight Double
      -- ^ The default height of single views when the
      --   visualization has a discrete y field.
      --
      --   @since 0.5.0.0
    | ViewFill Color
      -- ^ The fill color. See also 'ViewNoFill'.
      --
      --   This was changed to use the @Color@ type alias in version @0.5.0.0@
      --   and removed the @Maybe@ type in version @0.6.0.0@.
    | ViewNoFill
      -- ^ Do not use a fill. See also 'ViewFill'.
      --
      --   @since 0.6.0.0
    | ViewFillOpacity Opacity
      -- ^ The fill opacity.
    | ViewOpacity Opacity
      -- ^ The overall opacity.
      --
      --   The default is @0.7@ for non-aggregate plots with 'Graphics.Vega.VegaLite.Point', 'Graphics.Vega.VegaLite.Tick',
      --   'Graphics.Vega.VegaLite.Circle', or 'Graphics.Vega.VegaLite.Square' marks or layered 'Graphics.Vega.VegaLite.Bar' charts, and @1@
      --   otherwise.
      --
      --   @since 0.4.0.0
    | ViewStep Double
      -- ^ Default step size for discrete fields.
      --
      --   This replaces @SCRangeStep@ and @SCTextXRangeStep@ from
      --   'ScaleConfig'.
      --
      --   @since 0.5.0.0
    | ViewStroke Color
      -- ^ The stroke color. See also 'ViewNoStroke'.
      --
      --   This was changed to use the @Color@ type alias in version @0.5.0.0@
      --   and removed the @Maybe@ type in version @0.6.0.0@.
    | ViewNoStroke
      -- ^ Do not use a stroke color. See also 'ViewStroke'.
      --
      --   @since 0.6.0.0
    | ViewStrokeCap StrokeCap
      -- ^ The stroke cap for line-ending style.
      --
      --   @since 0.4.0.0
    | ViewStrokeDash DashStyle
      -- ^ The stroke dash pattern.
    | ViewStrokeDashOffset DashOffset
      -- ^ The offset for the dash pattern.
    | ViewStrokeJoin StrokeJoin
      -- ^ The stroke line-join method.
      --
      --   @since 0.4.0.0
    | ViewStrokeMiterLimit Double
      -- ^ The miter limit at which to bevel a line join.
      --
      --   @since 0.4.0.0
    | ViewStrokeOpacity Opacity
      -- ^ The stroke opacity.
    | ViewStrokeWidth Double
      -- ^ The stroke width, in pixels.
    | ViewWidth Double
      -- ^ As of version @0.5.0.0@ this is deprecated and 'ViewContinuousWidth' should
      --   be used instead.
    | ViewHeight Double
      -- ^ As of version @0.5.0.0@ this is deprecated and 'ViewContinuousHeight' should
      --   be used instead.


viewConfigProperties :: ViewConfig -> [Pair]
viewConfigProperties :: ViewConfig -> [Pair]
viewConfigProperties (ViewBackgroundStyle [ViewBackground]
bs) = (ViewBackground -> Pair) -> [ViewBackground] -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
map ViewBackground -> Pair
viewBackgroundSpec [ViewBackground]
bs
viewConfigProperties (ViewClip Bool
b) = [Key
"clip" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
b]
viewConfigProperties (ViewWidth Double
x) = [Key
"continuousWidth" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x]
viewConfigProperties (ViewHeight Double
x) = [Key
"continuousHeight" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x]
viewConfigProperties (ViewContinuousWidth Double
x) = [Key
"continuousWidth" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x]
viewConfigProperties (ViewContinuousHeight Double
x) = [Key
"continuousHeight" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x]
viewConfigProperties (ViewCornerRadius Double
x) = [Key
"cornerRadius" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x]
viewConfigProperties (ViewCursor Cursor
c) = [Key
"cursor" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Cursor -> Text
cursorLabel Cursor
c]
viewConfigProperties (ViewDiscreteWidth Double
x) = [Key
"discreteWidth" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x]
viewConfigProperties (ViewDiscreteHeight Double
x) = [Key
"discreteHeight" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x]
viewConfigProperties (ViewFill Text
ms) = [Key
"fill" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
fromColor Text
ms]
viewConfigProperties ViewConfig
ViewNoFill = [Key
"fill" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
A.Null]
viewConfigProperties (ViewFillOpacity Double
x) = [Key
"fillOpacity" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x]
viewConfigProperties (ViewOpacity Double
x) = [Key
"opacity" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x]
viewConfigProperties (ViewStep Double
x) = [Key
"step" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x]
viewConfigProperties (ViewStroke Text
ms) = [Key
"stroke" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
fromColor Text
ms]
viewConfigProperties ViewConfig
ViewNoStroke = [Key
"stroke" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
A.Null]
viewConfigProperties (ViewStrokeCap StrokeCap
sc) = [Key
"strokeCap" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= StrokeCap -> Text
strokeCapLabel StrokeCap
sc]
viewConfigProperties (ViewStrokeDash DashStyle
xs) = [Key
"strokeDash" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DashStyle -> Value
fromDS DashStyle
xs]
viewConfigProperties (ViewStrokeDashOffset Double
x) = [Key
"strokeDashOffset" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x]
viewConfigProperties (ViewStrokeJoin StrokeJoin
sj) = [Key
"strokeJoin" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= StrokeJoin -> Text
strokeJoinLabel StrokeJoin
sj]
viewConfigProperties (ViewStrokeMiterLimit Double
x) = [Key
"strokeMiterLimit" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x]
viewConfigProperties (ViewStrokeOpacity Double
x) = [Key
"strokeOpacity" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x]
viewConfigProperties (ViewStrokeWidth Double
x) = [Key
"strokeWidth" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x]


{-|

Axis configuration options for customising all axes. See the
<https://vega.github.io/vega-lite/docs/axis.html#general-config Vega-Lite documentation>
for more details.

This is used by 'ConfigurationProperty'.

In @0.5.0.0@ the @ShortTimeLabels@ constructor was removed.

The @TitleMaxLength@ constructor was removed in release @0.4.0.0@. The
@TitleLimit@ constructor should be used instead.

-}
data AxisConfig
    = Aria Bool
      -- ^ A boolean flag indicating if
      --   [ARIA attributes](https://developer.mozilla.org/en-US/docs/Web/Accessibility/ARIA)
      --   should be included (SVG output only).
      --
      --   If False, the \"aria-hidden\" attribute will be set on the output SVG group, removing
      --   the axis from the ARIA accessibility tree.
      --
      --   __Default value:__ True
      --
      --   @since 0.9.0.0
    | AriaDescription T.Text
      -- ^ A text description of this axis for
      --   [ARIA accessibility](https://developer.mozilla.org/en-US/docs/Web/Accessibility/ARIA)
      --   (SVG output only).
      --
      --   If the 'Aria' property is True, for SVG output the
      --   [\"aria-label\" attribute](https://developer.mozilla.org/en-US/docs/Web/Accessibility/ARIA/ARIA_Techniques/Using_the_aria-label_attribute)
      --   will be set to this description.
      --
      --   If the description is unspecified it will be automatically generated.
      --
      --   @since 0.9.0.0
    | AStyle [StyleLabel]
      -- ^ The named styles - generated with 'AxisNamedStyles' - to apply to the
      --   axis or axes.
      --
      --   Added in Vega-Lite 4.7.0 (although accidentally supported in @hvega@
      --   before this release).
      --
      --   @since 0.6.0.0
    | BandPosition Double
      -- ^ The default axis band position.
    | Disable Bool
      -- ^ Disable the axis?
      --
      --   Added in Vega-Lite 4.8.0.
      --
      --  @since 0.8.0.0
    | Domain Bool
      -- ^ Should the axis domain be displayed?
    | DomainCap StrokeCap
      -- ^ The stroke cap for the domain lines' ending style.
      --
      --   @since 0.9.0.0
    | DomainColor Color
      -- ^ The axis domain color.
    | DomainDash DashStyle
      -- ^ The dash pattern of the domain.
      --
      --   @since 0.4.0.0
    | DomainDashOffset DashOffset
      -- ^ The offset for the dash pattern.
      --
      --   @since 0.4.0.0
    | DomainOpacity Opacity
      -- ^ The axis domain opacity.
      --
      --   @since 0.4.0.0
    | DomainWidth Double
      -- ^ The width of the axis domain.
    | Format T.Text
      -- ^ [Formatting pattern](https://vega.github.io/vega-lite/docs/format.html) for
      --   axis values. To distinguish between formatting as numeric values
      --   and data/time values, additionally use 'FormatAsNum', 'FormatAsTemporal',
      --   or 'FormatAsCustom'.
      --
      --   When used with a [custom formatType](https://vega.github.io/vega-lite/docs/config.html#custom-format-type),
      --   this value will be passed as \"format\" alongside \"datum.value\" to the
      --   registered function.
      --
      --   @since 0.9.0.0
    | FormatAsNum
      -- ^ Facet headers should be formatted as numbers. Use a
      --   [d3 numeric format string](https://github.com/d3/d3-format#locale_format)
      --   with 'Format'.
      --
      --   @since 0.9.0.0
    | FormatAsTemporal
      -- ^ Facet headers should be formatted as dates or times. Use a
      --   [d3 date/time format string](https://github.com/d3/d3-time-format#locale_format)
      --   with 'Format'.
      --
      --   @since 0.9.0.0
    | FormatAsCustom T.Text
      -- ^ The [custom format type](https://vega.github.io/vega-lite/docs/config.html#custom-format-type)
      --   for use with with 'Format'.
      --
      --   @since 0.9.0.0
    | Grid Bool
      -- ^ Should an axis grid be displayed?
    | GridCap StrokeCap
      -- ^ The stroke cap for the grid lines' ending style.
      --
      --   @since 0.9.0.0
    | GridColor Color
      -- ^ The color for the grid.
    | GridDash DashStyle
      -- ^ The dash pattern of the grid.
    | GridDashOffset DashOffset
      -- ^ The offset for the dash pattern.
      --
      --   @since 0.4.0.0
    | GridOpacity Opacity
      -- ^ The opacity of the grid.
    | GridWidth Double
      -- ^ The width of the grid lines.
    | Labels Bool
      -- ^ Should labels be added to an axis?
    | LabelAlign HAlign
      -- ^ The horizontal alignment for labels.
      --
      --   @since 0.4.0.0
    | LabelAngle Angle
      -- ^ The angle at which to draw labels.
    | LabelBaseline VAlign
      -- ^ The vertical alignment for labels.
      --
      --   @since 0.4.0.0
    | LabelNoBound
      -- ^ No boundary overlap check is applied to labels. This is the
      --   default behavior.
      --
      --   See also 'LabelBound' and 'LabelBoundValue'.
      --
      --   @since 0.4.0.0
    | LabelBound
      -- ^ Labels are hidden if they exceed the axis range by more than 1
      --   pixel.
      --
      --   See also 'LabelNoBound' and 'LabelBoundValue'.
      --
      --   @since 0.4.0.0
    | LabelBoundValue Double
      -- ^ Labels are hidden if they exceed the axis range by more than
      --   the given number of pixels.
      --
      --   See also 'LabelNoBound' and 'LabelBound'.
      --
      --   @since 0.4.0.0
    | LabelColor Color
      -- ^ The label color.
    | LabelNoFlush
      -- ^ The labels are not aligned flush to the scale. This is the
      --   default for non-continuous X scales.
      --
      --   See also 'LabelFlush' and 'LabelFlushValue'.
      --
      --   @since 0.4.0.0
    | LabelFlush
      -- ^ The first and last axis labels are aligned flush to the scale
      --   range.
      --
      --   See also 'LabelNoFlush' and 'LabelFlushValue'.
      --
      --   @since 0.4.0.0
    | LabelFlushValue Double
      -- ^ The labels are aligned flush, and the parameter determines
      --   the extra offset, in pixels, to apply to the first and last
      --   labels. This can help the labels better group (visually) with
      --   the corresponding axis ticks.
      --
      --   See also 'LabelNoFlush' and 'LabelFlush'.
      --
      --   @since 0.4.0.0
    | LabelFlushOffset Double
      -- ^ The number of pixels to offset flush-adjusted labels.
      --
      --   @since 0.4.0.0
    | LabelFont T.Text
      -- ^ The font for the label.
    | LabelFontSize Double
      -- ^ The font size of the label.
    | LabelFontStyle T.Text
      -- ^ The font style of the label.
      --
      --   @since 0.4.0.0
    | LabelFontWeight FontWeight
      -- ^ The font weight of the label.
      --
      --   @since 0.4.0.0
    | LabelLimit Double
      -- ^ The maximum width of a label, in pixels.
    | LabelLineHeight Double
      -- ^ The line height, in pixels, for multi-line label text.
      --
      --   Added in Vega-Lite 4.6.0.
      --
      --   @since 0.7.0.0
    | LabelOffset Double
      -- ^ The pixel offset for labels, in addition to 'TickOffset'.
      --
      --   @since 0.6.0.0
    | LabelOpacity Opacity
      -- ^ The opacity of the label.
      --
      --   @since 0.4.0.0
    | LabelOverlap OverlapStrategy
      -- ^ How should overlapping labels be displayed?
    | LabelPadding Double
      -- ^ The padding, in pixels, between the label and the axis.
    | LabelSeparation Double
      -- ^ The minimum separation, in pixels, between label bounding boxes
      --   for them to be considered non-overlapping. This is ignored if
      --   the 'LabelOverlap' strategy is 'Graphics.Vega.VegaLite.ONone'.
      --
      --   @since 0.4.0.0
    | MaxExtent Double
      -- ^ The maximum extent, in pixels, that axis ticks and labels should use.
      --   This determines a maxmium offset value for axis titles.
    | MinExtent Double
      -- ^ The minimum extent, in pixels, that axis ticks and labels should use.
      --   This determines a minmium offset value for axis titles.
    | NoTitle
      -- ^ Do not draw a title for this axis.
      --
      --   @since 0.4.0.0
    | Orient Side
      -- ^ The orientation of the axis.
      --
      --   @since 0.4.0.0
    | Ticks Bool
      -- ^ Should tick marks be drawn on an axis?
    | TickBand BandAlign
      -- ^ For band scales, indicates if ticks and grid lines should be
      --   placed at the center of a band (the default) or at the band
      --   extents to indicate intervals.
      --
      --   @since 0.5.0.0
    | TickCap StrokeCap
      -- ^ The stroke cap for the grid lines' ending style.
      --
      --   @since 0.9.0.0
    | TickColor Color
      -- ^ The color of the ticks.
    | TickCount Int
      -- ^ The desired number of ticks for axes visualizing quantitative scales.
      --   This is a hint to the system, and the actual number used will be
      --   adjusted to be \"nice\" (multiples of 2, 5, or 10) and lie within the
      --   underlying scale's range.
      --
      --   The 'TickCountTime' option can instead be used for \"time\" or
      --   \"utc\" scales.
      --
      --   @since 0.9.0.0
    | TickCountTime ScaleNice
      -- ^ A specialised version of 'TickCount' for \"time\" and \"utc\"
      --   time scales.
      --
      --   The 'Graphics.Vega.VegaLite.IsNice' and 'Graphics.Vega.VegaLte.NTickCount'
      --   options should not be used as they generate invalid VegaLite.
      --
      --   @since 0.9.0.0
    | TickDash DashStyle
      -- ^ The dash pattern of the ticks.
    | TickDashOffset DashOffset
      -- ^ The offset for the dash pattern.
      --
      --   @since 0.4.0.0
    | TickExtra Bool
      -- ^ Should an extra axis tick mark be added for the initial position of
      --   the axis?
      --
      --   @since 0.4.0.0
    | TickOffset Double
      -- ^ The position offset, in pixels, to apply to ticks, labels, and grid lines.
      --
      --   See also 'LabelOffset'.
      --
      --   @since 0.4.0.0
    | TickOpacity Opacity
      -- ^ The opacity of the ticks.
      --
      --   @since 0.4.0.0
    | TickRound Bool
      -- ^ Should pixel position values be rounded to the nearest integer?
    | TickSize Double
      -- ^ The size of the tick marks in pixels.
    | TickWidth Double
      -- ^ The width of the tick marks in pixels.
    | TitleAlign HAlign
      -- ^ The horizontal alignment of the axis title.
    | TitleAnchor APosition
      -- ^ The text anchor position for placing axis titles.
      --
      --   @since 0.4.0.0
    | TitleAngle Angle
      -- ^ The angle of the axis title.
    | TitleBaseline VAlign
      -- ^ The vertical alignment of the axis title.
    | TitleColor Color
      -- ^ The color of the axis title.
    | TitleFont T.Text
      -- ^ The font for the axis title.
    | TitleFontSize Double
      -- ^ The font size of the axis title.
    | TitleFontStyle T.Text
      -- ^ The font style of the axis title.
      --
      --   @since 0.4.0.0
    | TitleFontWeight FontWeight
      -- ^ The font weight of the axis title.
    | TitleLimit Double
      -- ^ The maximum allowed width of the axis title, in pixels.
    | TitleLineHeight Double
      -- ^ Line height, in pixels, for multi-line title text.
      --
      --   @since 0.5.0.0
    | TitleOpacity Opacity
      -- ^ The opacity of the axis title.
      --
      --   @since 0.4.0.0
    | TitlePadding Double
      -- ^ The padding, in pixels, between title and axis.
    | TitleX Double
      -- ^ The X coordinate of the axis title, relative to the axis group.
    | TitleY Double
      -- ^ The Y coordinate of the axis title, relative to the axis group.
    | TranslateOffset Double
      -- ^ The translation offset in pixels applied to the axis group
      --   mark x and y. If specified it overrides the default value
      --   of a 0.5 offset to pixel-align stroked lines.
      --
      --   @since 0.5.0.0


axisConfigProperty :: AxisConfig -> Pair
axisConfigProperty :: AxisConfig -> Pair
axisConfigProperty (AStyle [Text
s]) = Key
"style" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
s
axisConfigProperty (AStyle [Text]
s) = Key
"style" Key -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Text]
s

axisConfigProperty (Aria Bool
b) = Key
"aria" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
b
axisConfigProperty (AriaDescription Text
t) = Key
"description" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
t

axisConfigProperty (BandPosition Double
x) = Key
"bandPosition" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
axisConfigProperty (Disable Bool
b) = Key
"disable" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
b
axisConfigProperty (Domain Bool
b) = Key
"domain" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
b
axisConfigProperty (DomainCap StrokeCap
c) = Key
"domainCap" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= StrokeCap -> Text
strokeCapLabel StrokeCap
c
axisConfigProperty (DomainColor Text
c) = Key
"domainColor" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
fromColor Text
c
axisConfigProperty (DomainDash DashStyle
ds) = Key
"domainDash" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DashStyle -> Value
fromDS DashStyle
ds
axisConfigProperty (DomainDashOffset Double
x) = Key
"domainDashOffset" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
axisConfigProperty (DomainOpacity Double
x) = Key
"domainOpacity" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
axisConfigProperty (DomainWidth Double
w) = Key
"domainWidth" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
w

axisConfigProperty (Format Text
fmt) = Key
"format" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
fmt
axisConfigProperty AxisConfig
FormatAsNum = Key
"formatNum" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
fromT Text
"number"
axisConfigProperty AxisConfig
FormatAsTemporal = Key
"formatNum" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
fromT Text
"type"
axisConfigProperty (FormatAsCustom Text
c) = Key
"formatType" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
c

axisConfigProperty (Grid Bool
b) = Key
"grid" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
b
axisConfigProperty (GridCap StrokeCap
c) = Key
"gridCap" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= StrokeCap -> Text
strokeCapLabel StrokeCap
c
axisConfigProperty (GridColor Text
c) = Key
"gridColor" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
fromColor Text
c
axisConfigProperty (GridDash DashStyle
ds) = Key
"gridDash" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DashStyle -> Value
fromDS DashStyle
ds
axisConfigProperty (GridDashOffset Double
x) = Key
"gridDashOffset" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
axisConfigProperty (GridOpacity Double
o) = Key
"gridOpacity" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
o
axisConfigProperty (GridWidth Double
x) = Key
"gridWidth" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
axisConfigProperty (LabelAlign HAlign
ha) = Key
"labelAlign" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= HAlign -> Text
hAlignLabel HAlign
ha
axisConfigProperty (LabelAngle Double
angle) = Key
"labelAngle" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
angle
axisConfigProperty (LabelBaseline VAlign
va) = Key
"labelBaseline" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= VAlign -> Text
vAlignLabel VAlign
va
axisConfigProperty AxisConfig
LabelNoBound = Key
"labelBound" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
False
axisConfigProperty AxisConfig
LabelBound = Key
"labelBound" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
True
axisConfigProperty (LabelBoundValue Double
x) = Key
"labelBound" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
axisConfigProperty (LabelColor Text
c) = Key
"labelColor" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
fromColor Text
c
axisConfigProperty AxisConfig
LabelNoFlush = Key
"labelFlush" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
False
axisConfigProperty AxisConfig
LabelFlush = Key
"labelFlush" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
True
axisConfigProperty (LabelFlushValue Double
x) = Key
"labelFlush" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
axisConfigProperty (LabelFlushOffset Double
x) = Key
"labelFlushOffset" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
axisConfigProperty (LabelFont Text
f) = Key
"labelFont" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
f
axisConfigProperty (LabelFontSize Double
x) = Key
"labelFontSize" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
axisConfigProperty (LabelFontStyle Text
s) = Key
"labelFontStyle" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
s
axisConfigProperty (LabelFontWeight FontWeight
fw) = Key
"labelFontWeight" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= FontWeight -> Value
fontWeightSpec FontWeight
fw
axisConfigProperty (LabelLimit Double
x) = Key
"labelLimit" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
axisConfigProperty (LabelLineHeight Double
x) = Key
"labelLineHeight" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
axisConfigProperty (LabelOffset Double
x) = Key
"labelOffset" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
axisConfigProperty (LabelOpacity Double
x) = Key
"labelOpacity" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
axisConfigProperty (LabelOverlap OverlapStrategy
strat) = Key
"labelOverlap" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= OverlapStrategy -> Value
overlapStrategyLabel OverlapStrategy
strat
axisConfigProperty (LabelPadding Double
pad) = Key
"labelPadding" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
pad
axisConfigProperty (LabelSeparation Double
x) = Key
"labelSeparation" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
axisConfigProperty (Labels Bool
b) = Key
"labels" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
b
axisConfigProperty (MaxExtent Double
n) = Key
"maxExtent" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
n
axisConfigProperty (MinExtent Double
n) = Key
"minExtent" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
n
axisConfigProperty (Orient Side
orient) = Key
"orient" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Side -> Text
sideLabel Side
orient
axisConfigProperty (TickBand BandAlign
band) = Key
"tickBand" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= BandAlign -> Text
bandAlignLabel BandAlign
band
axisConfigProperty (TickCap StrokeCap
c) = Key
"tickCap" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= StrokeCap -> Text
strokeCapLabel StrokeCap
c
axisConfigProperty (TickColor Text
c) = Key
"tickColor" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
fromColor Text
c
axisConfigProperty (TickCount Int
n) = Key
"tickCount" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
n
axisConfigProperty (TickCountTime ScaleNice
sn) = Key
"tickCount" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ScaleNice -> Value
scaleNiceSpec ScaleNice
sn
axisConfigProperty (TickDash DashStyle
ds) = Key
"tickDash" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DashStyle -> Value
fromDS DashStyle
ds
axisConfigProperty (TickDashOffset Double
x) = Key
"tickDashOffset" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
axisConfigProperty (TickExtra Bool
b) = Key
"tickExtra" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
b
axisConfigProperty (TickOffset Double
x) = Key
"tickOffset" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
axisConfigProperty (TickOpacity Double
x) = Key
"tickOpacity" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
axisConfigProperty (TickRound Bool
b) = Key
"tickRound" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
b
axisConfigProperty (TickSize Double
x) = Key
"tickSize" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
axisConfigProperty (TickWidth Double
x) = Key
"tickWidth" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
axisConfigProperty (Ticks Bool
b) = Key
"ticks" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
b
axisConfigProperty AxisConfig
NoTitle = Key
"title" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
A.Null
axisConfigProperty (TitleAlign HAlign
algn) = Key
"titleAlign" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= HAlign -> Text
hAlignLabel HAlign
algn
axisConfigProperty (TitleAnchor APosition
a) = Key
"titleAnchor" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= APosition -> Text
anchorLabel APosition
a
axisConfigProperty (TitleAngle Double
x) = Key
"titleAngle" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
axisConfigProperty (TitleBaseline VAlign
va) = Key
"titleBaseline" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= VAlign -> Text
vAlignLabel VAlign
va
axisConfigProperty (TitleColor Text
c) = Key
"titleColor" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
fromColor Text
c
axisConfigProperty (TitleFont Text
f) = Key
"titleFont" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
f
axisConfigProperty (TitleFontSize Double
x) = Key
"titleFontSize" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
axisConfigProperty (TitleFontStyle Text
s) = Key
"titleFontStyle" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
s
axisConfigProperty (TitleFontWeight FontWeight
w) = Key
"titleFontWeight" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= FontWeight -> Value
fontWeightSpec FontWeight
w
axisConfigProperty (TitleLimit Double
x) = Key
"titleLimit" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
axisConfigProperty (TitleLineHeight Double
x) = Key
"titleLineHeight" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
axisConfigProperty (TitleOpacity Double
x) = Key
"titleOpacity" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
axisConfigProperty (TitlePadding Double
x) = Key
"titlePadding" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
axisConfigProperty (TitleX Double
x) = Key
"titleX" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
axisConfigProperty (TitleY Double
x) = Key
"titleY" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
axisConfigProperty (TranslateOffset Double
x) = Key
"translate" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x


-- | Specifies how the title anchor is positioned relative to the frame.
--
--   @since 0.4.0.0
data TitleFrame
    = FrBounds
      -- ^ The position is relative to the full bounding box.
    | FrGroup
      -- ^ The pistion is relative to the group width / height.

titleFrameSpec :: TitleFrame -> VLSpec
titleFrameSpec :: TitleFrame -> Value
titleFrameSpec TitleFrame
FrBounds = Value
"bounds"
titleFrameSpec TitleFrame
FrGroup = Value
"group"


{-|

Title configuration properties. These are used to configure the default style
of all titles within a visualization with 'title' or 'TitleStyle'.

For further details see the
<https://vega.github.io/vega-lite/docs/title.html#config Vega-Lite documentation>.

-}

-- NOTES:
--   do not have a 'TTitle' field because this is handled by the first
--   argument of title, so there's no point in having it here (also, would
--   have to be called something different than TTitle as we already have
--   this).
--
--   could move TSubtitle out too, but the ergonomics aren't great
--   either way

data TitleConfig
    = TAlign HAlign
      -- ^ The horizontal text alignment for title text.
      --
      --   @since 0.5.0.0
    | TAnchor APosition
      -- ^ The anchor position when placing titles.
    | TAngle Angle
      -- ^ The angle when orientating titles.
    | TAria Bool
      -- ^ A boolean flag indicating if
      --   [ARIA attributes](https://developer.mozilla.org/en-US/docs/Web/Accessibility/ARIA)
      --   should be included (SVG output only).
      --
      --   If False, the \"aria-hidden\" attribute will be set on the output SVG group,
      --   removing the title from the ARIA accessibility tree.
      --
      --   __Default value:__ True
      --
      --   @since 0.9.0.0
    | TBaseline VAlign
      -- ^ The vertical alignment when placing titles.
    | TColor Color  -- this allows for null as a color
      -- ^ The color of title text.
    | TdX Double
      -- ^ The offset, in pixels, for the x coordinate of title and subtitle text.
      --
      --   @since 0.5.0.0
    | TdY Double
      -- ^ The offset, in pixels, for the x coordinate of title and subtitle text.
      --
      --   @since 0.5.0.0
    | TFont T.Text
      -- ^ Default font when showing titles.
    | TFontSize Double
      -- ^ Default font size when showing titles.
    | TFontStyle T.Text
      -- ^ Defaylt font style when showing titles.
      --
      --   @since 0.4.0.0
    | TFontWeight FontWeight
      -- ^ Default font weight when showing titles.
    | TFrame TitleFrame
      -- ^ Default title position anchor.
      --
      --   @since 0.4.0.0
    | TLimit Double
      -- ^ The maximum length, in pixels, of title and subtitle text.
    | TLineHeight Double
      -- ^ Line height, in pixels, for multi-line title text.
      --
      --   @since 0.5.0.0
    | TOffset Double
      -- ^ Default offset, in pixels, of titles relative to the chart body.
    | TOrient Side
      -- ^ Default placement of titles relative to the chart body.
    | TStyle [StyleLabel]
      -- ^ A list of named styles to apply. A named style can be specified
      --   via 'Graphics.Vega.VegaLite.MarkNamedStyles'. Later styles in the list will
      --   override earlier ones if there is a conflict in any of the
      --   properties.
      --
      --   @since 0.4.0.0
    | TSubtitle T.Text
      -- ^ Subtitle text. This is placed below the title text. Use \n
      --   to insert line breaks into the subtitle.
      --
      --   This should only be used with 'title' and not 'TitleConfig'.
      --
      --   @since 0.5.0.0
    | TSubtitleColor Color
      -- ^ Subtitle color.
      --
      --   @since 0.5.0.0
    | TSubtitleFont T.Text
      -- ^ Subtitle font.
      --
      --   @since 0.5.0.0
    | TSubtitleFontSize Double
      -- ^ Subtitle font size, in pixels.
      --
      --   @since 0.5.0.0
    | TSubtitleFontStyle T.Text
      -- ^ Subtitle font style.
      --
      --   @since 0.5.0.0
    | TSubtitleFontWeight FontWeight
      -- ^ Subtitle font weight.
      --
      --   @since 0.5.0.0
    | TSubtitleLineHeight Double
      -- ^ Subtitle line height, in pixels.
      --
      --   @since 0.5.0.0
    | TSubtitlePadding Double
      -- ^ Padding, in pixels, between the title and Subtitle.
      --
      --   @since 0.5.0.0
    | TZIndex ZIndex
      -- ^ Drawing order of a title relative to the other chart elements.
      --
      --   @since 0.4.0.0


titleConfigSpec :: TitleConfig -> Pair
titleConfigSpec :: TitleConfig -> Pair
titleConfigSpec (TAlign HAlign
ha) = Key
"align" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= HAlign -> Text
hAlignLabel HAlign
ha
titleConfigSpec (TAnchor APosition
an) = Key
"anchor" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= APosition -> Text
anchorLabel APosition
an
titleConfigSpec (TAngle Double
x) = Key
"angle" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
titleConfigSpec (TAria Bool
b) = Key
"aria" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
b
titleConfigSpec (TBaseline VAlign
va) = Key
"baseline" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= VAlign -> Text
vAlignLabel VAlign
va
titleConfigSpec (TColor Text
clr) = Key
"color" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
fromColor Text
clr
titleConfigSpec (TdX Double
x) = Key
"dx" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
titleConfigSpec (TdY Double
x) = Key
"dy" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
titleConfigSpec (TFont Text
fnt) = Key
"font" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
fnt
titleConfigSpec (TFontSize Double
x) = Key
"fontSize" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
titleConfigSpec (TFontStyle Text
s) = Key
"fontStyle" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
s
titleConfigSpec (TFontWeight FontWeight
w) = Key
"fontWeight" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= FontWeight -> Value
fontWeightSpec FontWeight
w
titleConfigSpec (TFrame TitleFrame
tf) = Key
"frame" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TitleFrame -> Value
titleFrameSpec TitleFrame
tf
titleConfigSpec (TLimit Double
x) = Key
"limit" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
titleConfigSpec (TLineHeight Double
x) = Key
"lineHeight" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
titleConfigSpec (TOffset Double
x) = Key
"offset" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
titleConfigSpec (TOrient Side
sd) = Key
"orient" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Side -> Text
sideLabel Side
sd
titleConfigSpec (TStyle [Text
style]) = Key
"style" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
style  -- minor simplification
titleConfigSpec (TStyle [Text]
styles) = Key
"style" Key -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Text]
styles
titleConfigSpec (TSubtitle Text
s) = Key
"subtitle" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
splitOnNewline Text
s
titleConfigSpec (TSubtitleColor Text
s) = Key
"subtitleColor" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
fromColor Text
s
titleConfigSpec (TSubtitleFont Text
s) = Key
"subtitleFont" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
s
titleConfigSpec (TSubtitleFontSize Double
x) = Key
"subtitleFontSize" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
titleConfigSpec (TSubtitleFontStyle Text
s) = Key
"subtitleFontStyle" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
s
titleConfigSpec (TSubtitleFontWeight FontWeight
fw) = Key
"subtitleFontWeight" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= FontWeight -> Value
fontWeightSpec FontWeight
fw
titleConfigSpec (TSubtitleLineHeight Double
x) = Key
"subtitleLineHeight" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
titleConfigSpec (TSubtitlePadding Double
x) = Key
"subtitlePadding" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
titleConfigSpec (TZIndex ZIndex
z) = Key
"zindex" Key -> ZIndex -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ZIndex
z


{-|

Configuration options for composition views, used with
'ConcatStyle', 'FacetStyle', and 'RepeatStyle'.

Prior to @0.6.0.0@ this information was made available in
two types - @ConcatConfig@ and @FacetConfig@ - which had
the same meaning.

@since 0.6.0.0

-}
data CompositionConfig
    = CompColumns Int
      -- ^ The number of columns to use. The default is to use a single
      --   row (an infinite number of columns).
      --
      --   Prior to @0.6.0.0@ this was either @ConcatColumns@ or @FColumns@.
    | CompSpacing Double
      -- ^ The spacing in pixels between sub-views. The default is 20.
      --
      --   Prior to @0.6.0.0@ this was either @ConcatSpacing@ or @FSpacing@.


compConfigProperty :: CompositionConfig -> Pair
compConfigProperty :: CompositionConfig -> Pair
compConfigProperty (CompColumns Int
n) = Key
"columns" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
n
compConfigProperty (CompSpacing Double
x) = Key
"spacing" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x


{-|

Defines a single configuration option to be applied globally across the visualization.
The first parameter identifies the type of configuration, the second a list of previous
configurations to which this one may be added.

The result should be used with 'Graphics.Vega.VegaLite.configure'.

@
'configuration' ('Axis' [ 'DomainWidth' 4 ]) []
@
-}
configuration ::
  ConfigurationProperty
  -> BuildConfigureSpecs
  -- ^ Prior to version @0.5.0.0@ this was @BuildLabelledSpecs@.
configuration :: ConfigurationProperty -> BuildConfigureSpecs
configuration ConfigurationProperty
cfg [ConfigureSpec]
ols = LabelledSpec -> ConfigureSpec
CS (ConfigurationProperty -> LabelledSpec
configProperty ConfigurationProperty
cfg) ConfigureSpec -> BuildConfigureSpecs
forall a. a -> [a] -> [a]
: [ConfigureSpec]
ols


{-|

Provide an optional title to be displayed in the visualization.

@
'Graphics.Vega.VegaLite.toVegaLite'
    [ 'title' "Population Growth" ['TColor' \"orange\"]
    , 'Graphics.Vega.VegaLite.dataFromUrl' \"data/population.json\" []
    , 'Graphics.Vega.VegaLite.mark' 'Graphics.Vega.VegaLite.Bar' []
    , 'Graphics.Vega.VegaLite.encoding' ...
    ]
@

Prior to @0.4.0.0@ there was no way to set the title options
(other than using 'configuration' with 'TitleStyle').

-}
title ::
  T.Text
  -- ^ The title. Any @'\n'@ characters are taken to mean a multi-line
  --   string and indicate a line break.
  --
  --   In version @0.5.0.0@, support for line breaks was added.
  -> [TitleConfig]
  -- ^ Configure the appearance of the title.
  --
  --   @since 0.4.0.0
  -> PropertySpec
title :: Text -> [TitleConfig] -> PropertySpec
title Text
s [] =
  (VLProperty
VLTitle, Text -> Value
splitOnNewline Text
s)
title Text
s [TitleConfig]
topts =
  (VLProperty
VLTitle,
    [Pair] -> Value
object (Key
"text" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
splitOnNewline Text
s Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: (TitleConfig -> Pair) -> [TitleConfig] -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
map TitleConfig -> Pair
titleConfigSpec [TitleConfig]
topts))