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

{-|

Plot traces to html using blaze-html

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.Blaze where

import Text.Blaze
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as A
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 :: H.Html
plotlyCDN :: Html
plotlyCDN = Html -> Html
H.script (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.src AttributeValue
"https://cdn.plot.ly/plotly-latest.min.js" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
""

-- |Activate a plot defined by a `Plotly` value
plotlyJS :: Plotly -> H.Html
plotlyJS :: Plotly -> Html
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 Html -> Html
H.script (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
H.toHtml (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 :: Plotly -> H.Html
plotlyDiv :: Plotly -> Html
plotlyDiv (Plotly Text
divNm [Trace]
_ Layout
_) =
  Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id (Text -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue Text
divNm) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
""


instance ToMarkup Plotly where
  toMarkup :: Plotly -> Html
toMarkup Plotly
pl = Plotly -> Html
plotlyDiv Plotly
pl Html -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Plotly -> Html
plotlyJS Plotly
pl