content: {-# LANGUAGE CPP #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE QuasiQuotes #-}
  
  --
  -- Based on the Elm VegaLite FillStrokeTests.elm as of version 1.12.0
  --
  -- Note that fill1, stroke1, and combined1 generate invalid Vega-Lite
  -- since they create empty objects for the fill or stroke fields,
  -- and that is not valid. I am leaving this as is for now.
  --
  module FillStrokeTests (testSpecs) where
  
  import qualified Data.Text as T
  
  import Data.Aeson (Value)
  import Data.Aeson.QQ.Simple (aesonQQ)
  
  #if !(MIN_VERSION_base(4, 12, 0))
  import Data.Monoid ((<>))
  #endif
  
  import Graphics.Vega.VegaLite hiding (filter, repeat)
  
  testSpecs :: [(String, VegaLite)]
  testSpecs = [ ("default", defChart)
              , ("fill1", fill1)
              , ("fill2", fill2)
              , ("fill3", fill3)
              , ("stroke1", stroke1)
              , ("stroke2", stroke2)
              , ("stroke3", stroke3)
              , ("combined1", combined1)
              , ("combined2", combined2)
              , ("combined3", combined3)
              , ("geo1", geo1)
              , ("geo2", geo2)
              , ("gradient1", gradient1)
              , ("gradient2", gradient2)
              , ("gradient3", gradient3)
              , ("gradientr1", gradientr1)
              , ("gradientr2", gradientr2)
              , ("gradientr3", gradientr3)
              , ("vrounded", vrounded)
              , ("hrounded", hrounded)
              , ("strokedash1", strokeDash1)
              , ("strokedash2", strokeDash2)
              , ("strokedash3", strokeDash3)
              , ("strokedash4", strokeDash4)
              , ("strokedash5", strokeDash5)
              , ("strokedash6", strokeDash6)
              , ("strokedash7", strokeDash7)
              , ("strokedash8", strokeDash8)
              , ("strokedash9", strokeDash9)
              , ("fillopacity", fillopacity)
              ]
  
  encChart :: ([a] -> [EncodingSpec]) -> VegaLite
  encChart extraEnc =
      let
          dataVals =
              dataFromColumns []
                  . dataColumn "x" (Numbers [ 10, 20, 30, 36 ])
                  . dataColumn "y" (Numbers [ 1, 2, 3, 4 ])
                  . dataColumn "val" (Numbers [ 1, 2, 3, 4 ])
                  . dataColumn "cat" (Strings [ "a", "b", "c", "d" ])
  
          enc =
              encoding
                  . position X [ PName "x", PmType Quantitative ]
                  . position Y [ PName "y", PmType Quantitative ]
                  . color [ MName "cat", MmType Nominal ]
                  . size [ MNumber 2000 ]
                  . extraEnc
      in
      toVegaLite [ width 200, height 200, dataVals [], enc [],
                   mark Circle [ MStroke "black" ] ]
  
  
  defChart :: VegaLite
  defChart = encChart (const [])
  
  fill1, fill2, fill3 :: VegaLite
  fill1 = encChart (fill [])  -- this produces invalid output
  fill2 = encChart (fill [ MName "y", MmType Ordinal ])
  fill3 = encChart (fill [ MString "red" ])
  
  stroke1, stroke2, stroke3 :: VegaLite
  stroke1 = encChart (stroke []) -- this produces invalid output
  stroke2 = encChart (stroke [ MName "y", MmType Ordinal ])
  stroke3 = encChart (stroke [ MString "red" ])
  
  combined1, combined2, combined3 :: VegaLite
  combined1 = encChart (stroke [] . fill [])
  combined2 = encChart (stroke [ MName "y", MmType Ordinal ] . fill [ MString "red" ])
  combined3 = encChart (stroke [ MString "red" ] . fill [ MName "y", MmType Ordinal ])
  
  geo1 :: VegaLite
  geo1 =
      let
          geojson =
              geoFeatureCollection
                  [ geometry (GeoPolygon [ [ ( -2, 58 ), ( 3, 58 ), ( 3, 53 ), ( -2, 53 ), ( -2, 58 ) ] ]) []
                  , geometry (GeoLine [ ( 4, 52 ), ( 4, 59 ), ( -3, 59 ) ]) []
                  ]
      in
      toVegaLite
          [ width 300
          , height 300
          , dataFromJson geojson []
          , mark Geoshape []
          ]
  
  geo2 :: VegaLite
  geo2 =
      let
          geojson =
              geoFeatureCollection
                  [ geometry (GeoPolygon [ [ ( -2, 58 ), ( 3, 58 ), ( 3, 53 ), ( -2, 53 ), ( -2, 58 ) ] ]) []
                  , geometry (GeoLine [ ( 4, 52 ), ( 4, 59 ), ( -3, 59 ) ]) []
                  ]
  
          -- NOTE: There is a bug in Vega-Lite that prevents nested geometry from being read correctly.
          enc =
              encoding . color [ MName "features.geometry.type",
                                 MmType Nominal ]
      in
      toVegaLite
          [ width 300
          , height 300
          , enc []
          , dataFromJson geojson []
          , mark Geoshape []
          ]
  
  
  gradientTest :: PropertySpec -> VegaLite
  gradientTest markType =
    let dvals = dataFromColumns []
                . dataColumn "cat" (Strings [ "a", "b", "c", "d" ])
                . dataColumn "value" (Numbers [ 10, 5, 20, 8 ])
  
        enc = encoding
              . position X [ PName "cat", PmType Nominal ]
              . position Y [ PName "value", PmType Quantitative ]
  
    in toVegaLite [ width 200, dvals [], enc [], markType ]
  
  
  gradient1 :: VegaLite
  gradient1 =
    let markType = mark Bar [ MColorGradient GrLinear stops opts ]
        stops = [ (0, "red"), (0.4, "orange"), (1, "blue") ]
        opts = [ GrX1 1
               , GrX2 1
               , GrY1 0
               , GrY2 1
               ]
  
    in gradientTest markType
  
  
  gradient2 :: VegaLite
  gradient2 =
    let markType = mark Bar [ MColorGradient GrLinear stops opts ]
        stops = [ (0, "red"), (1, "blue") ]
        opts = [ GrX1 0
               , GrX2 1
               , GrY1 1
               , GrY2 1
               ]
  
    in gradientTest markType
  
  
  gradient3 :: VegaLite
  gradient3 =
    let markType = mark Bar [ MColorGradient GrLinear stops opts ]
        stops = [ (1, "red"), (0, "blue") ]
        opts = [ GrX1 0
               , GrX2 1
               , GrY1 0
               , GrY2 1
               ]
  
    in gradientTest markType
  
  
  gradientr1 :: VegaLite
  gradientr1 =
    let markType = mark Circle [ MSize 1000
                               , MColorGradient GrRadial stops opts ]
        stops = [ (0, "red"), (0.5, "white"), (1, "blue") ]
        opts = [ ]
  
    in gradientTest markType
  
  
  -- these are the defaults, so they should be the same as r1
  gradientr2 :: VegaLite
  gradientr2 =
    let markType = mark Circle [ MSize 1000
                               , MColorGradient GrRadial stops opts ]
        stops = [ (0, "red"), (1, "blue"), (0.5, "white") ]
        opts = [ GrX1 0.5
               , GrX2 0.5
               , GrY1 0.5
               , GrY2 0.5
               ]
  
    in gradientTest markType
  
  
  -- not sure if these options make sense, but they are valid according to
  -- the Vega-Lite 4.0.2 spec so leave them be.
  --
  gradientr3 :: VegaLite
  gradientr3 =
    let markType = mark Circle [ MSize 1000
                               , MColorGradient GrRadial stops opts ]
        stops = [ (0, "red"), (1, "blue"), (0.5, "white") ]
        opts = [ GrX1 0.2
               , GrX2 0.8
               , GrY1 0.7
               , GrY2 0.3
               , GrR1 0.2
               , GrR2 0.4
               ]
  
    in gradientTest markType
  
  
  {-
  From https://vega.github.io/vega-lite/docs/bar.html#bar-chart-with-rounded-corners
  
  {
    "data": {
      "values": [
        {"a": "A", "b": 28}, {"a": "B", "b": 55}, {"a": "C", "b": 43},
        {"a": "D", "b": 91}, {"a": "E", "b": 81}, {"a": "F", "b": 53},
        {"a": "G", "b": 19}, {"a": "H", "b": 87}, {"a": "I", "b": 52}
      ]
    },
    "mark": {"type": "bar", "cornerRadiusEnd": 4},
    "encoding": {
      "x": {"field": "a", "type": "ordinal"},
      "y": {"field": "b", "type": "quantitative"}
    }
  }
  
  -}
  
  barData :: Value
  barData = [aesonQQ|
  [
    {"a": "A", "b": 28}, {"a": "B", "b": 55}, {"a": "C", "b": 43},
    {"a": "D", "b": 91}, {"a": "E", "b": 81}, {"a": "F", "b": 53},
    {"a": "G", "b": 19}, {"a": "H", "b": 87}, {"a": "I", "b": 52}
  ]
  |]
  
  rounded :: Position -> Position -> VegaLite
  rounded h v =
    toVegaLite [ dataFromJson barData []
               , mark Bar [ MCornerRadiusEnd 4 ]
               , encoding
                 . position h [ PName "a", PmType Ordinal ]
                 . position v [ PName "b", PmType Quantitative ]
                 $ []
               ]
  
  vrounded :: VegaLite
  vrounded = rounded X Y
  
  hrounded :: VegaLite
  hrounded = rounded Y X
  
  
  stockData :: Data
  stockData = dataFromUrl "https://vega.github.io/vega-lite/data/stocks.csv" []
  
  xDate, yPrice :: BuildEncodingSpecs
  xDate = position X [ PName "date", PmType Temporal ]
  yPrice = position Y [ PName "price", PmType Quantitative ]
  
  strokeDashTest :: [MarkChannel] -> VegaLite
  strokeDashTest sOpts =
    let enc = encoding
              . xDate
              . yPrice
              . strokeDash ([ MName "symbol", MmType Nominal ] ++ sOpts)
  
        lineOpts = [MStrokeWidth 1, MOpacity 0.6]
  
    in toVegaLite [ width 350, stockData, enc [], mark Line lineOpts ]
  
  
  strokeDash1 :: VegaLite
  strokeDash1 = strokeDashTest []
  
  strokeDash2 :: VegaLite
  strokeDash2 = strokeDashTest [ MScale
                             [ SDomain (DStrings [ "AAPL", "AMZN", "GOOG", "IBM", "MSFT" ])
                             , SRange (RNumberLists [ [ 1, 0 ], [ 3, 1 ], [ 2, 3 ], [ 4, 4 ], [ 5, 6 ] ])
                             ]
                           ]
  
  pName :: T.Text -> PositionChannel
  pName = PName
  
  mName :: T.Text -> MarkChannel
  mName = MName
  
  pQuant :: PositionChannel
  pQuant = PmType Quantitative
  
  mNominal, mOrdinal :: MarkChannel
  mNominal = MmType Nominal
  mOrdinal = MmType Ordinal
  
  
  sDash :: [MarkChannel] -> VegaLite
  sDash sdOpts =
    let dvals = dataFromColumns []
                . toCol "x" [ 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1 ]
                . toCol "y" [ 100, 100, 90, 90, 80, 80, 70, 70, 60, 60, 50, 50, 40, 40, 30, 30, 20, 20, 10, 10 ]
                . toCol "cat" [ 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6, 7, 7, 8, 8, 9, 9, 10, 10 ]
  
        toCol l = dataColumn l . Numbers
  
        encBase = encoding
                  . position X [ pName "x", pQuant ]
                  . position Y [ pName "y", pQuant ]
  
        enc1 = encBase
               . strokeDash ([ mName "cat", mNominal ] ++ sdOpts)
  
        spec1 = asSpec [ title "Nominal" [], width 200, enc1 [], mark Line [] ]
  
        enc2 = encBase
               . strokeDash ([ mName "cat", mOrdinal ] ++ sdOpts)
  
        spec2 = asSpec [ title "Ordinal" [], width 200, enc2 [], mark Line [] ]
  
        res = resolve
              . resolution (RScale [ ( ChStrokeDash, Independent ) ])
  
        cfg = configure
              . configuration (Axis [NoTitle, Grid False])
              . configuration (LineStyle [MStrokeWidth 1, MColor "orange", MOpacity 0.6])
  
    in toVegaLite [ dvals [], cfg [], res [], vlConcat [ spec1, spec2 ] ]
  
  
  d0, d1, d2, d3, d4, d5, d6, d7, d8, d9 :: [Double]
  d0 = [ 1, 0 ]
  d1 = [ 16, 4 ]
  d2 = [ 10, 4 ]
  d3 = [ 8, 4 ]
  d4 = [ 8, 4, 4, 4 ]
  d5 = [ 6, 4 ]
  d6 = [ 5, 4 ]
  d7 = [ 4, 6 ]
  d8 = [ 2, 4 ]
  d9 = [ 1, 3 ]
  
  strokeDash3, strokeDash4 :: VegaLite
  strokeDash3 = sDash []
  strokeDash4 = sDash [ MScale
                        [ SDomain (DNumbers [0, 1, 2, 3, 4, 5, 6, 7, 8, 9])
                        , SRange (RNumberLists [d0, d6, d8, d4, d9, d1, d5, d3, d7, d2])
                        ]
                      ]
  
  
  scaledStrokeDash :: Double -> VegaLite
  scaledStrokeDash dashScale =
    let scaleDash = map (map (dashScale *))
  
        dvals = dataSequenceAs 0 100 0.1 "x0"
  
        trans = transform
                . calculateAs "abs(sin(datum.x0+random()))" "y0"
                . calculateAs "datum.x0 %10" "x"
                . calculateAs "floor(datum.x0 / 10)" "cat"
                . calculateAs "datum.y0 + datum.cat" "y"
  
        enc = encoding
              . position X [ pName "x", pQuant, PAxis [ AxGrid False ] ]
              . position Y [ pName "y", pQuant, PAxis [ AxGrid False ] ]
              . strokeDash
                      [ mName "cat"
                      , mOrdinal
                      , MScale
                          [ SDomain (DNumbers [ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9 ])
                          , SRange (RNumberLists (scaleDash [ d0, d1, d2, d3, d4, d5, d6, d7, d8, d9 ]))
                          ]
                      ]
  
    in toVegaLite [ title ("Dash scale " <> T.pack (show dashScale)) []
                  , width 300
                  , height 300
                  , dvals
                  , trans []
                  , enc []
                  , mark Line []
                  ]
  
  
  strokeDash5, strokeDash6, strokeDash7, strokeDash8, strokeDash9 :: VegaLite
  strokeDash5 = scaledStrokeDash 0.2
  strokeDash6 = scaledStrokeDash 0.5
  strokeDash7 = scaledStrokeDash 1
  strokeDash8 = scaledStrokeDash 2
  strokeDash9 = scaledStrokeDash 4
  
  
  -- found in a bug report and thought would be a good test
  fillopacity :: VegaLite
  fillopacity =
    let dvals = dataFromColumns []
                . dataColumn "a" (Strings ["A", "B"])
                . dataColumn "b" (Numbers [10, 20])
                $ []
  
        enc = encoding
              . position X [PName "a", PmType Ordinal, PAxis [AxLabelAngle 0]]
              . position Y [PName "b", PmType Quantitative]
              . fillOpacity [MName "b", MmType Quantitative]
  
    in toVegaLite [ dvals
                  , mark Bar []
                  , enc []
                  ]
  