{-# LANGUAGE OverloadedStrings #-}

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

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

Types for legends.

-}

module Graphics.Vega.VegaLite.Legend
       ( LegendType(..)
       , LegendOrientation(..)
       , LegendLayout(..)
       , BaseLegendLayout(..)
       , LegendProperty(..)
       , LegendValues(..)

         -- not for external export
       , legendProp_
       , legendOrientLabel
       , legendLayoutSpec

       ) where

import qualified Data.Aeson as A
import qualified Data.Text as T

import Data.Aeson ((.=), object, toJSON)

import Graphics.Vega.VegaLite.Foundation
  ( APosition
  , Bounds
  , Color
  , CompositionAlignment
  , DashStyle
  , DashOffset
  , FontWeight
  , HAlign
  , Opacity
  , Orientation
  , OverlapStrategy
  , Side
  , Symbol
  , VAlign
  , VegaExpr
  , ZIndex
  , anchorLabel
  , boundsSpec
  , compositionAlignmentSpec
  , fontWeightSpec
  , hAlignLabel
  , orientationSpec
  , overlapStrategyLabel
  , sideLabel
  , symbolLabel
  , vAlignLabel

  , fromT
  , fromColor
  , fromDS
  , splitOnNewline
  )
import Graphics.Vega.VegaLite.Scale
  ( ScaleNice
  , scaleNiceSpec
  )
import Graphics.Vega.VegaLite.Specification (VLSpec, LabelledSpec)
import Graphics.Vega.VegaLite.Time
  ( DateTime
  , dateTimeSpec
  )


-- | Indicates the type of legend to create. It is used with 'LType'.
--
--   Prior to version @0.4.0.0.0@ this was called @Legend@ and the
--   constructors did not end in @Legend@.
--
data LegendType
    = GradientLegend
      -- ^ Typically used for continuous quantitative data.
    | SymbolLegend
      -- ^ Typically used for categorical data.


legendLabel :: LegendType -> T.Text
legendLabel :: LegendType -> Text
legendLabel LegendType
GradientLegend = Text
"gradient"
legendLabel LegendType
SymbolLegend = Text
"symbol"


{-|

Indicates the legend orientation. See the
<https://vega.github.io/vega-lite/docs/legend.html#config Vega-Lite documentation>
for more details.

-}

-- based on schema 3.3.0 #/definitions/LegendOrient

data LegendOrientation
  = LONone
  | LOLeft
  | LORight
  | LOTop
  -- ^ @since 0.4.0.0
  | LOBottom
  -- ^ @since 0.4.0.0
  | LOTopLeft
  | LOTopRight
  | LOBottomLeft
  | LOBottomRight


legendOrientLabel :: LegendOrientation -> T.Text
legendOrientLabel :: LegendOrientation -> Text
legendOrientLabel LegendOrientation
LONone = Text
"none"
legendOrientLabel LegendOrientation
LOLeft = Text
"left"
legendOrientLabel LegendOrientation
LORight = Text
"right"
legendOrientLabel LegendOrientation
LOTop = Text
"top"
legendOrientLabel LegendOrientation
LOBottom = Text
"bottom"
legendOrientLabel LegendOrientation
LOTopLeft = Text
"top-left"
legendOrientLabel LegendOrientation
LOTopRight = Text
"top-right"
legendOrientLabel LegendOrientation
LOBottomLeft = Text
"bottom-left"
legendOrientLabel LegendOrientation
LOBottomRight = Text
"bottom-right"


{- |

/Highly experimental/ and used with 'Graphics.Vega.VegaLite.LeLayout'.

@since 0.4.0.0

-}

-- based on schema 3.3.0 #/definitions/LegendLayout

-- TODO: support SignalRef?

