{-# LANGUAGE ExtendedDefaultRules #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE TypeOperators        #-}
{-# LANGUAGE DataKinds            #-}
{-# LANGUAGE GADTs                #-}
{-|
Module      : Knit.Report.Input.Visualization.Diagrams
Description : Support addition of Diagrams to knitted reports.
Copyright   : (c) Adam Conner-Sax 2019
License     : BSD-3-Clause
Maintainer  : adam_conner_sax@yahoo.com
Stability   : experimental

Functions to Diagrams (from the Diagrams library) to the current Pandoc document.
-}
module Knit.Report.Input.Visualization.Diagrams
  (
    -- * Add Diagrams Inputs
    addDiagramAsSVG
    -- * Diagrams Re-Exports
  , module Diagrams.Prelude
  , module Diagrams.Backend.SVG
  )
where

import           Knit.Report.Input.Html.Blaze   ( addBlaze )
import           Text.Blaze.Html                ( preEscapedLazyText
                                                , toValue
                                                )
import qualified Text.Blaze.Html5              as BH
import qualified Text.Blaze.Html5.Attributes   as BHA

import qualified Data.Text                     as T
--import           Data.Maybe                     ( fromMaybe )

import qualified Diagrams.Prelude              as D
import           Diagrams.Prelude         hiding ( trace ) -- this conflicts with Pandoc trace.  TO get it, you'll need to import it directly
--import qualified Diagrams.TwoD.Size            as D
import qualified Diagrams.Backend.SVG          as DSVG
import           Diagrams.Backend.SVG
import qualified Graphics.Svg                  as SVG

import qualified Polysemy                      as P
import qualified Knit.Effect.Pandoc            as PE
import qualified Knit.Effect.PandocMonad       as PM
import qualified Knit.Effect.UnusedId          as KUI

-- | Add diagram (via SVG inserted as HTML) with user supplied width and height.
addDiagramAsSVG
  :: ( PM.PandocEffects effs
     , P.Member PE.ToPandoc effs
     , P.Member KUI.UnusedId effs
     )
  => Maybe T.Text -- ^ id attribute for figure.  Will use next unused "figure" id if Nothing
  -> Maybe T.Text -- ^ caption for figure
  -> Double -- ^ width in pixels (?)
  -> Double -- ^ height in pixels (?)
  -> D.QDiagram DSVG.SVG D.V2 Double D.Any-- ^ diagram
  -> P.Sem effs T.Text
addDiagramAsSVG :: Maybe Text
-> Maybe Text
-> Double
-> Double
-> QDiagram SVG V2 Double Any
-> Sem effs Text
addDiagramAsSVG idTextM :: Maybe Text
idTextM captionTextM :: Maybe Text
captionTextM wPixels :: Double
wPixels hPixels :: Double
hPixels diagram :: QDiagram SVG V2 Double Any
diagram = do
  Text
idText <- Sem effs Text
-> (Text -> Sem effs Text) -> Maybe Text -> Sem effs Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Sem effs Text
forall (r :: [(* -> *) -> * -> *]).
Member UnusedId r =>
Text -> Sem r Text
KUI.getNextUnusedId "figure") Text -> Sem effs Text
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
idTextM
  let svgOptions :: Options SVG V2 Double
svgOptions =
        SizeSpec V2 Double
-> Maybe Element
-> Text
-> [Attribute]
-> Bool
-> Options SVG V2 Double
forall n.
SizeSpec V2 n
-> Maybe Element -> Text -> [Attribute] -> Bool -> Options SVG V2 n
DSVG.SVGOptions (Double -> Double -> SizeSpec V2 Double
forall n. n -> n -> SizeSpec V2 n
D.dims2D Double
wPixels Double
hPixels) Maybe Element
forall a. Maybe a
Nothing Text
idText [] Bool
False
  Maybe Text
-> Maybe Text
-> Options SVG V2 Double
-> QDiagram SVG V2 Double Any
-> Sem effs Text
forall (effs :: [(* -> *) -> * -> *]).
(PandocEffects effs, Member ToPandoc effs, Member UnusedId effs) =>
Maybe Text
-> Maybe Text
-> Options SVG V2 Double
-> QDiagram SVG V2 Double Any
-> Sem effs Text
addDiagramAsSVGWithOptions (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
idText) Maybe Text
captionTextM Options SVG V2 Double
svgOptions QDiagram SVG V2 Double Any
diagram

-- | Add diagram (via SVG inserted as HTML) with user-supplied options.
addDiagramAsSVGWithOptions
  :: ( PM.PandocEffects effs
     , P.Member PE.ToPandoc effs
     , P.Member KUI.UnusedId effs
     )
  => Maybe T.Text -- ^ id attribute for figure, will use next unsed "figure" id if nothing
  -> Maybe T.Text -- ^ caption for figure
  -> DSVG.Options DSVG.SVG D.V2 Double
  -> D.QDiagram DSVG.SVG D.V2 Double D.Any-- ^ diagram
  -> P.Sem effs T.Text
addDiagramAsSVGWithOptions :: Maybe Text
-> Maybe Text
-> Options SVG V2 Double
-> QDiagram SVG V2 Double Any
-> Sem effs Text
addDiagramAsSVGWithOptions idTextM :: Maybe Text
idTextM captionTextM :: Maybe Text
captionTextM svgOptions :: Options SVG V2 Double
svgOptions diagram :: QDiagram SVG V2 Double Any
diagram = do
  Text
idText <- Sem effs Text
-> (Text -> Sem effs Text) -> Maybe Text -> Sem effs Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Sem effs Text
forall (r :: [(* -> *) -> * -> *]).
Member UnusedId r =>
Text -> Sem r Text
KUI.getNextUnusedId "figure") Text -> Sem effs Text
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
idTextM
  Html -> Sem effs ()
forall (effs :: [(* -> *) -> * -> *]).
(PandocEffects effs, Member ToPandoc effs) =>
Html -> Sem effs ()
addBlaze (Html -> Sem effs ()) -> Html -> Sem effs ()
forall a b. (a -> b) -> a -> b
$ Html -> Html
BH.figure (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
BH.! AttributeValue -> Attribute
BHA.id (Text -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue Text
idText) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
    Text -> Html
preEscapedLazyText (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ Element -> Text
SVG.renderText (Element -> Text) -> Element -> Text
forall a b. (a -> b) -> a -> b
$ SVG
-> Options SVG V2 Double
-> QDiagram SVG V2 Double Any
-> Result SVG V2 Double
forall b (v :: * -> *) n m.
(Backend b v n, HasLinearMap v, Metric v, Typeable n,
 OrderedField n, Monoid' m) =>
b -> Options b v n -> QDiagram b v n m -> Result b v n
D.renderDia SVG
DSVG.SVG
                                                      Options SVG V2 Double
svgOptions
                                                      QDiagram SVG V2 Double Any
diagram
    Html -> (Text -> Html) -> Maybe Text -> Html
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Html
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (Html -> Html
BH.figcaption (Html -> Html) -> (Text -> Html) -> Text -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Html
forall a. ToMarkup a => a -> Html
BH.toHtml) Maybe Text
captionTextM
  Text -> Sem effs Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
idText