diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,18 @@ 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.2.1.0 + +Added the `toHtml` and `toHtmlFile` functions which create the necessary +HTML to view the Vega-Lite visualization using +[Vega Embed](https://vega.github.io/vega-lite/usage/embed.html) +(this is similar to how +[ihaskell-hvega](https://hackage.haskell.org/package/ihaskell-hvega) +works). + +This functionality was provided by Gregory Schwartz; apologies for +taking so long to get it released. + ## 0.2.0.0 The constructors for the LegendOrientation type have been renamed (by diff --git a/hvega.cabal b/hvega.cabal --- a/hvega.cabal +++ b/hvega.cabal @@ -1,5 +1,5 @@ name: hvega -version: 0.2.0.0 +version: 0.2.1.0 synopsis: Create Vega-Lite visualizations in Haskell. description: This is an almost-direct port of elm-vega () 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 @@ -10,7 +10,7 @@ Stability : unstable Portability : OverloadedStrings, TupleSections -This is essentially a straight port of the +This is essentially a straight port of the (version 2.2.1). It allows users to create a Vega-Lite specification, targeting @@ -24,7 +24,7 @@ 'toVegaLite' - is not a 'VLSpec' (an alias for 'Data.Aeson.Value') but is instead a newtype around this ('VegaLite'). There are also some minor changes to the exported types and symbols (e.g. 'Utc' is exported rather than -@utc@ and @bin@ is not exported). +@utc@ and @bin@ is not exported). Note that this module exports several symbols that are exported by the Prelude, namely 'filter', 'lookup', @@ -86,16 +86,18 @@ , fromVL , VLProperty , VLSpec - , VegaLite + , VegaLite , LabelledSpec , BuildLabelledSpecs , combineSpecs + , toHtml + , toHtmlFile -- * Creating the Data Specification -- -- Functions and types for declaring the input data to the -- visualization. - + , dataFromUrl , dataFromColumns , dataFromRows @@ -119,15 +121,15 @@ -- Functions and types for declaring the transformation rules that -- are applied to data fields or geospatial coordinates before they -- are encoded visually. - + , transform , projection , ProjectionProperty(..) , Projection(..) , ClipRect(..) - + -- ** Aggregation - + , aggregate , Operation(..) , opAs @@ -137,7 +139,7 @@ , binAs , BinProperty(..) - + -- ** Data Calculation , calculateAs @@ -169,7 +171,7 @@ -- * Creating the Encoding Specification -- -- $encoding - + , encoding , Measurement(..) @@ -189,7 +191,7 @@ , VAlign(..) , FontWeight(..) , TimeUnit(..) - + -- ** Mark channels -- -- Control the appearance of the visual marks in the visualization @@ -214,11 +216,11 @@ , text , tooltip , TextChannel(..) - + -- ** Hyperlink Channels -- -- $hyperlink - + , hyperlink , HyperlinkChannel(..) @@ -235,11 +237,11 @@ , row , column - + -- ** Level of detail Channel -- -- $detail - + , detail , DetailChannel(..) @@ -255,7 +257,7 @@ , ScaleRange(..) , ScaleNice(..) , CInterpolate(..) - + -- * Creating view compositions -- -- $view @@ -329,7 +331,7 @@ , ViewConfig(..) , RangeConfig(..) , FieldTitleProperty(..) - + -- * General Data types -- -- In addition to more general data types like integers and string, the following types @@ -348,7 +350,10 @@ import Prelude hiding (filter, lookup, repeat) import qualified Data.Aeson as A +import qualified Data.Aeson.Text as A import qualified Data.Text as T +import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy.IO as TL import qualified Data.Vector as V import Control.Arrow (first, second) @@ -559,7 +564,7 @@ let kvals = ("$schema" .= vlSchemaName) : map toProp vals toProp = first vlPropertyLabel - + in VL { fromVL = object kvals } @@ -582,6 +587,42 @@ {-| +Converts VegaLite to html Text. Uses Vega-Embed. + +-} +toHtml :: VegaLite -> TL.Text +toHtml vl = TL.unlines + [ "" + , "" + , "" + , " " + , " " + , " " + , " " + , " " + , "" + , "" + , "
" + , "" + , "" + , "" + ] + +{-| + +Converts VegaLite to an html file. Uses Vega-Embed. + +-} +toHtmlFile :: FilePath -> VegaLite -> IO () +toHtmlFile file = TL.writeFile file . toHtml + +{-| + Create a specification sufficient to define an element in a composed visualization such as a superposed layer or juxtaposed facet. Typically a layer will contain a full set of specifications that define a visualization with @@ -842,7 +883,7 @@ let ps = [("type", "json")] <> if T.null (T.strip js) then [] else [("property", js)] in map (second toJSON) ps - + formatProperty CSV = [("type", "csv")] formatProperty TSV = [("type", "tsv")] formatProperty (TopojsonFeature os) = [ ("type", "topojson") @@ -863,7 +904,7 @@ | otherwise -> "date:'" <> fmt <> "'" FoUtc fmt | T.null fmt -> "utc" | otherwise -> "utc:'" <> fmt <> "'" - in toJSON s + in toJSON s {-| @@ -913,7 +954,7 @@ -- written rather differently -- -- The input is expected to be a singleton list containing a pair. - let convert = extract . snd + let convert = extract . snd specs = map (second convert) namedData extract din = @@ -922,7 +963,7 @@ extract' _ = din in maybe din extract' (decode (encode din)) - + in (VLDatasets, object specs) @@ -955,7 +996,7 @@ else [("format", toJSON fmtObject)] fmtObject = object (concatMap formatProperty fmts) - + in (VLData, object vals) @@ -973,7 +1014,7 @@ elmTail (_:ts) = Just ts filterMap = mapMaybe - + in (x : heads) : transpose (xs : tails) @@ -1056,7 +1097,7 @@ dtToJSON = object . map dateTimeProperty x = map (colName,) col - + in x : xs @@ -1193,7 +1234,7 @@ vals = if null props then jsName else object (("type" .= jsName) : map markProperty props) - + in (VLMark, vals) @@ -1565,7 +1606,7 @@ let js = case extent of [mn, mx] -> object ["name" .= nme, "extent" .= [mn, mx]] _ -> toJSON nme - + in ("scheme", js) @@ -2388,8 +2429,8 @@ -- ^ Typically used for continuous quantitative data. | Symbol -- ^ Typically used for categorical data. - + legendLabel :: Legend -> T.Text legendLabel Gradient = "gradient" legendLabel Symbol = "symbol" @@ -2557,8 +2598,8 @@ -- ^ Use the same padding on all four edges of the container. | PEdges Double Double Double Double -- ^ Specify the padding for the left, top, right, and bottom edges. - - + + paddingSpec :: Padding -> VLSpec paddingSpec (PSize p) = toJSON p paddingSpec (PEdges l t r b) = @@ -2706,7 +2747,7 @@ ROrdinal nme -> ("ordinal", nme) RRamp nme -> ("ramp", nme) RSymbol nme -> ("symbol", nme) - + in l .= object [schemeProperty n []] @@ -2805,7 +2846,7 @@ -- ^ A that evaluates -- to @true@ or @false@. - + selectionProperty :: SelectionProperty -> LabelledSpec selectionProperty (Fields fNames) = "fields" .= map toJSON fNames selectionProperty (Encodings channels) = "encodings" .= map (toJSON . channelLabel) channels @@ -3129,7 +3170,7 @@ configProperty (Scale scs) = "scale" .= object (map scaleConfigProperty scs) configProperty (Stack sp) = stackProperty sp configProperty (Range rcs) = "range" .= object (map rangeConfigProperty rcs) -configProperty (SelectionStyle selConfig) = +configProperty (SelectionStyle selConfig) = let selProp (sel, sps) = selectionLabel sel .= object (map selectionProperty sps) in "selection" .= object (map selProp selConfig) configProperty (View vcs) = "view" .= object (map viewConfigProperty vcs) @@ -3908,10 +3949,10 @@ _ -> A.Null _ -> object [(str, val)] - - in (VLTransform, js) + in (VLTransform, js) + {-| Assigns a list of specifications to be juxtaposed vertically in a visualization. @@ -4042,7 +4083,7 @@ -> BuildLabelledSpecs color markProps ols = let cs = object (concatMap markChannelProperty markProps) - in ("color", cs) : ols + in ("color", cs) : ols {-| @@ -4166,10 +4207,10 @@ DateTimes dts -> map (object . map dateTimeProperty) dts Strings ss -> map toJSON ss Booleans bs -> map toJSON bs - + in object [field_ field, "oneOf" .= ans] - in ("filter", js) : ols + in ("filter", js) : ols {-| @@ -4265,7 +4306,7 @@ -- ^ The name of the field in the secondary data source to match against -- the primary key. -> T.Text - -- ^ The field name for the new data. + -- ^ The field name for the new data. -> BuildLabelledSpecs lookupAs key1 (_, spec) key2 asName ols = ("lookupAs" .= [toJSON key1, spec, toJSON key2, toJSON asName]) : ols