{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module IHaskell.Display.Hvega (vlShow, VegaLiteLab) where
import qualified Data.Text.Lazy as LT
import Data.Aeson.Text (encodeToLazyText)
#if !(MIN_VERSION_base(4, 12, 0))
import Data.Monoid ((<>))
#endif
import Graphics.Vega.VegaLite (VegaLite, fromVL)
import IHaskell.Display (IHaskellDisplay(..), Display(..)
, javascript, vegalite)
instance IHaskellDisplay VegaLite where
display :: VegaLite -> IO Display
display VegaLite
vl =
let
config :: String
config = String
"requirejs.config({"
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"baseUrl: 'https://cdn.jsdelivr.net/npm/',"
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"paths: {"
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"'vega-embed': 'vega-embed@6?noext',"
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"'vega-lib': 'vega-lib?noext',"
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"'vega-lite': 'vega-lite@4?noext',"
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"'vega': 'vega@5?noext'"
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"}});"
makeDiv :: String
makeDiv = String
"var ndiv = document.createElement('div');"
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"ndiv.innerHTML = "
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"'Awesome Vega-Lite visualization to appear here';"
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"element[0].appendChild(ndiv);"
js :: String
js = Text -> String
LT.unpack (Value -> Text
forall a. ToJSON a => a -> Text
encodeToLazyText (VegaLite -> Value
fromVL VegaLite
vl))
plot :: String
plot = String
"require(['vega-embed'],function(vegaEmbed){"
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"vegaEmbed(ndiv," String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
js String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
").then("
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"function (result) { console.log(result); }).catch("
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"function (error) { ndiv.innerHTML = "
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"'There was an error: ' + error; });"
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"});"
ds :: [DisplayData]
ds = [String -> DisplayData
javascript (String
config String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
makeDiv String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
plot)]
in Display -> IO Display
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([DisplayData] -> Display
Display [DisplayData]
ds)
newtype VegaLiteLab = VLL VegaLite
vlShow :: VegaLite -> VegaLiteLab
vlShow :: VegaLite -> VegaLiteLab
vlShow = VegaLite -> VegaLiteLab
VLL
instance IHaskellDisplay VegaLiteLab where
display :: VegaLiteLab -> IO Display
display (VLL VegaLite
vl) = let js :: String
js = Text -> String
LT.unpack (Value -> Text
forall a. ToJSON a => a -> Text
encodeToLazyText (VegaLite -> Value
fromVL VegaLite
vl))
in Display -> IO Display
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([DisplayData] -> Display
Display [String -> DisplayData
vegalite String
js])