content: {-# LANGUAGE OverloadedStrings #-}
  
  --
  -- Based on the Elm VegaLite ShapeTests.elm as of version 1.12.0
  --
  
  module ShapeTests (testSpecs) where
  
  import qualified Data.Map as M
  import qualified Data.Text as T
  
  import Data.Maybe (fromMaybe)
  import Graphics.Vega.VegaLite
  
  import Prelude hiding (filter, repeat)
  
  testSpecs :: [(String, VegaLite)]
  testSpecs = [ ("defNominal", scatter1)
              , ("defOrdinal", scatter2)
              , ("size1", scatter3)
              , ("size2", scatter4)
              , ("size3", scatter5)
              , ("multi1", scatter6)
              , ("multi2", scatter7)
              , ("multi3", scatter8)
              , ("multi4", scatter9)
              , ("multi5", scatter10)
              , ("multi6", scatter11)
              , ("custom1", scatter12)
              , ("custom2", scatter13)
              , ("custom3", scatter14)
              , ("custom4", scatter15)
              , ("isotype1", personGrid)
              , ("point1", point1)
              , ("point2", point2)
              , ("point3", point3)
              , ("point4", point4)
              , ("point5", point5)
              , ("point6", point6)
              , ("point7", point7)
              , ("rounded1", rounded1)
              , ("rounded2", rounded2)
              , ("rounded3", rounded3)
              , ("rounded4", rounded4)
              , ("rounded5", rounded5)
              , ("rounded6", rounded6)
              , ("symbols1", symbols1)
              , ("symbols2", symbols2)
              , ("windvector", windvector)
              ]
  
  
  chart :: T.Text -> ([a] -> [EncodingSpec]) -> VegaLite
  chart des enc =
      toVegaLite
          [ description des
          , dataFromUrl "https://vega.github.io/vega-lite/data/cars.json" []
          , (transform
              . calculateAs "year(datum.Year)" "YearOfManufacture"
              . filter (FExpr "datum.YearOfManufacture == 1970")
            )
              []
          , mark Point [ MFilled True ]
          , (encoding
              . position X [ PName "Horsepower", PmType Quantitative ]
              . position Y [ PName "Miles_per_Gallon", PmType Quantitative ]
              . opacity [ MNumber 0.6 ]
              . enc
            )
              []
          ]
  
  
  pointChart :: T.Text -> Bool -> Symbol -> VegaLite
  pointChart des filled sym =
      toVegaLite
          [ description des
          , dataFromUrl "https://vega.github.io/vega-lite/data/cars.json" []
          , (transform
              . calculateAs "year(datum.Year)" "YearOfManufacture"
              . filter (FExpr "datum.YearOfManufacture == 1970")
            )
              []
          , mark Point [ MFilled filled, MShape sym ]
          , (encoding
              . position X [ PName "Horsepower", PmType Quantitative ]
              . position Y [ PName "Miles_per_Gallon", PmType Quantitative ]
              . opacity [ MNumber 0.6 ]
            )
              []
          ]
  
  
  unitSquare, largeSquare, square, tri, cross :: T.Text
  unitSquare = "M -0.5 -0.5 h 1 v 1 h -1z"
  largeSquare = "M -5 -5 h 10 v 10 h -10z"
  square = "M -1.5 -1.5 h 3 v 3 h -3z"
  tri = "M -1.5 -1.5 h 3 l -1.5 3z"
  cross = "M -1.5 -1.5 m1 0 h 1 v 1 h 1 v 1 h -1 v 1 h -1  v -1 h -1 v -1 h 1z"
  
  
  scatter1 :: VegaLite
  scatter1 =
      chart "Default nominal shapes."
          (shape [ MName "Origin", MmType Nominal ])
  
  
  scatter2 :: VegaLite
  scatter2 =
      chart "Default ordinal shapes."
          (shape [ MName "Cylinders", MmType Ordinal ])
  
  
  scatter3 :: VegaLite
  scatter3 =
      chart "Enlarged shapes (but legend shapes should remain same size)"
          (shape [ MName "Origin", MmType Nominal ]
              . size [ MNumber 200 ]
          )
  
  
  scatter4 :: VegaLite
  scatter4 =
      chart "Reduced shapes (but legend shapes should remain same size)"
          (shape [ MName "Origin", MmType Nominal ]
              . size [ MNumber 20 ]
          )
  
  
  scatter5 :: VegaLite
  scatter5 =
      chart "Fixed shape, sized by number of cylinder category"
          (size [ MName "Cylinders", MmType Ordinal ])
  
  
  scatter6 :: VegaLite
  scatter6 =
      chart "Sized by number of cylinders, shape by origin"
          (shape [ MName "Origin", MmType Nominal ]
              . size [ MName "Cylinders", MmType Ordinal ]
          )
  
  
  scatter7 :: VegaLite
  scatter7 =
      chart "Sized and shaped by number of cylinders (should only have a single set of legend items)"
          (shape [ MName "Cylinders", MmType Ordinal ]
              . size [ MName "Cylinders", MmType Ordinal ]
          )
  
  
  scatter8 :: VegaLite
  scatter8 =
      chart "Sized, shaped and coloured by number of cylinders (should only have a single set of legend items)"
          (shape [ MName "Cylinders", MmType Ordinal ]
              . size [ MName "Cylinders", MmType Ordinal ]
              . color [ MName "Cylinders", MmType Ordinal ]
          )
  
  
  scatter9 :: VegaLite
  scatter9 =
      chart "Custom-shaped and coloured by origin (should only have a single set of legend items)"
          (shape [ MName "Origin", MmType Nominal ]
              . color [ MName "Origin", MmType Nominal ]
          )
  
  
  scatter10 :: VegaLite
  scatter10 =
      chart "Custom-shaped and coloured by origin (should only have a single set of legend items)"
          (shape
              [ MName "Origin"
              , MmType Nominal
              , MScale (categoricalDomainMap
                        [ ( "Europe", square )
                        , ( "Japan", cross )
                        , ( "USA", tri )
                        ])
              ]
              . color [ MName "Origin", MmType Nominal ]
          )
  
  
  scatter11 :: VegaLite
  scatter11 =
      chart "Sized, shaped and coloured by number of cylinders (should have two sets of legend items)"
          (shape [ MName "Cylinders", MmType Ordinal ]
              . size [ MName "Cylinders", MmType Ordinal ]
              . color [ MName "Origin", MmType Nominal ]
          )
  
  
  scatter12 :: VegaLite
  scatter12 =
      chart "Custom nominal shape with unit area."
          (shape [ MPath unitSquare ])
  
  
  scatter13 :: VegaLite
  scatter13 =
      chart "Custom nominal shape with unit area sized by Cylinders."
          (shape [ MPath unitSquare ]
              . size [ MName "Cylinders", MmType Ordinal ]
          )
  
  
  scatter14 :: VegaLite
  scatter14 =
      chart "Custom nominal shape with area of 10x10 pixel units."
          (shape [ MPath largeSquare ]
              . color [ MName "Origin", MmType Nominal ]
          )
  
  
  scatter15 :: VegaLite
  scatter15 =
      chart "Custom shape sets encoding origin."
          (shape
              [ MName "Origin"
              , MmType Nominal
              , MScale (categoricalDomainMap
                        [ ( "Europe", square )
                        , ( "Japan", cross )
                        , ( "USA", tri )
                        ])
              ]
          )
  
  
  isotypes :: M.Map T.Text T.Text
  isotypes =
      let
          cow =
              "M4 -2c0 0 0.9 -0.7 1.1 -0.8c0.1 -0.1 -0.1 0.5 -0.3 0.7c-0.2 0.2 1.1 1.1 1.1 1.2c0 0.2 -0.2 0.8 -0.4 0.7c-0.1 0 -0.8 -0.3 -1.3 -0.2c-0.5 0.1 -1.3 1.6 -1.5 2c-0.3 0.4 -0.6 0.4 -0.6 0.4c0 0.1 0.3 1.7 0.4 1.8c0.1 0.1 -0.4 0.1 -0.5 0c0 0 -0.6 -1.9 -0.6 -1.9c-0.1 0 -0.3 -0.1 -0.3 -0.1c0 0.1 -0.5 1.4 -0.4 1.6c0.1 0.2 0.1 0.3 0.1 0.3c0 0 -0.4 0 -0.4 0c0 0 -0.2 -0.1 -0.1 -0.3c0 -0.2 0.3 -1.7 0.3 -1.7c0 0 -2.8 -0.9 -2.9 -0.8c-0.2 0.1 -0.4 0.6 -0.4 1c0 0.4 0.5 1.9 0.5 1.9l-0.5 0l-0.6 -2l0 -0.6c0 0 -1 0.8 -1 1c0 0.2 -0.2 1.3 -0.2 1.3c0 0 0.3 0.3 0.2 0.3c0 0 -0.5 0 -0.5 0c0 0 -0.2 -0.2 -0.1 -0.4c0 -0.1 0.2 -1.6 0.2 -1.6c0 0 0.5 -0.4 0.5 -0.5c0 -0.1 0 -2.7 -0.2 -2.7c-0.1 0 -0.4 2 -0.4 2c0 0 0 0.2 -0.2 0.5c-0.1 0.4 -0.2 1.1 -0.2 1.1c0 0 -0.2 -0.1 -0.2 -0.2c0 -0.1 -0.1 -0.7 0 -0.7c0.1 -0.1 0.3 -0.8 0.4 -1.4c0 -0.6 0.2 -1.3 0.4 -1.5c0.1 -0.2 0.6 -0.4 0.6 -0.4z"
  
          pig =
              "M1.2 -2c0 0 0.7 0 1.2 0.5c0.5 0.5 0.4 0.6 0.5 0.6c0.1 0 0.7 0 0.8 0.1c0.1 0 0.2 0.2 0.2 0.2c0 0 -0.6 0.2 -0.6 0.3c0 0.1 0.4 0.9 0.6 0.9c0.1 0 0.6 0 0.6 0.1c0 0.1 0 0.7 -0.1 0.7c-0.1 0 -1.2 0.4 -1.5 0.5c-0.3 0.1 -1.1 0.5 -1.1 0.7c-0.1 0.2 0.4 1.2 0.4 1.2l-0.4 0c0 0 -0.4 -0.8 -0.4 -0.9c0 -0.1 -0.1 -0.3 -0.1 -0.3l-0.2 0l-0.5 1.3l-0.4 0c0 0 -0.1 -0.4 0 -0.6c0.1 -0.1 0.3 -0.6 0.3 -0.7c0 0 -0.8 0 -1.5 -0.1c-0.7 -0.1 -1.2 -0.3 -1.2 -0.2c0 0.1 -0.4 0.6 -0.5 0.6c0 0 0.3 0.9 0.3 0.9l-0.4 0c0 0 -0.4 -0.5 -0.4 -0.6c0 -0.1 -0.2 -0.6 -0.2 -0.5c0 0 -0.4 0.4 -0.6 0.4c-0.2 0.1 -0.4 0.1 -0.4 0.1c0 0 -0.1 0.6 -0.1 0.6l-0.5 0l0 -1c0 0 0.5 -0.4 0.5 -0.5c0 -0.1 -0.7 -1.2 -0.6 -1.4c0.1 -0.1 0.1 -1.1 0.1 -1.1c0 0 -0.2 0.1 -0.2 0.1c0 0 0 0.9 0 1c0 0.1 -0.2 0.3 -0.3 0.3c-0.1 0 0 -0.5 0 -0.9c0 -0.4 0 -0.4 0.2 -0.6c0.2 -0.2 0.6 -0.3 0.8 -0.8c0.3 -0.5 1 -0.6 1 -0.6z"
  
          sheep =
              "M-4.1 -0.5c0.2 0 0.2 0.2 0.5 0.2c0.3 0 0.3 -0.2 0.5 -0.2c0.2 0 0.2 0.2 0.4 0.2c0.2 0 0.2 -0.2 0.5 -0.2c0.2 0 0.2 0.2 0.4 0.2c0.2 0 0.2 -0.2 0.4 -0.2c0.1 0 0.2 0.2 0.4 0.1c0.2 0 0.2 -0.2 0.4 -0.3c0.1 0 0.1 -0.1 0.4 0c0.3 0 0.3 -0.4 0.6 -0.4c0.3 0 0.6 -0.3 0.7 -0.2c0.1 0.1 1.4 1 1.3 1.4c-0.1 0.4 -0.3 0.3 -0.4 0.3c-0.1 0 -0.5 -0.4 -0.7 -0.2c-0.3 0.2 -0.1 0.4 -0.2 0.6c-0.1 0.1 -0.2 0.2 -0.3 0.4c0 0.2 0.1 0.3 0 0.5c-0.1 0.2 -0.3 0.2 -0.3 0.5c0 0.3 -0.2 0.3 -0.3 0.6c-0.1 0.2 0 0.3 -0.1 0.5c-0.1 0.2 -0.1 0.2 -0.2 0.3c-0.1 0.1 0.3 1.1 0.3 1.1l-0.3 0c0 0 -0.3 -0.9 -0.3 -1c0 -0.1 -0.1 -0.2 -0.3 -0.2c-0.2 0 -0.3 0.1 -0.4 0.4c0 0.3 -0.2 0.8 -0.2 0.8l-0.3 0l0.3 -1c0 0 0.1 -0.6 -0.2 -0.5c-0.3 0.1 -0.2 -0.1 -0.4 -0.1c-0.2 -0.1 -0.3 0.1 -0.4 0c-0.2 -0.1 -0.3 0.1 -0.5 0c-0.2 -0.1 -0.1 0 -0.3 0.3c-0.2 0.3 -0.4 0.3 -0.4 0.3l0.2 1.1l-0.3 0l-0.2 -1.1c0 0 -0.4 -0.6 -0.5 -0.4c-0.1 0.3 -0.1 0.4 -0.3 0.4c-0.1 -0.1 -0.2 1.1 -0.2 1.1l-0.3 0l0.2 -1.1c0 0 -0.3 -0.1 -0.3 -0.5c0 -0.3 0.1 -0.5 0.1 -0.7c0.1 -0.2 -0.1 -1 -0.2 -1.1c-0.1 -0.2 -0.2 -0.8 -0.2 -0.8c0 0 -0.1 -0.5 0.4 -0.8z"
  
          person =
              "M1.7 -1.7h-0.8c0.3 -0.2 0.6 -0.5 0.6 -0.9c0 -0.6 -0.4 -1 -1 -1c-0.6 0 -1 0.4 -1 1c0 0.4 0.2 0.7 0.6 0.9h-0.8c-0.4 0 -0.7 0.3 -0.7 0.6v1.9c0 0.3 0.3 0.6 0.6 0.6h0.2c0 0 0 0.1 0 0.1v1.9c0 0.3 0.2 0.6 0.3 0.6h1.3c0.2 0 0.3 -0.3 0.3 -0.6v-1.8c0 0 0 -0.1 0 -0.1h0.2c0.3 0 0.6 -0.3 0.6 -0.6v-2c0.2 -0.3 -0.1 -0.6 -0.4 -0.6z"
      in
      M.fromList [ ( "cow", cow ), ( "pig", pig ), ( "sheep", sheep ), ( "person", person ) ]
  
  
  
  {- Grid of selectable person icons.
     Inspired by Alan Smith's D3 example http://bl.ocks.org/alansmithy/d832fc03f6e6a91e99f4
     and based around Amit Kapoor's unit chart example https://bl.ocks.org/amitkaps/d6648bd8ddb1c1e3706d7530126d1e2b
  -}
  
  
  personGrid :: VegaLite
  personGrid =
      let
          config =
              configure
                  . configuration (ViewStyle [ViewNoStroke])
                  . configuration (Axis [Disable True])
  
          dataVals =
              dataFromColumns []
                  . dataColumn "id" (Numbers [1 .. 100])
  
          trans =
              transform
                  . calculateAs "ceil (datum.id/10)" "col"
                  . calculateAs "datum.id - datum.col*10" "row"
  
          sel =
              selection
                  . select "highlight" Interval []
  
          mpath = M.lookup "person" isotypes
          enc =
              encoding
                  . position X [ PName "col", PmType Ordinal]
                  . position Y [ PName "row", PmType Ordinal]
                  . shape [ MPath (fromMaybe "circle" mpath) ]
                  . color
                      [ MSelectionCondition (SelectionName "highlight")
                          [ MString "rgb(194,81,64)" ]
                          [ MString "rgb(167,165,156)" ]
                      ]
                  . size [ MNumber 90 ]
      in
      toVegaLite
          [ config []
          , width 400
          , height 400
          , dataVals []
          , trans []
          , mark Point [ MFilled True ]
          , enc []
          , sel []
          ]
  
  
  point1 :: VegaLite
  point1 = pointChart "square-unfilled" False SymSquare
  
  
  point2 :: VegaLite
  point2 = pointChart "cross-filled" True SymCross
  
  
  point3 :: VegaLite
  point3 = pointChart "diamond-unfilled" False SymDiamond
  
  
  -- not going to try all the triangles
  point4 :: VegaLite
  point4 = pointChart "triangle-unfilled" False SymTriangle
  
  
  point5 :: VegaLite
  point5 = pointChart "stroke-unfilled" False SymStroke
  
  
  point6 :: VegaLite
  point6 = pointChart "arrow-filled" True SymArrow
  
  
  point7 :: VegaLite
  point7 = pointChart "wedge-unfilled" False SymWedge
  
  
  rectTest :: [MarkProperty] -> VegaLite
  rectTest mps =
    let dvals = dataFromUrl "https://vega.github.io/vega-lite/data/cars.json" []
        enc = encoding
              . position X [ PName "Origin", PmType Nominal ]
              . position Y [ PName "Cylinders", PmType Ordinal ]
  
        -- using MSize here returns the warning
        -- 'Cannot apply size to non-oriented mark "rect".'
        -- from Vega Embed. If we take it out the visualization doesn't
        -- "look as good".
        --
        rect = mark Rect (MSize 30 : MOpacity 0.6 : mps)
  
    in toVegaLite [ width 200, height 200, dvals, enc [], rect ]
  
  
  rounded1, rounded2, rounded3, rounded4, rounded5, rounded6 :: VegaLite
  rounded1 = rectTest [ MCornerRadius 8 ]
  rounded2 = rectTest [ MCornerRadiusTL 8 ]
  rounded3 = rectTest [ MCornerRadiusTR 8 ]
  rounded4 = rectTest [ MCornerRadiusBL 8 ]
  rounded5 = rectTest [ MCornerRadiusBR 8 ]
  rounded6 = rectTest [ MCornerRadius 16, MCornerRadiusBL 0, MCornerRadiusTR 0 ]
  
  
  symbols1 :: VegaLite
  symbols1 =
    let dvals = dataFromColumns []
                . dataColumn "x" (Numbers [ 0 ])
  
        shapeSpec sym = asSpec [ mark Point [ MFilled True
                                            , MStroke "black"
                                            , MSize 400
                                            , MShape sym
                                            , MStrokeWidth 0.5
                                            ]
                               ]
  
        shapeList = [ SymCircle, SymSquare, SymDiamond, SymCross
                    , SymTriangleUp, SymTriangleDown, SymTriangleLeft
                    , SymTriangleRight, SymTriangle, SymArrow
                    , SymWedge, SymStroke, SymPath "M -1 -1 L 1 1" ]
  
        shapes = map shapeSpec shapeList
  
    in toVegaLite [ dvals []
                  , columns 4
                  , vlConcat shapes
                  ]
  
  symbols2 :: VegaLite
  symbols2 =
    chart "Legend using non-default bordered square symbols"
          (color [ MName "Origin"
                 , MmType Nominal
                 , MLegend [ LSymbolType SymSquare
                           , LSymbolStrokeColor "black"
                           , LSymbolStrokeWidth 0.5
                           ]
                 ]
          )
  
  
  windvector :: VegaLite
  windvector =
    let dvals = dataFromUrl "https://vega.github.io/vega-lite/data/windvectors.csv" []
  
        enc = encoding
              . position X [PName "longitude", PmType Ordinal, PAxis []]
              . position Y [PName "latitude", PmType Ordinal, PAxis []]
              . color [ MName "dir"
                      , MmType Quantitative
                      , MScale [SDomain (DNumbers [0, 360]), SScheme "rainbow" []]
                      , MLegend []
                      ]
              . angle [ MName "dir"
                      , MmType Quantitative
                      , MScale [SDomain (DNumbers [0, 360]), SRange (RPair 180 540)]
                      ]
              . size [MName "speed", MmType Quantitative]
  
    in toVegaLite [ dvals
                  , mark Point [MShape SymWedge]
                  , enc []
                  , configure
                    . configuration (ViewStyle [ ViewFill "black"
                                               , ViewStep 10 ])
                    $ []
                  ]
  