content: {-# 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 { cwidth :: Double
                , cheight :: Double
                , traces :: Bool
                , colourScheme :: Text
                , lineColourScheme :: Text
                , chartType :: ChartType
                , fixedYAxisExtent :: Maybe Double
                }
  
  colourProperty :: ChartConfig -> ScaleProperty
  colourProperty c = SScheme (colourScheme c) []
  
  lineColourProperty :: ChartConfig -> ScaleProperty
  lineColourProperty c = SScheme (lineColourScheme c) []
  
  -----------------------------------------------------------------------------------
  -- The visualization consists of:
  -- - AreaChart (on the left top)
  -- - SelectionChart (on the left bottom)
  -- - Legend (on the right)
  -----------------------------------------------------------------------------------
  
  
  vegaJson :: ChartConfig -> Value
  vegaJson conf = fromVL (vegaResult conf)
  
  vegaJsonText :: ChartConfig -> Text
  vegaJsonText conf = toStrict (encodeToLazyText (vegaJson conf))
  
  vegaResult :: ChartConfig -> VegaLite
  vegaResult conf = toVegaLite $
    -- Subtract 100 from the width for the fixed size label allocation.
    let c' = conf { cwidth = cwidth conf - 130 }
    in
    [
      VL.width (cwidth conf),
      VL.height (cheight conf),
      config [],
      description "Heap Profile",
      case chartType conf of
        LineChart -> lineChartFull c'
        HeapChart -> heapChartFull c'
        AreaChart ct -> areaChartFull ct c'
    ]
  
  areaChartFull :: AreaChartType -> ChartConfig -> (VLProperty, VLSpec)
  areaChartFull ct c = vConcat [areaChart ct c,  selectionChart c]
  
  lineChartFull :: ChartConfig -> (VLProperty, VLSpec)
  lineChartFull c = vConcat [lineChart c, selectionChart c]
  
  heapChartFull :: ChartConfig -> (VLProperty, VLSpec)
  heapChartFull c = vConcat [heapChart c, selectionHeapChart c]
  
  config :: [ConfigureSpec] -> (VLProperty, VLSpec)
  config =
    configure
      . configuration (TextStyle [(MAlign AlignRight), (MdX (-5)), (MdY 5)])
  
  -----------------------------------------------------------------------------------
  -- The Line Chart
  -----------------------------------------------------------------------------------
  
  lineChart :: ChartConfig -> VLSpec
  lineChart c = asSpec [layer ([linesLayer c] ++ [tracesLayer | traces c])]
  
  linesLayer :: ChartConfig -> VLSpec
  linesLayer c = asSpec
    [
      VL.width (0.9 * cwidth c),
      VL.height (0.7 * cheight c),
      dataFromSource "data_json_samples" [],
      VL.mark Line [MPoint (PMMarker [])],
      encodingLineLayer c [],
      transformLineLayer [],
      selectionRight []
    ]
  
  encodingLineLayer :: ChartConfig -> [EncodingSpec] -> (VLProperty, VLSpec)
  encodingLineLayer c
   = encoding
      . color [MName "c", MmType Nominal, MScale [colourProperty c]
              , MSort [ByFieldOp "k" Max, Descending]
              , MLegend [LNoTitle]]
      . position X [PName "x", PmType Quantitative, PAxis [AxTitle ""]
                   ,PScale [SDomainOpt (DSelection "brush")]]
      . position Y [PName "norm_y", PmType Quantitative, PAxis [AxTitle "Allocation", AxFormat ".1f"]]
  
  transformLineLayer :: [TransformSpec] -> (VLProperty, VLSpec)
  transformLineLayer =
    transform
    . window [([WField "y", WAggregateOp Max], "max_y")] [WFrame Nothing Nothing, WGroupBy ["k"]]
    . calculateAs "datum.y / datum.max_y" "norm_y"
    . filter (FSelection "legend")
  
  -----------------------------------------------------------------------------------
  -- The Heap Chart
  -----------------------------------------------------------------------------------
  
  heapChart :: ChartConfig -> VLSpec
  heapChart c = asSpec [layer ([heapLayer c]  ++ [tracesLayer | traces c])]
  
  heapLayer :: ChartConfig -> VLSpec
  heapLayer c = asSpec
    [
      VL.width (0.9 * cwidth c),
      VL.height (0.7 * cheight c),
      dataFromSource "data_json_heap" [],
      VL.mark Line [MPoint (PMMarker [])],
      encodingHeapLayer c [],
      transformHeapLayer [],
      selectionRight []
    ]
  
  transformHeapLayer :: [TransformSpec] -> (VLProperty, VLSpec)
  transformHeapLayer =
    transform
    . filter (FSelection "legend")
  
  
  encodingHeapLayer :: ChartConfig -> [EncodingSpec] -> (VLProperty, VLSpec)
  encodingHeapLayer c
   = encoding
      . color [MName "c", MmType Nominal, MScale [lineColourProperty c]
              , MLegend [LNoTitle]]
      . position X [PName "x", PmType Quantitative, PAxis [AxTitle ""]
                   ,PScale [SDomainOpt (DSelection "brush")]]
      . position Y [PName "y", PmType Quantitative
                   , PAxis [AxTitle "Allocation", AxFormat "s"]
                   , PSort [ByFieldOp "k" Max]]
      . tooltip [TName "y", TmType Quantitative, TFormat "s" ]
  
  -----------------------------------------------------------------------------------
  -- The Selection Chart
  -----------------------------------------------------------------------------------
  
  
  encodingSelection :: ChartConfig -> [EncodingSpec] -> (VLProperty, VLSpec)
  encodingSelection c =
    encoding
      . order [OName "k", OmType Quantitative]
      . tooltip []
      . color [MName "c", MmType Nominal, MScale [colourProperty c], MLegend []
              , MSort [ByFieldOp "k" Max, Descending]]
      . position X [PName "x", PmType Quantitative, PAxis [AxTitle "Time (s)"]]
      . position Y [PName "y", PmType Quantitative, PAxis [{-AxTitle "Allocation", AxFormat "s"-}], PAggregate Sum, PStack StZero]
  
  brush :: [SelectSpec] -> PropertySpec
  brush = selection .
            select "brush" Interval [SInitInterval (Just (NullValue, NullValue)) Nothing]
  
  -- init field is not supported and necessary for dynamic loading
  
  selectionChart :: ChartConfig -> VLSpec
  selectionChart c = asSpec [
      VL.width (0.9 * cwidth c),
      VL.height (0.1 * cheight c),
      dataFromSource "data_json_samples" [],
      VL.mark Area [],
      encodingSelection c [],
      brush []
    ]
  
  -----------------------------------------------------------------------------------
  -- The Heap Selection Chart
  -----------------------------------------------------------------------------------
  
  encodingHeapSelection :: ChartConfig -> [EncodingSpec] -> (VLProperty, VLSpec)
  encodingHeapSelection c =
    encoding
      . tooltip []
      . color [MName "c", MmType Nominal, MScale [lineColourProperty c, SDomain (DStrings ["Heap Size", "Blocks Size", "Live Bytes"]) ]]
      . position X [PName "x", PmType Quantitative, PAxis [AxTitle "Time (s)"]]
      . position Y [PName "y", PmType Quantitative, PAxis [], PSort [ByFieldOp "k" Max]]
  
  -- init field is not supported and necessary for dynamic loading
  
  selectionHeapChart :: ChartConfig -> VLSpec
  selectionHeapChart c = asSpec [
      VL.width (0.9 * cwidth c),
      VL.height (0.1 * cheight c),
      dataFromSource "data_json_heap" [],
      VL.mark Line [MPoint (PMMarker [])],
      encodingHeapSelection c [],
      brush []
    ]
  
  -----------------------------------------------------------------------------------
  -- The Area Chart consists of:
  -- - Traces Layer
  -- - Bands Layer
  -----------------------------------------------------------------------------------
  
  areaChart :: AreaChartType -> ChartConfig -> VLSpec
  areaChart ct c = asSpec [layer ([bandsLayer ct c] ++ [tracesLayer | traces c])]
  
  -----------------------------------------------------------------------------------
  -- The bands layer:
  -----------------------------------------------------------------------------------
  
  bandsLayer :: AreaChartType -> ChartConfig -> VLSpec
  bandsLayer ct c = asSpec
    [
      VL.width (0.9 * cwidth c),
      VL.height (0.7 * cheight c),
      dataFromSource "data_json_samples" [],
      VL.mark Area [],
      encodingBandsLayer ct c [],
      transformBandsLayer [],
      selectionRight []
    ]
  
  encodingBandsLayer :: AreaChartType
                     -> ChartConfig
                     -> [EncodingSpec]
                     -> (VLProperty, VLSpec)
  encodingBandsLayer ct c =
    encoding
      . order [OName "k", OmType Quantitative]
      . color [MName "c", MmType Nominal, MScale [colourProperty c]
              , MSort [ByFieldOp "k" Max, Descending]
              , MLegend [LNoTitle]
              ]
      . tooltips
          [ [TName "y", TmType Quantitative, TFormat "s", TTitle "Allocation"]
          , [TName "c", TmType Nominal, TTitle "Type"]
          ]
      . position X [PName "x", PmType Quantitative, PAxis [AxTitle ""]
                   , PScale [SDomainOpt (DSelection "brush")]]
      . position Y ([PName "y"
                   , PmType Quantitative
                   , PAxis $ case ct of
                               Stacked -> [AxTitle "Allocation", AxFormat "s" ]
                               Normalized -> [AxTitle "Allocation (Normalized)", AxFormat "p"]
                               StreamGraph -> [AxTitle "Allocation (Streamgraph)", AxLabels False, AxTicks False, AxTitlePadding 10.0]
                   , PAggregate Sum
                   , PStack (case ct of
                               Stacked -> StZero
                               Normalized -> StNormalize
                               StreamGraph -> StCenter)]
                   ++
                    [PScale [SDomain (DNumbers [0,  extent])] | Just extent <- [fixedYAxisExtent c]] )
  
  transformBandsLayer :: [TransformSpec] -> (VLProperty, VLSpec)
  transformBandsLayer =
    transform
      . filter (FSelection "legend")
  
  -----------------------------------------------------------------------------------
  -- The traces layer:
  -----------------------------------------------------------------------------------
  
  tracesLayer :: VLSpec
  tracesLayer = asSpec
    [
      dataFromSource "data_json_traces" [],
      VL.mark Rule [],
      encodingTracesLayer []
    ]
  
  encodingTracesLayer :: [EncodingSpec] -> (VLProperty, VLSpec)
  encodingTracesLayer =
    encoding
      . color [MString "grey"]
      . position X [PmType Quantitative, PAxis [], PName "tx"
                   , PScale [SDomainOpt (DSelection "brush")] ]
      . VL.size [MNumber 2]
      . tooltip [TName "desc", TmType Nominal]
  
  -----------------------------------------------------------------------------------
  -- The legend selection
  -----------------------------------------------------------------------------------
  
  selectionRight :: [SelectSpec] -> (VLProperty, VLSpec)
  selectionRight =
      selection
        . select "legend" Multi [BindLegend (BLField "c")]
  
  