data LegendLayout
  = LeLAnchor APosition
    -- ^ The anchor point for legend orient group layout.
  | LeLBottom [BaseLegendLayout]
  | LeLBottomLeft [BaseLegendLayout]
  | LeLBottomRight [BaseLegendLayout]
  | LeLBounds Bounds
    -- ^ The bounds calculation to use for legend orient group layout.
  | LeLCenter Bool
    -- ^ A flag to center legends within a shared orient group.
  | LeLDirection Orientation
    -- ^ The layout firection for legend orient group layout.
  | LeLLeft [BaseLegendLayout]
  | LeLMargin Double
    -- ^ The margin, in pixels, between legends within an orient group.
  | LeLOffset Double
    -- ^ The offset, in pixels, from the chart body for a legend orient group.
  | LeLRight [BaseLegendLayout]
  | LeLTop [BaseLegendLayout]
  | LeLTopLeft [BaseLegendLayout]
  | LeLTopRight [BaseLegendLayout]


legendLayoutSpec :: LegendLayout -> LabelledSpec
legendLayoutSpec :: LegendLayout -> LabelledSpec
legendLayoutSpec (LeLAnchor APosition
anc) = Text
"anchor" Text -> Text -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= APosition -> Text
anchorLabel APosition
anc
legendLayoutSpec (LeLBottom [BaseLegendLayout]
bl) = Text
"bottom" Text -> VLSpec -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [BaseLegendLayout] -> VLSpec
toBLSpec [BaseLegendLayout]
bl
legendLayoutSpec (LeLBottomLeft [BaseLegendLayout]
bl) = Text
"bottom-left" Text -> VLSpec -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [BaseLegendLayout] -> VLSpec
toBLSpec [BaseLegendLayout]
bl
legendLayoutSpec (LeLBottomRight [BaseLegendLayout]
bl) = Text
"bottom-right" Text -> VLSpec -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [BaseLegendLayout] -> VLSpec
toBLSpec [BaseLegendLayout]
bl
legendLayoutSpec (LeLBounds Bounds
bnds) = Text
"bounds" Text -> VLSpec -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bounds -> VLSpec
boundsSpec Bounds
bnds
legendLayoutSpec (LeLCenter Bool
b) = Text
"center" Text -> Bool -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
b
legendLayoutSpec (LeLDirection Orientation
o) = Text
"direction" Text -> VLSpec -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Orientation -> VLSpec
orientationSpec Orientation
o
legendLayoutSpec (LeLLeft [BaseLegendLayout]
bl) = Text
"left" Text -> VLSpec -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [BaseLegendLayout] -> VLSpec
toBLSpec [BaseLegendLayout]
bl
legendLayoutSpec (LeLMargin Double
x) = Text
"margin" Text -> Double -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
x
legendLayoutSpec (LeLOffset Double
x) = Text
"offset" Text -> Double -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
x
legendLayoutSpec (LeLRight [BaseLegendLayout]
bl) = Text
"right" Text -> VLSpec -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [BaseLegendLayout] -> VLSpec
toBLSpec [BaseLegendLayout]
bl
legendLayoutSpec (LeLTop [BaseLegendLayout]
bl) = Text
"top" Text -> VLSpec -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [BaseLegendLayout] -> VLSpec
toBLSpec [BaseLegendLayout]
bl
legendLayoutSpec (LeLTopLeft [BaseLegendLayout]
bl) = Text
"top-left" Text -> VLSpec -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [BaseLegendLayout] -> VLSpec
toBLSpec [BaseLegendLayout]
bl
legendLayoutSpec (LeLTopRight [BaseLegendLayout]
bl) = Text
"top-right" Text -> VLSpec -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [BaseLegendLayout] -> VLSpec
toBLSpec [BaseLegendLayout]
bl


{- |

/Highly experimental/ and used with constructors from 'LegendLayout'.

@since 0.4.0.0

-}

-- based on schema 3.3.0 #/definitions/BaseLegendLayout

data BaseLegendLayout
  = BLeLAnchor APosition
    -- ^ The anchor point for legend orient group layout.
  | BLeLBounds Bounds
    -- ^ The bounds calculation to use for legend orient group layout.
  | BLeLCenter Bool
    -- ^ A flag to center legends within a shared orient group.
  | BLeLDirection Orientation
    -- ^ The layout direction for legend orient group layout.
  | BLeLMargin Double
    -- ^ The margin, in pixels, between legends within an orient group.
  | BLeLOffset Double
    -- ^ The offset, in pixels, from the chart body for a legend orient group.


