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

--
-- Based on the Elm VegaLite CompositeTests.elm as of version 1.12.0
--
module CompositeTests (testSpecs) where

import qualified Data.Text as T

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

import Graphics.Vega.VegaLite


testSpecs :: [(String, VegaLite)]
testSpecs = [ ("boxplot1", boxplot1)
            , ("boxplot2", boxplot2)
            , ("boxplot3", boxplot3)
            , ("boxplotnobox", boxplotNoBox)
            , ("boxplotnooutliers", boxplotNoOutliers)
            , ("boxplotnomedian", boxplotNoMedian)
            , ("boxplotnorule", boxplotNoRule)
            , ("boxplotnoticks", boxplotNoTicks)
            , ("errorband1", errorband1)
            , ("errorband1no", errorband1No)
            , ("errorband2", errorband2)
            , ("errorband2no", errorband2No)
            , ("errorbar1", errorbar1)
            , ("errorbar2", errorbar2)
            , ("errorbar3", errorbar3)
            , ("errorbar3no", errorbar3No)
            , ("errorbar4", errorbar4)
            , ("errorbar5", errorbar5)
            , ("errorbar6", errorbar6)
            , ("errorbar7", errorbar7)
            ]


-- help in converting from the Elm version
pName :: T.Text -> PositionChannel
pName = PName

pOrdinal, pQuant :: PositionChannel
pOrdinal = PmType Ordinal
pQuant = PmType Quantitative


bPlot :: MarkErrorExtent -> [MarkProperty] -> [MarkProperty] -> VegaLite
bPlot ext mops def =
  let pop = dataFromUrl "https://vega.github.io/vega-lite/data/population.json" []

      enc = encoding
            . position X [ PName "age", PmType Ordinal ]
            . position Y [ PName "people", PmType Quantitative, PAxis [ AxTitle "Population" ] ]

      -- special case the empty list so as not to change the boxplot1/2/3 output
      -- (created before this capability was added).
      --
      v = [ pop, mark Boxplot (MExtent ext : mops), enc [] ]
      vs = case def of
             [] -> v
             _ -> configure (configuration (BoxplotStyle def) []) : v

    in toVegaLite vs

boxplot1 :: VegaLite
boxplot1 = bPlot ExRange [] []

boxplot2 :: VegaLite
boxplot2 = bPlot (IqrScale 2) [] []

boxplot3 :: VegaLite
boxplot3 =
    let mopts = [ MBox [ MColor "firebrick" ]
                , MOutliers [ MColor "black", MStrokeWidth 0.3, MSize 10 ]
                , MMedian [ MSize 18, MFill "black", MStrokeWidth 0 ]
                , MRule [ MStrokeWidth 0.4 ]
                , MTicks [ MSize 8 ]
                ]

    in bPlot (IqrScale 0.5) mopts []

-- Could combine into one plot, but useful to see the individual elements turned off
--
-- We need to set the default values to turn on ticks (since they are off by
-- default).
--

defConfig :: [MarkProperty]
defConfig = [ MTicks [] ]

boxplotNoBox, boxplotNoOutliers, boxplotNoMedian, boxplotNoRule, boxplotNoTicks :: VegaLite
boxplotNoBox = bPlot (IqrScale 0.5) [ MNoBox ] defConfig
boxplotNoOutliers = bPlot (IqrScale 0.5) [ MNoOutliers ] defConfig
boxplotNoMedian = bPlot (IqrScale 0.5) [ MNoMedian ] defConfig
boxplotNoRule = bPlot (IqrScale 0.5) [ MNoRule ] defConfig
boxplotNoTicks = bPlot (IqrScale 0.5) [ MNoTicks ] defConfig

-- Note: at present only called with ci or stdev arguments

eBand :: T.Text -> Bool -> VegaLite
eBand ext hasBorders =
    let
        cars =
            dataFromUrl "https://vega.github.io/vega-lite/data/cars.json" []

        label =
            case ext of
                "ci" ->
                    "(95% CI)"

                "stdev" ->
                    "(1 stdev)"

                "stderr" ->
                    "(1 std Error)"

                "range" ->
                    "(min to max)"

                _ ->
                    "(IQR)"

        summary =
            case ext of
                "ci" ->
                    ConfidenceInterval

                "stdev" ->
                    StdDev

                "stderr" ->
                    StdErr

  {-
                "range" ->
                    ExRange
  -}
  
                _ ->
                    Iqr

        enc =
            encoding
                . position X [ PName "Year", PmType Temporal, PTimeUnit Year ]
                . position Y
                    [ PName "Miles_per_Gallon"
                    , PmType Quantitative
                    , PScale [ SZero False ]
                    , PTitle ("Miles per Gallon " <> label)
                    ]

        mopts = [ MExtent summary
                , MInterpolate Monotone
                , if hasBorders then MBorders [] else MNoBorders
                ]

    in
    toVegaLite [ cars
               , mark ErrorBand mopts
               , enc [] ]


errorband1, errorband1No :: VegaLite
errorband1 = eBand "ci" True
errorband1No = eBand "ci" False


errorband2, errorband2No :: VegaLite
errorband2 = eBand "stdev" True
errorband2No = eBand "stdev" False


