diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,97 @@ For the latest version of this document, please see [https://github.com/DougBurke/hvega/blob/master/hvega/CHANGELOG.md](https://github.com/DougBurke/hvega/blob/master/hvega/CHANGELOG.md). +## 0.12.0.7 + +Bump to support containers version 0.7. + +## 0.12.0.6 + +Bump to support text version 2.1. This appears to have been un-released, +so is a secret just between you and I. + +## 0.12.0.5 + +Bump to support bytestring version 0.12.0.0 (only needed if building +the tests). + +## 0.12.0.4 + +Bump to support aeson version 2.2 (tests may require building with +the --allower-newer=aeson option). + +## 0.12.0.3 + +Bump to support aeson version 2.1. + +## 0.12.0.2 + +Bump to support text version 2.0. All hail our new UTF-8 rulers. + +## 0.12.0.1 + +Bump to support bytestring version 0.11 for testing `hvega`. There +are no changes to the code. + +## 0.12.0.0 + +Support aeson version 2.0. There is currently no significant change to +the API but it is expected that in a future release there will be when +we wil require a minimum version of 2.0 for aeson. + +At the time of release of 0.12.0.0 the tests will fail when using +aeson >= 2.0 because `aeson-pretty` has not yet been updated (see +https://github.com/informatikr/aeson-pretty/issues/36). + +## 0.11.0.1 + +There is no change in the code, only the tests, which should now +pass when using hashable 0.3.1.0. + +## 0.11.0.0 + +The Vega-Lite tests are now validated against version 4.15 of the +Vega-Lite schema. + +Note that `hvega` does __not__ provide any information to help users +take advantage of the (new to 4.14) ability to omit the type of a +field when [it can be inferred](https://vega.github.io/vega-lite/docs/type.html). +As the type is currently optional in `hvega` users can just not give a type. +The example [IHaskell notebooks](https://github.com/DougBurke/hvega/tree/master/notebooks) +have been updated to show off the optional support. + +Similarly, Vega-Lite 4.14 allows you to share the type, scale, axis, +and legend in a shared encoding. There is no explicit support added in +0.11.0.0 because `hvega` already allowed you to create the specification. + +### New Constructors + +The `OrderChannel` type has gained `OBand`, `OTitle`/`ONoTitle`, +and conditional-predicate support with `ODataCondition`, +`OSelectionCondition`, and `ONumber` constructors. + +The `MarkChannel` type has gained the `MNullValue` constructor. + +The `ScaleRange` type has gained `RField`, `RMax`, and `RMin` +constructors. + +### Breaking Changes + +Domain settings in `ScaleProperty` and associated types have been +changed to better match the Vega-Lite schema: `SDomain` now takes +a new type (`DomainLimits`) which actually contains many of the +orignal symbols (so hopefully will require no changes), and a new +constructor has been added (`SDomainOpt`) which takes the +`ScaleDomain` type, which has seen new constructors - `DMax`, +`DMaxTime`, `DMid`, `DMin`, and `DMinTime` - as well as +some constructors moving to `DomainLimits`. + +### Deprecated symbols + +The `SDomainMid` constructor of `ScaleProperty` will be removed in a +future release as it has been replaced by the `DMid` constructor +in `ScaleDomain`. + ## 0.10.0.0 The Vega-Lite tests are now validated against version 4.13 of the @@ -21,7 +112,7 @@ Month` has been changed to `PTimeUnit (TU Month)` and `SNice NMinute` has changed to `SNice (NTU NMinute)`. -The `BaseTimeUnit' type has seen a number of additions: the `Week` and +The `BaseTimeUnit` type has seen a number of additions: the `Week` and `DayOfYear` time units added in Vega-Lite 4.13.0, along with the associated composite units (such as `YearWeek`), and a number of composite types that were missing (such as `MonthDateHours`). The @@ -62,7 +153,7 @@ The `angle` encoding channel has been added for text and point marks. The `Channel` type has gained `ChAngle`, `ChTheta`, `ChTheta2`, -`ChRadius`, `ChRadius`', 'ChDescription', and `ChURL`. +`ChRadius`, `ChRadius`, `ChDescription`, and `ChURL`. Layers have been added to `Arrangement` (`Layer`) and to `RepeatFields` (`LayerFields`). @@ -830,7 +921,7 @@ optional field name, to allow them to be used as part of an encoding aggregation (e.g. with `PAggregate`). -The "z index" value has changed from an 'Int' to the 'ZIndex' type. +The "z index" value has changed from an `Int` to the `ZIndex` type. The constructors for the `Symbol` type now all start with `Sym`, so `Cross`, `Diamond`, `TriangleUp`, `TriangleDown`, and `Path` have been @@ -838,7 +929,7 @@ `SymTriangleDown`, and `SymPath`, respectively. The `Legend` type has been renamed `LegendType` and its constructors -have been renamed 'GradientLegend' and 'SymbolLegend'. +have been renamed `GradientLegend` and `SymbolLegend`. ### Improved testing diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,9 +1,13 @@ + # hvega -[![vega-lite version](https://img.shields.io/badge/Vega--Lite-v4.13-purple.svg)](https://vega.github.io/vega-lite/) +[![Hackage](https://img.shields.io/hackage/v/hvega.svg)](https://hackage.haskell.org/package/hvega) +[![vega-lite version](https://img.shields.io/badge/Vega--Lite-v4.15-purple.svg)](https://vega.github.io/vega-lite/) +[![GitHub CI](https://github.com/DougBurke/hvega/workflows/hvega-CI/badge.svg)](https://github.com/DougBurke/hvega/actions) +[![Dependencies status](https://img.shields.io/hackage-deps/v/hvega.svg)](http://packdeps.haskellers.com/feed?needle=hvega) Create [Vega-Lite](https://vega.github.io/vega-lite/) visualizations in -Haskell. It targets version 4.13 of the Vega-Lite specification. Note that +Haskell. It targets version 4.15 of the Vega-Lite specification. Note that the module does not include a viewer for these visualizations (which are JSON files), but does provide several helper functions, such as [toHtmlFile](https://hackage.haskell.org/package/hvega/docs/Graphics-Vega-VegaLite.html#v:toHtmlFile), @@ -39,7 +43,7 @@ enc = encoding . position X [ PName "Horsepower", PmType Quantitative ] . position Y [ PName "Miles_per_Gallon", PmType Quantitative, PTitle "Miles per Gallon" ] - . color [ MName "Origin", MmType Nominal ] + . color [ MName "Origin" ] bkg = background "rgba(0, 0, 0, 0.05)" @@ -48,7 +52,7 @@ When the JSON is viewed with a Vega-Lite aware viewer, the resultant plot can be interacted with (e.g. to use the tooltip support) using the -[interactive version](https://vega.github.io/editor/#/url/vega-lite/N4IgtghgTg1iBcoAuB7FAbJBLADg0AxigHZICmpCIFRAJlsQOYgC+ANCEgJ45lUFYoBdH3YhaEJBHwgArlHRUAFkiQ4AzvAD0WgG5lGEAHSMsSJbIBGRrCj0GIAWglT1ZJOq0uIWgtHVGAFbqJKwcACTqBEpkkMqqGtr2hiZmFta2WlExkMlO6GZkegAsQSHEIBw0KPRMMkToKFAyAGZYZOi0VADyUFimFRzcvFTEKGAMEIpiAB6t7Z1UABJNbjgoAO5kzUM8fPAgAI6yEKRmklj6YSBc8x1dBwCyWCLqAPq8UG8A4lONg5wzCIqM9XgACT5g37of6VTh7KjHU7YKTYK4sMSWCAEGCMKAoWTEB4gKCMLEACgADGxqbSjJSAKwASlYQA). +[interactive version](https://vega.github.io/editor/#/url/vega-lite/N4IgtghgTg1iBcoAuB7FAbJBLADg0AxigHZICmpCIFRAJlsQOYgC+ANCEgJ45lUFYoBdH3YhaEJBHwgArlHRUAFkiQ4AzvAD0WgG5lGEAHSMsSJbIBGRrCj0GIAWglT1ZJOq0uIWgtHVGAFbqJKwcACTqBEpkkMqqGtr2hiZmFta2WlExkMlO6GZkegAsQSHEIBw0KPRMMkToKFAyAGZYZOi0VADyUFimFWIAHq3tnVQAEk1uOCgA7mTNHNy8VACOshCkZpJY+mEgXKMdXfAgALJYIuoA+rxQNwDiEOiNFctmIlSX1wAE979nq9QsseHwzhsttgpNh9iwxJYIAQYIwoChZMRTiAoIxEQAKAAMbF+RJJxIJRgJAFYAJSsIA). It can also be viewed as a PNG: ![Simple scatterplot](https://raw.githubusercontent.com/DougBurke/hvega/master/hvega/images/example-car.png "Simple scatterplot") @@ -63,7 +67,8 @@ at some point, and so there was [some speculation](https://en.wikipedia.org/wiki/Betelgeuse#2019%E2%80%932020_fading) that we could see a "naked-eye" supernova (even though the current models -suggest that Betelgeuse has about 100,000 more years to go before this happens). +suggest that Betelgeuse has about 100,000 more years to go before this happens, +and the rapid brightening in mid 2023 has also got some people's hopes up). This interest lead to a lot of observations added to the [American Association of Variable Star Observers](https://www.aavso.org/) database, which we are going to look at below. This example is rather-more @@ -76,12 +81,12 @@ w = width 600 h = height 150 - pos1Opts fld ttl = [PName fld, PmType Quantitative, PAxis [AxTitle ttl]] + pos1Opts fld ttl = [PName fld, PmType Quantitative, PTitle ttl] x1Opts = pos1Opts "days" "Days since January 1, 2020" y1Opts = pos1Opts "magnitude" "Magnitude" ++ [PSort [Descending], yRange] yRange = PScale [SDomain (DNumbers [-1, 3])] - filtOpts = [MName "filterName", MmType Nominal] + filtOpts = [MName "filterName"] filtEnc = color (MLegend [ LTitle "Filter", LTitleFontSize 16, LLabelFontSize 14 ] : filtOpts) . shape filtOpts @@ -93,8 +98,8 @@ . filtEnc selName = "brush" - pos2Opts fld = [PName fld, PmType Quantitative, PAxis [AxNoTitle], - PScale [SDomain (DSelectionField selName fld)]] + pos2Opts fld = [PName fld, PmType Quantitative, PNoTitle, + PScale [SDomainOpt (DSelectionField selName fld)]] x2Opts = pos2Opts "days" y2Opts = pos2Opts "magnitude" ++ [PSort [Descending]] @@ -132,7 +137,6 @@ details = asSpec [ columns 1 , facetFlow [ FName "filterName" - , FmType Nominal , FHeader headerOpts ] , spacing 10 @@ -155,7 +159,7 @@ This can be viewed as - - an [interactive version](https://vega.github.io/editor/#/url/vega-lite/N4KABGBEAuBOCGA7AzgMwPawLaQFxgG1wIxhJUBLAG2gFNY8oATeaAVywDpKb6A5eFloEADAF0wAXmlgA5ADVZkAL4AaYhDI86DfJBbsuWeAHNEFdk1pgAPGAAsK9SVKR4yRvvgBPD6qgAxvBUAWxUrLSeBhycAFZMYAC0YABM9gCsAByZ9gCcnCIqxGLOgeiIlCaMoC5uAB4UHvg1LlDQFlS0AGLl0ADqtBQmABbQnoiYxlSQpbXhAEa0VD2I0ADKFABekfgAjPazJDAd3b0b24y7AGwaYMrEasRe0PDVt5BssNN6o9AADshcAB6IEIADunBMFmGbHmbGQ9ACvVoq04SKwQIAIug2CYAEKfADWtCBwwAbrQTPAgcZkDpSRSqUCDNTFnQqCZaPDaIkUiI+YkRABmRK7fKxZDlSAPUqQMlIxBBMb4IguFq1YaDEbKsC7dIiQ4QSDGWCE6qQdB-eABCzeRgiTjpfwwbx-HZQP7oCirGZQHidJiMVDBBGPVpQMEUJjQYaMK4iA23I0IzoBdpS5pJo7zWDw2OZ8O1b0Wc11RgEXl8-y7BMlKB2lWCx3+FKOsRhwtGlFIpjekxNQiQMvOu0lLO1aCu92Qb06MnBaWd+7hju1bvoXuIKoFwuQJFUTBvTtGyhLQN6bT8QSRQ2tF1u8boLDehe3uaUlHn0jju8LJYrdYtndfY3zvdpoE6TwumoHQZh-CcTgA85gJuY87h-Vc72QYZ4AfZpyAoM9PEvWABCEX172nCZn0QBdMNqMsd07AiiL0FhfDgtDKM8ABHNgkHA1gKApTjj3qRpzXAyC9ExHxkDAZBvQCawACkkH42BvF1Ft+UKZdC3oo4G2-LjTyoL9jVMcxLBveCoGQIJpNcJgn3gb1y1FfwhXbUDk0wHV9FoBzPz7UTmMnPCoD4gSLCEkTfKgeAGgHMgpOnABZKyLDYKwiiXLN9IgTD1SOZA3QCI9d01IZRkufVQMs01zUta1bXtZs2inTxPVnCj-VoL9gyoUMGsjaN8zAeNE2Y9dN23EyxP3Q8mLEsyLJIsjbLQo0Iqop8X2mBKjU6TlEC-EquL-ZYziAy4DjshCIOnaDeAYI6jjSpDbr2VDtsKgyEsgbDcPdLRCPM4iYKvcjnV2x8aLowHGIW0zwYs9i-Ae+zHNB-RXPc-C1qiOSKJTWg0woDMoBzPMVEM8NuL0aLVli9p4qx8SUuOJ7GEQMIqH+ldAeMi7dyJvRjDMbLcveoGcfNFzjAJ1xxagSXrJym97KWcn00QTwaewunZclWAAqsYKztC2W4aZ-iWZeNmtu2znJJOXn+cF1ovaKgrbz3dAqA4FBLn94NlJ1UWTzRyHXs2sK701eArF0FHdyugBBRVhmWqBPwThmroAUTqP5U8gWQXp0fBZDAABqMBoi4K6C9-eBFioAAFZO5sYXl7su9v-xui4fsBtKPaoKhAczqghn1vRYBqsYMIa22oGog7F29-2ytardLhEW59LHI0ABIHM1YxPF+AFgSBRl4EhaFYU4SmgUv2hjAfyl4ESOe6AP3sHESU+tZQTxWjAWgdQAp4loOyD83JZDyXVtLawQh3CfC-iiaAyB-D7nCHQBI8wtIZwzvINYAB5BO5AR7AUyDKJ4FsAhLz+HrTwAAJdAYIwA4XknA9knIkHyRzMvRAQV5LziXgNfw8x3ADTAOURurB4BgAIREYhpDyFULAAAClvoCEEYJjGcHgPAMkkpOCYBMECAAlJwMAABNHECkc5hASCGdAYADzoEJGAVgvDoD-EMUCaAkYgn0DRE+IEbIljzHQNAfxZ1AnBPvlCGMr90SkgoH8P4xIYnwLiQkhxABJRJYJ3D+KnmAGM1gECckUYgBS6AbTBDAEIXsqiAm1IUi8M2ijUCpF0pwaUyggA) + - an [interactive version](https://vega.github.io/editor/#/url/vega-lite/N4IgLgTghgdgzgMwPYQLYgFwG1QIJYA2YAphJiACZRgCuqAdPkaQHJSrFYAMAugAQBeIXwDkANREgAvgBpchEmQyVqdeqigBzGHloVifADx8ALNLkgocclQCe1mSADGUAk5oFqxG6oYArCj4AWj4AJhMAVgAOKJMATnouaR5HJyQYfE1MUCgADzxrDFAwXQJiADF0sAB1YjxNAAswchgUDQIQR08AI2ICSpgwAGU8AC9vDABGE0cSsDKB4bGJyYA2KVkVMChskBoIDuUmsAAHOAwAegvoAHd6TV0Gmm6aOFI0weJB+jTUC4ARJA0TQAIX2AGtiBcGgA3YiaKAXDRwRTQuEIi5UbYXXokAiaYivYhBUJcUlBLgAZiCkwSfjg6XMIBhHxczWwoAadUa7MmES4jg0EHBuyQJygTl0tkwXHoEVmthOExAJyQeEGnRATDKFEwCFcb02NzwFDADUwqy4ApAbzKThKjKKIG6EFe5qd6t0u1ymCwJNJMkmVpSIGl2ApcpkoTlPE2XzSFHVmkKWBAPsc0pDYEVyvVihhrmkcZgCaTuzSBBQu3wfV1yiYijYHE1ZQJMDroB6fUWI3GmGms1KyvKClImrmCyqvZW602cAaUCV1bwtfIDdY7G8mx9TprBDrKns46H5H+UHsfDg6qcBgAUrAaFAILY+JMZGEyUkFUvlABHR+DLo1B4HCTJhvIq7KBo2i6DQ+ianALhlLsFBIBo6q+jSMiUrGjgMhA7KUMQiFfImMBZIO8zKgAsloOh6N437Kv+sBzMBoEbLIoBwEqTi7Fy9RNP2-KCk+IpOmKEpSjKkbgDm5CqnmmrasQdb6gQhqOMaprupa1rxkgZFZE6FZVruK77muo4QE2jEgK2pG7F2-RTss-YzOAJ7KCOzBkJRk6DNO-aznhC4-hBln1tZtlMjuEUHnYDg2khEygKh6EwMukGHkltrEPaeCOs6rrzkW-kTDAHgEEx5AsYB2wlBxGZZZFIDQfRcF2YhripZQaFQBh5nZe1sHwXhfT5Q6mXKC6bplTaKCEfoJHtmW5WYJVBDVXJP4gHVbGNVuGypEgBB0PA-aOPqN7svFVm+TFjhclA+hKJ2UC9AQACCJYNGZICOV0H19AAorkJxKCAIg+YoGCiHwADUfBYmozktsDBAAAovUZmAkh5zk9m5UyrOtGCbdtzlfQQ9TTSAECCc0x02uKkrkf2XBSCGAAkiFcho5DHGclwXOiUD3I8zz0IVFx88QGii-CUBBDTJCiyY9D0oyZPFMQuSESCxB4vChJvCIcB8CNDGW8QVj7PLXxgHA74Vp4JCBN0L5fV9YhDAA8sprl9lMUSbMtTgMycU3kAAEkgNx8AuFuG3iBJEubfAuozMDERbBYM6p77dFYql8OkyPUFAfCu14Htez7-t8AAFEL5xXDcHf0FAUAwgy9AoJoFwAJT0HwACaQKXn9HiBAaSB8JWSDgnw1CJ2ApxtxcYDGuvpA-GhOJG303RIGAK-tmvG8iw8ZpS780J4CcJyQofeIn2Ao8AJJnzcVgr1tfAzQGGgASMuMBLxIElK4G2iYq6ryAZebYBEy4IA-KSeg0ggA) - as a PNG: diff --git a/default.nix b/default.nix --- a/default.nix +++ b/default.nix @@ -1,2 +1,50 @@ -{ nixpkgs ? import {}, compiler ? "ghc883" }: -nixpkgs.pkgs.haskell.packages.${compiler}.callPackage ./hvega.nix { } +{ sources ? import ../nix/sources.nix +, pkgs ? import sources.nixpkgs {} +, compiler ? "ghc928" +}: + +let + # There must be a better way than this! I just want to avoid + # excessive compilation when using a non-standard compiler. + # + isDefaultCompiler = compiler == "ghc8107"; # drop HLS for now + + # since we are in a sub-directory + # gitignore = pkgs.nix-gitignore.gitignoreSourcePure [ ./.gitignore ]; + gitignore = pkgs.nix-gitignore.gitignoreSourcePure [ ../.gitignore ]; + + myHaskellPackages = pkgs.haskell.packages.${compiler}.override { + overrides = hself: hsuper: { + "hvega" = + hself.callCabal2nix "hvega" (gitignore ./.) {}; + }; + }; + + shell = myHaskellPackages.shellFor { + packages = p: [ + p."hvega" + ]; + buildInputs = [ + pkgs.haskellPackages.cabal-install + pkgs.haskellPackages.hlint + pkgs.niv + ] ++ pkgs.lib.optionals isDefaultCompiler [ + pkgs.haskellPackages.haskell-language-server + ]; + withHoogle = isDefaultCompiler; + }; + + # exe = pkgs.haskell.lib.justStaticExecutables (myHaskellPackages."hvega"); + + # docker = pkgs.dockerTools.buildImage { + # name = "{{cookiecutter.project_name}}"; + # config.Cmd = [ "${exe}/bin/{{cookiecutter.project_name}}" ]; + # }; +in +{ + inherit shell; + # inherit exe; + # inherit docker; + inherit myHaskellPackages; + "hvega" = myHaskellPackages."hvega"; +} diff --git a/hvega.cabal b/hvega.cabal --- a/hvega.cabal +++ b/hvega.cabal @@ -1,5 +1,5 @@ name: hvega -version: 0.10.0.0 +version: 0.12.0.7 synopsis: Create Vega-Lite visualizations (version 4) in Haskell. description: This is based on the elm-vegalite package () @@ -10,7 +10,7 @@ license-file: LICENSE author: Douglas Burke maintainer: dburke.gw@gmail.com -copyright: 2018-2020 Douglas Burke +copyright: 2018-2023 Douglas Burke category: Graphics build-type: Simple extra-source-files: README.md @@ -18,7 +18,6 @@ stack.yaml default.nix shell.nix - hvega.nix tests/specs/axis/*.vl tests/specs/color/*.vl tests/specs/composite/*.vl @@ -160,8 +159,8 @@ Graphics.Vega.VegaLite.Time Graphics.Vega.VegaLite.Transform build-depends: base >= 4.9 && < 5 - , aeson >= 0.11 && < 1.6 - , text == 1.2.* + , aeson >= 0.11 && < 2.3 + , text >= 1.2 && < 2.2 , unordered-containers == 0.2.* default-language: Haskell2010 @@ -216,16 +215,18 @@ Gallery.Scatter Gallery.Table - build-depends: aeson >= 1.4.2 && < 1.6 + build-depends: aeson >= 1.4.2 , aeson-pretty == 0.8.* - , base >= 4 && < 5 - , bytestring == 0.10.* - , containers >= 0.5.7 && < 0.7 + , base + , bytestring >= 0.10 && < 0.13 + , containers >= 0.5.7 && < 0.8 , filepath , tasty , tasty-golden >= 2.2 && < 2.4 - , text == 1.2.* - , unordered-containers >= 0.2 && < 0.3 + , text + , unordered-containers + -- hvega is not needed with recent cabal's, but it's + -- not obvious if this is true with older versions , hvega default-language: Haskell2010 @@ -243,6 +244,8 @@ , bytestring , directory , filepath + -- hvega is not needed with recent cabal's, but it's + -- not obvious if this is true with older versions , hvega , text else diff --git a/hvega.nix b/hvega.nix deleted file mode 100644 --- a/hvega.nix +++ /dev/null @@ -1,24 +0,0 @@ -{ mkDerivation, aeson, aeson-pretty, base, bytestring, containers -, directory, filepath, http-conduit, stdenv, tagsoup, tasty -, tasty-golden, text, unordered-containers -}: -mkDerivation { - pname = "hvega"; - version = "0.10.0.0"; - src = ./.; - configureFlags = [ "-ftools" ]; - isLibrary = true; - isExecutable = true; - libraryHaskellDepends = [ aeson base text unordered-containers ]; - executableHaskellDepends = [ - aeson aeson-pretty base bytestring directory filepath http-conduit - tagsoup text - ]; - testHaskellDepends = [ - aeson aeson-pretty base bytestring containers filepath tasty - tasty-golden text unordered-containers - ]; - homepage = "https://github.com/DougBurke/hvega"; - description = "Create Vega-Lite visualizations (version 4) in Haskell"; - license = stdenv.lib.licenses.bsd3; -} diff --git a/shell.nix b/shell.nix --- a/shell.nix +++ b/shell.nix @@ -1,2 +1,3 @@ -{ nixpkgs ? import {}, compiler ? "ghc883" }: -(import ./default.nix { inherit nixpkgs compiler; }).env +{ compiler ? "ghc928" +}: +(import ./default.nix { compiler = compiler; }).shell diff --git a/src/Graphics/Vega/Tutorials/VegaLite.hs b/src/Graphics/Vega/Tutorials/VegaLite.hs --- a/src/Graphics/Vega/Tutorials/VegaLite.hs +++ b/src/Graphics/Vega/Tutorials/VegaLite.hs @@ -3,7 +3,7 @@ {-| Module : Graphics.Vega.Tutorials.VegaLite -Copyright : (c) Douglas Burke, 2019-2020 +Copyright : (c) Douglas Burke, 2019-2021 License : BSD3 Maintainer : dburke.gw@gmail.com @@ -19,7 +19,9 @@ . The tutorial targets version 4 of the Vega-Lite specification and -the functionality provided in version @0.9.0.0@ of hvega. +the functionality provided in version @0.12.0.0@ of hvega (although +a number of examples could be simplified by removing the +now-optional type information as of Vega-Lite 4.14). -} @@ -75,6 +77,7 @@ -- ** Adding color as an encoding , stripPlotWithColor + , stripPlotWithColor2 -- ** Comparing Ordinal with Nominal data types -- @@ -358,7 +361,8 @@ -- example, @elm-vegalite@ provides @pQuant n@ which in @hvega@ is the -- combination of @'PName' n@ and @'PmType' 'Quantitative'@ in @hvega@. -- The top-level functions - such as 'dataFromUrl', 'encoding', and --- 'filter' - are generally the same. +-- 'filter' - are generally the same. As the VegaLite schema has expanded +-- over time the differences between the two approaches has also grown. -- -- Version @0.5.0.0@ does introduce more-significant changes, in that -- there are now separate types for a number of functions - such as @@ -469,7 +473,7 @@ <> - + @ 'toVegaLite' @@ -492,7 +496,7 @@ this case we use the function 'position' to provide an encoding of the @\"plx\"@ field as the x-position in our plot. The precise way in which the data value (parallax) is mapped to the x-position will depend on the type of -data we are encoding. We can provide a hint by delcaring the +data we are encoding. We can provide a hint by declaring the measurement type of the data field, here 'Quantitative' indicating a numeric measurement type. The final parameter of position is a list of any additional encodings in our specification. Here, with only one @@ -543,7 +547,7 @@ <> - + @ let enc = encoding @@ -586,7 +590,7 @@ <> - + @ let enc = encoding @@ -639,7 +643,7 @@ 'dataFromRows' - or directly from JSON (as a 'Data.Aeson.Value') using 'dataFromJson'. -Examples showing 'dataFromColumns' are the 'pieChart' and'skyPlotWithGraticules' plots, +Examples showing 'dataFromColumns' are the 'pieChart' and 'skyPlotWithGraticules' plots, but let's not peak ahead! -} @@ -661,7 +665,7 @@ <> - + @ let enc = encoding @@ -706,7 +710,47 @@ , enc [] ] +{-| +As of Vega-Lite version 4.14 we can now drop the type information when +it can be inferred. I am a little hazy of the rules, so I am going to +include the information (as it also means I don't have to change +the existing code!). However, as an example, we don't need to +add the @MmType Nominal@ setting to the 'color' channel, since the +following creates the same visualization as 'stripPlotWithColor': + + + +@ +let enc = encoding + . position X [ PName \"plx\", PmType Quantitative, 'PTitle' \"Parallax (mas)\" ] + . 'color' [ 'MName' \"Cluster\" ] + +in toVegaLite + [ gaiaData + , mark Tick [] + , enc [] + ] +@ + +Note that as well as removing @MmType Nominal@ from the 'color' encoding, I have +switched to the 'PTitle' option (which is the same as @PAxis [AxTitle ...]@. + +-} + +stripPlotWithColor2 :: VegaLite +stripPlotWithColor2 = + let enc = encoding + . position X [ PName "plx", PmType Quantitative, PTitle "Parallax (mas)" ] + . color [ MName "Cluster" ] + + in toVegaLite + [ gaiaData + , mark Tick [] + , enc [] + ] + + -- $stripplot-mmtype -- It is instructive to see what happens if we change the mark type for -- the color encoding from 'Nominal' to 'Ordinal'. @@ -715,7 +759,7 @@ <> - + @ let enc = encoding @@ -747,7 +791,7 @@ -- $pie-chart -- Before adding a second axis, let's temporarily look at another --- \"one dimensiona" chart, namel the humble pie chart. +-- \"one dimensiona" chart, namely the humble pie chart. -- The 'Arc' mark type allows you to create pie charts, as well as more -- complex visualizations which we won't discuss further in this -- tutorial. @@ -3972,7 +4016,7 @@ <> - + The image was captured after panning and zooming in the \"parallax-RA_ICRS\" plot. @@ -4069,7 +4113,8 @@ ] . position Y [ PName \"plx\" , PmType Quantitative - , PScale [ SDomain ('DSelection' \"brush\") ] + -- prior to 0.11.0.0 this was 'SDomain' + , PScale [ 'SDomainOpt' ('DSelection' \"brush\") ] ] . color [ MName \"Cluster\", MmType Nominal ] @@ -4115,7 +4160,7 @@ ] . position Y [ PName "plx" , PmType Quantitative - , PScale [ SDomain (DSelection "brush") ] + , PScale [ SDomainOpt (DSelection "brush") ] ] . color [ MName "Cluster", MmType Nominal ] @@ -4236,42 +4281,34 @@ <> - + @ let simplify = transform . filter (FExpr \"(datum.DE_ICRS >= 0) & (datum.DE_ICRS <= 40)\") - rawEnc = encoding - . position X [ PName \"Gmag\" - , PmType Quantitative - , PScale [ SZero False ] - ] - . position Y [ PName \"plx\" - , PmType Quantitative - , PScale [ SZero False ] - ] + baseEnc = encoding + . position X [ PName \"Gmag\" + , PmType Quantitative + , PScale [ SZero False ] + ] + . position Y [ PName \"plx\" + , PmType Quantitative + , PScale [ SZero False ] + ] + + rawEnc = baseEnc . color [ MName \"Cluster\" - , MmType Nominal , MLegend [] ] rawLayer = asSpec [ rawEnc [], mark Point [] ] trans = transform - . 'loess' \"plx\" \"Gmag\" [ 'LsAs' \"x\" \"y\" - , 'LsGroupBy' [ \"Cluster\" ] ] - - trendAx pos lbl = position pos [ PName lbl - , PmType Quantitative - , PAxis [] - ] - trendEnc = encoding - . trendAx X \"x\" - . trendAx Y \"y\" + . 'loess' \"plx\" \"Gmag\" [ 'LsGroupBy' [ \"Cluster\" ] ] trendLayer = asSpec [ trans [] - , trendEnc [] + , baseEnc [] , mark Line [ MStroke \"black\" , MStrokeWidth 2 ] @@ -4306,36 +4343,28 @@ let simplify = transform . filter (FExpr "(datum.DE_ICRS >= 0) & (datum.DE_ICRS <= 40)") - rawEnc = encoding - . position X [ PName "Gmag" - , PmType Quantitative - , PScale [ SZero False ] - ] - . position Y [ PName "plx" - , PmType Quantitative - , PScale [ SZero False ] - ] - . color [ MName "Cluster" - , MmType Nominal - , MLegend [] - ] + baseEnc = encoding + . position X [ PName "Gmag" + , PmType Quantitative + , PScale [ SZero False ] + ] + . position Y [ PName "plx" + , PmType Quantitative + , PScale [ SZero False ] + ] + rawEnc = baseEnc + . color [ MName "Cluster" + , MLegend [] + ] + rawLayer = asSpec [ rawEnc [], mark Point [] ] trans = transform - . loess "plx" "Gmag" [ LsAs "x" "y" - , LsGroupBy [ "Cluster" ] ] - - trendAx pos lbl = position pos [ PName lbl - , PmType Quantitative - , PAxis [] - ] - trendEnc = encoding - . trendAx X "x" - . trendAx Y "y" + . loess "plx" "Gmag" [ LsGroupBy [ "Cluster" ] ] trendLayer = asSpec [ trans [] - , trendEnc [] + , baseEnc [] , mark Line [ MStroke "black" , MStrokeWidth 2 ] @@ -4364,42 +4393,28 @@ <> - + @ let simplify = transform . filter (FExpr \"(datum.DE_ICRS >= 0) & (datum.DE_ICRS <= 40)\") - rawAx pos lbl = position pos [ PName lbl - , PmType Quantitative - , PScale [ SZero False ] - ] - cluster = color [ MName \"Cluster\" - , MmType Nominal - ] - - rawEnc = encoding - . rawAx X \"Gmag\" - . rawAx Y \"plx\" - . cluster + axis pos lbl = position pos [ PName lbl + , PmType Quantitative + , PScale [ SZero False ] + ] + enc = encoding + . axis X \"Gmag\" + . axis Y \"plx\" + . color [ MName \"Cluster\" ] - rawLayer = asSpec [ rawEnc [], mark Point [] ] + rawLayer = asSpec [ enc [], mark Point [] ] trans = transform - . 'regression' \"plx\" \"Gmag\" [ 'RgAs' \"x\" \"y\" - , 'RgGroupBy' [ \"Cluster\" ] ] - - trendAx pos lbl = position pos [ PName lbl - , PmType Quantitative - , PAxis [] - ] - trendEnc = encoding - . trendAx X \"x\" - . trendAx Y \"y\" - . cluster + . 'regression' \"plx\" \"Gmag\" [ 'RgGroupBy' [ \"Cluster\" ] ] trendLayer = asSpec [ trans [] - , trendEnc [] + , enc [] , mark Line [ MStroke \"black\" , MStrokeWidth 2 ] @@ -4424,36 +4439,22 @@ let simplify = transform . filter (FExpr "(datum.DE_ICRS >= 0) & (datum.DE_ICRS <= 40)") - rawAx pos lbl = position pos [ PName lbl - , PmType Quantitative - , PScale [ SZero False ] - ] - cluster = color [ MName "Cluster" - , MmType Nominal - ] - - rawEnc = encoding - . rawAx X "Gmag" - . rawAx Y "plx" - . cluster + axis pos lbl = position pos [ PName lbl + , PmType Quantitative + , PScale [ SZero False ] + ] + enc = encoding + . axis X "Gmag" + . axis Y "plx" + . color [ MName "Cluster" ] - rawLayer = asSpec [ rawEnc [], mark Point [] ] + rawLayer = asSpec [ enc [], mark Point [] ] trans = transform - . regression "plx" "Gmag" [ RgAs "x" "y" - , RgGroupBy [ "Cluster" ] ] - - trendAx pos lbl = position pos [ PName lbl - , PmType Quantitative - , PAxis [] - ] - trendEnc = encoding - . trendAx X "x" - . trendAx Y "y" - . cluster + . regression "plx" "Gmag" [ RgGroupBy [ "Cluster" ] ] trendLayer = asSpec [ trans [] - , trendEnc [] + , enc [] , mark Line [ MStroke "black" , MStrokeWidth 2 ] diff --git a/src/Graphics/Vega/VegaLite.hs b/src/Graphics/Vega/VegaLite.hs --- a/src/Graphics/Vega/VegaLite.hs +++ b/src/Graphics/Vega/VegaLite.hs @@ -1,6 +1,6 @@ {-| Module : Graphics.Vega.VegaLite -Copyright : (c) Douglas Burke, 2018-2020 +Copyright : (c) Douglas Burke, 2018-2021 License : BSD3 Maintainer : dburke.gw@gmail.com @@ -14,14 +14,10 @@ it has been updated to match later versions. This module allows users to create a Vega-Lite specification, targeting __version 4__ of the . -Version 0.10 of @hvega@ supports version 4.13 of the Vega-Lite specification. +Version 0.12 of @hvega@ supports version 4.15 of the Vega-Lite specification. -Although this is based on the Elm module, there are differences, such -as using type constructors rather than functions for many properties - -such as @'VL.PName' \"HorsePower\"@ rather than @pName \"HorsePower\"@ - -and the return value of 'VL.toVegaLite'. The intention is to keep close -to the Elm module, but it is more a guide than an absolute -requirement! +Although this was based on the Elm module, there have been a number of +changes - on both sides. Please see "Graphics.Vega.Tutorials.VegaLite" for an introduction to using @hvega@ to create visualizations. The @@ -65,7 +61,7 @@ enc = 'VL.encoding' . 'VL.position' 'VL.X' [ 'VL.PName' \"Horsepower\", 'VL.PmType' 'VL.Quantitative' ] . 'VL.position' 'VL.Y' [ 'VL.PName' \"Miles_per_Gallon\", 'VL.PmType' 'VL.Quantitative', 'VL.PTitle' \"Miles per Gallon\" ] - . 'VL.color' [ 'VL.MName' \"Origin\", 'VL.MmType' 'VL.Nominal' ] + . 'VL.color' [ 'VL.MName' \"Origin\" ] bkg = 'VL.background' \"rgba(0, 0, 0, 0.05)\" @@ -92,7 +88,7 @@ The visualization can be viewed in the Vega Editor, which lets you interact with the plot and modify its contents, as shown for -. +. It can also be viewed as a PNG version: @@ -156,7 +152,7 @@ -- Define the properties used for the "position" channels. For this example -- it makes sense to define as functions since they are used several times. -- - pos1Opts fld ttl = ['VL.PName' fld, 'VL.PmType' 'VL.Quantitative', 'VL.PAxis' ['VL.AxTitle' ttl]] + pos1Opts fld ttl = ['VL.PName' fld, 'VL.PmType' 'VL.Quantitative', 'VL.PTitle' ttl] x1Opts = pos1Opts \"days\" \"Days since January 1, 2020\" y1Opts = pos1Opts \"magnitude\" \"Magnitude\" ++ ['VL.PSort' ['VL.Descending'], y1Range] y1Range = 'VL.PScale' ['VL.SDomain' ('VL.DNumbers' [-1, 3])] @@ -164,7 +160,7 @@ -- The filter name is used as a facet, but also to define the -- color and shape of the points. -- - filtOpts = ['VL.MName' \"filterName\", 'VL.MmType' 'VL.Nominal'] + filtOpts = ['VL.MName' \"filterName\"] filtEnc = 'VL.color' ('VL.MLegend' ['VL.LTitle' \"Filter\", 'VL.LTitleFontSize' 16, 'VL.LLabelFontSize' 14] : filtOpts) . 'VL.shape' filtOpts @@ -199,8 +195,8 @@ -- What is plotted in the "detail" plot? -- selName = \"brush\" - pos2Opts fld = [ 'VL.PName' fld, 'VL.PmType' 'VL.Quantitative', 'VL.PAxis' ['VL.AxNoTitle'] - , 'VL.PScale' ['VL.SDomain' ('VL.DSelectionField' selName fld)] ] + pos2Opts fld = [ 'VL.PName' fld, 'VL.PmType' 'VL.Quantitative', 'VL.PNoTitle' + , 'VL.PScale' ['VL.SDomainOpt' ('VL.DSelectionField' selName fld)] ] x2Opts = pos2Opts \"days\" y2Opts = pos2Opts \"magnitude\" ++ ['VL.PSort' ['VL.Descending']] @@ -231,7 +227,6 @@ -- details = 'VL.asSpec' [ 'VL.columns' 1 , 'VL.facetFlow' [ 'VL.FName' \"filterName\" - , 'VL.FmType' 'VL.Nominal' , 'VL.FHeader' headerOpts ] , 'VL.spacing' 10 @@ -266,7 +261,7 @@ However this is missing the interactive elements of the visualization, primarily selection and zooming in the top plot changes the axis ranges of the bottom two plots. This interactivity requires a Vega-Lite viewer such as -. +. -} @@ -664,6 +659,7 @@ , VL.categoricalDomainMap , VL.domainRangeMap , VL.ScaleDomain(..) + , VL.DomainLimits(..) , VL.ScaleRange(..) , VL.ScaleNice(..) , VL.NTimeUnit(..) @@ -857,6 +853,17 @@ -- -- $update + -- ** Version 0.12 + -- + -- $update01202 + -- $update01201 + -- $update01200 + + -- ** Version 0.11 + -- + -- $update01101 + -- $update01100 + -- ** Version 0.10 -- -- $update01000 @@ -1263,6 +1270,75 @@ -- The following section describes how to update code that used -- an older version of @hvega@. +-- $update01202 +-- The @0.12.0.2@ release adds support for version 2.0 of the text package. +-- There are no changes to the code. + +-- $update01201 +-- The @0.12.0.1@ release is purely to support bytestring 0.11 when +-- running the tests. There are no changes to the code. + +-- $update01200 +-- The @0.12.0.0@ release allows @hvega@ to be built with version 2.0 of the +-- [aeson package](https://hackage.haskell.org/package/aeson). There are +-- no changes to the API of @hvega@, but it does mean that you may need +-- to update code that directly creates JSON, such as 'VL.dataFromJson'. +-- It is likely that 'VL.LabelledSpec' type and the related +-- @toXXXSpec/fromXXXSpec@ functions, such as 'VL.fromSelectSpec' and +-- 'VL.toSelectSpec', will be updated once we can drop +-- support for versions of @aeson@ prior to 2.0. +-- + +-- $update01101 +-- The @0.11.0.1@ release is purely to support testing with @hashable@ 0.3.1.0. +-- There are no changes to the module. +-- + +-- $update01100 +-- The @0.11.0.0@ release updates @hvega@ to support version 4.15 of +-- the Vega-Lite schema. +-- +-- Note that @hvega@ does __not__ provide any information to help users +-- take advantage of the (new to 4.14) ability to +-- omit the type of a field when +-- [it can be inferred](https://vega.github.io/vega-lite/docs/type.html). +-- As the type is currently optional in @hvega@ users can just +-- not give a type. The example [IHaskell notebooks](https://github.com/DougBurke/hvega/tree/master/notebooks) +-- have been updated to show off the optional support. +-- +-- Similarly, Vega-Lite 4.14 allows you to share the type, scale, axis, +-- and legend in a shared encoding. There is no explicit support added in +-- @0.11.0.0@ because @hvega@ already allowed you to create the specification. +-- +-- __New constructors__ +-- +-- The 'VL.OrderChannel' type has gained 'VL.OBand', 'VL.OTitle'/'VL.ONoTitle', +-- and conditional-predicate support with 'VL.ODataCondition', +-- 'VL.OSelectionCondition', and 'VL.ONumber' constructors. +-- +-- The 'VL.MarkChannel' type has gained the 'VL.MNullValue' constructor. +-- +-- +-- The 'VL.ScaleRange' type has gained 'VL.RField', 'VL.RMax', and 'VL.RMin' +-- constructors. +-- +-- __Breaking Changes__ +-- +-- Domain settings in 'VL.ScaleProperty' and associated types have been +-- changed to better match the Vega-Lite schema: 'VL.SDomain' now takes +-- a new type ('VL.DomainLimits') which actually contains many of the +-- orignal symbols (so hopefully will require no changes), and a new +-- constructor has been added ('VL.SDomainOpt') which takes the +-- 'VL.ScaleDomain' type, which has seen new constructors - 'VL.DMax', +-- 'VL.DMaxTime', 'VL.DMid', 'VL.DMin', and 'VL.DMinTime' - as well as +-- some constructors moving to 'VL.DomainLimits'. +-- +-- __Deprecated symbols__: +-- +-- The 'VL.SDomainMid' constructor of 'VL.ScaleProperty' will be removed in a +-- future release as it has been replaced by the 'VL.DMid' constructor +-- in 'VL.ScaleDomain'. + -- $update01000 -- The @0.10.0.0@ release updates @hvega@ to support version 4.13 of -- the Vega-Lite schema. diff --git a/src/Graphics/Vega/VegaLite/Configuration.hs b/src/Graphics/Vega/VegaLite/Configuration.hs --- a/src/Graphics/Vega/VegaLite/Configuration.hs +++ b/src/Graphics/Vega/VegaLite/Configuration.hs @@ -3,12 +3,12 @@ {-| Module : Graphics.Vega.VegaLite.Configuration -Copyright : (c) Douglas Burke, 2018-2020 +Copyright : (c) Douglas Burke, 2018-2021 License : BSD3 Maintainer : dburke.gw@gmail.com Stability : unstable -Portability : OverloadedStrings +Portability : CPP, OverloadedStrings Top-level configuration options. As this can configure most of a visualization, it needs to import most of the other @@ -38,9 +38,11 @@ import qualified Data.Aeson as A + import qualified Data.Text as T import Data.Aeson ((.=), object) +import Data.Aeson.Types (Pair) #if !(MIN_VERSION_base(4, 12, 0)) import Data.Monoid ((<>)) @@ -97,6 +99,7 @@ , autosizeProperty , viewBackgroundSpec , cursorLabel + , (.=~), toObject ) import Graphics.Vega.VegaLite.Geometry ( ProjectionProperty @@ -110,7 +113,7 @@ ) import Graphics.Vega.VegaLite.Mark ( MarkProperty - , mprops_ + , oldMprops_ ) import Graphics.Vega.VegaLite.Scale ( ScaleNice @@ -530,7 +533,7 @@ toAxis :: T.Text -> [AxisConfig] -> LabelledSpec -toAxis lbl acs = ("axis" <> lbl) .= object (map axisConfigProperty acs) +toAxis lbl acs = ("axis" <> lbl) .=~ object (map axisConfigProperty acs) toAxisChoice :: AxisChoice -> T.Text -> [AxisConfig] -> LabelledSpec toAxisChoice AxXY lbl = toAxis lbl @@ -538,14 +541,14 @@ toAxisChoice AxY lbl = toAxis ("Y" <> lbl) aprops_ :: T.Text -> [AxisProperty] -> LabelledSpec -aprops_ f mps = f .= object (map axisProperty mps) +aprops_ f mps = f .=~ object (map axisProperty mps) -- easier to turn into a ConfigSpec in config than here configProperty :: ConfigurationProperty -> LabelledSpec -configProperty (ArcStyle mps) = mprops_ "arc" mps -configProperty (AreaStyle mps) = mprops_ "area" mps -configProperty (AriaStyle b) = "aria" .= b -configProperty (AutosizeStyle aus) = "autosize" .= object (map autosizeProperty aus) +configProperty (ArcStyle mps) = oldMprops_ "arc" mps +configProperty (AreaStyle mps) = oldMprops_ "area" mps +configProperty (AriaStyle b) = "aria" .=~ b +configProperty (AutosizeStyle aus) = "autosize" .=~ object (map autosizeProperty aus) configProperty (Axis acs) = toAxis "" acs configProperty (AxisBand c acs) = toAxisChoice c "Band" acs configProperty (AxisBottom acs) = toAxis "Bottom" acs @@ -559,78 +562,78 @@ configProperty (AxisX acs) = toAxis "X" acs configProperty (AxisY acs) = toAxis "Y" acs --- configProperty (AxisNamedStyles [(nme, mps)]) = "style" .= object [aprops_ nme mps] +-- configProperty (AxisNamedStyles [(nme, mps)]) = "style" .=~ object [aprops_ nme mps] configProperty (AxisNamedStyles styles) = let toStyle = uncurry aprops_ - in "style" .= object (map toStyle styles) + in "style" .=~ toObject (map toStyle styles) -configProperty (BackgroundStyle bg) = "background" .= bg -configProperty (BarStyle mps) = mprops_ "bar" mps -configProperty (BoxplotStyle mps) = mprops_ "boxplot" mps -configProperty (CircleStyle mps) = mprops_ "circle" mps -configProperty (ConcatStyle cps) = "concat" .= object (map compConfigProperty cps) -configProperty (CountTitleStyle ttl) = "countTitle" .= ttl -configProperty (CustomFormatStyle b) = "customFormatTypes" .= b -configProperty (ErrorBandStyle mps) = mprops_ "errorband" mps -configProperty (ErrorBarStyle mps) = mprops_ "errorbar" mps -configProperty (FacetStyle cps) = "facet" .= object (map compConfigProperty cps) -configProperty (FieldTitleStyle ftp) = "fieldTitle" .= fieldTitleLabel ftp -configProperty (FontStyle font) = "font" .= font -configProperty (GeoshapeStyle mps) = mprops_ "geoshape" mps +configProperty (BackgroundStyle bg) = "background" .=~ bg +configProperty (BarStyle mps) = oldMprops_ "bar" mps +configProperty (BoxplotStyle mps) = oldMprops_ "boxplot" mps +configProperty (CircleStyle mps) = oldMprops_ "circle" mps +configProperty (ConcatStyle cps) = "concat" .=~ object (map compConfigProperty cps) +configProperty (CountTitleStyle ttl) = "countTitle" .=~ ttl +configProperty (CustomFormatStyle b) = "customFormatTypes" .=~ b +configProperty (ErrorBandStyle mps) = oldMprops_ "errorband" mps +configProperty (ErrorBarStyle mps) = oldMprops_ "errorbar" mps +configProperty (FacetStyle cps) = "facet" .=~ object (map compConfigProperty cps) +configProperty (FieldTitleStyle ftp) = "fieldTitle" .=~ fieldTitleLabel ftp +configProperty (FontStyle font) = "font" .=~ font +configProperty (GeoshapeStyle mps) = oldMprops_ "geoshape" mps configProperty (HeaderStyle hps) = header_ "" hps configProperty (HeaderColumnStyle hps) = header_ "Column" hps configProperty (HeaderFacetStyle hps) = header_ "Facet" hps configProperty (HeaderRowStyle hps) = header_ "Row" hps -configProperty (ImageStyle mps) = mprops_ "image" mps -configProperty (LegendStyle lcs) = "legend" .= object (map legendConfigProperty lcs) -configProperty (LineStyle mps) = mprops_ "line" mps +configProperty (ImageStyle mps) = oldMprops_ "image" mps +configProperty (LegendStyle lcs) = "legend" .=~ object (map legendConfigProperty lcs) +configProperty (LineStyle mps) = oldMprops_ "line" mps -configProperty (LineBreakStyle s) = "lineBreak" .= s +configProperty (LineBreakStyle s) = "lineBreak" .=~ s -configProperty (MarkStyle mps) = mprops_ "mark" mps --- configProperty (MarkNamedStyles [(nme, mps)]) = "style" .= object [mprops_ nme mps] +configProperty (MarkStyle mps) = oldMprops_ "mark" mps +-- configProperty (MarkNamedStyles [(nme, mps)]) = "style" .=~ object [mprops_ nme mps] configProperty (MarkNamedStyles styles) = - let toStyle = uncurry mprops_ - in "style" .= object (map toStyle styles) + let toStyle = uncurry oldMprops_ + in "style" .=~ toObject (map toStyle styles) -configProperty (NumberFormatStyle fmt) = "numberFormat" .= fmt -configProperty (PaddingStyle pad) = "padding" .= paddingSpec pad -configProperty (PointStyle mps) = mprops_ "point" mps -configProperty (ProjectionStyle pps) = "projection" .= object (map projectionProperty pps) -configProperty (RangeStyle rcs) = "range" .= object (map rangeConfigProperty rcs) -configProperty (RectStyle mps) = mprops_ "rect" mps -configProperty (RepeatStyle cps) = "repeat" .= object (map compConfigProperty cps) -configProperty (RuleStyle mps) = mprops_ "rule" mps +configProperty (NumberFormatStyle fmt) = "numberFormat" .=~ fmt +configProperty (PaddingStyle pad) = "padding" .=~ paddingSpec pad +configProperty (PointStyle mps) = oldMprops_ "point" mps +configProperty (ProjectionStyle pps) = "projection" .=~ object (map projectionProperty pps) +configProperty (RangeStyle rcs) = "range" .=~ object (map rangeConfigProperty rcs) +configProperty (RectStyle mps) = oldMprops_ "rect" mps +configProperty (RepeatStyle cps) = "repeat" .=~ object (map compConfigProperty cps) +configProperty (RuleStyle mps) = oldMprops_ "rule" mps configProperty (ScaleStyle scs) = scaleConfig_ scs configProperty (SelectionStyle selConfig) = - let selProp (sel, sps) = selectionLabel sel .= object (concatMap selectionProperties sps) - in "selection" .= object (map selProp selConfig) -configProperty (SquareStyle mps) = mprops_ "square" mps -configProperty (TextStyle mps) = mprops_ "text" mps -configProperty (TickStyle mps) = mprops_ "tick" mps -configProperty (TimeFormatStyle fmt) = "timeFormat" .= fmt -configProperty (TitleStyle tcs) = "title" .= object (map titleConfigSpec tcs) -configProperty (TrailStyle mps) = mprops_ "trail" mps -configProperty (ViewStyle vcs) = "view" .= object (concatMap viewConfigProperties vcs) + let selProp (sel, sps) = selectionLabel sel .=~ object (concatMap selectionProperties sps) + in "selection" .=~ toObject (map selProp selConfig) +configProperty (SquareStyle mps) = oldMprops_ "square" mps +configProperty (TextStyle mps) = oldMprops_ "text" mps +configProperty (TickStyle mps) = oldMprops_ "tick" mps +configProperty (TimeFormatStyle fmt) = "timeFormat" .=~ fmt +configProperty (TitleStyle tcs) = "title" .=~ object (map titleConfigSpec tcs) +configProperty (TrailStyle mps) = oldMprops_ "trail" mps +configProperty (ViewStyle vcs) = "view" .=~ object (concatMap viewConfigProperties vcs) -- deprecated aliases -configProperty (Autosize aus) = "autosize" .= object (map autosizeProperty aus) -configProperty (Background bg) = "background" .= bg -configProperty (CountTitle ttl) = "countTitle" .= ttl -configProperty (FieldTitle ftp) = "fieldTitle" .= fieldTitleLabel ftp -configProperty (Legend lcs) = "legend" .= object (map legendConfigProperty lcs) -configProperty (NumberFormat fmt) = "numberFormat" .= fmt -configProperty (Padding pad) = "padding" .= paddingSpec pad -configProperty (Projection pps) = "projection" .= object (map projectionProperty pps) -configProperty (Range rcs) = "range" .= object (map rangeConfigProperty rcs) +configProperty (Autosize aus) = "autosize" .=~ object (map autosizeProperty aus) +configProperty (Background bg) = "background" .=~ bg +configProperty (CountTitle ttl) = "countTitle" .=~ ttl +configProperty (FieldTitle ftp) = "fieldTitle" .=~ fieldTitleLabel ftp +configProperty (Legend lcs) = "legend" .=~ object (map legendConfigProperty lcs) +configProperty (NumberFormat fmt) = "numberFormat" .=~ fmt +configProperty (Padding pad) = "padding" .=~ paddingSpec pad +configProperty (Projection pps) = "projection" .=~ object (map projectionProperty pps) +configProperty (Range rcs) = "range" .=~ object (map rangeConfigProperty rcs) configProperty (Scale scs) = scaleConfig_ scs -configProperty (TimeFormat fmt) = "timeFormat" .= fmt -configProperty (View vcs) = "view" .= object (concatMap viewConfigProperties vcs) +configProperty (TimeFormat fmt) = "timeFormat" .=~ fmt +configProperty (View vcs) = "view" .=~ object (concatMap viewConfigProperties vcs) -configProperty (NamedStyle nme mps) = "style" .= object [mprops_ nme mps] +configProperty (NamedStyle nme mps) = "style" .=~ toObject [oldMprops_ nme mps] configProperty (NamedStyles styles) = - let toStyle = uncurry mprops_ - in "style" .= object (map toStyle styles) + let toStyle = uncurry oldMprops_ + in "style" .=~ toObject (map toStyle styles) {-| @@ -705,7 +708,7 @@ scaleConfig_ :: [ScaleConfig] -> LabelledSpec -- scaleConfig_ [] = "scale" .= A.Null -- not sure here -scaleConfig_ scs = "scale" .= object (map scaleConfigProperty scs) +scaleConfig_ scs = "scale" .=~ object (map scaleConfigProperty scs) -- | Indicates the style in which field names are displayed. @@ -1043,7 +1046,7 @@ -- -- @since 0.9.0.0 -legendConfigProperty :: LegendConfig -> LabelledSpec +legendConfigProperty :: LegendConfig -> Pair legendConfigProperty (LeAria b) = "bool" .= b legendConfigProperty (LeAriaDescription t) = "description" .= t legendConfigProperty (LeClipHeight x) = "clipHeight" .= x @@ -1140,7 +1143,7 @@ | RSymbol T.Text -rangeConfigProperty :: RangeConfig -> LabelledSpec +rangeConfigProperty :: RangeConfig -> Pair rangeConfigProperty rangeCfg = let (l, n) = case rangeCfg of RCategory nme -> ("category", nme) @@ -1153,7 +1156,7 @@ in l .= object [schemeProperty n []] -scaleConfigProperty :: ScaleConfig -> LabelledSpec +scaleConfigProperty :: ScaleConfig -> Pair scaleConfigProperty (SCBandPaddingInner x) = "bandPaddingInner" .= x scaleConfigProperty (SCBandPaddingOuter x) = "bandPaddingOuter" .= x scaleConfigProperty (SCBarBandPaddingInner x) = "barBandPaddingInner" .= x @@ -1306,7 +1309,7 @@ -- be used instead. -viewConfigProperties :: ViewConfig -> [LabelledSpec] +viewConfigProperties :: ViewConfig -> [Pair] viewConfigProperties (ViewBackgroundStyle bs) = map viewBackgroundSpec bs viewConfigProperties (ViewClip b) = ["clip" .= b] viewConfigProperties (ViewWidth x) = ["continuousWidth" .= x] @@ -1674,7 +1677,7 @@ -- @since 0.5.0.0 -axisConfigProperty :: AxisConfig -> LabelledSpec +axisConfigProperty :: AxisConfig -> Pair axisConfigProperty (AStyle [s]) = "style" .= s axisConfigProperty (AStyle s) = "style" .= s @@ -1899,7 +1902,7 @@ -- @since 0.4.0.0 -titleConfigSpec :: TitleConfig -> LabelledSpec +titleConfigSpec :: TitleConfig -> Pair titleConfigSpec (TAlign ha) = "align" .= hAlignLabel ha titleConfigSpec (TAnchor an) = "anchor" .= anchorLabel an titleConfigSpec (TAngle x) = "angle" .= x @@ -1954,7 +1957,7 @@ -- Prior to @0.6.0.0@ this was either @ConcatSpacing@ or @FSpacing@. -compConfigProperty :: CompositionConfig -> LabelledSpec +compConfigProperty :: CompositionConfig -> Pair compConfigProperty (CompColumns n) = "columns" .= n compConfigProperty (CompSpacing x) = "spacing" .= x diff --git a/src/Graphics/Vega/VegaLite/Core.hs b/src/Graphics/Vega/VegaLite/Core.hs --- a/src/Graphics/Vega/VegaLite/Core.hs +++ b/src/Graphics/Vega/VegaLite/Core.hs @@ -4,7 +4,7 @@ {-| Module : Graphics.Vega.VegaLite.Core -Copyright : (c) Douglas Burke, 2018-2020 +Copyright : (c) Douglas Burke, 2018-2021 License : BSD3 Maintainer : dburke.gw@gmail.com @@ -174,9 +174,15 @@ import Prelude hiding (filter, lookup, repeat) import qualified Data.Aeson as A + +#if MIN_VERSION_aeson(2, 0, 0) +import qualified Data.Aeson.Key as Key +#endif + import qualified Data.Text as T import Data.Aeson (object, toJSON, (.=)) +import Data.Aeson.Types (Pair) import Data.Maybe (mapMaybe) #if !(MIN_VERSION_base(4, 12, 0)) @@ -259,6 +265,7 @@ , cInterpolateSpec , viewBackgroundSpec , symbolLabel + , (.=~), toObject, toKey ) import Graphics.Vega.VegaLite.Input ( Data @@ -275,16 +282,17 @@ ) import Graphics.Vega.VegaLite.Scale ( ScaleDomain(..) + , DomainLimits(..) , ScaleRange(..) , ScaleNice - , scaleDomainSpec + , scaleDomainProperty + , domainLimitsSpec , scaleNiceSpec ) import Graphics.Vega.VegaLite.Specification ( VLProperty(..) , VLSpec , PropertySpec - , LabelledSpec , EncodingSpec(..) , BuildEncodingSpecs , TransformSpec(..) @@ -297,7 +305,7 @@ import Graphics.Vega.VegaLite.Time ( DateTime , TimeUnit - , dateTimeProperty + , dateTimeSpec , timeUnitSpec ) import Graphics.Vega.VegaLite.Transform @@ -318,6 +326,7 @@ , imputeTS ) + --- helpers -- This could be extended to any Ord type but specialize for now to Double @@ -332,40 +341,40 @@ clamped xmin xmax x = max xmin (min xmax x) -repeat_ :: Arrangement -> LabelledSpec +repeat_ :: Arrangement -> Pair repeat_ arr = "repeat" .= arrangementLabel arr -sort_ :: [SortProperty] -> LabelledSpec +sort_ :: [SortProperty] -> Pair sort_ ops = "sort" .= sortPropertySpec ops mchan_ :: T.Text -> [MarkChannel] -> EncodingSpec -mchan_ f ms = ES (f .= object (concatMap markChannelProperty ms)) +mchan_ f ms = ES (f .=~ object (concatMap markChannelProperty ms)) -mtype_ :: Measurement -> LabelledSpec +mtype_ :: Measurement -> Pair mtype_ m = "type" .= measurementLabel m -timeUnit_ :: TimeUnit -> LabelledSpec +timeUnit_ :: TimeUnit -> Pair timeUnit_ tu = "timeUnit" .= timeUnitSpec tu -- The assumption at the moment is that it's always correct to -- replace the empty list by null. -- -scaleProp_ :: [ScaleProperty] -> LabelledSpec +scaleProp_ :: [ScaleProperty] -> Pair scaleProp_ [] = "scale" .= A.Null scaleProp_ sps = "scale" .= object (map scaleProperty sps) -value_ :: T.Text -> LabelledSpec +value_ :: T.Text -> Pair value_ v = "value" .= v -selCond_ :: (a -> [LabelledSpec]) -> BooleanOp -> [a] -> [a] -> [LabelledSpec] +selCond_ :: (a -> [Pair]) -> BooleanOp -> [a] -> [a] -> [Pair] selCond_ getProps selName ifClause elseClause = let h = ("condition", hkey) toProps = concatMap getProps - hkey = object (("selection", booleanOpSpec selName) : toProps ifClause) + hkey = object (toKey ("selection", booleanOpSpec selName) : toProps ifClause) hs = toProps elseClause - in h : hs + in (h : hs) -- Special case the single-condition check, so that I don't get false -- positives when comparing against the Vega-Lite specification. There @@ -378,7 +387,7 @@ -- selection: xxx -- which happens for the Selection operator. -- -dataCond_ :: (a -> [LabelledSpec]) -> [(BooleanOp, [a])] -> [a] -> [LabelledSpec] +dataCond_ :: (a -> [Pair]) -> [(BooleanOp, [a])] -> [a] -> [Pair] dataCond_ getProps tests elseClause = let h = ("condition", condClause) condClause = case conds of @@ -388,10 +397,10 @@ testClause (Selection sel, ifClause) = object (("selection" .= sel) : toProps ifClause) testClause (predicate, ifClause) = - object (("test", booleanOpSpec predicate) : toProps ifClause) + object (toKey ("test", booleanOpSpec predicate) : toProps ifClause) toProps = concatMap getProps hs = toProps elseClause - in h : hs + in (h : hs) @@ -555,6 +564,10 @@ -- ^ Literal string value when encoding with a mark property channel. | MBoolean Bool -- ^ Boolean value when encoding with a mark property channel. + | MNullValue + -- ^ A null value. + -- + -- @since 0.11.0.0 | MSymbol Symbol -- ^ A symbol literal. This can be useful when making a symbol dependent on some data or -- selection condition (e.g. 'MDataCondition' or 'MSelectionCondition'). @@ -571,8 +584,8 @@ -- -- @since 0.6.0.0 -markChannelProperty :: MarkChannel -> [LabelledSpec] -markChannelProperty (MName s) = [field_ s] +markChannelProperty :: MarkChannel -> [Pair] +markChannelProperty (MName s) = ["field" .= s] markChannelProperty (MRepeat arr) = ["field" .= object [repeat_ arr]] markChannelProperty (MRepeatDatum arr) = ["datum" .= object [repeat_ arr]] markChannelProperty (MmType t) = [mtype_ t] @@ -593,6 +606,7 @@ markChannelProperty (MString s) = ["value" .= s] markChannelProperty (MBoolean b) = ["value" .= b] markChannelProperty (MSymbol s) = ["value" .= symbolLabel s] +markChannelProperty MNullValue = ["value" .= A.Null] markChannelProperty (MTitle s) = ["title" .= splitOnNewline s] markChannelProperty MNoTitle = ["title" .= A.Null] @@ -629,7 +643,7 @@ -- -- Prior to @0.5.0.0@ this argument was @['LabelledSpec']@. -> PropertySpec -encoding channels = (VLEncoding, object (map unES channels)) +encoding channels = (VLEncoding, toObject (map unES channels)) {-| @@ -755,12 +769,21 @@ -- The default is @1@. -- -- @since 0.4.0.0 - | SDomain ScaleDomain - -- ^ Custom scaling domain. + | SDomain DomainLimits + -- ^ Custom scaling domain. See also 'SDomainOpt'. + -- + -- In verson @0.11.0.0@ some functionality was moved to 'SDomainOpt'. | SDomainMid Double -- ^ Set the mid-point of a continuous diverging domain. -- + -- This is deprecated as of 0.11.0.0 and @'SDomainOpt' ('DMid' x)@ should be used + -- instead. + -- -- @since 0.6.0.0 + | SDomainOpt ScaleDomain + -- ^ Custom scaling domain. See also 'SDomain'. + -- + -- @since 0.11.0.0 | SExponent Double -- ^ The exponent to use for power scaling ('Graphics.Vega.VegaLite.ScPow'). -- @@ -807,21 +830,25 @@ -- channel. -scaleProperty :: ScaleProperty -> LabelledSpec +scaleProperty :: ScaleProperty -> Pair scaleProperty (SType sType) = "type" .= scaleLabel sType scaleProperty (SAlign c) = "align" .= clamped 0 1 c scaleProperty (SBase x) = "base" .= x scaleProperty (SBins xs) = "bins" .= xs scaleProperty (SClamp b) = "clamp" .= b scaleProperty (SConstant x) = "constant" .= x -scaleProperty (SDomain sdType) = "domain" .= scaleDomainSpec sdType +scaleProperty (SDomain dl) = "domain" .= domainLimitsSpec dl scaleProperty (SDomainMid x) = "domainMid" .= x +scaleProperty (SDomainOpt sd) = scaleDomainProperty sd scaleProperty (SExponent x) = "exponent" .= x scaleProperty (SInterpolate interp) = "interpolate" .= cInterpolateSpec interp scaleProperty (SNice ni) = "nice" .= scaleNiceSpec ni scaleProperty (SPadding x) = "padding" .= x scaleProperty (SPaddingInner x) = "paddingInner" .= x scaleProperty (SPaddingOuter x) = "paddingOuter" .= x +scaleProperty (SRange (RField f)) = "range" .= object ["field" .= f] +scaleProperty (SRange (RMax x)) = "rangeMax" .= x +scaleProperty (SRange (RMin x)) = "rangeMin" .= x scaleProperty (SRange (RPair lo hi)) = "range" .= [lo, hi] scaleProperty (SRange (RHeight w)) = "range" .= [fromT "height", toJSON w] scaleProperty (SRange (RWidth h)) = "range" .= [toJSON h, fromT "width"] @@ -839,7 +866,7 @@ -- -- based on schema 3.3.0 #/definitions/SchemeParams -schemeProperty :: T.Text -> [Double] -> LabelledSpec +schemeProperty :: T.Text -> [Double] -> Pair schemeProperty nme [n] = "scheme" .= object ["name" .= nme, "count" .= n] schemeProperty nme [mn, mx] = "scheme" .= object ["name" .= nme, "extent" .= [mn, mx]] schemeProperty nme [n, mn, mx] = "scheme" .= object ["name" .= nme, "count" .= n, "extent" .= [mn, mx]] @@ -899,11 +926,11 @@ -- @since 0.4.0.0 -sortProperty :: SortProperty -> [LabelledSpec] +sortProperty :: SortProperty -> [Pair] sortProperty Ascending = [order_ "ascending"] sortProperty Descending = [order_ "descending"] sortProperty (ByChannel ch) = ["encoding" .= channelLabel ch] -sortProperty (ByFieldOp field op) = [field_ field, op_ op] +sortProperty (ByFieldOp field op) = ["field" .= field, op_ op] sortProperty (ByRepeatOp arr op) = ["field" .= object [repeat_ arr], op_ op] sortProperty (CustomSort _) = [] @@ -1083,8 +1110,8 @@ -- -- @since 0.5.0.0 -positionChannelProperty :: PositionChannel -> LabelledSpec -positionChannelProperty (PName s) = field_ s +positionChannelProperty :: PositionChannel -> Pair +positionChannelProperty (PName s) = "field" .= s positionChannelProperty (PmType m) = mtype_ m positionChannelProperty (PBin b) = bin b positionChannelProperty PBinned = binned_ @@ -1616,7 +1643,7 @@ -- ^ The z-index of the axis, relative to the chart marks. -axisProperty :: AxisProperty -> LabelledSpec +axisProperty :: AxisProperty -> Pair axisProperty (AxStyle [s]) = "style" .= s axisProperty (AxStyle s) = "style" .= s @@ -1713,7 +1740,7 @@ axisProperty (AxTitleY x) = "titleY" .= x axisProperty (AxTranslateOffset x) = "translate" .= x axisProperty (AxValues vals) = "values" .= dataValuesSpecs vals -axisProperty (AxDates dtss) = "values" .= map (object . map dateTimeProperty) dtss +axisProperty (AxDates dtss) = "values" .= map dateTimeSpec dtss axisProperty (AxZIndex z) = "zindex" .= z @@ -2016,10 +2043,15 @@ -- @since 0.4.0.0 -fop_ :: FieldName -> T.Text -> DataValue -> [LabelledSpec] -fop_ field label val = [field_ field, label .= dataValueSpec val] +#if MIN_VERSION_aeson(2, 0, 0) +fop_ :: FieldName -> Key.Key -> DataValue -> [Pair] +#else +fop_ :: FieldName -> T.Text -> DataValue -> [Pair] +#endif +fop_ field label val = ["field" .= field, + label .= dataValueSpec val] -filterProperty :: Filter -> [LabelledSpec] +filterProperty :: Filter -> [Pair] filterProperty (FEqual field val) = fop_ field "equal" val filterProperty (FLessThan field val) = fop_ field "lt" val @@ -2037,20 +2069,20 @@ DateRange dMin dMax -> [process dMin, process dMax] process [] = A.Null - process dts = object (map dateTimeProperty dts) + process dts = dateTimeSpec dts - in [field_ field, "range" .= ans] + in ["field" .= field, "range" .= ans] filterProperty (FOneOf field vals) = let ans = case vals of Numbers xs -> map toJSON xs - DateTimes dts -> map (object . map dateTimeProperty) dts + DateTimes dts -> map dateTimeSpec dts Strings ss -> map toJSON ss Booleans bs -> map toJSON bs - in [field_ field, "oneOf" .= ans] + in ["field" .= field, "oneOf" .= ans] -filterProperty (FValid field) = [field_ field, "valid" .= True] +filterProperty (FValid field) = ["field" .= field, "valid" .= True] filterProperty _ = [] -- ignore FExpr and FCompose @@ -2169,8 +2201,8 @@ -- -- @since 0.9.0.0 -hyperlinkChannelProperty :: HyperlinkChannel -> [LabelledSpec] -hyperlinkChannelProperty (HName s) = [field_ s] +hyperlinkChannelProperty :: HyperlinkChannel -> [Pair] +hyperlinkChannelProperty (HName s) = ["field" .= s] hyperlinkChannelProperty (HRepeat arr) = ["field" .= object [repeat_ arr]] hyperlinkChannelProperty (HmType t) = [mtype_ t] hyperlinkChannelProperty (HAggregate op) = [aggregate_ op] @@ -2251,8 +2283,8 @@ -- ^ Display no title. -ariaDescriptionChannelProperty :: AriaDescriptionChannel -> [LabelledSpec] -ariaDescriptionChannelProperty (ADName s) = [field_ s] +ariaDescriptionChannelProperty :: AriaDescriptionChannel -> [Pair] +ariaDescriptionChannelProperty (ADName s) = ["field" .= s] ariaDescriptionChannelProperty (ADRepeat arr) = ["field" .= object [repeat_ arr]] ariaDescriptionChannelProperty (ADmType t) = [mtype_ t] ariaDescriptionChannelProperty (ADAggregate op) = [aggregate_ op] @@ -2386,14 +2418,14 @@ -- -- @since 0.4.0.0 -facetChannelProperty :: FacetChannel -> LabelledSpec -facetChannelProperty (FName s) = field_ s +facetChannelProperty :: FacetChannel -> Pair +facetChannelProperty (FName s) = "field" .= s facetChannelProperty (FmType measure) = mtype_ measure facetChannelProperty (FAlign algn) = "align" .= compositionAlignmentSpec algn facetChannelProperty (FAggregate op) = aggregate_ op facetChannelProperty (FBin bps) = bin bps facetChannelProperty (FCenter b) = "center" .= b -facetChannelProperty (FHeader hps) = header_ "" hps +facetChannelProperty (FHeader hps) = toKey (header_ "" hps) facetChannelProperty (FSort sps) = sort_ sps facetChannelProperty (FSpacing x) = "spacing" .= x facetChannelProperty (FTitle s) = "title" .= s @@ -2507,8 +2539,8 @@ -- -- @since 0.4.0.0 -textChannelProperty :: TextChannel -> [LabelledSpec] -textChannelProperty (TName s) = [field_ s] +textChannelProperty :: TextChannel -> [Pair] +textChannelProperty (TName s) = ["field" .= s] textChannelProperty (TRepeat arr) = ["field" .= object [repeat_ arr]] textChannelProperty (TRepeatDatum arr) = ["datum" .= object [repeat_ arr]] textChannelProperty (TmType measure) = [mtype_ measure] @@ -2535,6 +2567,8 @@ -- | Properties of an ordering channel used for sorting data fields. +-- maps to OrderFieldDef + data OrderChannel = OName FieldName -- ^ The name of the field used for encoding with an order channel. @@ -2542,30 +2576,83 @@ -- ^ Reference in an order channel to a field name generated by 'repeatFlow' -- or 'repeat'. The parameter identifies whether reference is being made to -- fields that are to be arranged in columns, in rows, or a with a flow layout. - | OmType Measurement - -- ^ The level of measurement when encoding with an order channel. - | OBin [BinProperty] - -- ^ Discretize numeric values into bins when encoding with an - -- order channel. | OAggregate Operation -- ^ Compute some aggregate summary statistics for a field to be encoded -- with an order channel. + | OBand Double + -- ^ For rect-based marks, define the mark size relative to the bandwidth of + -- band scales, bins, or time units: a value of 1 uses the range and 0.5 + -- half the range. For other marks it defines the relative position in a + -- band of a stacked, binned, time unit, or band scale: if 0 the marks + -- will be positioned at the beginning of the band and 0.5 gives the + -- middle of the band. + -- + -- The argument must be in the range 0 to 1, inclusive, but there is no + -- check on this. + -- + -- @since 0.11.0.0 + | OBin [BinProperty] + -- ^ Discretize numeric values into bins when encoding with an + -- order channel. + | OSort [SortProperty] + -- ^ Sort order for field when encoding with an order channel. | OTimeUnit TimeUnit -- ^ Form of time unit aggregation of field values when encoding with -- an order channel. - | OSort [SortProperty] - -- ^ Sort order for field when encoding with an order channel. - - -orderChannelProperty :: OrderChannel -> LabelledSpec -orderChannelProperty (OName s) = field_ s -orderChannelProperty (ORepeat arr) = "field" .= object [repeat_ arr] -orderChannelProperty (OmType measure) = mtype_ measure -orderChannelProperty (OBin bps) = bin bps -orderChannelProperty (OAggregate op) = aggregate_ op -orderChannelProperty (OTimeUnit tu) = timeUnit_ tu -orderChannelProperty (OSort ops) = sort_ ops + | OTitle T.Text + -- ^ The title for the field. + -- + -- Note that if both the field and axis, header, or legend titles are + -- defined than the latter (axis, header, or legend) will be used. + -- + -- @since 0.11.0.0 + | ONoTitle + -- ^ Remove the title. + -- + -- @since 0.11.0.0 + | OmType Measurement + -- ^ The level of measurement when encoding with an order channel. + | ODataCondition [(BooleanOp, [OrderChannel])] [OrderChannel] + -- ^ Make an order channel conditional on one or more predicate expressions. The first + -- parameter is a list of tuples each pairing an expression to evaluate with the encoding + -- if that expression is @True@. The second is the encoding if none of the expressions + -- evaluate as @True@. + -- + -- @since 0.11.0.0 + | OSelectionCondition BooleanOp [OrderChannel] [OrderChannel] + -- ^ Make an order channel conditional on interactive selection. The first parameter + -- is a selection condition to evaluate; the second the encoding to apply if that + -- selection is true; the third parameter is the encoding if the selection is false. + -- + -- An example: + -- + -- @'order' ['OSelectionCondition' ('SelectionName' "highlight") + -- ['ONumber' 1] ['ONumber' 0]] + -- @ + -- + -- @since 0.11.0.0 + | ONumber Double + -- ^ Create a value with this number. For use with 'OSelectionCondition' + -- and 'ODataCondition'. + -- + -- @since 0.11.0.0 +orderChannelProperty :: OrderChannel -> [Pair] +orderChannelProperty (OAggregate op) = [aggregate_ op] +orderChannelProperty (OBand x) = ["band" .= x] +orderChannelProperty (OBin bps) = [bin bps] +orderChannelProperty (OName s) = ["field" .= s] +orderChannelProperty (ORepeat arr) = ["field" .= object [repeat_ arr]] +orderChannelProperty (OSort ops) = [sort_ ops] +orderChannelProperty (OTimeUnit tu) = [timeUnit_ tu] +orderChannelProperty (OTitle s) = ["title" .= s] +orderChannelProperty ONoTitle = ["title" .= A.Null] +orderChannelProperty (OmType measure) = [mtype_ measure] +orderChannelProperty (ODataCondition tests elseClause) = + dataCond_ orderChannelProperty tests elseClause +orderChannelProperty (OSelectionCondition selName ifClause elseClause) = + selCond_ orderChannelProperty selName ifClause elseClause +orderChannelProperty (ONumber n) = ["value" .= n] -- | Level of detail channel properties used for creating a grouped channel -- encoding. @@ -2583,8 +2670,8 @@ -- ^ How should the detail field be aggregated? -detailChannelProperty :: DetailChannel -> LabelledSpec -detailChannelProperty (DName s) = field_ s +detailChannelProperty :: DetailChannel -> Pair +detailChannelProperty (DName s) = "field" .= s -- field_ s detailChannelProperty (DmType t) = mtype_ t detailChannelProperty (DBin bps) = bin bps detailChannelProperty (DTimeUnit tu) = timeUnit_ tu @@ -2602,7 +2689,7 @@ | RowBy [FacetChannel] -facetMappingProperty :: FacetMapping -> LabelledSpec +facetMappingProperty :: FacetMapping -> Pair facetMappingProperty (RowBy fFields) = "row" .= object (map facetChannelProperty fFields) facetMappingProperty (ColumnBy fFields) = @@ -2633,9 +2720,9 @@ [ConfigureSpec] -- ^ The configuration options, created with 'Graphics.Vega.VegaLite.configuration'. -- - -- Prior to version @0.5.0.0@ this was @[LabelledSpec]@. + -- Prior to version @0.5.0.0@ this was @['LabelledSpec']@. -> PropertySpec -configure configs = (VLConfig, object (map unCS configs)) +configure configs = (VLConfig, toObject (map unCS configs)) -- | Alignment to apply to grid rows and columns generated by a composition @@ -3074,7 +3161,7 @@ -- -- Prior to @0.5.0.0@ this argument was @['LabelledSpec']@. -> PropertySpec -resolve res = (VLResolve, object (map unRS res)) +resolve res = (VLResolve, toObject (map unRS res)) {-| @@ -4661,19 +4748,27 @@ Encode an order channel. @ -enc = - 'encoding' - . 'position' 'Graphics.Vega.VegaLite.X' [ 'PName' "miles", 'PmType' 'Graphics.Vega.VegaLite.Quantitative' ] - . 'position' 'Graphics.Vega.VegaLite.Y' [ 'PName' "gas", 'PmType' 'Graphics.Vega.VegaLite.Quantitative' ] - . 'order' [ 'OName' "year", 'OmType' 'Graphics.Vega.VegaLite.Temporal', 'OSort' ['Descending'] ] +'encoding' + . 'position' 'Graphics.Vega.VegaLite.X' [ 'PName' "miles", 'PmType' 'Graphics.Vega.VegaLite.Quantitative' ] + . 'position' 'Graphics.Vega.VegaLite.Y' [ 'PName' "gas", 'PmType' 'Graphics.Vega.VegaLite.Quantitative' ] + . 'order' [ 'OName' "year", 'OmType' 'Graphics.Vega.VegaLite.Temporal', 'OSort' ['Descending'] ] @ + + +can be set with 'OSelectionCondition', such as + +@ +'order' [ 'OSelectionCondition' ('SelectionName "highlight") + ['ONumber' 1] ['ONumber' 0] +@ -} + order :: [OrderChannel] -- ^ The order-encoding options. -> BuildEncodingSpecs order oDefs ols = - ES ("order", object (map orderChannelProperty oDefs)) : ols + ES ("order", object (concatMap orderChannelProperty oDefs)) : ols {-| @@ -5005,4 +5100,4 @@ -- ^ A separate list of properties for each channel. -> BuildEncodingSpecs tooltips tDefs ols = - ES ("tooltip" .= map (object . concatMap textChannelProperty) tDefs) : ols + ES ("tooltip" .=~ map (object . concatMap textChannelProperty) tDefs) : ols diff --git a/src/Graphics/Vega/VegaLite/Data.hs b/src/Graphics/Vega/VegaLite/Data.hs --- a/src/Graphics/Vega/VegaLite/Data.hs +++ b/src/Graphics/Vega/VegaLite/Data.hs @@ -24,13 +24,13 @@ import qualified Data.Aeson as A import qualified Data.Text as T -import Data.Aeson (object, toJSON) +import Data.Aeson (toJSON) import Graphics.Vega.VegaLite.Specification (VLSpec) import Graphics.Vega.VegaLite.Time ( DateTime - , dateTimeProperty + , dateTimeSpec ) @@ -68,7 +68,7 @@ dataValueSpec :: DataValue -> VLSpec dataValueSpec (Boolean b) = toJSON b -dataValueSpec (DateTime dt) = object (map dateTimeProperty dt) +dataValueSpec (DateTime dt) = dateTimeSpec dt dataValueSpec (Number x) = toJSON x dataValueSpec (Str t) = toJSON t dataValueSpec NullValue = A.Null @@ -94,7 +94,7 @@ dataValuesSpecs :: DataValues -> [VLSpec] dataValuesSpecs (Booleans bs) = map toJSON bs -dataValuesSpecs (DateTimes dtss) = map (object . map dateTimeProperty) dtss +dataValuesSpecs (DateTimes dtss) = map dateTimeSpec dtss dataValuesSpecs (Numbers xs) = map toJSON xs dataValuesSpecs (Strings ss) = map toJSON ss diff --git a/src/Graphics/Vega/VegaLite/Foundation.hs b/src/Graphics/Vega/VegaLite/Foundation.hs --- a/src/Graphics/Vega/VegaLite/Foundation.hs +++ b/src/Graphics/Vega/VegaLite/Foundation.hs @@ -3,7 +3,7 @@ {-| Module : Graphics.Vega.VegaLite.Foundation -Copyright : (c) Douglas Burke, 2018-2020 +Copyright : (c) Douglas Burke, 2018-2021 License : BSD3 Maintainer : dburke.gw@gmail.com @@ -112,13 +112,29 @@ , header_ , order_ , allowNull + + -- aeson 2.0 support + , (.=~) + , toKey + , toKeys + , toObject ) where import qualified Data.Aeson as A + +#if MIN_VERSION_aeson(2, 0, 0) +import qualified Data.Aeson.Key as Key +#endif + import qualified Data.Text as T +#if MIN_VERSION_aeson(2, 0, 0) +import Control.Arrow (first) +#endif + import Data.Aeson ((.=), object, toJSON) +import Data.Aeson.Types (Pair, ToJSON) #if !(MIN_VERSION_base(4, 12, 0)) import Data.Monoid ((<>)) @@ -135,14 +151,45 @@ ) -field_ :: FieldName -> LabelledSpec +{- +Similar to the Aeson .= version, but retains the Text,Value pairing as +this matches LabelledSpec. Ideally we'd change LabelledSpec to match +Pair (aka Key,Value) but then we'd have different types depending on +the version of aeson in use, which is less-than-ideal. The current +thinking is that we can bump the minimum aeson value to 2.0 at some +point and make the change then. + +It does leave a number of "internal" routines in place that return +LabelledSpec rather than Pair, since they have been made available for +use, which means a confusing set of "this function can use .= and this +one has to use .=~". +-} + +(.=~) :: ToJSON a => T.Text -> a -> (T.Text, A.Value) +a .=~ b = (a, toJSON b) + +toKey :: LabelledSpec -> Pair +#if MIN_VERSION_aeson(2, 0, 0) +toKey = first Key.fromText +#else +toKey = id +#endif + +toKeys :: [LabelledSpec] -> [Pair] +toKeys = map toKey + +toObject :: [LabelledSpec] -> VLSpec +toObject = object . toKeys + + +field_ :: FieldName -> Pair field_ f = "field" .= f header_ :: T.Text -> [HeaderProperty] -> LabelledSpec -header_ extra hps = ("header" <> extra) .= object (map headerProperty hps) +header_ extra hps = ("header" <> extra, object (map headerProperty hps)) -- could restrict to ascending/descending -order_ :: T.Text -> LabelledSpec +order_ :: T.Text -> Pair order_ o = "order" .= o @@ -1066,10 +1113,9 @@ stackOffsetSpec StCenter = "center" stackOffsetSpec NoStack = A.Null -stackOffset :: StackOffset -> LabelledSpec +stackOffset :: StackOffset -> Pair stackOffset so = "stack" .= stackOffsetSpec so - stackPropertySpecOffset , stackPropertySpecSort:: StackProperty -> Maybe VLSpec stackPropertySpecOffset (StOffset op) = Just (stackOffsetSpec op) stackPropertySpecOffset _ = Nothing @@ -1247,8 +1293,8 @@ RLegend chRules -> ("legend", chRules) RScale chRules -> ("scale", chRules) - ans = map (\(ch, rule) -> channelLabel ch .= resolutionLabel rule) rls - in RS (nme, object ans) + ans = map (\(ch, rule) -> channelLabel ch .=~ resolutionLabel rule) rls + in RS (nme, toObject ans) -- | This is used with 'Graphics.Vega.VegaLite.bounds' to define the extent of a sub plot. @@ -1350,7 +1396,7 @@ -- ^ Recalculate autosizing on every view update. -autosizeProperty :: Autosize -> LabelledSpec +autosizeProperty :: Autosize -> Pair autosizeProperty APad = "type" .= fromT "pad" autosizeProperty AFit = "type" .= fromT "fit" autosizeProperty AFitX = "type" .= fromT "fit-x" @@ -1374,12 +1420,11 @@ | LayerFields [FieldName] -- ^ @since 0.9.0.0 -repeatFieldsProperty :: RepeatFields -> LabelledSpec +repeatFieldsProperty :: RepeatFields -> Pair repeatFieldsProperty (RowFields fs) = "row" .= fs repeatFieldsProperty (ColumnFields fs) = "column" .= fs repeatFieldsProperty (LayerFields fs) = "layer" .= fs - {-| Indicates the type of color interpolation to apply, when mapping a data field @@ -1414,8 +1459,13 @@ -- Need to tie down some types as things are too polymorphic, -- particularly in the presence of OverloadedStrings. -- -pairT :: T.Text -> T.Text -> (T.Text, A.Value) +#if MIN_VERSION_aeson(2, 0, 0) +pairT :: Key.Key -> T.Text -> Pair pairT a b = a .= b +#else +pairT :: T.Text -> T.Text -> Pair +pairT a b = a .= b +#endif cInterpolateSpec :: CInterpolate -> VLSpec @@ -1489,7 +1539,7 @@ -- ^ The mitre limit at which to bevel the line around the background, if drawn. -viewBackgroundSpec :: ViewBackground -> LabelledSpec +viewBackgroundSpec :: ViewBackground -> Pair viewBackgroundSpec (VBStyle [style]) = "style" .= style -- special case singleton viewBackgroundSpec (VBStyle styles) = "style" .= styles viewBackgroundSpec (VBCornerRadius r) = "cornerRadius" .= r @@ -1693,7 +1743,7 @@ -- @since 0.4.0.0 -headerProperty :: HeaderProperty -> LabelledSpec +headerProperty :: HeaderProperty -> Pair headerProperty (HFormat fmt) = "format" .= fmt headerProperty HFormatAsNum = "formatType" .= fromT "number" headerProperty HFormatAsTemporal = "formatType" .= fromT "time" diff --git a/src/Graphics/Vega/VegaLite/Geometry.hs b/src/Graphics/Vega/VegaLite/Geometry.hs --- a/src/Graphics/Vega/VegaLite/Geometry.hs +++ b/src/Graphics/Vega/VegaLite/Geometry.hs @@ -3,7 +3,7 @@ {-| Module : Graphics.Vega.VegaLite.Geometry -Copyright : (c) Douglas Burke, 2018-2020 +Copyright : (c) Douglas Burke, 2018-2021 License : BSD3 Maintainer : dburke.gw@gmail.com @@ -35,10 +35,13 @@ ) where import qualified Data.Aeson as A + import qualified Data.Text as T import Control.Arrow (second) + import Data.Aeson ((.=), object, toJSON) +import Data.Aeson.Types (Pair) #if !(MIN_VERSION_base(4, 12, 0)) import Data.Monoid ((<>)) @@ -49,11 +52,13 @@ ( DataValue , dataValueSpec ) -import Graphics.Vega.VegaLite.Foundation (fromT) +import Graphics.Vega.VegaLite.Foundation + ( fromT + , toObject + ) import Graphics.Vega.VegaLite.Specification ( VLProperty(VLData, VLProjection) , VLSpec - , LabelledSpec , PropertySpec ) import Graphics.Vega.VegaLite.Input @@ -61,7 +66,7 @@ ) -type_ :: T.Text -> LabelledSpec +type_ :: T.Text -> Pair type_ t = "type" .= t @@ -285,7 +290,7 @@ -- ^ @Satellite@ map projection tilt. -projectionProperty :: ProjectionProperty -> LabelledSpec +projectionProperty :: ProjectionProperty -> Pair projectionProperty (PrType proj) = "type" .= projectionLabel proj projectionProperty (PrClipAngle numOrNull) = "clipAngle" .= maybe A.Null toJSON numOrNull projectionProperty (PrClipExtent rClip) = @@ -366,7 +371,7 @@ <> if null properties then [] else [("properties", - object (map (second dataValueSpec) properties))] + toObject (map (second dataValueSpec) properties))] ) @@ -477,7 +482,7 @@ -- The default is @2.5@. -graticuleProperty :: GraticuleProperty -> LabelledSpec +graticuleProperty :: GraticuleProperty -> Pair graticuleProperty (GrExtent (lng1, lat1) (lng2, lat2)) = "extent" .= [[lng1, lat1], [lng2, lat2]] graticuleProperty (GrExtentMajor (lng1, lat1) (lng2, lat2)) = diff --git a/src/Graphics/Vega/VegaLite/Input.hs b/src/Graphics/Vega/VegaLite/Input.hs --- a/src/Graphics/Vega/VegaLite/Input.hs +++ b/src/Graphics/Vega/VegaLite/Input.hs @@ -4,7 +4,7 @@ {-| Module : Graphics.Vega.VegaLite.Input -Copyright : (c) Douglas Burke, 2018-2020 +Copyright : (c) Douglas Burke, 2018-2021 License : BSD3 Maintainer : dburke.gw@gmail.com @@ -40,12 +40,14 @@ ) where import qualified Data.Aeson as A + import qualified Data.HashMap.Strict as HM import qualified Data.Text as T import Control.Arrow (second) import Data.Aeson ((.=), Value, decode, encode, object, toJSON) +import Data.Aeson.Types (Pair) import Data.Maybe (fromMaybe, mapMaybe) #if !(MIN_VERSION_base(4, 12, 0)) @@ -59,13 +61,14 @@ ) import Graphics.Vega.VegaLite.Foundation ( FieldName + , toObject ) import Graphics.Vega.VegaLite.Specification ( VLProperty(VLData, VLDatasets) , VLSpec , LabelledSpec ) -import Graphics.Vega.VegaLite.Time (dateTimeProperty) +import Graphics.Vega.VegaLite.Time (dateTimeSpec) {-| @@ -177,7 +180,7 @@ type Data = (VLProperty, VLSpec) -formatProperty :: Format -> [LabelledSpec] +formatProperty :: Format -> [Pair] formatProperty (JSON js) = let ps = [("type", "json")] <> if T.null (T.strip js) then [] else [("property", js)] @@ -194,7 +197,7 @@ , "mesh" .= os ] formatProperty (Parse fmts) = - let pObj = object (map (second dataTypeSpec) fmts) + let pObj = toObject (map (second dataTypeSpec) fmts) in [("parse", pObj)] @@ -222,7 +225,7 @@ @ -} dataRow :: [(FieldName, DataValue)] -> [DataRow] -> [DataRow] -dataRow rw = (object (map (second dataValueSpec) rw) :) +dataRow rw = (toObject (map (second dataValueSpec) rw) :) {-| @@ -271,7 +274,7 @@ in fromMaybe din (convert din >>= extract') - in (VLDatasets, object specs) + in (VLDatasets, toObject specs) -- | This is for composed specifications, and it tells the visualization to @@ -317,7 +320,7 @@ -- a relatively easy conversion. The type annotation isn't needed -- but left in for reference. -- - convert :: Maybe [(T.Text, Value)] + convert :: Maybe [Pair] convert = HM.toList <$> decode (encode dataSpec) extract [v] = Just v @@ -359,7 +362,7 @@ -- calls to 'dataColumn'. -> Data dataFromColumns fmts cols = - let dataArray = map object (transpose cols) + let dataArray = map toObject (transpose cols) vals = [("values", toJSON dataArray)] <> if null fmts @@ -433,11 +436,10 @@ dataColumn colName dVals xs = let col = case dVals of Booleans cs -> map toJSON cs - DateTimes cs -> map dtToJSON cs + DateTimes cs -> map dateTimeSpec cs Numbers cs -> map toJSON cs Strings cs -> map toJSON cs - dtToJSON = object . map dateTimeProperty x = map (colName,) col in x : xs diff --git a/src/Graphics/Vega/VegaLite/Legend.hs b/src/Graphics/Vega/VegaLite/Legend.hs --- a/src/Graphics/Vega/VegaLite/Legend.hs +++ b/src/Graphics/Vega/VegaLite/Legend.hs @@ -32,7 +32,9 @@ import qualified Data.Text as T import Data.Aeson ((.=), object, toJSON) +import Data.Aeson.Types (Pair) + import Graphics.Vega.VegaLite.Foundation ( APosition , Bounds @@ -70,10 +72,10 @@ ( ScaleNice , scaleNiceSpec ) -import Graphics.Vega.VegaLite.Specification (VLSpec, LabelledSpec) +import Graphics.Vega.VegaLite.Specification (VLSpec) import Graphics.Vega.VegaLite.Time ( DateTime - , dateTimeProperty + , dateTimeSpec ) @@ -165,7 +167,7 @@ | LeLTopRight [BaseLegendLayout] -legendLayoutSpec :: LegendLayout -> LabelledSpec +legendLayoutSpec :: LegendLayout -> Pair legendLayoutSpec (LeLAnchor anc) = "anchor" .= anchorLabel anc legendLayoutSpec (LeLBottom bl) = "bottom" .= toBLSpec bl legendLayoutSpec (LeLBottomLeft bl) = "bottom-left" .= toBLSpec bl @@ -210,7 +212,7 @@ toBLSpec :: [BaseLegendLayout] -> VLSpec toBLSpec = object . map baseLegendLayoutSpec -baseLegendLayoutSpec :: BaseLegendLayout -> LabelledSpec +baseLegendLayoutSpec :: BaseLegendLayout -> Pair baseLegendLayoutSpec (BLeLAnchor anc) = "anchor" .= anchorLabel anc baseLegendLayoutSpec (BLeLBounds bnds) = "bounds" .= boundsSpec bnds baseLegendLayoutSpec (BLeLCenter b) = "center" .= b @@ -490,7 +492,7 @@ | LZIndex ZIndex -- ^ The z-index at which to draw the legend. -legendProperty :: LegendProperty -> LabelledSpec +legendProperty :: LegendProperty -> Pair legendProperty (LAria b) = "aria" .= b legendProperty (LAriaDescription t) = "description" .= t legendProperty (LClipHeight x) = "clipHeight" .= x @@ -561,7 +563,7 @@ legendProperty (LValues vals) = let ls = case vals of LNumbers xs -> map toJSON xs - LDateTimes dts -> map (object . map dateTimeProperty) dts + LDateTimes dts -> map dateTimeSpec dts LStrings ss -> map toJSON ss in "values" .= ls legendProperty (LeX x) = "legendX" .= x @@ -569,7 +571,7 @@ legendProperty (LZIndex z) = "zindex" .= z -legendProp_ :: [LegendProperty] -> LabelledSpec +legendProp_ :: [LegendProperty] -> Pair legendProp_ [] = "legend" .= A.Null legendProp_ lps = "legend" .= object (map legendProperty lps) diff --git a/src/Graphics/Vega/VegaLite/Mark.hs b/src/Graphics/Vega/VegaLite/Mark.hs --- a/src/Graphics/Vega/VegaLite/Mark.hs +++ b/src/Graphics/Vega/VegaLite/Mark.hs @@ -1,13 +1,14 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-| Module : Graphics.Vega.VegaLite.Mark -Copyright : (c) Douglas Burke, 2018-2020 +Copyright : (c) Douglas Burke, 2018-2021 License : BSD3 Maintainer : dburke.gw@gmail.com Stability : unstable -Portability : OverloadedStrings +Portability : CPP, OverloadedStrings This provides the functionality of the VegaLite module but is not directly exported to the user. @@ -29,7 +30,7 @@ , BlendMode(..) -- not for external export - , mprops_ + , oldMprops_ , markLabel , markProperty @@ -37,9 +38,15 @@ ) where import qualified Data.Aeson as A + +#if MIN_VERSION_aeson(2, 0, 0) +import qualified Data.Aeson.Key as Key +#endif + import qualified Data.Text as T import Data.Aeson ((.=), object, toJSON) +import Data.Aeson.Types (Pair) import Data.List (sortOn) @@ -71,6 +78,7 @@ , ttContentLabel , hAlignLabel , vAlignLabel + , (.=~) ) import Graphics.Vega.VegaLite.Specification ( VLSpec @@ -79,11 +87,20 @@ -- As of version 0.6.0.0, an empty list is mapped to True -mprops_ :: T.Text -> [MarkProperty] -> LabelledSpec +#if MIN_VERSION_aeson(2, 0, 0) +mprops_ :: Key.Key -> [MarkProperty] -> Pair +#else +mprops_ :: T.Text -> [MarkProperty] -> Pair +#endif mprops_ f [] = f .= True mprops_ f mps = f .= object (map markProperty mps) +-- Used by Configuration to create top-level data +oldMprops_ :: T.Text -> [MarkProperty] -> LabelledSpec +oldMprops_ f [] = f .=~ True +oldMprops_ f mps = f .=~ object (map markProperty mps) + -- | Type of visual mark used to represent data in the visualization. -- -- The properties of the mark can be changed with the 'MarkProperty' @@ -713,7 +730,7 @@ -- @since 0.9.0.0 -markProperty :: MarkProperty -> LabelledSpec +markProperty :: MarkProperty -> Pair -- special case the gradients markProperty (MColorGradient dir stops opts) = @@ -868,7 +885,7 @@ let sortedStops = sortOn fst stops in object ([ "gradient" .= colorGradientLabel dir , "stops" .= map stopSpec sortedStops ] - ++ map gradientProperty props) + ++ map gradientProperty props) {-| @@ -1024,10 +1041,10 @@ -- This is a little different from the other calls since I wanted to -- make sure the scale factor was encoded as a number not a string. -- -extent_ :: T.Text -> LabelledSpec +extent_ :: T.Text -> Pair extent_ v = "extent" .= v -markErrorExtentLSpec :: MarkErrorExtent -> LabelledSpec +markErrorExtentLSpec :: MarkErrorExtent -> Pair markErrorExtentLSpec ConfidenceInterval = extent_ "ci" markErrorExtentLSpec StdErr = extent_ "stderr" markErrorExtentLSpec StdDev = extent_ "stdev" @@ -1129,7 +1146,7 @@ -- only). The default is 0.5. -gradientProperty :: GradientProperty -> LabelledSpec +gradientProperty :: GradientProperty -> Pair gradientProperty (GrX1 x) = "x1" .= x gradientProperty (GrX2 x) = "x2" .= x gradientProperty (GrY1 x) = "y1" .= x diff --git a/src/Graphics/Vega/VegaLite/Scale.hs b/src/Graphics/Vega/VegaLite/Scale.hs --- a/src/Graphics/Vega/VegaLite/Scale.hs +++ b/src/Graphics/Vega/VegaLite/Scale.hs @@ -2,7 +2,7 @@ {-| Module : Graphics.Vega.VegaLite.Scale -Copyright : (c) Douglas Burke, 2018-2020 +Copyright : (c) Douglas Burke, 2018-2021 License : BSD3 Maintainer : dburke.gw@gmail.com @@ -15,18 +15,21 @@ module Graphics.Vega.VegaLite.Scale ( ScaleDomain(..) + , DomainLimits(..) , ScaleRange(..) , ScaleNice(..) , NTimeUnit(..) -- not for external export - , scaleDomainSpec + , scaleDomainProperty + , domainLimitsSpec , scaleNiceSpec ) where import qualified Data.Text as T import Data.Aeson ((.=), object, toJSON) +import Data.Aeson.Types (Pair) import Graphics.Vega.VegaLite.Foundation @@ -41,7 +44,7 @@ ) import Graphics.Vega.VegaLite.Time ( DateTime - , dateTimeProperty + , dateTimeSpec ) @@ -49,15 +52,44 @@ Describes the scale domain (type of data in scale). For full details see the . + +In @0.11.0.0@ the functionality has been split into 'ScaleDomain' and +'DomainLimits'. -} data ScaleDomain - = DNumbers [Double] - -- ^ Numeric values that define a scale domain. - | DStrings [T.Text] - -- ^ String values that define a scale domain. - | DDateTimes [[DateTime]] - -- ^ Date-time values that define a scale domain. + = DMax Double + -- ^ Sets the maximum value in the scale domain. + -- It is only intended for scales with a continuous domain. + -- + -- It is supported in Vega-Lite 4.14 and later. + -- + -- @since 0.11.0.0 + | DMaxTime [DateTime] + -- ^ 'DMax' for dates. + -- + -- It is supported in Vega-Lite 4.14 and later. + -- + -- @since 0.11.0.0 + | DMid Double + -- ^ Sets the mid-point of a continuous diverging domain. + -- + -- It replaces 'Graphics.Vega.VegaLite.SDomainMid'. + -- + -- @since 0.11.0.0 + | DMin Double + -- ^ Sets the minimum value in the scale domain. + -- It is only intended for scales with a continuous domain. + -- + -- It is supported in Vega-Lite 4.14 and later. + -- + -- @since 0.11.0.0 + | DMinTime [DateTime] + -- ^ 'DMin' for dates. + -- + -- It is supported in Vega-Lite 4.14 and later. + -- + -- @since 0.11.0.0 | DSelection SelectionLabel -- ^ Scale domain based on a named interactive selection. -- See also 'DSelectionField' and 'DSelectionChannel', which should @@ -77,38 +109,74 @@ -- is projected over multiple fields or encodings. -- -- @since 0.7.0.0 - | DUnionWith ScaleDomain + | DUnionWith DomainLimits -- ^ Combine the domain of the data with the provided domain. -- -- The following example will use a range of at least 0 to 100, -- but this will be increased if the data (either initially or -- via any updates to the Vege-Lite visualization) exceeds this: -- - -- @'Graphics.Vega.VegaLite.PScale' ['Graphics.Vega.VegaLite.SDomain' (DUnionWith ('DNumbers' [0, 100]))]@ - -- - -- Note that 'DUnionWith' should not be nested, but this - -- is not enforced by @hvega@. + -- @'Graphics.Vega.VegaLite.PScale' ['Graphics.Vega.VegaLite.SDomainOpt' (DUnionWith ('DNumbers' [0, 100]))]@ -- -- @since 0.6.0.0 | Unaggregated - -- ^ Indicate that a domain of aggregated data should be scaled to - -- the domain of the data prior to aggregation. + -- ^ Indicate that a domain of aggregated data should be scaled to + -- the domain of the data prior to aggregation. -scaleDomainSpec :: ScaleDomain -> VLSpec -scaleDomainSpec (DNumbers nums) = toJSON (map toJSON nums) -scaleDomainSpec (DDateTimes dts) = toJSON (map (object . map dateTimeProperty) dts) -scaleDomainSpec (DStrings cats) = toJSON (map toJSON cats) -scaleDomainSpec (DSelection selName) = object ["selection" .= selName] -scaleDomainSpec (DSelectionField selName field) = object [ "selection" .= selName - , "field" .= field ] -scaleDomainSpec (DSelectionChannel selName ch) = object [ "selection" .= selName - , "encoding" .= channelLabel ch ] -scaleDomainSpec (DUnionWith sd) = object ["unionWith" .= scaleDomainSpec sd] -scaleDomainSpec Unaggregated = "unaggregated" +-- For now we do not include Unaggregated in DomainLimits as the +-- documentaiton suggests we should ubt the schema does not: see +-- https://github.com/vega/vega-lite/issues/7022 +-- {-| +Represent the range of the domain, which is used by 'VL.SDomain' +and 'DUnionWith'. + +Prior to @0.11.0.0@ this was part of 'ScaleDomain'. + +@since 0.11.0.0 +-} +data DomainLimits + = DNumbers [Double] + -- ^ Numeric values that define a scale domain. + -- + -- It is expected that this contains two values (minimum and + -- maximum), but more can be given for + -- [piecewise quantitative scales](https://vega.github.io/vega-lite/docs/scale.html#piecewise). + | DStrings [T.Text] + -- ^ String values that define a scale domain + | DDateTimes [[DateTime]] + -- ^ Date-time values that define a scale domain. + + +scaleDomainProperty :: ScaleDomain -> Pair + +scaleDomainProperty (DMax x) = "domainMax" .= x +scaleDomainProperty (DMaxTime dts) = "domainMax" .= dateTimeSpec dts +scaleDomainProperty (DMid x) = "domainMid" .= x +scaleDomainProperty (DMin x) = "domainMin" .= x +scaleDomainProperty (DMinTime dts) = "domainMin" .= dateTimeSpec dts + + +scaleDomainProperty (DSelection selName) = "domain" .= object ["selection" .= selName] +scaleDomainProperty (DSelectionField selName field) = "domain" .= object [ "selection" .= selName + , "field" .= field ] +scaleDomainProperty (DSelectionChannel selName ch) = "domain" .= object [ "selection" .= selName + , "encoding" .= channelLabel ch ] +scaleDomainProperty (DUnionWith sd) = "domain" .= object ["unionWith" .= domainLimitsSpec sd] +scaleDomainProperty Unaggregated = "domain" .= fromT "unaggregated" + + +domainLimitsSpec :: DomainLimits -> VLSpec +domainLimitsSpec (DNumbers nums) = toJSON (map toJSON nums) +domainLimitsSpec (DDateTimes dts) = toJSON (map dateTimeSpec dts) +domainLimitsSpec (DStrings cats) = toJSON (map toJSON cats) + + +{-| + Describes the way a scale can be rounded to \"nice\" numbers. For full details see the . @@ -188,7 +256,32 @@ -} data ScaleRange - = RPair Double Double + = RField FieldName + -- ^ For [discrete](https://vega.github.io/vega-lite/docs/scale.html#discrete) + -- and [discretizing](https://vega.github.io/vega-lite/docs/scale.html#discretizing) + -- scales, the name if the field to use. + -- + -- For example. if the field \"color\" contains CSS color names, we can say + -- @RField \"color\"@. + -- + -- It is supported in Vega-Lite 4.14 and later. + -- + -- @since 0.11.0.0 + | RMax Double + -- ^ Sets the maximum value in the scale range. + -- It is only intended for scales with a continuous range. + -- + -- It is supported in Vega-Lite 4.14 and later. + -- + -- @since 0.11.0.0 + | RMin Double + -- ^ Sets the minimum value in the scale range. + -- It is only intended for scales with a continuous range. + -- + -- It is supported in Vega-Lite 4.14 and later. + -- + -- @since 0.11.0.0 + | RPair Double Double -- ^ The minimum and maximum values. -- -- @since 0.9.0.0 diff --git a/src/Graphics/Vega/VegaLite/Selection.hs b/src/Graphics/Vega/VegaLite/Selection.hs --- a/src/Graphics/Vega/VegaLite/Selection.hs +++ b/src/Graphics/Vega/VegaLite/Selection.hs @@ -35,6 +35,7 @@ import Control.Arrow (second) import Data.Aeson ((.=), object, toJSON) +import Data.Aeson.Types (Pair) import Data.Maybe (mapMaybe) @@ -55,11 +56,11 @@ , fromColor , fromDS , cursorLabel + , (.=~), toKey, toObject ) import Graphics.Vega.VegaLite.Specification ( VLProperty(VLSelection) , PropertySpec - , LabelledSpec , SelectSpec(..) , BuildSelectSpecs , SelectionLabel @@ -238,10 +239,10 @@ -- [Vega-Lite toggle documentation](https://vega.github.io/vega-lite/docs/toggle.html). -selectionProperties :: SelectionProperty -> [LabelledSpec] +selectionProperties :: SelectionProperty -> [Pair] selectionProperties (Fields fNames) = ["fields" .= fNames] selectionProperties (Encodings channels) = ["encodings" .= map channelLabel channels] -selectionProperties (SInit iVals) = ["init" .= object (map (second dataValueSpec) iVals)] +selectionProperties (SInit iVals) = ["init" .= toObject (map (second dataValueSpec) iVals)] selectionProperties (SInitInterval Nothing Nothing) = [] selectionProperties (SInitInterval mx my) = let conv (_, Nothing) = Nothing @@ -321,7 +322,7 @@ -- ^ The offset at which to start the dash pattern. -selectionMarkProperty :: SelectionMarkProperty -> LabelledSpec +selectionMarkProperty :: SelectionMarkProperty -> Pair selectionMarkProperty (SMCursor c) = "cursor" .= cursorLabel c selectionMarkProperty (SMFill colour) = "fill" .= fromColor colour selectionMarkProperty (SMFillOpacity x) = "fillOpacity" .= x @@ -373,10 +374,10 @@ -- ^ The initial text for input elements such as text fields. -inputProperty :: InputProperty -> LabelledSpec +inputProperty :: InputProperty -> Pair inputProperty (Debounce x) = "debounce" .= x inputProperty (Element el) = "element" .= el -- #/definitions/Element -inputProperty (InOptions opts) = "options" .= map toJSON opts +inputProperty (InOptions opts) = "options" .= map toJSON opts -- don't need the map inputProperty (InMin x) = "min" .= x inputProperty (InMax x) = "max" .= x inputProperty (InName s) = "name" .= s @@ -421,7 +422,7 @@ -- ^ Color input element that can bound to a named field value. -bindingSpec :: Binding -> LabelledSpec +bindingSpec :: Binding -> Pair bindingSpec bnd = let (lbl, input, ps) = case bnd of IRange label props -> (label, fromT "range", props) @@ -438,7 +439,7 @@ ITel label props -> (label, "tel", props) IColor label props -> (label, "color", props) - in (lbl, object (("input" .= input) : map inputProperty ps)) + in toKey (lbl, object (("input" .= input) : map inputProperty ps)) {-| @@ -465,7 +466,7 @@ -- that should trigger the selection. -bindLegendProperty :: BindLegendProperty -> [LabelledSpec] +bindLegendProperty :: BindLegendProperty -> [Pair] bindLegendProperty (BLField f) = [ toLBind Nothing , "fields" .= [f] ] @@ -479,7 +480,7 @@ , "encodings" .= [channelLabel ch] ] -toLBind :: Maybe T.Text -> LabelledSpec +toLBind :: Maybe T.Text -> Pair toLBind Nothing = "bind" .= fromT "legend" toLBind (Just es) = "bind" .= object ["legend" .= es] @@ -506,7 +507,7 @@ -- -- Prior to @0.5.0.0@ this argument was @['LabelledSpec']@. -> PropertySpec -selection sels = (VLSelection, object (map unS sels)) +selection sels = (VLSelection, toObject (map unS sels)) {-| @@ -535,4 +536,4 @@ select nme sType options ols = -- TODO: elm filters out those properties that are set to A.Null let selProps = ("type" .= selectionLabel sType) : concatMap selectionProperties options - in S (nme .= object selProps) : ols + in S (nme .=~ object selProps) : ols diff --git a/src/Graphics/Vega/VegaLite/Specification.hs b/src/Graphics/Vega/VegaLite/Specification.hs --- a/src/Graphics/Vega/VegaLite/Specification.hs +++ b/src/Graphics/Vega/VegaLite/Specification.hs @@ -3,7 +3,7 @@ {-| Module : Graphics.Vega.VegaLite.Specification -Copyright : (c) Douglas Burke, 2018-2020 +Copyright : (c) Douglas Burke, 2018-2021 License : BSD3 Maintainer : dburke.gw@gmail.com @@ -50,6 +50,10 @@ ) where +#if MIN_VERSION_aeson(2, 0, 0) +import qualified Data.Aeson.Key as Key +#endif + -- VegaLite uses these symbols. import Prelude hiding (filter, lookup, repeat) @@ -58,7 +62,12 @@ import Control.Arrow (first) -- Aeson's Value type conflicts with the Number type +#if MIN_VERSION_aeson(2, 0, 0) +import Data.Aeson (Value, object, toJSON) +#else import Data.Aeson (Value, object, (.=)) +#endif + import Data.Maybe (catMaybes, fromMaybe) #if !(MIN_VERSION_base(4, 12, 0)) @@ -232,7 +241,11 @@ -- JSON representation of the visualization (noting that @VLSpec@ is -- an alias for @Value@). fromVL (VL (schema, specs)) = +#if MIN_VERSION_aeson(2, 0, 0) + let kvals = map (first Key.fromText) (("$schema", toJSON schema) : specs) +#else let kvals = ("$schema" .= schema) : specs +#endif in object kvals @@ -249,8 +262,11 @@ @ -} asSpec :: [PropertySpec] -> VLSpec +#if MIN_VERSION_aeson(2, 0, 0) +asSpec = object . map (first Key.fromText) . unProperty +#else asSpec = object . unProperty - +#endif {-| diff --git a/src/Graphics/Vega/VegaLite/Time.hs b/src/Graphics/Vega/VegaLite/Time.hs --- a/src/Graphics/Vega/VegaLite/Time.hs +++ b/src/Graphics/Vega/VegaLite/Time.hs @@ -3,7 +3,7 @@ {-| Module : Graphics.Vega.VegaLite.Time -Copyright : (c) Douglas Burke, 2018-2020 +Copyright : (c) Douglas Burke, 2018-2021 License : BSD3 Maintainer : dburke.gw@gmail.com @@ -22,7 +22,7 @@ , BaseTimeUnit(..) -- not for external export - , dateTimeProperty + , dateTimeSpec , timeUnitSpec ) where @@ -30,6 +30,7 @@ import qualified Data.Text as T import Data.Aeson ((.=), object, toJSON) +import Data.Aeson.Types (Pair) #if !(MIN_VERSION_base(4, 12, 0)) import Data.Monoid ((<>)) @@ -38,7 +39,7 @@ -- added in base 4.8.0.0 / ghc 7.10.1 import Numeric.Natural (Natural) -import Graphics.Vega.VegaLite.Specification (LabelledSpec, VLSpec) +import Graphics.Vega.VegaLite.Specification (VLSpec) {-| @@ -364,7 +365,7 @@ baseTimeUnitLabel SecondsMilliseconds = "secondsmilliseconds" -dateTimeProperty :: DateTime -> LabelledSpec +dateTimeProperty :: DateTime -> Pair dateTimeProperty (DTYear y) = "year" .= y dateTimeProperty (DTQuarter q) = "quarter" .= q dateTimeProperty (DTMonth mon) = "month" .= monthNameLabel mon @@ -379,6 +380,9 @@ dateTimeProperty (DTSeconds s) = "seconds" .= s dateTimeProperty (DTMilliseconds ms) = "milliseconds" .= ms + +dateTimeSpec :: [DateTime] -> VLSpec +dateTimeSpec = object . map dateTimeProperty dayLabel :: DayName -> T.Text dayLabel Mon = "Mon" diff --git a/src/Graphics/Vega/VegaLite/Transform.hs b/src/Graphics/Vega/VegaLite/Transform.hs --- a/src/Graphics/Vega/VegaLite/Transform.hs +++ b/src/Graphics/Vega/VegaLite/Transform.hs @@ -3,7 +3,7 @@ {-| Module : Graphics.Vega.VegaLite.Transform -Copyright : (c) Douglas Burke, 2018-2020 +Copyright : (c) Douglas Burke, 2018-2021 License : BSD3 Maintainer : dburke.gw@gmail.com @@ -46,6 +46,7 @@ import qualified Data.Text as T import Data.Aeson ((.=), object, toJSON) +import Data.Aeson.Types (Pair) import Data.Maybe (mapMaybe) #if !(MIN_VERSION_base(4, 12, 0)) @@ -62,13 +63,12 @@ ( FieldName , SortField , sortFieldSpec - , field_ + -- , field_ , fromT , allowNull ) import Graphics.Vega.VegaLite.Specification ( VLSpec - , LabelledSpec , TransformSpec(..) , SelectionLabel ) @@ -195,10 +195,10 @@ operationSpec VarianceP = "variancep" -aggregate_ :: Operation -> LabelledSpec +aggregate_ :: Operation -> Pair aggregate_ op = "aggregate" .= operationSpec op -op_ :: Operation -> LabelledSpec +op_ :: Operation -> Pair op_ op = "op" .= operationSpec op @@ -219,11 +219,11 @@ -- that do not apply to fields such as 'Count', 'Rank', and 'DenseRank'. -windowFieldProperty :: Window -> LabelledSpec +windowFieldProperty :: Window -> Pair windowFieldProperty (WAggregateOp op) = "op" .= operationSpec op windowFieldProperty (WOp op) = "op" .= wOperationLabel op windowFieldProperty (WParam n) = "param" .= n -windowFieldProperty (WField f) = field_ f +windowFieldProperty (WField f) = "field" .= f -- was "field_ f" -- | Window-specific operation for transformations (for use with 'WOp'). @@ -340,7 +340,7 @@ -- ^ Pick the step size from this list. -binProperty :: BinProperty -> LabelledSpec +binProperty :: BinProperty -> Pair binProperty (AlreadyBinned b) = "binned" .= b binProperty (BinAnchor x) = "anchor" .= x binProperty (Base x) = "base" .= x @@ -354,11 +354,11 @@ binProperty (Steps xs) = "steps" .= xs -bin :: [BinProperty] -> LabelledSpec +bin :: [BinProperty] -> Pair bin [] = "bin" .= True bin xs = "bin" .= object (map binProperty xs) -binned_ :: LabelledSpec +binned_ :: Pair binned_ = "bin" .= fromT "binned" @@ -462,7 +462,7 @@ -- ^ The replacement value (when using @ImMethod 'ImValue'@). -imputeProperty :: ImputeProperty -> LabelledSpec +imputeProperty :: ImputeProperty -> Pair imputeProperty (ImFrame m1 m2) = "frame" .= map allowNull [m1, m2] imputeProperty (ImKeyVals dVals) = "keyvals" .= dataValuesSpecs dVals imputeProperty (ImKeyValSequence start stop step) = @@ -497,7 +497,7 @@ imputePropertySpecValue _ = Nothing -impute_ :: [ImputeProperty] -> LabelledSpec +impute_ :: [ImputeProperty] -> Pair impute_ ips = "impute" .= object (map imputeProperty ips) diff --git a/stack.yaml b/stack.yaml --- a/stack.yaml +++ b/stack.yaml @@ -5,4 +5,4 @@ extra-deps: [] -resolver: lts-15.5 +resolver: lts-21.2 diff --git a/tests/CompositeTests.hs b/tests/CompositeTests.hs --- a/tests/CompositeTests.hs +++ b/tests/CompositeTests.hs @@ -174,13 +174,13 @@ errorband2No = eBand "stdev" False +barley :: Data +barley = dataFromUrl "https://vega.github.io/vega-lite/data/barley.json" [] + + eBar :: MarkErrorExtent -> VegaLite eBar ext = - let - barley = - dataFromUrl "https://vega.github.io/vega-lite/data/barley.json" [] - - enc = + let enc = encoding . position X [ PName "yield", PmType Quantitative , PScale [ SZero False ] ] @@ -235,7 +235,7 @@ in toVegaLite [ des - , dataFromUrl "https://vega.github.io/vega-lite/data/barley.json" [] + , barley , layer [ specErrorBars, specPoints ] ] diff --git a/tests/ConditionalTests.hs b/tests/ConditionalTests.hs --- a/tests/ConditionalTests.hs +++ b/tests/ConditionalTests.hs @@ -25,6 +25,7 @@ , ("selectionCondition5", selectionCondition5) , ("bindScales1", bindScales1) , ("bindScales2", bindScales2) + , ("selectionHeatMap", selectionHeatMap) ] @@ -325,3 +326,51 @@ in toVegaLite [ width 300, height 300, carData, sel [], mark Circle [], encHorses [] ] + + +-- https://github.com/vega/vega-lite/blob/master/examples/specs/selection_heatmap.vl.json +-- +selectionHeatMap :: VegaLite +selectionHeatMap = + let dvals = dataFromColumns [] + . dataColumn "count" (Numbers [13, 0, 0, 0, 10, 6, 0, 0, 9]) + . dataColumn "actual" (Strings ["A", "A", "A", "B", "B", "B", "C", "C", "C"]) + . dataColumn "predicted" (Strings ["A", "B", "C", "A", "B", "C", "A", "B", "C"]) + + enc = encoding + . position X [PName "predicted", PmType Nominal] + . position Y [PName "actual", PmType Nominal] + . fill [MName "count", MmType Quantitative] + . stroke [ MDataCondition + [(And + (Selection "highlight") + (Expr "length(data(\"highlight_store\"))") + , [MString "black"])] + [MNullValue] + ] + . opacity [ MSelectionCondition + (SelectionName "highlight") + [MNumber 1] + [MNumber 0.5] + ] + . order [ OSelectionCondition + (SelectionName "highlight") + [ONumber 1] + [ONumber 0] + ] + + sel = selection + . select "highlight" Single [] + + conf = configure + . configuration (ScaleStyle [SCBandPaddingInner 0, SCBandPaddingOuter 0]) + . configuration (ViewStyle [ViewStep 40]) + . configuration (RangeStyle [RRamp "yellowgreenblue"]) + . configuration (Axis [Domain False]) + + in toVegaLite [ dvals [] + , sel [] + , enc [] + , mark Rect [MStrokeWidth 2] + , conf [] + ] diff --git a/tests/DataTests.hs b/tests/DataTests.hs --- a/tests/DataTests.hs +++ b/tests/DataTests.hs @@ -694,7 +694,7 @@ domain1, domain2, domain3 :: VegaLite domain1 = domain [] domain2 = domain [SDomain (DNumbers [90, 100])] -domain3 = domain [SDomain (DUnionWith (DNumbers [90, 100]))] +domain3 = domain [SDomainOpt (DUnionWith (DNumbers [90, 100]))] {- diff --git a/tests/EncodingTests.hs b/tests/EncodingTests.hs --- a/tests/EncodingTests.hs +++ b/tests/EncodingTests.hs @@ -13,6 +13,7 @@ testSpecs :: [(String, VegaLite)] testSpecs = [ ("strokedashgroup", strokeDashGroup) , ("strokedashline", strokeDashLine) + , ("nullencoding", nullEncoding) ] @@ -41,3 +42,26 @@ . strokeDash [ MName "predicted", MmType Nominal ] $ [] ] + +-- See https://github.com/vega/vega-lite/issues/6762 +-- +-- Note: a "null" encoding here is with no arguments, which creates {}. +-- We don't support creating null instead of {}. +-- +nullEncoding :: VegaLite +nullEncoding = + let dvals = dataFromColumns [] + . dataColumn "a" (Strings ["A", "B", "D", "E", "E", "G", "H", "I"]) + . dataColumn "b" (Numbers [28, 55, 91, 81, 81, 19, 87, 52]) + + lyr1 = [mark Bar []] + lyr2 = [mark Rule [], encoding (position X [] [])] + + in toVegaLite [ description "Can we null the encoding" + , dvals [] + , encoding + . position X [PName "a", PmType Nominal, PAxis [AxLabelAngle 0]] + . position Y [PName "b", PmType Quantitative] + $ [] + , layer (map asSpec [lyr1, lyr2]) + ] diff --git a/tests/Gallery/Bar.hs b/tests/Gallery/Bar.hs --- a/tests/Gallery/Bar.hs +++ b/tests/Gallery/Bar.hs @@ -21,6 +21,8 @@ , ("bar4", bar4) , ("bar5", bar5) , ("bar6", bar6) + , ("bar6order", bar6order) + , ("bar6sort", bar6sort) , ("bar7", bar7) , ("bar8", bar8) , ("bar9", bar9) @@ -208,25 +210,58 @@ ] --- bar9 in GalleryBar.elm +barley :: Data +barley = dataFromUrl "https://vega.github.io/vega-lite/data/barley.json" [] + + +barleyEnc :: [EncodingSpec] -> PropertySpec +barleyEnc = encoding + . position X [ PName "yield", PmType Quantitative, PAggregate Sum ] + . position Y [ PName "variety", PmType Nominal ] + . color [ MName "site", MmType Nominal ] + + +-- bar9 in GalleryBar.elm, also first version of +-- https://vega.github.io/vega-lite/docs/stack.html#sorting-stack-order bar6 :: VegaLite bar6 = - let - des = - description "Barley crop yields as a horizontal stacked bar chart" + let des = description "Barley crop yields as a horizontal stacked bar chart" - enc = - encoding - . position X [ PName "yield", PmType Quantitative, PAggregate Sum ] - . position Y [ PName "variety", PmType Nominal ] - . color [ MName "site", MmType Nominal ] - in - toVegaLite - [ des - , dataFromUrl "https://vega.github.io/vega-lite/data/barley.json" [] - , mark Bar [] - , enc [] - ] + in toVegaLite [ des + , barley + , mark Bar [] + , barleyEnc [] + ] + + +-- tweaks to bar6 from https://vega.github.io/vega-lite/docs/stack.html#sorting-stack-order +-- +bar6order :: VegaLite +bar6order = + let enc = barleyEnc + . order [ OName "yield", OmType Quantitative, OAggregate Sum ] + + in toVegaLite [ barley + , mark Bar [] + , enc [] + ] + + +-- tweaks to bar6 from https://vega.github.io/vega-lite/docs/stack.html#sorting-stack-order +-- +bar6sort :: VegaLite +bar6sort = + let enc = barleyEnc + . order [ OName "siteOrder" ] + + trans = transform + . calculateAs "if(datum.site === 'University Farm', 0, if(datum.site === 'Grand Rapids', 1, 2))" "siteOrder" + + in toVegaLite [ barley + , trans [] + , mark Bar [] + , enc [] + ] -- bar10 in GalleryBar.elm diff --git a/tests/Gallery/Facet.hs b/tests/Gallery/Facet.hs --- a/tests/Gallery/Facet.hs +++ b/tests/Gallery/Facet.hs @@ -8,10 +8,13 @@ import Graphics.Vega.VegaLite --- import qualified Data.Text as T +import qualified Data.Text as T import Prelude hiding (filter, lookup, repeat) +import Data.Aeson (Value, (.=), object, toJSON) + + testSpecs :: [(String, VegaLite)] testSpecs = [ ("facet1", facet1) , ("facet2", facet2) @@ -22,6 +25,7 @@ , ("facet7", facet7) , ("trellisareaseattle", trellisAreaSeattle) , ("facetgridbar", facetGridBar) + , ("facet_bullet", facetBullet) ] @@ -326,4 +330,70 @@ , spacing 5 , mark Bar [] , enc [] + ] + + +bullets :: Value +bullets = + let item :: T.Text -> T.Text -> [Double] -> [Double] -> [Double] -> Value + item ttl subtitle ranges measures markers = + object [ "title" .= ttl + , "subtitle" .= subtitle + , "ranges" .= ranges + , "measures" .= measures + , "markers" .= markers + ] + + in toJSON [ item "Revenue" "US$, in thousands" [150,225,300] [220,270] [250] + , item "Profit" "%" [20,25,30] [21,23] [26] + , item "Order Size" "US$, average" [350,500,600] [100,320] [550] + , item "New Customers" "count" [1400,2000,2500] [1000,1650] [2100] + , item "Satisfaction" "out of 5" [3.5,4.25,5] [3.2,4.7] [4.4] + ] + + +-- https://vega.github.io/vega-lite/examples/facet_bullet.html +facetBullet :: VegaLite +facetBullet = + let facetOpts = facet [ RowBy [ FName "title" + , FmType Ordinal + , FHeader [ HLabelAngle 0 + , HNoTitle ] + ] + ] + + plot = asSpec [ encoding + (position X [ PmType Quantitative + , PScale [SNice (IsNice False)] + , PNoTitle + ] []) + , layer (map asSpec plots) + ] + + encX fld = encoding (position X [PName fld] []) + + plots = [ [ mark Bar [MColor "#eee"] + , encX "ranges[2]" ] + , [ mark Bar [MColor "#ddd"] + , encX "ranges[1]" ] + , [ mark Bar [MColor "#ccc"] + , encX "ranges[0]" ] + , [ mark Bar [MColor "lightsteelblue", MSize 10] + , encX "measures[1]" ] + , [ mark Bar [MColor "steelblue", MSize 10] + , encX "measures[0]" ] + , [ mark Tick [MColor "black"] + , encX "markers[0]" ] + ] + + res = resolve . resolution (RScale [(ChX, Independent)]) + + cfg = configure . configuration (TickStyle [MThickness 2]) + + in toVegaLite [ dataFromJson bullets [] + , facetOpts + , spacing 10 + , specification plot + , res [] + , cfg [] ] diff --git a/tests/Gallery/Geo.hs b/tests/Gallery/Geo.hs --- a/tests/Gallery/Geo.hs +++ b/tests/Gallery/Geo.hs @@ -280,7 +280,7 @@ encoding . position Longitude [ PName "longitude", PmType Quantitative ] . position Latitude [ PName "latitude", PmType Quantitative ] - . order [ OName "order", OmType Ordinal ] + . order [ OName "order" ] flightsSpec = asSpec diff --git a/tests/Gallery/Label.hs b/tests/Gallery/Label.hs --- a/tests/Gallery/Label.hs +++ b/tests/Gallery/Label.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} @@ -9,7 +10,11 @@ import Data.Aeson (Value(Object)) import Data.Aeson.QQ.Simple (aesonQQ) +#if MIN_VERSION_aeson(2, 0, 0) +import Data.Aeson.KeyMap (empty) +#else import Data.HashMap.Strict (empty) +#endif import Graphics.Vega.VegaLite diff --git a/tests/Gallery/Line.hs b/tests/Gallery/Line.hs --- a/tests/Gallery/Line.hs +++ b/tests/Gallery/Line.hs @@ -134,7 +134,7 @@ encoding . position X [ PName "miles", PmType Quantitative, PScale [ SZero False ] ] . position Y [ PName "gas", PmType Quantitative, PScale [ SZero False ] ] - . order [ OName "year", OmType Temporal ] + . order [ OName "year" ] in toVegaLite [ des diff --git a/tests/Gallery/Multi.hs b/tests/Gallery/Multi.hs --- a/tests/Gallery/Multi.hs +++ b/tests/Gallery/Multi.hs @@ -37,7 +37,7 @@ . position X [ PName "date" , PmType Temporal - , PScale [ SDomain (DSelection "myBrush") ] + , PScale [ SDomainOpt (DSelection "myBrush") ] , PAxis [ AxNoTitle ] ] . position Y [ PName "price", PmType Quantitative ] @@ -515,8 +515,8 @@ xr = (Number 0.2, Number 6) yr = (Number (-0.8), Number 0.8) - xscale = [ SDomain (DSelectionField "brush" "theta") ] - yscale = [ SDomain (DSelectionChannel "brush" ChY) ] + xscale = [ SDomainOpt (DSelectionField "brush" "theta") ] + yscale = [ SDomainOpt (DSelectionChannel "brush" ChY) ] plot2 = asSpec [ encoding . position X [ PName "theta", PmType Quantitative, PScale xscale ] diff --git a/tests/MarkTests.hs b/tests/MarkTests.hs --- a/tests/MarkTests.hs +++ b/tests/MarkTests.hs @@ -25,6 +25,7 @@ , ("pieChartWithLabels", pieChartWithLabels) , ("donutChart", donutChart) , ("radialChart", radialChart) + , ("pyramidChart", pyramidChart) , ("histogram_binned_no_x2", histogramBinnedNoX2) ] @@ -226,6 +227,48 @@ . color [MName "data", MmType Nominal, MLegend []] $ [] , layer [asSpec plot, asSpec label] + , viewBackground [VBNoStroke] + ] + + +-- https://vega.github.io/vega-lite/examples/arc_pie_pyramid.html +-- +pyramidChart :: VegaLite +pyramidChart = + let desc = description "Reproducing http://robslink.com/SAS/democd91/pyramid_pie.htm" + dvals = dataFromColumns [] + . dataColumn "value" (Numbers [75, 10, 15]) + . dataColumn "order" (Numbers [3, 1, 2]) + . dataColumn "category" (Strings ["Sky", "Shady side of a pyramid", "Sunny side of a pyramid"]) + $ [] + + cmap = [ ("Sky", "#416D9D") + , ("Shady side of a pyramid", "#674028") + , ("Sunny side of a pyramid", "#DEAC58") + ] + + in toVegaLite [ desc + , dvals + , mark Arc [MOuterRadius 80] + , encoding + . position Theta [ PName "value" + , PmType Quantitative + , PScale [SRange (RPair 2.35619449 8.639379797)] + -- How to get "stack": True??? + , PStack StZero + ] + . color [ MName "category" + , MmType Nominal + , MScale (categoricalDomainMap cmap) + , MLegend [ LOrient LONone + , LNoTitle + , LColumns 1 + , LeX 200 + , LeY 80 + ] + ] + . order [OName "order"] + $ [] , viewBackground [VBNoStroke] ] diff --git a/tests/ScaleTests.hs b/tests/ScaleTests.hs --- a/tests/ScaleTests.hs +++ b/tests/ScaleTests.hs @@ -20,6 +20,8 @@ , ("diverging1", diverging1) , ("diverging2", diverging2) , ("axisrange", axisrange) + , ("axislimit", axislimit) + , ("namedaxisrange", namedAxisRange) ] scale1 :: VegaLite @@ -206,21 +208,19 @@ diverging2 :: VegaLite diverging2 = toVegaLite [ divergingData - , divergingEnc [ SDomainMid 0 ] + , divergingEnc [ SDomainOpt (DMid 0) ] , mark Bar [] ] -axisrange :: VegaLite -axisrange = +axes :: [ScaleProperty] -> [ScaleProperty] -> VegaLite +axes xscale yscale = let cars = dataFromUrl "https://vega.github.io/vega-lite/data/cars.json" [] - ax axis vals = [ PName axis, PmType Quantitative, PScale [SRange vals] ] - xrange = RWidth 50 - yrange = RHeight 60 + ax axis vals = [ PName axis, PmType Quantitative, PScale vals ] enc = encoding - . position X (ax "Horsepower" xrange) - . position Y (ax "Miles_per_Gallon" yrange) + . position X (ax "Horsepower" xscale) + . position Y (ax "Miles_per_Gallon" yscale) . size [ MName "Acceleration", MmType Quantitative, MBin [] ] . opacity [ MName "Acceleration", MmType Quantitative, MBin [] ] @@ -228,3 +228,26 @@ , enc [] , mark Point [ MFilled True, MStroke "white", MStrokeWidth 0.4 ] ] + + +axisrange, axislimit :: VegaLite +axisrange = axes [SRange (RWidth 50)] [SRange (RHeight 60)] +axislimit = axes + [SDomainOpt (DMin (-10)), SDomainOpt (DMax 300)] + [SRange (RMin 220), SRange (RMax 10)] + + +-- Based on https://github.com/vega/vega-lite/issues/6392 +-- +namedAxisRange :: VegaLite +namedAxisRange = + let dataVals = dataFromColumns [] + . dataColumn "col" (Strings ["X", "Y"]) + . dataColumn "l" (Strings ["A", "B"]) + . dataColumn "c" (Strings ["#ff0000", "#0000ff"]) + + enc = encoding + . position Y [PName "col", PmType Nominal] + . color [MName "l", MmType Nominal, MScale [SRange (RField "c")]] + + in toVegaLite [dataVals [], mark Circle [], enc []] diff --git a/tests/Test.hs b/tests/Test.hs --- a/tests/Test.hs +++ b/tests/Test.hs @@ -25,7 +25,8 @@ import qualified Data.ByteString.Lazy.Char8 as BL8 -import Data.Aeson.Encode.Pretty (encodePretty) +import Data.Aeson (Value) +import Data.Aeson.Encode.Pretty (Config(confCompare), encodePretty', defConfig) import System.FilePath ((), (<.>)) @@ -84,6 +85,20 @@ import qualified Gallery.Repeat as GR import qualified Gallery.Scatter as GS import qualified Gallery.Table as GTBL + + +-- Ensure we have a repeatable ordering for the output. +-- Hopefully this is repeatable enough (brought on by +-- changes in hashable 0.3.1.0 but it makes sense to +-- do this here as I hadn't realised that the default +-- encodePretty didn't actually apply any sorting to +-- the keys). +-- +encodePretty :: Value -> BL8.ByteString +encodePretty = encodePretty' config + where + config = defConfig { confCompare = compare } + -- The "golden" output is "tests/specs/