toBLSpec :: [BaseLegendLayout] -> VLSpec
toBLSpec :: [BaseLegendLayout] -> VLSpec
toBLSpec = [LabelledSpec] -> VLSpec
object ([LabelledSpec] -> VLSpec)
-> ([BaseLegendLayout] -> [LabelledSpec])
-> [BaseLegendLayout]
-> VLSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BaseLegendLayout -> LabelledSpec)
-> [BaseLegendLayout] -> [LabelledSpec]
forall a b. (a -> b) -> [a] -> [b]
map BaseLegendLayout -> LabelledSpec
baseLegendLayoutSpec

baseLegendLayoutSpec :: BaseLegendLayout -> LabelledSpec
baseLegendLayoutSpec :: BaseLegendLayout -> LabelledSpec
baseLegendLayoutSpec (BLeLAnchor APosition
anc) = Text
"anchor" Text -> Text -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= APosition -> Text
anchorLabel APosition
anc
baseLegendLayoutSpec (BLeLBounds Bounds
bnds) = Text
"bounds" Text -> VLSpec -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bounds -> VLSpec
boundsSpec Bounds
bnds
baseLegendLayoutSpec (BLeLCenter Bool
b) = Text
"center" Text -> Bool -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
b
baseLegendLayoutSpec (BLeLDirection Orientation
o) = Text
"direction" Text -> VLSpec -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Orientation -> VLSpec
orientationSpec Orientation
o
baseLegendLayoutSpec (BLeLMargin Double
x) = Text
"margin" Text -> Double -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
x
baseLegendLayoutSpec (BLeLOffset Double
x) = Text
"offset" Text -> Double -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
x


{-|

Legend properties, set with 'Graphics.Vega.VegaLite.MLegend'. For more detail see the
<https://vega.github.io/vega-lite/docs/legend.html#legend-properties Vega-Lite documentation>.

The @LEntryPadding@ constructor was removed in @0.4.0.0@.

-}

-- based on schema #/definitions/Legend

