{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}

{-|
Module      : IHaskell.Display.Hvega
Copyright   : (c) Douglas Burke 2018, 2019, 2020, 2021
License     : BSD3

Maintainer  : dburke.gw@gmail.com
Stability   : unstable
Portability : CPP, OverloadedStrings

Allow VegaLite visualizations to be displayed directly in Jupyter notebooks
or Jupyter Lab. For the moment they are handled separately, in that the Jupyter
Lab version requires use of the `vlShow` routine.

Jupyter Lab can be installed with nix using the
<https://github.com/tweag/jupyterWith jupyterWith> setup.

== Example

If we have the following Vega-Lite definition:

@
\{\-\# language OverloadedStrings \#\-\}

import Graphics.Vega.VegaLite

vl1 = 'toVegaLite' ['description' desc, 'background' "white", 'dat' [], 'mark' 'Bar' 'barOpts', 'enc' []] where
    desc = "A very exciting bar chart"

    dat = 'dataFromRows' ['Parse' [("start", 'FoDate' "%Y-%m-%d")]]
          . 'dataRow' [("start", 'Str' "2011-03-25"), ("count", 'Number' 23)]
          . dataRow [("start", Str "2011-04-02"), ("count", Number 45)]
          . dataRow [("start", Str "2011-04-12"), ("count", Number 3)]

    barOpts = ['MOpacity' 0.4, 'MColor' "teal"]

    enc = 'encoding'
          . 'position' 'X' ['PName' "start", 'PmType' 'Temporal', 'PAxis' ['AxTitle' "Inception date"]]
          . position Y [PName "count", PmType Quantitative]
@

then it can be displayed automatically in Jupyter Lab by

> vlShow vl1

where @vlShow@ should be imported automatically by IHaskell.
-}

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)


-- ^ View a Vega-Lite visualization in a Jupyter *notebook*. Use 'vlShow'
--   instead if you are using Jupyter *lab*.
--
--   There is currently no way to pass
--   <https://github.com/vega/vega-embed#options options>
--   to the @vegaEmbed@ call.
--
--   Note that local file access is __not__ guaranteed to work - e.g.
--   @dataFromUrl@ where the file name refers to a local file -
--   since the JavaScript @fs@ module may not be loaded.
--
instance IHaskellDisplay VegaLite where
  display :: VegaLite -> IO Display
display VegaLite
vl =

    let -- does https://github.com/vega/vega-embed/issues/8 help?
        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
"}});"

        -- rely on the element variable being set up; it appears to be an array
        -- so use the first element to add the div to.
        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))

        -- Use the div element we have just created for the plot.
        -- More options could be passed to vegaEmbed.
        --
        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 (f :: * -> *) a. Applicative f => a -> f a
pure ([DisplayData] -> Display
Display [DisplayData]
ds)

-- | A wrapper around 'VegaLite' so that we can write a 'Display'
--   instance for JupyterLab and not end up with "overlapping
--   instances".
--
--   Is there a better way to do this (other than drop support for
--   Jupyter notebook users)?
--
newtype VegaLiteLab = VLL VegaLite

-- | Convert a VegaLite visualization so that it can be auto-displayed
--   in Jupyter Lab.
--
vlShow :: VegaLite -> VegaLiteLab
vlShow :: VegaLite -> VegaLiteLab
vlShow = VegaLite -> VegaLiteLab
VLL

-- ^ Display Vega-Lite visualizations in an IHaskell notebook when
--   using Jupyter Lab.
--
--   Use the @IHaskell.Display.Hvega@ module when using IHaskell from
--   a Jupyter notebook.
--
--   Note that local file access is __not__ guaranteed to work - e.g.
--   @dataFromUrl@ where the file name refers to a local file -
--   since the JavaScript @fs@ module may not be loaded.
--
--   It would be nice to create a PNG version for non-browser viewers,
--   but I am not sure how to get Jupyter to do this (and if it would
--   even do what I hope it does).
--
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 (f :: * -> *) a. Applicative f => a -> f a
pure ([DisplayData] -> Display
Display [String -> DisplayData
vegalite String
js])