{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Graphics.Vega.VegaLite.Output
( toHtml
, toHtmlFile
, toHtmlWith
, toHtmlFileWith
) where
import qualified Data.Aeson.Text as A
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.IO as TL
import Data.Aeson (Value)
#if !(MIN_VERSION_base(4, 12, 0))
import Data.Monoid ((<>))
#endif
import Graphics.Vega.VegaLite.Specification (VegaLite, fromVL)
toHtml :: VegaLite -> TL.Text
toHtml :: VegaLite -> Text
toHtml = Maybe Value -> VegaLite -> Text
toHtmlWith Maybe Value
forall a. Maybe a
Nothing
toHtmlFile :: FilePath -> VegaLite -> IO ()
toHtmlFile :: FilePath -> VegaLite -> IO ()
toHtmlFile FilePath
file = FilePath -> Text -> IO ()
TL.writeFile FilePath
file (Text -> IO ()) -> (VegaLite -> Text) -> VegaLite -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VegaLite -> Text
toHtml
toHtmlWith ::
Maybe Value
-> VegaLite
-> TL.Text
toHtmlWith :: Maybe Value -> VegaLite -> Text
toHtmlWith Maybe Value
mopts VegaLite
vl =
let spec :: Text
spec = Value -> Text
forall a. ToJSON a => a -> Text
A.encodeToLazyText (VegaLite -> Value
fromVL VegaLite
vl)
opts :: Text
opts = Text -> (Value -> Text) -> Maybe Value -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (\Value
o -> Text
"," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Value -> Text
forall a. ToJSON a => a -> Text
A.encodeToLazyText Value
o) Maybe Value
mopts
in [Text] -> Text
TL.unlines
[ Text
"<!DOCTYPE html>"
, Text
"<html>"
, Text
"<head>"
, Text
" <script src=\"https://cdn.jsdelivr.net/npm/vega@5\"></script>"
, Text
" <script src=\"https://cdn.jsdelivr.net/npm/vega-lite@4\"></script>"
, Text
" <script src=\"https://cdn.jsdelivr.net/npm/vega-embed\"></script>"
, Text
"</head>"
, Text
"<body>"
, Text
"<div id=\"vis\"></div>"
, Text
"<script type=\"text/javascript\">"
, Text
" var spec = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
spec Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
";"
, Text
" vegaEmbed(\'#vis\', spec" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
opts Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
").then(function(result) {"
, Text
" // Access the Vega view instance (https://vega.github.io/vega/docs/api/view/) as result.view"
, Text
" }).catch(console.error);"
, Text
"</script>"
, Text
"</body>"
, Text
"</html>"
]
toHtmlFileWith ::
Maybe Value
-> FilePath
-> VegaLite
-> IO ()
toHtmlFileWith :: Maybe Value -> FilePath -> VegaLite -> IO ()
toHtmlFileWith Maybe Value
mopts FilePath
file = FilePath -> Text -> IO ()
TL.writeFile FilePath
file (Text -> IO ()) -> (VegaLite -> Text) -> VegaLite -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Value -> VegaLite -> Text
toHtmlWith Maybe Value
mopts