diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,16 @@ -v 0.1.0.0 -* Initial version +v 0.3.0.0 +* Added exports of "Colonnade" and "Text.Blaze.Colonnade" to "Knit.Report.Input.Table.Colonnade" +* Added "knitError" function to Knit.Report to allow user throwing of errors. These will become PandocSomeError and handled as a PandocError. +* Lowered bound on containers (to 0.5.0) to accomodate use of Plots. +* Added Knit.Report.Input.Visualization.Diagrams. Adds Diagrams from diagrams-lib via SVG backend. +* Added some more re-exports (Colonnade, Diagrams.Prelude) from Knit.Report to simplify imports on use. +* Added an optional figure caption argument to Hvega and Diagrams inputs. (this is a breaking change since it requires another argument). +* Added a state effect wrapper to facilitate getting unused ids for figures, etc. +* Changed id argument for Hvega and Diagrams visualizations to "Maybe Text" from Text. Will use built-in facilities for unique ids when set to Nothing. +* Visualization "addXXX" functions now return the figure id (as "Sem r Text") so it can be referred to elsewhere. +* Added KnitOne and KnitMany constraint-type-aliases to Knit.Report to simplify constraining doc producing functions. +* Updated examples. Added a diagrams example to SimpleExample and fixed id and caption arguments throughout. +* Bumped upper bounds (network) v 0.2.0.0 * Documentation Fixes @@ -8,3 +19,7 @@ * Added a multi-doc example * (internal) Removed odd, and no longer necessary, "LastMember" constraint from knit functions. * Updated effects for polysemy 1.2 + +v 0.1.0.0 +* Initial version + diff --git a/examples/ErrorExample.hs b/examples/ErrorExample.hs new file mode 100644 --- /dev/null +++ b/examples/ErrorExample.hs @@ -0,0 +1,67 @@ +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE GADTs #-} +module Main where + +import qualified Knit.Report as K + +import qualified Data.Map as M +import qualified Data.Text.IO as T +import qualified Data.Text.Lazy as TL +import qualified Data.Text as T +import Data.String.Here (here) +import qualified Graphics.Vega.VegaLite as V + +templateVars :: M.Map String String +templateVars = M.fromList + [ ("lang" , "English") + , ("author" , "Adam Conner-Sax") + , ("pagetitle", "knit-haskell simple example") +-- , ("tufte","True") + ] + +main :: IO () +main = do + let pandocWriterConfig = K.PandocWriterConfig (Just "pandoc-templates/minWithVega-pandoc.html") templateVars K.mindocOptionsF + resSimpleE <- K.knitHtml (Just "SimpleExample.Main") K.logAll pandocWriterConfig makeDocWithKnitError + case resSimpleE of + Right htmlAsText -> + T.writeFile "examples/html/example_simple.html" + $ TL.toStrict + $ htmlAsText + Left err -> putStrLn $ "Pandoc Error: " ++ show err + +md1 :: T.Text +md1 = [here| +## Some example markdown +* [Markdown][MarkdownLink] is a nice way to write formatted notes with a minimum of code. +* It supports links and tables and some *styling* information. + +[MarkDownLink]: +|] + +makeDocWithKnitError :: K.KnitOne effs => K.Sem effs () +makeDocWithKnitError = K.wrapPrefix "makeDocWithKnitError" $ do + K.logLE K.Info "adding some markdown..." + K.addMarkDown md1 + K.logLE K.Info "adding some latex..." + K.addMarkDown "## Some example latex" + K.addLatex "Overused favorite equation: $e^{i\\pi} + 1 = 0$" + K.logLE K.Info "adding a visualization..." + K.knitError "Uh oh! Something went wrong which I am explaining with this message." + K.addMarkDown "## An example hvega visualization" + _ <- K.addHvega Nothing Nothing exampleVis + return () + + +exampleVis :: V.VegaLite +exampleVis = + let cars = V.dataFromUrl "https://vega.github.io/vega-datasets/data/cars.json" [] + enc = V.encoding + . V.position V.X [ V.PName "Horsepower", V.PmType V.Quantitative ] + . V.position V.Y [ V.PName "Miles_per_Gallon", V.PmType V.Quantitative ] + . V.color [ V.MName "Origin", V.MmType V.Nominal ] + bkg = V.background "rgba(0, 0, 0, 0.05)" + in V.toVegaLite [ bkg, cars, V.mark V.Circle [], enc [] ] diff --git a/examples/MtlExample.hs b/examples/MtlExample.hs --- a/examples/MtlExample.hs +++ b/examples/MtlExample.hs @@ -59,8 +59,7 @@ [MarkDownLink]: |] -makeDoc :: (K.Member K.ToPandoc effs - , K.PandocEffects effs +makeDoc :: ( K.KnitOne effs , K.KnitBase ExampleApp effs) => K.Sem effs () makeDoc = K.wrapPrefix "makeDoc" $ do K.logLE K.Info "adding some markdown..." @@ -72,7 +71,7 @@ K.logLE K.Info "adding a visualization..." K.addMarkDown "## An example hvega visualization" - K.addHvega "someID" exampleVis + _ <- K.addHvega Nothing Nothing exampleVis K.logLE K.Info "Retrieving some text from the base monad and current date-time." envText <- K.liftKnit @ExampleApp getEnv diff --git a/examples/MultiDocExample.hs b/examples/MultiDocExample.hs --- a/examples/MultiDocExample.hs +++ b/examples/MultiDocExample.hs @@ -43,10 +43,7 @@ [MarkDownLink]: |] -makeDoc1 :: (K.Member K.ToPandoc effs -- required for the single-document variant - , K.PandocEffects effs -- all effects for knitting - ) - => K.Sem effs () +makeDoc1 :: K.KnitOne effs => K.Sem effs () makeDoc1 = K.wrapPrefix "makeDoc1" $ do K.logLE K.Info "adding some markdown." K.addMarkDown md1 @@ -55,7 +52,8 @@ K.addLatex "Overused favorite equation: $e^{i\\pi} + 1 = 0$" K.logLE K.Info "adding a visualization." K.addMarkDown "## An example hvega visualization (Doc 1)" - K.addHvega "someID" exampleVis + _ <- K.addHvega Nothing Nothing exampleVis + return () md2 :: T.Text md2 = [here| @@ -66,10 +64,7 @@ [MarkDownLink]: |] -makeDoc2 :: (K.Member K.ToPandoc effs -- required for the single-document variant - , K.PandocEffects effs -- all effects for knitting - ) - => K.Sem effs () +makeDoc2 :: K.KnitOne effs => K.Sem effs () makeDoc2 = K.wrapPrefix "makeDoc2" $ do K.logLE K.Info "adding some markdown." K.addMarkDown md2 @@ -78,7 +73,8 @@ K.addLatex "A different equation: $a^2 + b^2 = c^2$" K.logLE K.Info "adding a visualization." K.addMarkDown "## An example hvega visualization (Doc 2)" - K.addHvega "someID" exampleVis + _ <- K.addHvega Nothing Nothing exampleVis + return () exampleVis :: V.VegaLite exampleVis = @@ -89,3 +85,4 @@ . V.color [ V.MName "Origin", V.MmType V.Nominal ] bkg = V.background "rgba(0, 0, 0, 0.05)" in V.toVegaLite [ bkg, cars, V.mark V.Circle [], enc [] ] + diff --git a/examples/RandomExample.hs b/examples/RandomExample.hs --- a/examples/RandomExample.hs +++ b/examples/RandomExample.hs @@ -66,8 +66,7 @@ [MarkDownLink]: |] -makeDoc :: (K.Member K.ToPandoc effs - , K.PandocEffects effs +makeDoc :: ( K.KnitOne effs , K.Member KR.Random effs -- this one needs to be handled before knitting , K.KnitBase ExampleApp effs) => K.Sem effs () makeDoc = K.wrapPrefix "makeDoc" $ do @@ -80,7 +79,7 @@ K.logLE K.Info "adding a visualization..." K.addMarkDown "## An example hvega visualization" - K.addHvega "someID" exampleVis + _ <- K.addHvega Nothing Nothing exampleVis K.logLE K.Info "Retrieving some text from the base monad and current date-time." envText <- K.liftKnit @ExampleApp getEnv diff --git a/examples/SimpleExample.hs b/examples/SimpleExample.hs --- a/examples/SimpleExample.hs +++ b/examples/SimpleExample.hs @@ -5,15 +5,17 @@ {-# LANGUAGE GADTs #-} module Main where -import qualified Knit.Report as K +import qualified Knit.Report as K -import qualified Data.Map as M -import qualified Data.Text.IO as T -import qualified Data.Text.Lazy as TL +import qualified Data.Map as M +import qualified Data.Text.IO as T +import qualified Data.Text.Lazy as TL import qualified Data.Text as T -import Data.String.Here (here) -import qualified Graphics.Vega.VegaLite as V +import Data.String.Here (here) +import qualified Graphics.Vega.VegaLite as V +import qualified Plots as P + templateVars :: M.Map String String templateVars = M.fromList [ ("lang" , "English") @@ -42,10 +44,7 @@ [MarkDownLink]: |] -makeDoc :: (K.Member K.ToPandoc effs -- required for the single-document variant - , K.PandocEffects effs -- all effects for knitting - ) - => K.Sem effs () +makeDoc :: K.KnitOne effs => K.Sem effs () makeDoc = K.wrapPrefix "makeDoc" $ do K.logLE K.Info "adding some markdown..." K.addMarkDown md1 @@ -54,8 +53,13 @@ K.addLatex "Overused favorite equation: $e^{i\\pi} + 1 = 0$" K.logLE K.Info "adding a visualization..." K.addMarkDown "## An example hvega visualization" - K.addHvega "someID" exampleVis + _ <- K.addHvega Nothing (Just "From the cars data-set") exampleVis + K.addMarkDown "## An example Diagrams visualization" + K.logLE K.Info "adding a Diagrams plot..." + _ <- K.addDiagramAsSVG Nothing (Just "Example diagrams visualization using the Plots library") 300 300 samplePlot + return () +-- example using HVega exampleVis :: V.VegaLite exampleVis = let cars = V.dataFromUrl "https://vega.github.io/vega-datasets/data/cars.json" [] @@ -65,3 +69,22 @@ . V.color [ V.MName "Origin", V.MmType V.Nominal ] bkg = V.background "rgba(0, 0, 0, 0.05)" in V.toVegaLite [ bkg, cars, V.mark V.Circle [], enc [] ] + + +-- example using Plots (as an example of using Diagrams) +samplePlot :: K.Diagram K.SVG +samplePlot = P.renderAxis logAxis + +logData = [K.V2 1 10, K.V2 2 100, K.V2 2.5 316, K.V2 3 1000] + +logAxis :: P.Axis K.SVG K.V2 Double +logAxis = P.r2Axis K.&~ do + P.scatterPlot' logData + -- yMin ?= 200 + + P.yAxis P.&= do + P.logScale K..= P.LogAxis + P.majorTicksFunction K..= P.logMajorTicks 5 -- <> pure [1] + -- minorTicksFunction .= minorTicksHelper 5 + +--exampleDiagram :: diff --git a/knit-haskell.cabal b/knit-haskell.cabal --- a/knit-haskell.cabal +++ b/knit-haskell.cabal @@ -1,7 +1,7 @@ cabal-version: 2.2 name: knit-haskell -version: 0.2.0.0 +version: 0.3.0.0 synopsis: a minimal Rmarkdown sort-of-thing for haskell, by way of Pandoc description: knit-haskell is a beginning attempt at bringing some of the benefits of Rmarkdown to Haskell. @@ -42,6 +42,7 @@ , Knit.Effect.RandomFu , Knit.Effect.PandocMonad , Knit.Effect.Pandoc + , Knit.Effect.UnusedId , Knit.Report.Input.Table.Colonnade , Knit.Report.Input.Html , Knit.Report.Input.Html.Lucid @@ -49,6 +50,7 @@ , Knit.Report.Input.Latex , Knit.Report.Input.MarkDown.PandocMarkDown , Knit.Report.Input.Visualization.Hvega + , Knit.Report.Input.Visualization.Diagrams , Knit.Report.Output , Knit.Report.Output.Html , Knit.Report @@ -62,13 +64,15 @@ bytestring >= 0.10.8 && < 0.11, case-insensitive >= 1.2.0.11 && < 1.3.0.0, colonnade >= 1.1 && < 1.3, - containers >= 0.6.0 && < 0.7, + containers >= 0.5.0 && < 0.7, directory >= 1.3.3.0 && < 1.4.0.0, + diagrams-lib >= 1.4 && < 1.5.0.0, + diagrams-svg >= 1.4.1 && < 1.5.0.0, Glob >= 0.10.0 && < 0.11.0, http-client >= 0.6.4 && < 0.7.0, http-client-tls >= 0.3.5.3 && < 0.4.0.0, http-types >= 0.12.3 && < 0.13.0, - network >= 2.8.0.0 && < 3.1.0.0, + network >= 2.8.0.0 && < 3.2.0.0, network-uri >= 2.6.1.0 && < 2.7.0.0, text >= 1.2.3 && < 1.3, time >= 1.8.0 && < 2.0.0, @@ -83,6 +87,7 @@ pandoc >= 2.7.2 && < 2.8, random-fu >= 0.2.7 && < 0.3, random-source >= 0.3.0 && < 0.4, + svg-builder >= 0.1.1 && < 0.2 hs-source-dirs: src default-language: Haskell2010 @@ -90,6 +95,21 @@ executable SimpleExample main-is: SimpleExample.hs + hs-source-dirs: examples + ghc-options: -Wall + build-depends: base, + blaze-html, + containers, + here >= 1.2.10 && < 1.3.0, + hvega, + knit-haskell -any, + plots, + polysemy, + text + default-language: Haskell2010 + +executable ErrorExample + main-is: ErrorExample.hs hs-source-dirs: examples ghc-options: -Wall build-depends: base, diff --git a/src/Knit/Effect/Pandoc.hs b/src/Knit/Effect/Pandoc.hs --- a/src/Knit/Effect/Pandoc.hs +++ b/src/Knit/Effect/Pandoc.hs @@ -5,9 +5,9 @@ {-# LANGUAGE PolyKinds #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE LambdaCase #-} {-# OPTIONS_GHC -fwarn-incomplete-patterns #-} {-| Module : Knit.Effect.Pandoc diff --git a/src/Knit/Effect/UnusedId.hs b/src/Knit/Effect/UnusedId.hs new file mode 100644 --- /dev/null +++ b/src/Knit/Effect/UnusedId.hs @@ -0,0 +1,55 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# OPTIONS_GHC -fwarn-incomplete-patterns #-} +{-| +Module : Knit.Effect.UnusedId +Description : Wrapper around Polysemy.State for generating unused ids with a given prefix +Copyright : (c) Adam Conner-Sax 2019 +License : BSD-3-Clause +Maintainer : adam_conner_sax@yahoo.com +Stability : experimental + +-} +module Knit.Effect.UnusedId + ( + -- * Effect + UnusedId + + -- * actions + , getNextUnusedId + + -- * interpretations + , runUnusedId + ) +where + +import qualified Polysemy as P +import qualified Polysemy.State as PS + +import qualified Data.Map as M +import qualified Data.Text as T +import Data.Maybe ( fromMaybe ) + +-- | Type alias for the dictionary ('M.Map') of current last used id at each prefix. +type IdMap = M.Map T.Text Int + +-- | Type alias for 'Polysemy.State' using "IdMap". +type UnusedId = PS.State IdMap + +-- | Get an unused id with prefix as specified. Useful for figures, etc. +getNextUnusedId :: P.Member UnusedId r => T.Text -> P.Sem r T.Text +getNextUnusedId prefixT = do + idMap <- PS.get @IdMap + let nextId = fromMaybe 1 $ M.lookup prefixT idMap + PS.put $ M.insert prefixT (nextId + 1) idMap + return $ prefixT <> "_" <> (T.pack $ show nextId) + +-- | Run the UnusedId effect and throw away the state. +runUnusedId :: P.Sem (UnusedId ': r) a -> P.Sem r a +runUnusedId = fmap snd . PS.runState M.empty diff --git a/src/Knit/Report.hs b/src/Knit/Report.hs --- a/src/Knit/Report.hs +++ b/src/Knit/Report.hs @@ -40,6 +40,10 @@ knitHtml , knitHtmls , liftKnit + , knitError + , KnitEffects + , KnitOne + , KnitMany , KnitBase -- * Inputs @@ -50,6 +54,7 @@ , module Knit.Report.Input.Html.Lucid , module Knit.Report.Input.Latex , module Knit.Report.Input.Visualization.Hvega + , module Knit.Report.Input.Visualization.Diagrams -- * Output , module Knit.Report.Output @@ -61,6 +66,7 @@ , module Knit.Effect.Docs , module Knit.Effect.PandocMonad , module Knit.Effect.Logger + , module Knit.Effect.UnusedId ) where @@ -86,10 +92,6 @@ , LogWithPrefixesLE ) import Knit.Report.Input.Table.Colonnade - ( addColonnadeTextTable - , addColonnadeHtmlTable - , addColonnadeCellTable - ) import Knit.Report.Input.MarkDown.PandocMarkDown ( addMarkDown ) import Knit.Report.Input.Html ( addStrictTextHtml @@ -100,6 +102,8 @@ import Knit.Report.Input.Latex ( addLatex ) import Knit.Report.Input.Visualization.Hvega ( addHvega ) +import Knit.Report.Input.Visualization.Diagrams +-- hiding ( trace ) -- trace conflicts with Pandoc.trace import Knit.Report.Output ( PandocWriterConfig(..) ) import Knit.Report.Output.Html ( pandocWriterToBlazeDocument @@ -125,7 +129,8 @@ import qualified Knit.Effect.Pandoc as KP import qualified Knit.Effect.PandocMonad as KPM import qualified Knit.Effect.Logger as KLog - +import qualified Knit.Effect.UnusedId as KUI +import Knit.Effect.UnusedId ( getNextUnusedId ) -- | Create multiple HTML docs (as Text) from the named sets of pandoc fragments. @@ -165,11 +170,27 @@ liftKnit :: Member (Lift m) r => m a -> Sem r a liftKnit = P.sendM --- From here down is unexported. +-- | Throw an error with a specific message. This will emerge as a 'PandocSomeError' in order +-- to avoid complicating the error type. +-- NB: The Member constraint is satisfied by KnitEffectStack m. +knitError :: P.Member (PE.Error PA.PandocError) r => T.Text -> P.Sem r () +knitError msg = + PE.throw (PA.PandocSomeError $ "Knit User Error: " ++ T.unpack msg) +-- | Constraint alias for the effects we need when calling Knit +type KnitEffects r = (KPM.PandocEffects r, P.Member KUI.UnusedId r) + +-- | Constraint alias for the effects we need to knit one document +type KnitOne r = (KnitEffects r, P.Member KP.ToPandoc r) + +-- | Constraint alias for the effects we need to knit multiple documents. +type KnitMany r = (KnitEffects r, P.Member (KD.Docs KP.PandocWithRequirements) r) + +-- From here down is unexported. -- | The exact stack we are interpreting when we knit type KnitEffectStack m = - '[ KPM.Pandoc + '[ KUI.UnusedId + , KPM.Pandoc , KLog.Logger KLog.LogEntry , KLog.PrefixLog , PE.Error PA.PandocError @@ -196,5 +217,6 @@ . PE.runError . KLog.filteredLogEntriesToIO ls . KPM.interpretInIO -- PA.PandocIO + . KUI.runUnusedId . maybe id KLog.wrapPrefix loggingPrefixM diff --git a/src/Knit/Report/Input/Table/Colonnade.hs b/src/Knit/Report/Input/Table/Colonnade.hs --- a/src/Knit/Report/Input/Table/Colonnade.hs +++ b/src/Knit/Report/Input/Table/Colonnade.hs @@ -23,12 +23,17 @@ addColonnadeTextTable , addColonnadeHtmlTable , addColonnadeCellTable + -- * Re-exports + , module Colonnade + , module Text.Blaze.Colonnade ) where import qualified Colonnade as C +import Colonnade import qualified Text.Blaze.Colonnade as BC +import Text.Blaze.Colonnade import qualified Text.Blaze.Html as BH import qualified Text.Blaze.Html5.Attributes as BHA import Knit.Report.Input.Html.Blaze ( addBlaze ) diff --git a/src/Knit/Report/Input/Visualization/Diagrams.hs b/src/Knit/Report/Input/Visualization/Diagrams.hs new file mode 100644 --- /dev/null +++ b/src/Knit/Report/Input/Visualization/Diagrams.hs @@ -0,0 +1,85 @@ +{-# LANGUAGE ExtendedDefaultRules #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-| +Module : Knit.Report.Input.Visualization.Diagrams +Description : Support addition of Diagrams to knitted reports. +Copyright : (c) Adam Conner-Sax 2019 +License : BSD-3-Clause +Maintainer : adam_conner_sax@yahoo.com +Stability : experimental + +Functions to Diagrams (from the Diagrams library) to the current Pandoc document. +-} +module Knit.Report.Input.Visualization.Diagrams + ( + -- * Add Diagrams Inputs + addDiagramAsSVG + -- * re-exports + , module Diagrams.Prelude + , module Diagrams.Backend.SVG + ) +where + +import Knit.Report.Input.Html.Blaze ( addBlaze ) +import Text.Blaze.Html ( preEscapedLazyText + , toValue + ) +import qualified Text.Blaze.Html5 as BH +import qualified Text.Blaze.Html5.Attributes as BHA + +import qualified Data.Text as T +--import Data.Maybe ( fromMaybe ) + +import qualified Diagrams.Prelude as D +import Diagrams.Prelude hiding ( trace ) -- this conflicts with Pandoc trace. TO get it, you'll need to import it directly +--import qualified Diagrams.TwoD.Size as D +import qualified Diagrams.Backend.SVG as DSVG +import Diagrams.Backend.SVG +import qualified Graphics.Svg as SVG + +import qualified Polysemy as P +import qualified Knit.Effect.Pandoc as PE +import qualified Knit.Effect.PandocMonad as PM +import qualified Knit.Effect.UnusedId as KUI + +-- | Add diagram (via svg inserted as html). +addDiagramAsSVG + :: ( PM.PandocEffects effs + , P.Member PE.ToPandoc effs + , P.Member KUI.UnusedId effs + ) + => Maybe T.Text -- ^ id attribute for figure. Will use next unused "figure" id if Nothing + -> Maybe T.Text -- ^ caption for figure + -> Double -- ^ width in pixels (?) + -> Double -- ^ height in pixels (?) + -> D.QDiagram DSVG.SVG D.V2 Double D.Any-- ^ diagram + -> P.Sem effs T.Text +addDiagramAsSVG idTextM captionTextM wPixels hPixels diagram = do + idText <- maybe (KUI.getNextUnusedId "figure") return idTextM + let svgOptions = + DSVG.SVGOptions (D.dims2D wPixels hPixels) Nothing idText [] False + addDiagramAsSVGWithOptions (Just idText) captionTextM svgOptions diagram + +addDiagramAsSVGWithOptions + :: ( PM.PandocEffects effs + , P.Member PE.ToPandoc effs + , P.Member KUI.UnusedId effs + ) + => Maybe T.Text -- ^ id attribute for figure, will use next unsed "figure" id if nothing + -> Maybe T.Text -- ^ caption for figure + -> DSVG.Options DSVG.SVG D.V2 Double + -> D.QDiagram DSVG.SVG D.V2 Double D.Any-- ^ diagram + -> P.Sem effs T.Text +addDiagramAsSVGWithOptions idTextM captionTextM svgOptions diagram = do + idText <- maybe (KUI.getNextUnusedId "figure") return idTextM + addBlaze $ BH.figure BH.! BHA.id (toValue idText) $ do + preEscapedLazyText $ SVG.renderText $ D.renderDia DSVG.SVG + svgOptions + diagram + maybe (return ()) (BH.figcaption . BH.toHtml) captionTextM + return idText diff --git a/src/Knit/Report/Input/Visualization/Hvega.hs b/src/Knit/Report/Input/Visualization/Hvega.hs --- a/src/Knit/Report/Input/Visualization/Hvega.hs +++ b/src/Knit/Report/Input/Visualization/Hvega.hs @@ -35,24 +35,30 @@ import qualified Polysemy as P import qualified Knit.Effect.Pandoc as PE import qualified Knit.Effect.PandocMonad as PM +import qualified Knit.Effect.UnusedId as KUI -- TODO: Add some autogenerated unique id support -- | Add hvega (via html). Requires html since vega-lite renders using javascript. addHvega - :: (PM.PandocEffects effs, P.Member PE.ToPandoc effs) - => T.Text + :: ( PM.PandocEffects effs + , P.Member PE.ToPandoc effs + , P.Member KUI.UnusedId effs + ) + => Maybe T.Text -- ^ figure id, will get next unused with prefix "figure" if Nothing + -> Maybe T.Text -- ^ figure caption, none if Nothing -> GV.VegaLite - -> P.Sem effs () -addHvega vizId vl = do + -> P.Sem effs T.Text +addHvega idTextM captionTextM vl = do PE.require PE.VegaSupport - addBlaze $ placeVisualization vizId vl - + idText <- maybe (KUI.getNextUnusedId "figure") return idTextM + addBlaze $ placeVisualization idText captionTextM vl + return idText -- | Build (Blaze) Html for hvega visualization with the given id -placeVisualization :: T.Text -> GV.VegaLite -> BH.Html -placeVisualization idText vl = +placeVisualization :: T.Text -> Maybe T.Text -> GV.VegaLite -> BH.Html +placeVisualization idText captionTextM vl = let vegaScript :: T.Text = T.decodeUtf8 $ BS.toStrict $ A.encodePretty $ GV.fromVL vl script = @@ -62,12 +68,9 @@ <> "vegaEmbed(\'#" <> idText <> "\',vlSpec);" - in BH.figure - BH.! BHA.id (BH.toValue idText) - $ BH.script - BH.! BHA.type_ "text/javascript" - $ BH.preEscapedToHtml script - + in BH.figure BH.! BHA.id (BH.toValue idText) $ do + BH.script BH.! BHA.type_ "text/javascript" $ BH.preEscapedToHtml script + maybe (return ()) (BH.figcaption . BH.toHtml) captionTextM