{-# LANGUAGE ExtendedDefaultRules #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
module Knit.Report.Input.Visualization.Diagrams
(
addDiagramAsSVG
, 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 qualified Diagrams.Prelude as D
import Diagrams.Prelude hiding ( trace )
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
addDiagramAsSVG
:: ( PM.PandocEffects effs
, P.Member PE.ToPandoc effs
, P.Member KUI.UnusedId effs
)
=> Maybe T.Text
-> Maybe T.Text
-> Double
-> Double
-> D.QDiagram DSVG.SVG D.V2 Double D.Any
-> 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
addDiagramAsSVGWithOptions
:: ( PM.PandocEffects effs
, P.Member PE.ToPandoc effs
, P.Member KUI.UnusedId effs
)
=> Maybe T.Text
-> Maybe T.Text
-> DSVG.Options DSVG.SVG D.V2 Double
-> D.QDiagram DSVG.SVG D.V2 Double D.Any
-> 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