{-# LANGUAGE ExtendedDefaultRules #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
module Knit.Report.Input.Visualization.Hvega
(
addHvega
)
where
import Knit.Report.Input.Html.Blaze ( addBlaze )
import qualified Data.Aeson.Encode.Pretty as A
import qualified Data.ByteString.Lazy.Char8 as BS
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Graphics.Vega.VegaLite as GV
import qualified Text.Blaze.Html5 as BH
import qualified Text.Blaze.Html5.Attributes as BHA
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
addHvega
:: ( PM.PandocEffects effs
, P.Member PE.ToPandoc effs
, P.Member KUI.UnusedId effs
)
=> Maybe T.Text
-> Maybe T.Text
-> GV.VegaLite
-> P.Sem effs T.Text
addHvega idTextM captionTextM vl = do
PE.require PE.VegaSupport
idText <- maybe (KUI.getNextUnusedId "figure") return idTextM
addBlaze $ placeVisualization idText captionTextM vl
return idText
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 =
"var vlSpec=\n"
<> vegaScript
<> ";\n"
<> "vegaEmbed(\'#"
<> idText
<> "\',vlSpec);"
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