data LegendProperty
    = LAria 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
    | LAriaDescription 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 'LAria' 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
    | LClipHeight Double
      -- ^ The height, in pixels, to clip symbol legend entries.
      --
      --   @since 0.4.0.0
    | LColumnPadding Double
      -- ^ The horizontal padding, in pixels, between symbol legend entries.
      --
      --   @since 0.4.0.0
    | LColumns 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
    | LCornerRadius Double
      -- ^ The corner radius for the full legend.
      --
      --   @since 0.4.0.0
    | LDirection Orientation
      -- ^ The direction of the legend.
      --
      --   @since 0.4.0.0
    | LFillColor Color
      -- ^ The background fill color for the full legend.
      --
      --   @since 0.4.0.0
    | LFormat T.Text
      -- ^ [Formatting pattern](https://vega.github.io/vega-lite/docs/format.html) for
      --   legend values. To distinguish between formatting as numeric values
      --   and data/time values, additionally use 'LFormatAsNum', 'LFormatAsTemporal',
      --   or 'LFormatAsCustom'.
    | LFormatAsNum
      -- ^ Legends should be formatted as numbers. Use a
      --   [d3 numeric format string](https://github.com/d3/d3-format#locale_format)
      --   with 'LFormat'.
      --
      -- @since 0.4.0.0
    | LFormatAsTemporal
      -- ^ Legends should be formatted as dates or times. Use a
      --   [d3 date/time format string](https://github.com/d3/d3-time-format#locale_format)
      --   with 'LFormat'.
      --
      -- @since 0.4.0.0
    | LFormatAsCustom T.Text
      -- ^ The [custom format type](https://vega.github.io/vega-lite/docs/config.html#custom-format-type)
      --   for use with with 'LFormat'.
      --
      --   @since 0.9.0.0
    | LGradientLength Double
      -- ^ The length in pixels of the primary axis of the color gradient.
      --
      --   @since 0.4.0.0
    | LGradientOpacity Opacity
      -- ^ The opacity of the color gradient.
      --
      --   @since 0.4.0.0
    | LGradientStrokeColor Color
      -- ^ The color of the gradient stroke.
      --
      --   @since 0.4.0.0
    | LGradientStrokeWidth Double
      -- ^ The width, in pixels, of the gradient stroke.
      --
      --   @since 0.4.0.0
    | LGradientThickness Double
      -- ^ The thickness, in pixels, of the color gradient.
      --
      --   @since 0.4.0.0
    | LGridAlign CompositionAlignment
      -- ^ The [grid layout](https://vega.github.io/vega/docs/layout) for
      --   the symbol legends.
      --
      --   @since 0.4.0.0
    | LLabelAlign HAlign
      -- ^ @since 0.4.0.0
    | LLabelBaseline VAlign
      -- ^ @since 0.4.0.0
    | LLabelColor Color
      -- ^ The color of the legend label.
      --
      --   @since 0.4.0.0
    | LLabelExpr VegaExpr
      -- ^ Customize the legend label. The default text and value can be accessed
      --   with the @datum.label@ and @datum.value@ expressions.
      --
      --   @LLabelExpr \"\'\<\' + datum.label + \'\>\'\"@
      --
      --   @since 0.8.0.0
    | LLabelFont T.Text
      -- ^ @since 0.4.0.0
    | LLabelFontSize Double
      -- ^ @since 0.4.0.0
    | LLabelFontStyle T.Text
      -- ^ @since 0.4.0.0
    | LLabelFontWeight FontWeight
      -- ^ @since 0.4.0.0
    | LLabelLimit Double
      -- ^ @since 0.4.0.0
    | LLabelOffset Double
      -- ^ @since 0.4.0.0
    | LLabelOpacity Opacity
      -- ^ @since 0.4.0.0
    | LLabelOverlap OverlapStrategy
      -- ^ @since 0.4.0.0
    | LLabelPadding Double
      -- ^ @since 0.4.0.0
    | LLabelSeparation Double
      -- ^ @since 0.4.0.0
    | LOffset Double
      -- ^ The offset in pixels by which to displace the legend from
      --   the data rectangle and axes.
    | LOrient LegendOrientation
      -- ^ The legend orientation.
    | LPadding Double
      -- ^ The padding, in pixels, between the border and content of
      --   the legend group.
    | LRowPadding Double
      -- ^ The vertical padding, in pixels, between symbol legend entries.
      --
      --   @since 0.4.0.0
    | LStrokeColor Color
      -- ^ The border stroke color for the full legend.
      --
      --   @since 0.4.0.0
    | LSymbolDash DashStyle
      -- ^ The dash pattern for symbols.
      --
      --   @since 0.4.0.0
    | LSymbolDashOffset DashOffset
      -- ^ The offset for the dash pattern.
      --
      --   @since 0.4.0.0
    | LSymbolFillColor Color
      -- ^ The fill color of the legend symbol.
      --
      --   @since 0.4.0.0
    | LSymbolLimit Int  -- TODO: use a Natural?
      -- ^ The maximum numbed of entries to show in the legend. Additional entries
      --   are dropped.
      --
      --   @since 0.8.0.0
    | LSymbolOffset Double
      -- ^ The horizontal pixel offset for legend symbols.
      --
      --   @since 0.4.0.0
    | LSymbolOpacity Opacity
      -- ^ The opacity of the legend symbols.
      --
      --   @since 0.4.0.0
    | LSymbolSize Double
      -- ^ The size of the legend symbol, in pixels.
      --
      --   @since 0.4.0.0
    | LSymbolStrokeColor Color
      -- ^ The edge color of the legend symbol.
      --
      --   @since 0.4.0.0
    | LSymbolStrokeWidth Double
      -- ^ The width of the sumbol's stroke.
      --
      --   @since 0.4.0.0
    | LSymbolType Symbol
      -- ^ @since 0.4.0.0
    | LTickCount Double
      -- ^ The desired number of tick values for quantitative legends.
      --
      --   The 'LTickCountTime' option can instead be used for \"time\" or
      --   \"utc\" scales.
    | LTickCountTime ScaleNice
      -- ^ A specialised version of 'LTickCount' 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
    | LTickMinStep Double
      -- ^ The minimum desired step between legend ticks, in terms of the scale
      --   domain values.
      --
      --   @since 0.4.0.0
    | LTitle T.Text
    | LNoTitle
      -- ^ Draw no title.
      --
      -- @since 0.4.0.0
    | LTitleAlign HAlign
      -- ^ @since 0.4.0.0
    | LTitleAnchor APosition
      -- ^ @since 0.4.0.0
    | LTitleBaseline VAlign
      -- ^ @since 0.4.0.0
    | LTitleColor Color
      -- ^ @since 0.4.0.0
    | LTitleFont T.Text
      -- ^ @since 0.4.0.0
    | LTitleFontSize Double
      -- ^ @since 0.4.0.0
    | LTitleFontStyle T.Text
      -- ^ @since 0.4.0.0
    | LTitleFontWeight FontWeight
      -- ^ @since 0.4.0.0
    | LTitleLimit Double
      -- ^ The maximum allowed pixel width of the legend title.
      --
      --   @since 0.4.0.0
    | LTitleLineHeight Double
      -- ^ The line height, in pixels, for multi-line title text.
      --
      --   @since 0.8.0.0
    | LTitleOpacity Opacity
      -- ^ Opacity of the legend title.
      --
      --   @since 0.4.0.0
    | LTitleOrient Side
      -- ^ Orientation of the legend title.
      --
      --   @since 0.4.0.0
    | LTitlePadding Double
      -- ^ The padding, in pixels, between title and legend.
      --
      --   @since 0.4.0.0
    | LType LegendType
      -- ^ The type of the legend.
    | LValues LegendValues
      -- ^ Explicitly set the visible legend values.
    | LeX Double
      -- ^ Custom x position, in pixels, for the legend when 'LOrient' is set to 'LONone'.
      --
      --   @since 0.4.0.0
    | LeY Double
      -- ^ Custom y position, in pixels, for the legend when 'LOrient' is set to 'LONone'.
      --
      --   @since 0.4.0.0
    | LZIndex ZIndex
      -- ^ The z-index at which to draw the legend.

legendProperty :: LegendProperty -> LabelledSpec
legendProperty :: LegendProperty -> LabelledSpec
legendProperty (LAria Bool
b) = Text
"aria" Text -> Bool -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
b
legendProperty (LAriaDescription Text
t) = Text
"description" Text -> Text -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
t
legendProperty (LClipHeight Double
x) = Text
"clipHeight" Text -> Double -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
x
legendProperty (LColumnPadding Double
x) = Text
"columnPadding" Text -> Double -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
x
legendProperty (LColumns Int
n) = Text
"columns" Text -> Int -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
n
legendProperty (LCornerRadius Double
x) = Text
"cornerRadius" Text -> Double -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
x
legendProperty (LDirection Orientation
o) = Text
"direction" Text -> VLSpec -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Orientation -> VLSpec
orientationSpec Orientation
o
legendProperty (LFillColor Text
s) = Text
"fillColor" Text -> VLSpec -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> VLSpec
fromColor Text
s
legendProperty (LFormat Text
s) = Text
"format" Text -> Text -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
s
legendProperty LegendProperty
LFormatAsNum = Text
"formatType" Text -> VLSpec -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> VLSpec
fromT Text
"number"
legendProperty LegendProperty
LFormatAsTemporal = Text
"formatType" Text -> VLSpec -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> VLSpec
fromT Text
"time"
legendProperty (LFormatAsCustom Text
c) = Text
"formatType" Text -> Text -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
c
legendProperty (LGradientLength Double
x) = Text
"gradientLength" Text -> Double -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
x
legendProperty (LGradientOpacity Double
x) = Text
"gradientOpacity" Text -> Double -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
x
legendProperty (LGradientStrokeColor Text
s) = Text
"gradientStrokeColor" Text -> VLSpec -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> VLSpec
fromColor Text
s
legendProperty (LGradientStrokeWidth Double
x) = Text
"gradientStrokeWidth" Text -> Double -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
x
legendProperty (LGradientThickness Double
x) = Text
"gradientThickness" Text -> Double -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
x
legendProperty (LGridAlign CompositionAlignment
ga) = Text
"gridAlign" Text -> VLSpec -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= CompositionAlignment -> VLSpec
compositionAlignmentSpec CompositionAlignment
ga
legendProperty (LLabelAlign HAlign
ha) = Text
"labelAlign" Text -> Text -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= HAlign -> Text
hAlignLabel HAlign
ha
legendProperty (LLabelBaseline VAlign
va) = Text
"labelBaseline" Text -> Text -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= VAlign -> Text
vAlignLabel VAlign
va
legendProperty (LLabelColor Text
s) = Text
"labelColor" Text -> VLSpec -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> VLSpec
fromColor Text
s
legendProperty (LLabelExpr Text
s) = Text
"labelExpr" Text -> Text -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
s
legendProperty (LLabelFont Text
s) = Text
"labelFont" Text -> Text -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
s
legendProperty (LLabelFontSize Double
x) = Text
"labelFontSize" Text -> Double -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
x
legendProperty (LLabelFontStyle Text
s) = Text
"labelFontStyle" Text -> Text -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
s
legendProperty (LLabelFontWeight FontWeight
fw) = Text
"labelFontWeight" Text -> VLSpec -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= FontWeight -> VLSpec
fontWeightSpec FontWeight
fw
legendProperty (LLabelLimit Double
x) = Text
"labelLimit" Text -> Double -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
x
legendProperty (LLabelOffset Double
x) = Text
"labelOffset" Text -> Double -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
x
legendProperty (LLabelOpacity Double
x) = Text
"labelOpacity" Text -> Double -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
x
legendProperty (LLabelOverlap OverlapStrategy
strat) = Text
"labelOverlap" Text -> VLSpec -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= OverlapStrategy -> VLSpec
overlapStrategyLabel OverlapStrategy
strat
legendProperty (LLabelPadding Double
x) = Text
"labelPadding" Text -> Double -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
x
legendProperty (LLabelSeparation Double
x) = Text
"labelSeparation" Text -> Double -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
x
legendProperty (LOffset Double
x) = Text
"offset" Text -> Double -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
x
legendProperty (LOrient LegendOrientation
orl) = Text
"orient" Text -> Text -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= LegendOrientation -> Text
legendOrientLabel LegendOrientation
orl
legendProperty (LPadding Double
x) = Text
"padding" Text -> Double -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
x
legendProperty (LRowPadding Double
x) = Text
"rowPadding" Text -> Double -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
x
legendProperty (LStrokeColor Text
s) = Text
"strokeColor" Text -> VLSpec -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> VLSpec
fromColor Text
s

legendProperty (LSymbolDash DashStyle
ds) = Text
"symbolDash" Text -> VLSpec -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= DashStyle -> VLSpec
fromDS DashStyle
ds
legendProperty (LSymbolDashOffset Double
x) = Text
"symbolDashOffset" Text -> Double -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
x
legendProperty (LSymbolFillColor Text
s) = Text
"symbolFillColor" Text -> VLSpec -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> VLSpec
fromColor Text
s
legendProperty (LSymbolLimit Int
x) = Text
"symbolLimit" Text -> Int -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
x
legendProperty (LSymbolOffset Double
x) = Text
"symbolOffset" Text -> Double -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
x
legendProperty (LSymbolOpacity Double
x) = Text
"symbolOpacity" Text -> Double -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
x
legendProperty (LSymbolSize Double
x) = Text
"symbolSize" Text -> Double -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
x
legendProperty (LSymbolStrokeColor Text
s) = Text
"symbolStrokeColor" Text -> VLSpec -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> VLSpec
fromColor Text
s
legendProperty (LSymbolStrokeWidth Double
x) = Text
"symbolStrokeWidth" Text -> Double -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
x
legendProperty (LSymbolType Symbol
sym) = Text
"symbolType" Text -> Text -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Symbol -> Text
symbolLabel Symbol
sym
legendProperty (LTickCount Double
x) = Text
"tickCount" Text -> Double -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
x
legendProperty (LTickCountTime ScaleNice
sn) = Text
"tickCount" Text -> VLSpec -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ScaleNice -> VLSpec
scaleNiceSpec ScaleNice
sn
legendProperty (LTickMinStep Double
x) = Text
"tickMinStep" Text -> Double -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
x
legendProperty (LTitle Text
s) = Text
"title" Text -> VLSpec -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> VLSpec
splitOnNewline Text
s
legendProperty LegendProperty
LNoTitle = Text
"title" Text -> VLSpec -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= VLSpec
A.Null
legendProperty (LTitleAlign HAlign
ha) = Text
"titleAlign" Text -> Text -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= HAlign -> Text
hAlignLabel HAlign
ha
legendProperty (LTitleAnchor APosition
anc) = Text
"titleAnchor" Text -> Text -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= APosition -> Text
anchorLabel APosition
anc
legendProperty (LTitleBaseline VAlign
va) = Text
"titleBaseline" Text -> Text -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= VAlign -> Text
vAlignLabel VAlign
va
legendProperty (LTitleColor Text
s) = Text
"titleColor" Text -> VLSpec -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> VLSpec
fromColor Text
s
legendProperty (LTitleFont Text
s) = Text
"titleFont" Text -> Text -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
s
legendProperty (LTitleFontSize Double
x) = Text
"titleFontSize" Text -> Double -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
x
legendProperty (LTitleFontStyle Text
s) = Text
"titleFontStyle" Text -> Text -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
s
legendProperty (LTitleFontWeight FontWeight
fw) = Text
"titleFontWeight" Text -> VLSpec -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= FontWeight -> VLSpec
fontWeightSpec FontWeight
fw
legendProperty (LTitleLimit Double
x) = Text
"titleLimit" Text -> Double -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
x
legendProperty (LTitleLineHeight Double
x) = Text
"titleLineHeight" Text -> Double -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
x
legendProperty (LTitleOpacity Double
x) = Text
"titleOpacity" Text -> Double -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
x
legendProperty (LTitleOrient Side
orient) = Text
"titleOrient" Text -> Text -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Side -> Text
sideLabel Side
orient
legendProperty (LTitlePadding Double
x) = Text
"titlePadding" Text -> Double -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
x
legendProperty (LType LegendType
lType) = Text
"type" Text -> Text -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= LegendType -> Text
legendLabel LegendType
lType
legendProperty (LValues LegendValues
vals) =
  let ls :: [VLSpec]
ls = case LegendValues
vals of
        LNumbers DashStyle
xs    -> (Double -> VLSpec) -> DashStyle -> [VLSpec]
forall a b. (a -> b) -> [a] -> [b]
map Double -> VLSpec
forall a. ToJSON a => a -> VLSpec
toJSON DashStyle
xs
        LDateTimes [[DateTime]]
dts -> ([DateTime] -> VLSpec) -> [[DateTime]] -> [VLSpec]
forall a b. (a -> b) -> [a] -> [b]
map [DateTime] -> VLSpec
dateTimeSpec [[DateTime]]
dts
        LStrings [Text]
ss    -> (Text -> VLSpec) -> [Text] -> [VLSpec]
forall a b. (a -> b) -> [a] -> [b]
map Text -> VLSpec
forall a. ToJSON a => a -> VLSpec
toJSON [Text]
ss
  in Text
"values" Text -> [VLSpec] -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [VLSpec]
ls
legendProperty (LeX Double
x) = Text
"legendX" Text -> Double -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
x
legendProperty (LeY Double
x) = Text
"legendY" Text -> Double -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
x
legendProperty (LZIndex ZIndex
z) = Text
"zindex" Text -> ZIndex -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ZIndex
z


legendProp_ :: [LegendProperty] -> LabelledSpec
legendProp_ :: [LegendProperty] -> LabelledSpec
legendProp_ [] = Text
"legend" Text -> VLSpec -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= VLSpec
A.Null
legendProp_ [LegendProperty]
lps = Text
"legend" Text -> VLSpec -> LabelledSpec
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [LabelledSpec] -> VLSpec
object ((LegendProperty -> LabelledSpec)
-> [LegendProperty] -> [LabelledSpec]
forall a b. (a -> b) -> [a] -> [b]
map LegendProperty -> LabelledSpec
legendProperty [LegendProperty]
lps)


-- | A list of data values suitable for setting legend values, used with
--   'LValues'.


data LegendValues
    = LDateTimes [[DateTime]]
    | LNumbers [Double]
    | LStrings [T.Text]