{-# LANGUAGE OverloadedStrings, ExtendedDefaultRules #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

{-|

Plot traces to html using lucid

Example code:

@
plotHtml :: Html ()
plotHtml = toHtml $ plotly "myDiv" [trace] & layout . title ?~ "my plot"
                                           & layout . width ?~ 300

@

where `trace` is a value of type `Trace`

-}
module Graphics.Plotly.Lucid where

import Lucid
import Graphics.Plotly.Base
import Data.Monoid ((<>))
import Data.Text.Encoding (decodeUtf8)
import Data.ByteString.Lazy (toStrict)
import Data.Aeson

-- |`script` tag to go in the header to import the plotly.js javascript from the official CDN
plotlyCDN :: Monad m => HtmlT m ()
plotlyCDN :: forall (m :: * -> *). Monad m => HtmlT m ()
plotlyCDN = [Attribute] -> HtmlT Identity () -> HtmlT m ()
forall arg result. TermRaw arg result => arg -> result
script_ [Text -> Attribute
src_ Text
"https://cdn.plot.ly/plotly-latest.min.js"] (HtmlT Identity () -> HtmlT m ())
-> HtmlT Identity () -> HtmlT m ()
forall a b. (a -> b) -> a -> b
$ String -> HtmlT Identity ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml (String
""::String)

-- |Activate a plot defined by a `Plotly` value
plotlyJS :: Monad m => Plotly -> HtmlT m ()
plotlyJS :: forall (m :: * -> *). Monad m => Plotly -> HtmlT m ()
plotlyJS (Plotly Text
divNm [Trace]
trs Layout
lay) =
  let trJSON :: Text
trJSON = ByteString -> Text
decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ [Trace] -> ByteString
forall a. ToJSON a => a -> ByteString
encode [Trace]
trs
      layoutJSON :: Text
layoutJSON = ByteString -> Text
decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Layout -> ByteString
forall a. ToJSON a => a -> ByteString
encode Layout
lay
  in Text -> HtmlT m ()
forall arg result. TermRaw arg result => arg -> result
script_ (Text
"Plotly.newPlot('"Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
divNmText -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
"', "Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
trJSONText -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
","Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
layoutJSONText -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
", {displayModeBar: false});")

-- |Create a div for a Plotly value
plotlyDiv :: Monad m => Plotly -> HtmlT m ()
plotlyDiv :: forall (m :: * -> *). Monad m => Plotly -> HtmlT m ()
plotlyDiv (Plotly Text
divNm [Trace]
_ Layout
_) =
  [Attribute] -> HtmlT m () -> HtmlT m ()
forall arg result. Term arg result => arg -> result
div_ [Text -> Attribute
id_ Text
divNm]
       HtmlT m ()
""

instance ToHtml Plotly where
  toHtml :: forall (m :: * -> *). Monad m => Plotly -> HtmlT m ()
toHtml Plotly
pl = Plotly -> HtmlT m ()
forall (m :: * -> *). Monad m => Plotly -> HtmlT m ()
plotlyDiv Plotly
pl HtmlT m () -> HtmlT m () -> HtmlT m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Plotly -> HtmlT m ()
forall (m :: * -> *). Monad m => Plotly -> HtmlT m ()
plotlyJS Plotly
pl
  toHtmlRaw :: forall (m :: * -> *). Monad m => Plotly -> HtmlT m ()
toHtmlRaw = Plotly -> HtmlT m ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml