{-# LANGUAGE OverloadedStrings #-}
module Graphics.Vega.VegaLite.Legend
( LegendType(..)
, LegendOrientation(..)
, LegendLayout(..)
, BaseLegendLayout(..)
, LegendProperty(..)
, LegendValues(..)
, 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
, ZIndex
, anchorLabel
, boundsSpec
, compositionAlignmentSpec
, fontWeightSpec
, hAlignLabel
, orientationSpec
, overlapStrategyLabel
, sideLabel
, symbolLabel
, vAlignLabel
, fromT
, fromColor
, fromDS
, splitOnNewline
)
import Graphics.Vega.VegaLite.Specification (VLSpec, LabelledSpec)
import Graphics.Vega.VegaLite.Time
( DateTime
, dateTimeProperty
)
data LegendType
= GradientLegend
| SymbolLegend
legendLabel :: LegendType -> T.Text
legendLabel GradientLegend = "gradient"
legendLabel SymbolLegend = "symbol"
data LegendOrientation
= LONone
| LOLeft
| LORight
| LOTop
| LOBottom
| LOTopLeft
| LOTopRight
| LOBottomLeft
| LOBottomRight
legendOrientLabel :: LegendOrientation -> T.Text
legendOrientLabel LONone = "none"
legendOrientLabel LOLeft = "left"
legendOrientLabel LORight = "right"
legendOrientLabel LOTop = "top"
legendOrientLabel LOBottom = "bottom"
legendOrientLabel LOTopLeft = "top-left"
legendOrientLabel LOTopRight = "top-right"
legendOrientLabel LOBottomLeft = "bottom-left"
legendOrientLabel LOBottomRight = "bottom-right"
data LegendLayout
= LeLAnchor APosition
| LeLBottom [BaseLegendLayout]
| LeLBottomLeft [BaseLegendLayout]
| LeLBottomRight [BaseLegendLayout]
| LeLBounds Bounds
| LeLCenter Bool
| LeLDirection Orientation
| LeLLeft [BaseLegendLayout]
| LeLMargin Double
| LeLOffset Double
| LeLRight [BaseLegendLayout]
| LeLTop [BaseLegendLayout]
| LeLTopLeft [BaseLegendLayout]
| LeLTopRight [BaseLegendLayout]
legendLayoutSpec :: LegendLayout -> LabelledSpec
legendLayoutSpec (LeLAnchor anc) = "anchor" .= anchorLabel anc
legendLayoutSpec (LeLBottom bl) = "bottom" .= toBLSpec bl
legendLayoutSpec (LeLBottomLeft bl) = "bottom-left" .= toBLSpec bl
legendLayoutSpec (LeLBottomRight bl) = "bottom-right" .= toBLSpec bl
legendLayoutSpec (LeLBounds bnds) = "bounds" .= boundsSpec bnds
legendLayoutSpec (LeLCenter b) = "center" .= b
legendLayoutSpec (LeLDirection o) = "direction" .= orientationSpec o
legendLayoutSpec (LeLLeft bl) = "left" .= toBLSpec bl
legendLayoutSpec (LeLMargin x) = "margin" .= x
legendLayoutSpec (LeLOffset x) = "offset" .= x
legendLayoutSpec (LeLRight bl) = "right" .= toBLSpec bl
legendLayoutSpec (LeLTop bl) = "top" .= toBLSpec bl
legendLayoutSpec (LeLTopLeft bl) = "top-left" .= toBLSpec bl
legendLayoutSpec (LeLTopRight bl) = "top-right" .= toBLSpec bl
data BaseLegendLayout
= BLeLAnchor APosition
| BLeLBounds Bounds
| BLeLCenter Bool
| BLeLDirection Orientation
| BLeLMargin Double
| BLeLOffset Double
toBLSpec :: [BaseLegendLayout] -> VLSpec
toBLSpec = object . map baseLegendLayoutSpec
baseLegendLayoutSpec :: BaseLegendLayout -> LabelledSpec
baseLegendLayoutSpec (BLeLAnchor anc) = "anchor" .= anchorLabel anc
baseLegendLayoutSpec (BLeLBounds bnds) = "bounds" .= boundsSpec bnds
baseLegendLayoutSpec (BLeLCenter b) = "center" .= b
baseLegendLayoutSpec (BLeLDirection o) = "direction" .= orientationSpec o
baseLegendLayoutSpec (BLeLMargin x) = "margin" .= x
baseLegendLayoutSpec (BLeLOffset x) = "offset" .= x
data LegendProperty
= LClipHeight Double
| LColumnPadding Double
| LColumns Int
| LCornerRadius Double
| LDirection Orientation
| LFillColor Color
| LFormat T.Text
| LFormatAsNum
| LFormatAsTemporal
| LGradientLength Double
| LGradientOpacity Opacity
| LGradientStrokeColor Color
| LGradientStrokeWidth Double
| LGradientThickness Double
| LGridAlign CompositionAlignment
| LLabelAlign HAlign
| LLabelBaseline VAlign
| LLabelColor Color
| LLabelFont T.Text
| LLabelFontSize Double
| LLabelFontStyle T.Text
| LLabelFontWeight FontWeight
| LLabelLimit Double
| LLabelOffset Double
| LLabelOpacity Opacity
| LLabelOverlap OverlapStrategy
| LLabelPadding Double
| LLabelSeparation Double
| LOffset Double
| LOrient LegendOrientation
| LPadding Double
| LRowPadding Double
| LStrokeColor Color
| LSymbolDash DashStyle
| LSymbolDashOffset DashOffset
| LSymbolFillColor Color
| LSymbolOffset Double
| LSymbolOpacity Opacity
| LSymbolSize Double
| LSymbolStrokeColor Color
| LSymbolStrokeWidth Double
| LSymbolType Symbol
| LTickCount Double
| LTickMinStep Double
| LTitle T.Text
| LNoTitle
| LTitleAlign HAlign
| LTitleAnchor APosition
| LTitleBaseline VAlign
| LTitleColor Color
| LTitleFont T.Text
| LTitleFontSize Double
| LTitleFontStyle T.Text
| LTitleFontWeight FontWeight
| LTitleLimit Double
| LTitleOpacity Opacity
| LTitleOrient Side
| LTitlePadding Double
| LType LegendType
| LValues LegendValues
| LeX Double
| LeY Double
| LZIndex ZIndex
legendProperty :: LegendProperty -> LabelledSpec
legendProperty (LClipHeight x) = "clipHeight" .= x
legendProperty (LColumnPadding x) = "columnPadding" .= x
legendProperty (LColumns n) = "columns" .= n
legendProperty (LCornerRadius x) = "cornerRadius" .= x
legendProperty (LDirection o) = "direction" .= orientationSpec o
legendProperty (LFillColor s) = "fillColor" .= fromColor s
legendProperty (LFormat s) = "format" .= s
legendProperty LFormatAsNum = "formatType" .= fromT "number"
legendProperty LFormatAsTemporal = "formatType" .= fromT "time"
legendProperty (LGradientLength x) = "gradientLength" .= x
legendProperty (LGradientOpacity x) = "gradientOpacity" .= x
legendProperty (LGradientStrokeColor s) = "gradientStrokeColor" .= fromColor s
legendProperty (LGradientStrokeWidth x) = "gradientStrokeWidth" .= x
legendProperty (LGradientThickness x) = "gradientThickness" .= x
legendProperty (LGridAlign ga) = "gridAlign" .= compositionAlignmentSpec ga
legendProperty (LLabelAlign ha) = "labelAlign" .= hAlignLabel ha
legendProperty (LLabelBaseline va) = "labelBaseline" .= vAlignLabel va
legendProperty (LLabelColor s) = "labelColor" .= fromColor s
legendProperty (LLabelFont s) = "labelFont" .= s
legendProperty (LLabelFontSize x) = "labelFontSize" .= x
legendProperty (LLabelFontStyle s) = "labelFontStyle" .= s
legendProperty (LLabelFontWeight fw) = "labelFontWeight" .= fontWeightSpec fw
legendProperty (LLabelLimit x) = "labelLimit" .= x
legendProperty (LLabelOffset x) = "labelOffset" .= x
legendProperty (LLabelOpacity x) = "labelOpacity" .= x
legendProperty (LLabelOverlap strat) = "labelOverlap" .= overlapStrategyLabel strat
legendProperty (LLabelPadding x) = "labelPadding" .= x
legendProperty (LLabelSeparation x) = "labelSeparation" .= x
legendProperty (LOffset x) = "offset" .= x
legendProperty (LOrient orl) = "orient" .= legendOrientLabel orl
legendProperty (LPadding x) = "padding" .= x
legendProperty (LRowPadding x) = "rowPadding" .= x
legendProperty (LStrokeColor s) = "strokeColor" .= fromColor s
legendProperty (LSymbolDash ds) = "symbolDash" .= fromDS ds
legendProperty (LSymbolDashOffset x) = "symbolDashOffset" .= x
legendProperty (LSymbolFillColor s) = "symbolFillColor" .= fromColor s
legendProperty (LSymbolOffset x) = "symbolOffset" .= x
legendProperty (LSymbolOpacity x) = "symbolOpacity" .= x
legendProperty (LSymbolSize x) = "symbolSize" .= x
legendProperty (LSymbolStrokeColor s) = "symbolStrokeColor" .= fromColor s
legendProperty (LSymbolStrokeWidth x) = "symbolStrokeWidth" .= x
legendProperty (LSymbolType sym) = "symbolType" .= symbolLabel sym
legendProperty (LTickCount x) = "tickCount" .= x
legendProperty (LTickMinStep x) = "tickMinStep" .= x
legendProperty (LTitle s) = "title" .= splitOnNewline s
legendProperty LNoTitle = "title" .= A.Null
legendProperty (LTitleAlign ha) = "titleAlign" .= hAlignLabel ha
legendProperty (LTitleAnchor anc) = "titleAnchor" .= anchorLabel anc
legendProperty (LTitleBaseline va) = "titleBaseline" .= vAlignLabel va
legendProperty (LTitleColor s) = "titleColor" .= fromColor s
legendProperty (LTitleFont s) = "titleFont" .= s
legendProperty (LTitleFontSize x) = "titleFontSize" .= x
legendProperty (LTitleFontStyle s) = "titleFontStyle" .= s
legendProperty (LTitleFontWeight fw) = "titleFontWeight" .= fontWeightSpec fw
legendProperty (LTitleLimit x) = "titleLimit" .= x
legendProperty (LTitleOpacity x) = "titleOpacity" .= x
legendProperty (LTitleOrient orient) = "titleOrient" .= sideLabel orient
legendProperty (LTitlePadding x) = "titlePadding" .= x
legendProperty (LType lType) = "type" .= legendLabel lType
legendProperty (LValues vals) =
let ls = case vals of
LNumbers xs -> map toJSON xs
LDateTimes dts -> map (object . map dateTimeProperty) dts
LStrings ss -> map toJSON ss
in "values" .= ls
legendProperty (LeX x) = "legendX" .= x
legendProperty (LeY x) = "legendY" .= x
legendProperty (LZIndex z) = "zindex" .= z
legendProp_ :: [LegendProperty] -> LabelledSpec
legendProp_ [] = "legend" .= A.Null
legendProp_ lps = "legend" .= object (map legendProperty lps)
data LegendValues
= LDateTimes [[DateTime]]
| LNumbers [Double]
| LStrings [T.Text]