{-# LANGUAGE OverloadedStrings #-}

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

import Graphics.Vega.VegaLite

import Data.Function ((&))
import Prelude hiding (filter)

testSpecs :: [(String, VegaLite)]
testSpecs = [ ("markCondition1", markCondition1)
            , ("markCondition2", markCondition2)
            , ("axisCondition1", axisCondition1)
            , ("axisCondition2", axisCondition2)
            , ("axisCondition3", axisCondition3)
            , ("axisconditionlabeloffset", axisConditionLabelOffset)
            , ("axisDateCondition1", axisDateCondition1)
            , ("selectionCondition1", selectionCondition1)
            , ("selectionCondition2", selectionCondition2)
            , ("selectionCondition3", selectionCondition3)
            , ("selectionCondition4", selectionCondition4)
            , ("selectionCondition5", selectionCondition5)
            , ("bindScales1", bindScales1)
            , ("bindScales2", bindScales2)
            ]


movieData, carData :: Data
movieData = dataFromUrl "https://vega.github.io/vega-lite/data/movies.json" []
carData = dataFromUrl "https://vega.github.io/vega-lite/data/cars.json" []

rtRating :: BuildEncodingSpecs
rtRating = position Y [ PName "Rotten_Tomatoes_Rating", PmType Quantitative ]

encCars :: [EncodingSpec] -> PropertySpec
encCars = encoding
          . position Y [ PName "Origin", PmType Ordinal ]
          . position X [ PName "Cylinders", PmType Ordinal ]

encHorses :: [EncodingSpec] -> PropertySpec
encHorses = encoding
            . position X [ PName "Horsepower", PmType Quantitative ]
            . position Y [ PName "Miles_per_Gallon", PmType Quantitative ]


markCondition1 :: VegaLite
markCondition1 =
    let
        config =
            configure
                . configuration (MarkStyle [ MRemoveInvalid False ])

        enc =
            encoding
                . position X [ PName "IMDB_Rating", PmType Quantitative ]
                . rtRating
                . color
                    [ MDataCondition
                        [ ( Or (Expr "datum.IMDB_Rating === null")
                            (Expr "datum.Rotten_Tomatoes_Rating === null")
                          ,  [ MString "#ddd" ]
                          )
                        ]
                        [ MString "#0099ee" ]
                    ]
    in
    toVegaLite [ config []
               , movieData
               -- Vega-Lite 4 turned off tooltips by default, so
               -- enable them here
               , mark Point [ MTooltip TTEncoding ]
               , enc [] ]


markCondition2 :: VegaLite
markCondition2 =
    let
        dataVals =
            dataFromColumns []
                . dataColumn "value" (Numbers [ 10, 20, 30, 40, 50, 60 ])

        enc =
            encoding
                . position X [ PName "value", PmType Ordinal ]
                . color
                    [ MDataCondition
                        [ ( Expr "datum.value < 40", [ MString "blue" ] )
                        , ( Expr "datum.value < 50", [ MString "red" ] )
                        , ( Expr "datum.value < 60", [ MString "yellow" ] )
                        ]
                        [ MString "black" ]
                    ]
    in
    toVegaLite [ width 400, dataVals [], mark Circle [ MSize 800 ], enc [] ]


axisTest :: [AxisProperty] -> VegaLite
axisTest axConds =
  let enc = encoding
                . position X
                    [ PName "IMDB_Rating"
                    , PmType Quantitative
                    , PAxis (AxTickCount 20 : axConds)
                    ]
                . rtRating

  in toVegaLite [ width 600, height 600, movieData, mark Point [ MOpacity 0.1 ], enc [] ]


axisCondition1 :: VegaLite
axisCondition1 =
  axisTest [ AxDataCondition (Expr "datum.value <= 5") (CAxGridDash [ 5, 5 ] [])
           , AxDataCondition (Expr "datum.value <= 7") (CAxGridColor "green" "red")
           ]


axisCondition2 :: VegaLite
axisCondition2 =
  axisTest [ AxDataCondition (Expr "datum.value <= 2") (CAxTickColor "red" "blue")
           , AxDataCondition (Expr "datum.value >=8") (CAxTickOpacity 0.3 0.8)
           , AxDataCondition (Expr "datum.label =='4.0'") (CAxTickWidth 5 2)
           , AxDataCondition (Expr "(datum.value >= 5) && (datum.value <= 8)")
                              (CAxTickDash [2, 2] [])
           {- Vega-Embed (Early Jan 2020) doesn't seem to display this well
           , AxDataCondition (Expr "(datum.value >= 3) && (datum.value <= 7)")
                              (CAxTickDashOffset 4 0)
           -}
           , AxDataCondition (Expr "(datum.value > 0) && (datum.value < 3)")
                              (CAxTickSize 20 5)
           , AxDataCondition (Expr "(datum.value >= 1) && (datum.value <= 4)")
                              (CAxLabelPadding 20 5)
           ]


axisCondition3 :: VegaLite
axisCondition3 =
  axisTest [ AxDataCondition (Expr "datum.value <= 2") (CAxLabelColor "red" "blue")
           , AxDataCondition (Expr "datum.value <= 1") (CAxLabelAlign AlignRight AlignLeft)
           , AxDataCondition (Expr "datum.value <= 3") (CAxLabelBaseline AlignTop AlignBottom)
           , AxDataCondition (Expr "datum.value <= 4") (CAxLabelFont "serif" "sans-serif")
           , AxDataCondition (Expr "datum.value <= 6") (CAxLabelFontSize 12 18)
           , AxDataCondition (Expr "datum.value <=8") (CAxLabelFontStyle "normal" "italic")
           , AxDataCondition (Expr "datum.label =='4.0'") (CAxLabelFontWeight Bold W100)
           , AxDataCondition (Expr "datum.value >=9") (CAxLabelOpacity 0.3 0.8)
           ]

-- Vega Lite 4.5.0 or later
axisConditionLabelOffset :: VegaLite
axisConditionLabelOffset =
  axisTest [ AxDataCondition (Expr "datum.value <= 5") (CAxLabelOffset 10 5) ]


-- add a basic test of date handling (so that I can check the example given in the
-- documentation, or at least one similar to it, even if in this case it affects
-- all grid lines).
--
axisDateCondition1 :: VegaLite
axisDateCondition1 =
  let enc =
        encoding
          . position X [ PName "Year"
                       , PmType Temporal
                       , PTimeUnit Year
                       , PAxis [ AxDataCondition
                                 (FEqual "value" (DateTime [DTMonth Jan, DTDate 1])
                                   & FilterOpTrans (MTimeUnit MonthDate))
                                 (CAxGridWidth 4 1)
                               ]
                       ]
          . position Y [ PName "Miles_per_Gallon"
                       , PmType Quantitative
                       , PScale [ SZero False ]
                       ]

      mopts = [ MExtent Iqr, MInterpolate Monotone, MBorders [] ]

  in toVegaLite [ width 600, carData, enc [], mark ErrorBand mopts ]


selectionCondition1 :: VegaLite
selectionCondition1 =
    let sel =
            selection
                . select "alex"
                    Interval
                    [ On "[mousedown[!event.shiftKey], mouseup] > mousemove"
                    , Translate "[mousedown[!event.shiftKey], mouseup] > mousemove"
                    ]
                . select "morgan"
                    Interval
                    [ On "[mousedown[event.shiftKey], mouseup] > mousemove"
                    , Translate "[mousedown[event.shiftKey], mouseup] > mousemove"
                    , SelectionMark [ SMFill "#fdbb84", SMFillOpacity 0.5, SMStroke "#e34a33" ]
                    ]

        enc = encCars
                . color [ MAggregate Count, MName "*", MmType Quantitative ]
    in
    toVegaLite
        [ carData, sel [], mark Rect [ MCursor CGrab ], enc [] ]


selectionCondition2 :: VegaLite
selectionCondition2 =
    let sel =
            selection
                . select "alex"
                    Interval
                    [ On "[mousedown[!event.shiftKey], mouseup] > mousemove"
                    , Translate "[mousedown[!event.shiftKey], mouseup] > mousemove"
                    ]
                . select "morgan"
                    Interval
                    [ On "[mousedown[event.shiftKey], mouseup] > mousemove"
                    , Translate "[mousedown[event.shiftKey], mouseup] > mousemove"
                    , SelectionMark [ SMFill "#fdbb84", SMFillOpacity 0.5, SMStroke "#e34a33" ]
                    ]

        enc = encCars
                . color
                    [ MSelectionCondition
                        (And (SelectionName "alex") (SelectionName "morgan"))
                        [ MAggregate Count, MName "*", MmType Quantitative ]
                        [ MString "gray" ]
                    ]
    in
    toVegaLite
        [ carData, sel [], mark Rect [ MCursor CGrab ], enc [] ]


selectionCondition3 :: VegaLite
selectionCondition3 =
    let trans =
            transform
                . filter (FCompose (And (Selection "brush") (Expr "datum.Weight_in_lbs > 3000")))

        sel =
            selection
                . select "brush" Interval []

        spec1 =
            asSpec [ sel [], mark Point [], encHorses [] ]

        enc2 =
            encoding
                . position X [ PName "Acceleration", PmType Quantitative, PScale [ SDomain (DNumbers [ 0, 25 ]) ] ]
                . position Y [ PName "Displacement", PmType Quantitative, PScale [ SDomain (DNumbers [ 0, 500 ]) ] ]

        spec2 =
            asSpec [ trans [], mark Point [], enc2 [] ]
    in
    toVegaLite
        [ carData, vConcat [ spec1, spec2 ] ]


selectionCondition4 :: VegaLite
selectionCondition4 =
    let sel =
            selection
                . select "mySelection"
                    Interval
                    [ Clear ""
                    , On "[mousedown[!event.shiftKey], mouseup] > mousemove"
                    , Translate "[mousedown[!event.shiftKey], mouseup] > mousemove"
                    ]

        enc = encCars
                . color
                    [ MSelectionCondition
                        (SelectionName "mySelection")
                        [ MAggregate Count, MName "*", MmType Quantitative ]
                        [ MString "gray" ]
                    ]
    in
    toVegaLite
        [ carData, sel [], mark Rect [ MCursor CGrab ], enc [] ]


selectionCondition5 :: VegaLite
selectionCondition5 =
    let sel =
            selection
                . select "mySelection"
                    Interval
                    [ Clear "mouseup"
                    , Empty
                    , On "[mousedown[!event.shiftKey], mouseup] > mousemove"
                    , Translate "[mousedown[!event.shiftKey], mouseup] > mousemove"
                    ]

        enc = encCars
                . color
                    [ MSelectionCondition
                        (SelectionName "mySelection")
                        [ MAggregate Count, MName "*", MmType Quantitative ]
                        [ MString "gray" ]
                    ]
    in
    toVegaLite
        [ carData, sel [], mark Rect [ MCursor CGrab ], enc [] ]


bindScales1 :: VegaLite
bindScales1 =
    let sel =
            selection
                . select "myZoomPan" Interval [ BindScales ]

    in
    toVegaLite
        [ width 300, height 300, carData, sel [], mark Circle [], encHorses [] ]


bindScales2 :: VegaLite
bindScales2 =
    let sel =
            selection
                . select "myZoomPan"
                    Interval
                    [ BindScales, Clear "click[event.shiftKey]" ]

    in
    toVegaLite
        [ width 300, height 300, carData, sel [], mark Circle [], encHorses [] ]