{-# LANGUAGE ExtendedDefaultRules #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Knit.Report.Other.Blaze
(
makeReportHtml
, placeVisualization
, placeTextSection
, latexToHtml
, latex_
)
where
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 H
import Text.Blaze.Html5 ( (!) )
import qualified Text.Blaze.Html5.Attributes as HA
import qualified Text.Pandoc as P
latexToHtml :: T.Text -> H.Html
latexToHtml :: Text -> Html
latexToHtml lText :: Text
lText = do
let
latexReadOptions :: ReaderOptions
latexReadOptions = ReaderOptions
forall a. Default a => a
P.def
htmlWriteOptions :: WriterOptions
htmlWriteOptions = WriterOptions
forall a. Default a => a
P.def { writerHTMLMathMethod :: HTMLMathMethod
P.writerHTMLMathMethod = Text -> HTMLMathMethod
P.MathJax "" }
asHtml :: PandocPure Text
asHtml =
ReaderOptions -> Text -> PandocPure Pandoc
forall (m :: * -> *).
PandocMonad m =>
ReaderOptions -> Text -> m Pandoc
P.readLaTeX ReaderOptions
latexReadOptions Text
lText PandocPure Pandoc -> (Pandoc -> PandocPure Text) -> PandocPure Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WriterOptions -> Pandoc -> PandocPure Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
P.writeHtml5String WriterOptions
htmlWriteOptions
case PandocPure Text -> Either PandocError Text
forall a. PandocPure a -> Either PandocError a
P.runPure PandocPure Text
asHtml of
Left err :: PandocError
err -> Html -> Html
H.span (String -> Html
forall a. ToMarkup a => a -> Html
H.toHtml (String -> Html) -> String -> Html
forall a b. (a -> b) -> a -> b
$ PandocError -> String
forall a. Show a => a -> String
show PandocError
err)
Right htmlText :: Text
htmlText -> Html -> Html
H.span (Text -> Html
forall a. ToMarkup a => a -> Html
H.preEscapedToHtml Text
htmlText)
latex_ :: T.Text -> H.Html
latex_ :: Text -> Html
latex_ = Text -> Html
latexToHtml
mathJaxScript :: H.Html
mathJaxScript :: Html
mathJaxScript =
Html -> Html
H.script
(Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
HA.src
"https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js?config=TeX-MML-AM_CHTML"
(Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
HA.async ""
(Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ ""
vegaScripts2 :: H.Html
vegaScripts2 :: Html
vegaScripts2 = do
Html -> Html
H.script (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
HA.src "https://cdn.jsdelivr.net/npm/vega@4.4.0" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ ""
Html -> Html
H.script (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
HA.src "https://cdn.jsdelivr.net/npm/vega-lite@3.0.0-rc11" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ ""
Html -> Html
H.script (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
HA.src "https://cdn.jsdelivr.net/npm/vega-embed@3.28.0" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ ""
vegaScripts3 :: H.Html
vegaScripts3 :: Html
vegaScripts3 = do
Html -> Html
H.script (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
HA.src "https://cdn.jsdelivr.net/npm/vega@4.4.0/build/vega.js" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ ""
Html -> Html
H.script
(Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
HA.src
"https://cdn.jsdelivr.net/npm/vega-lite@3.0.0-rc12/build/vega-lite.js"
(Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ ""
Html -> Html
H.script
(Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
HA.src
"https://cdn.jsdelivr.net/npm/vega-embed@3.29.1/build/vega-embed.js"
(Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ ""
tufteSetup :: H.Html
tufteSetup :: Html
tufteSetup = do
Html
H.link Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
HA.rel "stylesheet" Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
HA.href
"https://cdnjs.cloudflare.com/ajax/libs/tufte-css/1.4/tufte.min.css"
Html
H.meta Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
HA.name "viewport" Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
HA.content "width=device-width, initial-scale=1"
makeReportHtml :: T.Text -> H.Html -> H.Html
makeReportHtml :: Text -> Html -> Html
makeReportHtml title :: Text
title reportHtml :: Html
reportHtml = Html -> Html
H.html (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
H.docTypeHtml (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
Html -> Html
H.head (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
Html -> Html
H.title (Text -> Html
forall a. ToMarkup a => a -> Html
H.toHtml Text
title)
Html
tufteSetup
Html
mathJaxScript
Html
vegaScripts2
Html -> Html
H.body (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
H.article (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
reportHtml
placeVisualization :: T.Text -> GV.VegaLite -> H.Html
placeVisualization :: Text -> VegaLite -> Html
placeVisualization idText :: Text
idText vl :: VegaLite
vl =
let Text
vegaScript :: T.Text =
ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BS.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Value -> ByteString
forall a. ToJSON a => a -> ByteString
A.encodePretty (Value -> ByteString) -> Value -> ByteString
forall a b. (a -> b) -> a -> b
$ VegaLite -> Value
GV.fromVL VegaLite
vl
script :: Text
script =
"var vlSpec=\n"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
vegaScript
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ";\n"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "vegaEmbed(\'#"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
idText
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\',vlSpec);"
in Html -> Html
H.figure
(Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
HA.id (Text -> AttributeValue
forall a. ToValue a => a -> AttributeValue
H.toValue Text
idText)
(Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
H.script
(Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
HA.type_ "text/javascript"
(Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
H.preEscapedToHtml Text
script
placeTextSection :: H.Html -> H.Html
placeTextSection :: Html -> Html
placeTextSection = Html -> Html
H.section