{-# LANGUAGE OverloadedStrings #-}
module Eventlog.VegaTemplate
  (
    AreaChartType(..)
  , ChartConfig(..)
  , ChartType(..)
  , vegaResult
  , vegaJson
  , vegaJsonText
  ) where

import Prelude hiding (filter, lookup)
import Graphics.Vega.VegaLite as VL
import Data.Aeson.Types hiding (Number)
import Data.Text (Text)
import Data.Aeson.Text (encodeToLazyText)
import Data.Text.Lazy (toStrict)

data AreaChartType
  = Stacked
  | Normalized
  | StreamGraph

data ChartType
  = AreaChart AreaChartType
  | LineChart
  | HeapChart

-- Arguments for directly outputting javascript
data ChartConfig =
  ChartConfig { ChartConfig -> Double
cwidth :: Double
              , ChartConfig -> Double
cheight :: Double
              , ChartConfig -> Bool
traces :: Bool
              , ChartConfig -> SelectionLabel
colourScheme :: Text
              , ChartConfig -> SelectionLabel
lineColourScheme :: Text
              , ChartConfig -> ChartType
chartType :: ChartType
              , ChartConfig -> Maybe Double
fixedYAxisExtent :: Maybe Double
              }

colourProperty :: ChartConfig -> ScaleProperty
colourProperty :: ChartConfig -> ScaleProperty
colourProperty ChartConfig
c = SelectionLabel -> [Double] -> ScaleProperty
SScheme (ChartConfig -> SelectionLabel
colourScheme ChartConfig
c) []

lineColourProperty :: ChartConfig -> ScaleProperty
lineColourProperty :: ChartConfig -> ScaleProperty
lineColourProperty ChartConfig
c = SelectionLabel -> [Double] -> ScaleProperty
SScheme (ChartConfig -> SelectionLabel
lineColourScheme ChartConfig
c) []

-----------------------------------------------------------------------------------
-- The visualization consists of:
-- - AreaChart (on the left top)
-- - SelectionChart (on the left bottom)
-- - Legend (on the right)
-----------------------------------------------------------------------------------


vegaJson :: ChartConfig -> Value
vegaJson :: ChartConfig -> Value
vegaJson ChartConfig
conf = VegaLite -> Value
fromVL (ChartConfig -> VegaLite
vegaResult ChartConfig
conf)

vegaJsonText :: ChartConfig -> Text
vegaJsonText :: ChartConfig -> SelectionLabel
vegaJsonText ChartConfig
conf = Text -> SelectionLabel
toStrict (forall a. ToJSON a => a -> Text
encodeToLazyText (ChartConfig -> Value
vegaJson ChartConfig
conf))

vegaResult :: ChartConfig -> VegaLite
vegaResult :: ChartConfig -> VegaLite
vegaResult ChartConfig
conf = [PropertySpec] -> VegaLite
toVegaLite forall a b. (a -> b) -> a -> b
$
  -- Subtract 100 from the width for the fixed size label allocation.
  let c' :: ChartConfig
c' = ChartConfig
conf { cwidth :: Double
cwidth = ChartConfig -> Double
cwidth ChartConfig
conf forall a. Num a => a -> a -> a
- Double
130 }
  in
  [
    Double -> PropertySpec
VL.width (ChartConfig -> Double
cwidth ChartConfig
conf),
    Double -> PropertySpec
VL.height (ChartConfig -> Double
cheight ChartConfig
conf),
    [ConfigureSpec] -> PropertySpec
config [],
    SelectionLabel -> PropertySpec
description SelectionLabel
"Heap Profile",
    case ChartConfig -> ChartType
chartType ChartConfig
conf of
      ChartType
LineChart -> ChartConfig -> PropertySpec
lineChartFull ChartConfig
c'
      ChartType
HeapChart -> ChartConfig -> PropertySpec
heapChartFull ChartConfig
c'
      AreaChart AreaChartType
ct -> AreaChartType -> ChartConfig -> PropertySpec
areaChartFull AreaChartType
ct ChartConfig
c'
  ]

areaChartFull :: AreaChartType -> ChartConfig -> (VLProperty, VLSpec)
areaChartFull :: AreaChartType -> ChartConfig -> PropertySpec
areaChartFull AreaChartType
ct ChartConfig
c = [Value] -> PropertySpec
vConcat [AreaChartType -> ChartConfig -> Value
areaChart AreaChartType
ct ChartConfig
c,  ChartConfig -> Value
selectionChart ChartConfig
c]

lineChartFull :: ChartConfig -> (VLProperty, VLSpec)
lineChartFull :: ChartConfig -> PropertySpec
lineChartFull ChartConfig
c = [Value] -> PropertySpec
vConcat [ChartConfig -> Value
lineChart ChartConfig
c, ChartConfig -> Value
selectionChart ChartConfig
c]

heapChartFull :: ChartConfig -> (VLProperty, VLSpec)
heapChartFull :: ChartConfig -> PropertySpec
heapChartFull ChartConfig
c = [Value] -> PropertySpec
vConcat [ChartConfig -> Value
heapChart ChartConfig
c, ChartConfig -> Value
selectionHeapChart ChartConfig
c]

config :: [ConfigureSpec] -> (VLProperty, VLSpec)
config :: [ConfigureSpec] -> PropertySpec
config =
  [ConfigureSpec] -> PropertySpec
configure
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfigurationProperty -> BuildConfigureSpecs
configuration ([MarkProperty] -> ConfigurationProperty
TextStyle [(HAlign -> MarkProperty
MAlign HAlign
AlignRight), (Double -> MarkProperty
MdX (-Double
5)), (Double -> MarkProperty
MdY Double
5)])

-----------------------------------------------------------------------------------
-- The Line Chart
-----------------------------------------------------------------------------------

lineChart :: ChartConfig -> VLSpec
lineChart :: ChartConfig -> Value
lineChart ChartConfig
c = [PropertySpec] -> Value
asSpec [[Value] -> PropertySpec
layer ([ChartConfig -> Value
linesLayer ChartConfig
c] forall a. [a] -> [a] -> [a]
++ [Value
tracesLayer | ChartConfig -> Bool
traces ChartConfig
c])]

linesLayer :: ChartConfig -> VLSpec
linesLayer :: ChartConfig -> Value
linesLayer ChartConfig
c = [PropertySpec] -> Value
asSpec
  [
    Double -> PropertySpec
VL.width (Double
0.9 forall a. Num a => a -> a -> a
* ChartConfig -> Double
cwidth ChartConfig
c),
    Double -> PropertySpec
VL.height (Double
0.7 forall a. Num a => a -> a -> a
* ChartConfig -> Double
cheight ChartConfig
c),
    SelectionLabel -> [Format] -> PropertySpec
dataFromSource SelectionLabel
"data_json_samples" [],
    Mark -> [MarkProperty] -> PropertySpec
VL.mark Mark
Line [PointMarker -> MarkProperty
MPoint ([MarkProperty] -> PointMarker
PMMarker [])],
    ChartConfig -> [EncodingSpec] -> PropertySpec
encodingLineLayer ChartConfig
c [],
    [TransformSpec] -> PropertySpec
transformLineLayer [],
    [SelectSpec] -> PropertySpec
selectionRight []
  ]

encodingLineLayer :: ChartConfig -> [EncodingSpec] -> (VLProperty, VLSpec)
encodingLineLayer :: ChartConfig -> [EncodingSpec] -> PropertySpec
encodingLineLayer ChartConfig
c
 = [EncodingSpec] -> PropertySpec
encoding
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MarkChannel] -> [EncodingSpec] -> [EncodingSpec]
color [SelectionLabel -> MarkChannel
MName SelectionLabel
"c", Measurement -> MarkChannel
MmType Measurement
Nominal, [ScaleProperty] -> MarkChannel
MScale [ChartConfig -> ScaleProperty
colourProperty ChartConfig
c]
            , [SortProperty] -> MarkChannel
MSort [SelectionLabel -> Operation -> SortProperty
ByFieldOp SelectionLabel
"k" Operation
Max, SortProperty
Descending]
            , [LegendProperty] -> MarkChannel
MLegend [LegendProperty
LNoTitle]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> [PositionChannel] -> [EncodingSpec] -> [EncodingSpec]
position Position
X [SelectionLabel -> PositionChannel
PName SelectionLabel
"x", Measurement -> PositionChannel
PmType Measurement
Quantitative, [AxisProperty] -> PositionChannel
PAxis [SelectionLabel -> AxisProperty
AxTitle SelectionLabel
""]
                 ,[ScaleProperty] -> PositionChannel
PScale [ScaleDomain -> ScaleProperty
SDomainOpt (SelectionLabel -> ScaleDomain
DSelection SelectionLabel
"brush")]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> [PositionChannel] -> [EncodingSpec] -> [EncodingSpec]
position Position
Y [SelectionLabel -> PositionChannel
PName SelectionLabel
"norm_y", Measurement -> PositionChannel
PmType Measurement
Quantitative, [AxisProperty] -> PositionChannel
PAxis [SelectionLabel -> AxisProperty
AxTitle SelectionLabel
"Allocation", SelectionLabel -> AxisProperty
AxFormat SelectionLabel
".1f"]]

transformLineLayer :: [TransformSpec] -> (VLProperty, VLSpec)
transformLineLayer :: [TransformSpec] -> PropertySpec
transformLineLayer =
  [TransformSpec] -> PropertySpec
transform
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. [([Window], SelectionLabel)]
-> [WindowProperty] -> [TransformSpec] -> [TransformSpec]
window [([SelectionLabel -> Window
WField SelectionLabel
"y", Operation -> Window
WAggregateOp Operation
Max], SelectionLabel
"max_y")] [Maybe Int -> Maybe Int -> WindowProperty
WFrame forall a. Maybe a
Nothing forall a. Maybe a
Nothing, [SelectionLabel] -> WindowProperty
WGroupBy [SelectionLabel
"k"]]
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. SelectionLabel
-> SelectionLabel -> [TransformSpec] -> [TransformSpec]
calculateAs SelectionLabel
"datum.y / datum.max_y" SelectionLabel
"norm_y"
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. Filter -> [TransformSpec] -> [TransformSpec]
filter (SelectionLabel -> Filter
FSelection SelectionLabel
"legend")

-----------------------------------------------------------------------------------
-- The Heap Chart
-----------------------------------------------------------------------------------

heapChart :: ChartConfig -> VLSpec
heapChart :: ChartConfig -> Value
heapChart ChartConfig
c = [PropertySpec] -> Value
asSpec [[Value] -> PropertySpec
layer ([ChartConfig -> Value
heapLayer ChartConfig
c]  forall a. [a] -> [a] -> [a]
++ [Value
tracesLayer | ChartConfig -> Bool
traces ChartConfig
c])]

heapLayer :: ChartConfig -> VLSpec
heapLayer :: ChartConfig -> Value
heapLayer ChartConfig
c = [PropertySpec] -> Value
asSpec
  [
    Double -> PropertySpec
VL.width (Double
0.9 forall a. Num a => a -> a -> a
* ChartConfig -> Double
cwidth ChartConfig
c),
    Double -> PropertySpec
VL.height (Double
0.7 forall a. Num a => a -> a -> a
* ChartConfig -> Double
cheight ChartConfig
c),
    SelectionLabel -> [Format] -> PropertySpec
dataFromSource SelectionLabel
"data_json_heap" [],
    Mark -> [MarkProperty] -> PropertySpec
VL.mark Mark
Line [PointMarker -> MarkProperty
MPoint ([MarkProperty] -> PointMarker
PMMarker [])],
    ChartConfig -> [EncodingSpec] -> PropertySpec
encodingHeapLayer ChartConfig
c [],
    [TransformSpec] -> PropertySpec
transformHeapLayer [],
    [SelectSpec] -> PropertySpec
selectionRight []
  ]

transformHeapLayer :: [TransformSpec] -> (VLProperty, VLSpec)
transformHeapLayer :: [TransformSpec] -> PropertySpec
transformHeapLayer =
  [TransformSpec] -> PropertySpec
transform
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. Filter -> [TransformSpec] -> [TransformSpec]
filter (SelectionLabel -> Filter
FSelection SelectionLabel
"legend")


encodingHeapLayer :: ChartConfig -> [EncodingSpec] -> (VLProperty, VLSpec)
encodingHeapLayer :: ChartConfig -> [EncodingSpec] -> PropertySpec
encodingHeapLayer ChartConfig
c
 = [EncodingSpec] -> PropertySpec
encoding
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MarkChannel] -> [EncodingSpec] -> [EncodingSpec]
color [SelectionLabel -> MarkChannel
MName SelectionLabel
"c", Measurement -> MarkChannel
MmType Measurement
Nominal, [ScaleProperty] -> MarkChannel
MScale [ChartConfig -> ScaleProperty
lineColourProperty ChartConfig
c]
            , [LegendProperty] -> MarkChannel
MLegend [LegendProperty
LNoTitle]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> [PositionChannel] -> [EncodingSpec] -> [EncodingSpec]
position Position
X [SelectionLabel -> PositionChannel
PName SelectionLabel
"x", Measurement -> PositionChannel
PmType Measurement
Quantitative, [AxisProperty] -> PositionChannel
PAxis [SelectionLabel -> AxisProperty
AxTitle SelectionLabel
""]
                 ,[ScaleProperty] -> PositionChannel
PScale [ScaleDomain -> ScaleProperty
SDomainOpt (SelectionLabel -> ScaleDomain
DSelection SelectionLabel
"brush")]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> [PositionChannel] -> [EncodingSpec] -> [EncodingSpec]
position Position
Y [SelectionLabel -> PositionChannel
PName SelectionLabel
"y", Measurement -> PositionChannel
PmType Measurement
Quantitative
                 , [AxisProperty] -> PositionChannel
PAxis [SelectionLabel -> AxisProperty
AxTitle SelectionLabel
"Allocation", SelectionLabel -> AxisProperty
AxFormat SelectionLabel
"s"]
                 , [SortProperty] -> PositionChannel
PSort [SelectionLabel -> Operation -> SortProperty
ByFieldOp SelectionLabel
"k" Operation
Max]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TextChannel] -> [EncodingSpec] -> [EncodingSpec]
tooltip [SelectionLabel -> TextChannel
TName SelectionLabel
"y", Measurement -> TextChannel
TmType Measurement
Quantitative, SelectionLabel -> TextChannel
TFormat SelectionLabel
"s" ]

-----------------------------------------------------------------------------------
-- The Selection Chart
-----------------------------------------------------------------------------------


encodingSelection :: ChartConfig -> [EncodingSpec] -> (VLProperty, VLSpec)
encodingSelection :: ChartConfig -> [EncodingSpec] -> PropertySpec
encodingSelection ChartConfig
c =
  [EncodingSpec] -> PropertySpec
encoding
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OrderChannel] -> [EncodingSpec] -> [EncodingSpec]
order [SelectionLabel -> OrderChannel
OName SelectionLabel
"k", Measurement -> OrderChannel
OmType Measurement
Quantitative]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TextChannel] -> [EncodingSpec] -> [EncodingSpec]
tooltip []
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MarkChannel] -> [EncodingSpec] -> [EncodingSpec]
color [SelectionLabel -> MarkChannel
MName SelectionLabel
"c", Measurement -> MarkChannel
MmType Measurement
Nominal, [ScaleProperty] -> MarkChannel
MScale [ChartConfig -> ScaleProperty
colourProperty ChartConfig
c], [LegendProperty] -> MarkChannel
MLegend []
            , [SortProperty] -> MarkChannel
MSort [SelectionLabel -> Operation -> SortProperty
ByFieldOp SelectionLabel
"k" Operation
Max, SortProperty
Descending]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> [PositionChannel] -> [EncodingSpec] -> [EncodingSpec]
position Position
X [SelectionLabel -> PositionChannel
PName SelectionLabel
"x", Measurement -> PositionChannel
PmType Measurement
Quantitative, [AxisProperty] -> PositionChannel
PAxis [SelectionLabel -> AxisProperty
AxTitle SelectionLabel
"Time (s)"]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> [PositionChannel] -> [EncodingSpec] -> [EncodingSpec]
position Position
Y [SelectionLabel -> PositionChannel
PName SelectionLabel
"y", Measurement -> PositionChannel
PmType Measurement
Quantitative, [AxisProperty] -> PositionChannel
PAxis [{-AxTitle "Allocation", AxFormat "s"-}], Operation -> PositionChannel
PAggregate Operation
Sum, StackOffset -> PositionChannel
PStack StackOffset
StZero]

brush :: [SelectSpec] -> PropertySpec
brush :: [SelectSpec] -> PropertySpec
brush = [SelectSpec] -> PropertySpec
selection forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          SelectionLabel
-> Selection -> [SelectionProperty] -> BuildSelectSpecs
select SelectionLabel
"brush" Selection
Interval [Maybe (DataValue, DataValue)
-> Maybe (DataValue, DataValue) -> SelectionProperty
SInitInterval (forall a. a -> Maybe a
Just (DataValue
NullValue, DataValue
NullValue)) forall a. Maybe a
Nothing]

-- init field is not supported and necessary for dynamic loading

selectionChart :: ChartConfig -> VLSpec
selectionChart :: ChartConfig -> Value
selectionChart ChartConfig
c = [PropertySpec] -> Value
asSpec [
    Double -> PropertySpec
VL.width (Double
0.9 forall a. Num a => a -> a -> a
* ChartConfig -> Double
cwidth ChartConfig
c),
    Double -> PropertySpec
VL.height (Double
0.1 forall a. Num a => a -> a -> a
* ChartConfig -> Double
cheight ChartConfig
c),
    SelectionLabel -> [Format] -> PropertySpec
dataFromSource SelectionLabel
"data_json_samples" [],
    Mark -> [MarkProperty] -> PropertySpec
VL.mark Mark
Area [],
    ChartConfig -> [EncodingSpec] -> PropertySpec
encodingSelection ChartConfig
c [],
    [SelectSpec] -> PropertySpec
brush []
  ]

-----------------------------------------------------------------------------------
-- The Heap Selection Chart
-----------------------------------------------------------------------------------

encodingHeapSelection :: ChartConfig -> [EncodingSpec] -> (VLProperty, VLSpec)
encodingHeapSelection :: ChartConfig -> [EncodingSpec] -> PropertySpec
encodingHeapSelection ChartConfig
c =
  [EncodingSpec] -> PropertySpec
encoding
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TextChannel] -> [EncodingSpec] -> [EncodingSpec]
tooltip []
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MarkChannel] -> [EncodingSpec] -> [EncodingSpec]
color [SelectionLabel -> MarkChannel
MName SelectionLabel
"c", Measurement -> MarkChannel
MmType Measurement
Nominal, [ScaleProperty] -> MarkChannel
MScale [ChartConfig -> ScaleProperty
lineColourProperty ChartConfig
c], [LegendProperty] -> MarkChannel
MLegend [LegendValues -> LegendProperty
LValues ([SelectionLabel] -> LegendValues
LStrings [SelectionLabel
"Heap Size", SelectionLabel
"Blocks Size", SelectionLabel
"Live Bytes"])]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> [PositionChannel] -> [EncodingSpec] -> [EncodingSpec]
position Position
X [SelectionLabel -> PositionChannel
PName SelectionLabel
"x", Measurement -> PositionChannel
PmType Measurement
Quantitative, [AxisProperty] -> PositionChannel
PAxis [SelectionLabel -> AxisProperty
AxTitle SelectionLabel
"Time (s)"]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> [PositionChannel] -> [EncodingSpec] -> [EncodingSpec]
position Position
Y [SelectionLabel -> PositionChannel
PName SelectionLabel
"y", Measurement -> PositionChannel
PmType Measurement
Quantitative, [AxisProperty] -> PositionChannel
PAxis [], [SortProperty] -> PositionChannel
PSort [SelectionLabel -> Operation -> SortProperty
ByFieldOp SelectionLabel
"k" Operation
Max]]

-- init field is not supported and necessary for dynamic loading

selectionHeapChart :: ChartConfig -> VLSpec
selectionHeapChart :: ChartConfig -> Value
selectionHeapChart ChartConfig
c = [PropertySpec] -> Value
asSpec [
    Double -> PropertySpec
VL.width (Double
0.9 forall a. Num a => a -> a -> a
* ChartConfig -> Double
cwidth ChartConfig
c),
    Double -> PropertySpec
VL.height (Double
0.1 forall a. Num a => a -> a -> a
* ChartConfig -> Double
cheight ChartConfig
c),
    SelectionLabel -> [Format] -> PropertySpec
dataFromSource SelectionLabel
"data_json_heap" [],
    Mark -> [MarkProperty] -> PropertySpec
VL.mark Mark
Line [PointMarker -> MarkProperty
MPoint ([MarkProperty] -> PointMarker
PMMarker [])],
    ChartConfig -> [EncodingSpec] -> PropertySpec
encodingHeapSelection ChartConfig
c [],
    [SelectSpec] -> PropertySpec
brush []
  ]

-----------------------------------------------------------------------------------
-- The Area Chart consists of:
-- - Traces Layer
-- - Bands Layer
-----------------------------------------------------------------------------------

areaChart :: AreaChartType -> ChartConfig -> VLSpec
areaChart :: AreaChartType -> ChartConfig -> Value
areaChart AreaChartType
ct ChartConfig
c = [PropertySpec] -> Value
asSpec [[Value] -> PropertySpec
layer ([AreaChartType -> ChartConfig -> Value
bandsLayer AreaChartType
ct ChartConfig
c] forall a. [a] -> [a] -> [a]
++ [Value
tracesLayer | ChartConfig -> Bool
traces ChartConfig
c])]

-----------------------------------------------------------------------------------
-- The bands layer:
-----------------------------------------------------------------------------------

bandsLayer :: AreaChartType -> ChartConfig -> VLSpec
bandsLayer :: AreaChartType -> ChartConfig -> Value
bandsLayer AreaChartType
ct ChartConfig
c = [PropertySpec] -> Value
asSpec
  [
    Double -> PropertySpec
VL.width (Double
0.9 forall a. Num a => a -> a -> a
* ChartConfig -> Double
cwidth ChartConfig
c),
    Double -> PropertySpec
VL.height (Double
0.7 forall a. Num a => a -> a -> a
* ChartConfig -> Double
cheight ChartConfig
c),
    SelectionLabel -> [Format] -> PropertySpec
dataFromSource SelectionLabel
"data_json_samples" [],
    Mark -> [MarkProperty] -> PropertySpec
VL.mark Mark
Area [],
    AreaChartType -> ChartConfig -> [EncodingSpec] -> PropertySpec
encodingBandsLayer AreaChartType
ct ChartConfig
c [],
    [TransformSpec] -> PropertySpec
transformBandsLayer [],
    [SelectSpec] -> PropertySpec
selectionRight []
  ]

encodingBandsLayer :: AreaChartType
                   -> ChartConfig
                   -> [EncodingSpec]
                   -> (VLProperty, VLSpec)
encodingBandsLayer :: AreaChartType -> ChartConfig -> [EncodingSpec] -> PropertySpec
encodingBandsLayer AreaChartType
ct ChartConfig
c =
  [EncodingSpec] -> PropertySpec
encoding
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OrderChannel] -> [EncodingSpec] -> [EncodingSpec]
order [SelectionLabel -> OrderChannel
OName SelectionLabel
"k", Measurement -> OrderChannel
OmType Measurement
Quantitative]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MarkChannel] -> [EncodingSpec] -> [EncodingSpec]
color [SelectionLabel -> MarkChannel
MName SelectionLabel
"c", Measurement -> MarkChannel
MmType Measurement
Nominal, [ScaleProperty] -> MarkChannel
MScale [ChartConfig -> ScaleProperty
colourProperty ChartConfig
c]
            , [SortProperty] -> MarkChannel
MSort [SelectionLabel -> Operation -> SortProperty
ByFieldOp SelectionLabel
"k" Operation
Max, SortProperty
Descending]
            , [LegendProperty] -> MarkChannel
MLegend [LegendProperty
LNoTitle]
            ]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[TextChannel]] -> [EncodingSpec] -> [EncodingSpec]