eBar :: MarkErrorExtent -> VegaLite
eBar ext =
    let
        barley =
            dataFromUrl "https://vega.github.io/vega-lite/data/barley.json" []

        enc =
            encoding
                . position X [ PName "yield", PmType Quantitative
                             , PScale [ SZero False ] ]
                . position Y
                    [ PName "variety"
                    , PmType Ordinal
                    ]

        mopts = [ MExtent ext, MTicks [ MStroke "blue" ] ]
        
    in
    toVegaLite [ barley
               , mark ErrorBar mopts
               , enc [] ]


errorbar1 :: VegaLite
errorbar1 =
    eBar ConfidenceInterval


errorbar2 :: VegaLite
errorbar2 =
    eBar StdDev


ebarsColor :: Bool -> VegaLite
ebarsColor hasTicks =
    let
        des =
            description "Error bars with color encoding"

        specErrorBars =
            asSpec [ mark ErrorBar [ if hasTicks then MTicks [] else MNoTicks ]
                   , encErrorBars [] ]

        encErrorBars =
            encoding
                . position X [ PName "yield", PmType Quantitative
                             , PScale [ SZero False ] ]
                . position Y [ PName "variety", PmType Ordinal ]
                . color [ MString "#4682b4" ]

        specPoints =
            asSpec [ mark Point [ MFilled True, MColor "black" ], encPoints [] ]

        encPoints =
            encoding
                . position X [ PName "yield", PmType Quantitative
                             , PAggregate Mean ]
                . position Y [ PName "variety", PmType Ordinal ]
    in
    toVegaLite
        [ des
        , dataFromUrl "https://vega.github.io/vega-lite/data/barley.json" []
        , layer [ specErrorBars, specPoints ]
        ]


errorbar3, errorbar3No :: VegaLite
errorbar3 = ebarsColor True
errorbar3No = ebarsColor False


yieldData :: [DataColumn] -> Data
yieldData =
  dataFromColumns []
  . dataColumn "yieldError" (Numbers [ 7.55, 6.98, 3.92, 11.97 ])
  . dataColumn "yieldError2" (Numbers [ -10.55, -3.98, -0.92, -15.97 ])
  . dataColumn "yield" (Numbers [ 32.4, 30.97, 33.96, 30.45 ])
  . dataColumn "variety" (Strings [ "Glabron", "Manchuria", "No. 457", "No. 462" ])

  
errorbar4 :: VegaLite
errorbar4 =
  let des = description "Symetric error bars encoded with xError channel"

      specErrorBars = asSpec [ mark ErrorBar [ MTicks [] ], encErrorBars [] ]

      encErrorBars = encoding
                     . position X [ pName "yield", pQuant
                                  , PScale [ SZero False ] ]
                     . position Y [ pName "variety", pOrdinal ]
                     . position XError [ pName "yieldError" ]

      specPoints = asSpec [ mark Point [ MFilled True, MColor "black" ]
                          , encPoints [] ]

      encPoints = encoding
                  . position X [ pName "yield", pQuant ]
                  . position Y [ pName "variety", pOrdinal ]

  in toVegaLite [ des, yieldData []
                , layer [ specErrorBars, specPoints ]
                ]


errorbar5 :: VegaLite
errorbar5 =
  let des = description "Asymetric error bars encoded with xError and xError2 channels"
  
      specErrorBars = asSpec [ mark ErrorBar [ MTicks [] ]
                             , encErrorBars [] ]

      encErrorBars =
        encoding
        . position X [ pName "yield", pQuant, PScale [ SZero False ] ]
        . position Y [ pName "variety", pOrdinal ]
        . position XError [ pName "yieldError" ]
        . position XError2 [ pName "yieldError2" ]

      specPoints = asSpec [ mark Point [ MFilled True, MColor "black" ]
                          , encPoints [] ]

      encPoints = encoding
                  . position X [ pName "yield", pQuant ]
                  . position Y [ pName "variety", pOrdinal ]

  in toVegaLite [ des, yieldData [], layer [ specErrorBars, specPoints ] ]


errorbar6 :: VegaLite
errorbar6 =
  let des = description "Symetric error bars encoded with yError channel"

      specErrorBars = asSpec [ mark ErrorBar [ MTicks [] ], encErrorBars [] ]
      encErrorBars = encoding
                     . position Y [ pName "yield", pQuant, PScale [ SZero False ] ]
                     . position X [ pName "variety", pOrdinal ]
                     . position YError [ pName "yieldError" ]

      specPoints = asSpec [ mark Point [ MFilled True, MColor "black" ]
                          , encPoints [] ]
      encPoints = encoding
                  . position Y [ pName "yield", pQuant ]
                  . position X [ pName "variety", pOrdinal ]

  in toVegaLite [ des, yieldData [], layer [ specErrorBars, specPoints ] ]


errorbar7 :: VegaLite
errorbar7 =
  let des = description "Asymetric error bars encoded with yError and yError2 channels"

      specErrorBars = asSpec [ mark ErrorBar [ MTicks [] ], encErrorBars [] ]
      encErrorBars = encoding
                     . position Y [ pName "yield", pQuant, PScale [ SZero False ] ]
                     . position X [ pName "variety", pOrdinal ]
                     . position YError [ pName "yieldError" ]
                     . position YError2 [ pName "yieldError2" ]

      specPoints = asSpec [ mark Point [ MFilled True, MColor "black" ]
                          , encPoints [] ]
      encPoints = encoding
                  . position Y [ pName "yield", pQuant ]
                  . position X [ pName "variety", pOrdinal ]

  in toVegaLite [ des, yieldData [], layer [ specErrorBars, specPoints ] ]