{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

-- |
-- Description: Exports convenience function for rendering Diagrams in Hakyll.
-- Copyright: Copyright (C) 2023 Yoo Chung
-- License: All rights reserved
-- Maintainer: web@chungyc.org
--
-- Exports the 'putDiagram' function for conveniently printing SVG generated from a diagram.
--
-- This also re-exports the "Diagrams.Prelude" and "Diagrams.Backend.SVG" modules,
-- so that code does not have to import these separately.
module Diagrams.Runner
  ( putDiagram,
    defaultOptions,
    module Diagrams.Prelude,
    module Diagrams.Backend.SVG,
  )
where

import Data.Text.Lazy.IO (putStr)
import Diagrams.Backend.SVG
import Diagrams.Prelude
import Graphics.Svg
import Prelude hiding (putStr)

-- |
-- Write out SVG for the given diagram to standard output.
--
-- >>> putDiagram defaultOptions $ circle 1
-- <?xml version="1.0" encoding="UTF-8"?>
-- ...
--
-- It can be passed in a fully specified 'SVGOptions',
-- but it is usually enough to give the default set of options in 'defaultOptions'.
putDiagram :: (SVGFloat n) => Options SVG V2 n -> QDiagram SVG V2 n Any -> IO ()
putDiagram :: forall n.
SVGFloat n =>
Options SVG V2 n -> QDiagram SVG V2 n Any -> IO ()
putDiagram Options SVG V2 n
options QDiagram SVG V2 n Any
diagram =
  Text -> IO ()
putStr (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$
    Element -> Text
renderText (Element -> Text) -> Element -> Text
forall a b. (a -> b) -> a -> b
$
      SVG -> Options SVG V2 n -> QDiagram SVG V2 n Any -> Result SVG V2 n
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
renderDia SVG
SVG Options SVG V2 n
options (QDiagram SVG V2 n Any -> Result SVG V2 n)
-> QDiagram SVG V2 n Any -> Result SVG V2 n
forall a b. (a -> b) -> a -> b
$
        -- Include padding to prevent non-zero width lines from being cut off.
        n -> QDiagram SVG V2 n Any -> QDiagram SVG V2 n Any
forall (v :: * -> *) n m b.
(Metric v, OrderedField n, Monoid' m) =>
n -> QDiagram b v n m -> QDiagram b v n m
pad n
1.1 QDiagram SVG V2 n Any
diagram

-- |
-- Default options for rendering a diagram into SVG.
--
-- This is a record value, so specific options can be overridden using record syntax.
-- For example, the width of the rendered image can be overridden:
--
-- >>> let options = defaultOptions & sizeSpec .~ mkWidth 128
-- >>> view sizeSpec options
-- SizeSpec (V2 128.0 0.0)
defaultOptions :: (SVGFloat n) => Options SVG V2 n
defaultOptions :: forall n. SVGFloat n => Options SVG V2 n
defaultOptions = SizeSpec V2 n
-> Maybe Element -> Text -> [Attribute] -> Bool -> Options SVG V2 n
forall n.
SizeSpec V2 n
-> Maybe Element -> Text -> [Attribute] -> Bool -> Options SVG V2 n
SVGOptions (n -> SizeSpec V2 n
forall n. Num n => n -> SizeSpec V2 n
mkWidth n
4096) Maybe Element
forall a. Maybe a
Nothing Text
"" [] Bool
True