tooltips
        [ [SelectionLabel -> TextChannel
TName SelectionLabel
"y", Measurement -> TextChannel
TmType Measurement
Quantitative, SelectionLabel -> TextChannel
TFormat SelectionLabel
"s", SelectionLabel -> TextChannel
TTitle SelectionLabel
"Allocation"]
        , [SelectionLabel -> TextChannel
TName SelectionLabel
"c", Measurement -> TextChannel
TmType Measurement
Nominal, SelectionLabel -> TextChannel
TTitle SelectionLabel
"Type"]
        ]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> [PositionChannel] -> [EncodingSpec] -> [EncodingSpec]
position Position
X [SelectionLabel -> PositionChannel
PName SelectionLabel
"x", Measurement -> PositionChannel
PmType Measurement
Quantitative, [AxisProperty] -> PositionChannel
PAxis [SelectionLabel -> AxisProperty
AxTitle SelectionLabel
""]
                 , [ScaleProperty] -> PositionChannel
PScale [ScaleDomain -> ScaleProperty
SDomainOpt (SelectionLabel -> ScaleDomain
DSelection SelectionLabel
"brush")]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> [PositionChannel] -> [EncodingSpec] -> [EncodingSpec]
position Position
Y ([SelectionLabel -> PositionChannel
PName SelectionLabel
"y"
                 , Measurement -> PositionChannel
PmType Measurement
Quantitative
                 , [AxisProperty] -> PositionChannel
PAxis forall a b. (a -> b) -> a -> b
$ case AreaChartType
ct of
                             AreaChartType
Stacked -> [SelectionLabel -> AxisProperty
AxTitle SelectionLabel
"Allocation"
                                        , SelectionLabel -> AxisProperty
AxFormat SelectionLabel
"s"
                                        , Double -> AxisProperty
AxTitlePadding Double
15.0
                                        , Double -> AxisProperty
AxMaxExtent Double
15.0]
                             AreaChartType
Normalized -> [SelectionLabel -> AxisProperty
AxTitle SelectionLabel
"Allocation (Normalized)", SelectionLabel -> AxisProperty
AxFormat SelectionLabel
"p"]
                             AreaChartType
StreamGraph -> [SelectionLabel -> AxisProperty
AxTitle SelectionLabel
"Allocation (Streamgraph)", Bool -> AxisProperty
AxLabels Bool
False, Bool -> AxisProperty
AxTicks Bool
False, Double -> AxisProperty
AxTitlePadding Double
10.0]
                 , Operation -> PositionChannel
PAggregate Operation
Sum
                 , StackOffset -> PositionChannel
PStack (case AreaChartType
ct of
                             AreaChartType
Stacked -> StackOffset
StZero
                             AreaChartType
Normalized -> StackOffset
StNormalize
                             AreaChartType
StreamGraph -> StackOffset
StCenter)]
                 forall a. [a] -> [a] -> [a]
++
                  [[ScaleProperty] -> PositionChannel
PScale [DomainLimits -> ScaleProperty
SDomain ([Double] -> DomainLimits
DNumbers [Double
0,  Double
extent])] | Just Double
extent <- [ChartConfig -> Maybe Double
fixedYAxisExtent ChartConfig
c]] )

transformBandsLayer :: [TransformSpec] -> (VLProperty, VLSpec)
transformBandsLayer :: [TransformSpec] -> PropertySpec
transformBandsLayer =
  [TransformSpec] -> PropertySpec
transform
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Filter -> [TransformSpec] -> [TransformSpec]
filter (SelectionLabel -> Filter
FSelection SelectionLabel
"legend")

-----------------------------------------------------------------------------------
-- The traces layer:
-----------------------------------------------------------------------------------

tracesLayer :: VLSpec
tracesLayer :: Value
tracesLayer = [PropertySpec] -> Value
asSpec
  [
    SelectionLabel -> [Format] -> PropertySpec
dataFromSource SelectionLabel
"data_json_traces" [],
    Mark -> [MarkProperty] -> PropertySpec
VL.mark Mark
Rule [],
    [EncodingSpec] -> PropertySpec
encodingTracesLayer []
  ]

encodingTracesLayer :: [EncodingSpec] -> (VLProperty, VLSpec)
encodingTracesLayer :: [EncodingSpec] -> PropertySpec
encodingTracesLayer =
  [EncodingSpec] -> PropertySpec
encoding
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MarkChannel] -> [EncodingSpec] -> [EncodingSpec]
color [SelectionLabel -> MarkChannel
MString SelectionLabel
"grey"]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> [PositionChannel] -> [EncodingSpec] -> [EncodingSpec]
position Position
X [Measurement -> PositionChannel
PmType Measurement
Quantitative, [AxisProperty] -> PositionChannel
PAxis [], SelectionLabel -> PositionChannel
PName SelectionLabel
"tx"
                 , [ScaleProperty] -> PositionChannel
PScale [ScaleDomain -> ScaleProperty
SDomainOpt (SelectionLabel -> ScaleDomain
DSelection SelectionLabel
"brush")] ]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MarkChannel] -> [EncodingSpec] -> [EncodingSpec]
VL.size [Double -> MarkChannel
MNumber Double
2]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TextChannel] -> [EncodingSpec] -> [EncodingSpec]
tooltip [SelectionLabel -> TextChannel
TName SelectionLabel
"desc", Measurement -> TextChannel
TmType Measurement
Nominal]

-----------------------------------------------------------------------------------
-- The legend selection
-----------------------------------------------------------------------------------

selectionRight :: [SelectSpec] -> (VLProperty, VLSpec)
selectionRight :: [SelectSpec] -> PropertySpec
selectionRight =
    [SelectSpec] -> PropertySpec
selection
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. SelectionLabel
-> Selection -> [SelectionProperty] -> BuildSelectSpecs
select SelectionLabel
"legend" Selection
Multi [BindLegendProperty -> SelectionProperty
BindLegend (SelectionLabel -> BindLegendProperty
BLField SelectionLabel
"c")]