{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TupleSections #-}

-- | An intermediary representation not unlike SVG or XML but only forming a subset of these standards.
module Chart.Markup
  ( Attributes (..),
    attribute,
    Markup (..),
    Content (..),
    renderMarkup,
    encodeMarkup,
    ChartOptions (..),
    markupChartOptions,
    markupChartTree,
    markupChart,
    header,
    renderChartOptions,
    encodeChartOptions,
    writeChartOptions,
    CssOptions (..),
    defaultCssOptions,
    CssPreferColorScheme (..),
    cssPreferColorScheme,
    fillSwitch,
    CssShapeRendering (..),
    markupCssOptions,
    MarkupOptions (..),
    defaultMarkupOptions,
    encodeNum,
    encodePx,
  )
where

import Chart.Data
import Chart.Hud
import Chart.Primitive hiding (tree)
import Chart.Style
import Data.Bool
import Data.ByteString (ByteString, intercalate, writeFile)
import Data.ByteString.Char8 (pack)
import Data.Colour
import Data.FormatN
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe
import Data.Path
import Data.Path.Parser
import Data.String.Interpolate
import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8)
import Data.Tree (Tree (..))
import Data.TreeDiff
import GHC.Generics
import Optics.Core hiding (element)
import Prelude

-- $setup
--
-- >>> :set -XOverloadedLabels
-- >>> :set -XOverloadedStrings
-- >>> import Chart
-- >>> import Optics.Core
-- >>> let c0 = ChartOptions (defaultMarkupOptions & #cssOptions % #preferColorScheme .~ PreferNormal) mempty mempty
-- >>> import Chart.Examples

-- | Show a Double, or rounded to 4 decimal places if this is shorter.
--
-- >>> encodeNum 1
-- "1.0"
--
-- >>> encodeNum 1.23456
-- "1.2346"
encodeNum :: Double -> ByteString
encodeNum :: Double -> ByteString
encodeNum = Text -> ByteString
encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. FormatStyle -> Maybe Int -> Double -> Text
formatOrShow (Int -> FormatStyle
FixedStyle Int
4) forall a. Maybe a
Nothing

-- | SVG width and height, without any unit suffix, are defined as pixels, which are Integers
--
-- >>> encodePx 300.0
-- "300"
encodePx :: Double -> ByteString
encodePx :: Double -> ByteString
encodePx = String -> ByteString
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (RealFrac a, Integral b) => a -> b
floor :: Double -> Int)

-- | A collection of attributes as a ByteString key-value map.
newtype Attributes = Attributes {Attributes -> Map ByteString ByteString
attMap :: Map ByteString ByteString} deriving (Attributes -> Attributes -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Attributes -> Attributes -> Bool
$c/= :: Attributes -> Attributes -> Bool
== :: Attributes -> Attributes -> Bool
$c== :: Attributes -> Attributes -> Bool
Eq, Int -> Attributes -> ShowS
[Attributes] -> ShowS
Attributes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Attributes] -> ShowS
$cshowList :: [Attributes] -> ShowS
show :: Attributes -> String
$cshow :: Attributes -> String
showsPrec :: Int -> Attributes -> ShowS
$cshowsPrec :: Int -> Attributes -> ShowS
Show, forall x. Rep Attributes x -> Attributes
forall x. Attributes -> Rep Attributes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Attributes x -> Attributes
$cfrom :: forall x. Attributes -> Rep Attributes x
Generic)

instance ToExpr Attributes

-- Like Last for most attributes but concatenates the "class" attribute.
instance Semigroup Attributes where
  <> :: Attributes -> Attributes -> Attributes
(<>) (Attributes Map ByteString ByteString
m) (Attributes Map ByteString ByteString
m') =
    Map ByteString ByteString -> Attributes
Attributes forall a b. (a -> b) -> a -> b
$
      forall k a.
Ord k =>
(k -> a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWithKey
        ( \ByteString
k ByteString
a ByteString
b ->
            case ByteString
k of
              ByteString
"class" -> ByteString
a forall a. Semigroup a => a -> a -> a
<> ByteString
" " forall a. Semigroup a => a -> a -> a
<> ByteString
b
              ByteString
_ -> ByteString
b
        )
        Map ByteString ByteString
m
        Map ByteString ByteString
m'

instance Monoid Attributes where
  mempty :: Attributes
mempty = Map ByteString ByteString -> Attributes
Attributes forall k a. Map k a
Map.empty

-- | Create a singleton Attributes
attribute :: (ByteString, ByteString) -> Attributes
attribute :: (ByteString, ByteString) -> Attributes
attribute (ByteString
k, ByteString
v) = Map ByteString ByteString -> Attributes
Attributes forall a b. (a -> b) -> a -> b
$ forall k a. k -> a -> Map k a
Map.singleton ByteString
k ByteString
v

-- | A representation of SVG (and XML) markup with no specific knowledge of SVG or XML syntax rules.
--
-- >>> let c0 = ChartOptions (defaultMarkupOptions & #cssOptions % #preferColorScheme .~ PreferNormal) mempty mempty
-- >>> markupChartOptions c0
-- Markup {tag = "svg", atts = Attributes {attMap = fromList [("height","300"),("viewBox","-0.75 -0.5 1.5 1.0"),("width","450"),("xmlns","http://www.w3.org/2000/svg"),("xmlns:xlink","http://www.w3.org/1999/xlink")]}, contents = [MarkupLeaf (Markup {tag = "style", atts = Attributes {attMap = fromList []}, contents = [Content ""]}),MarkupLeaf (Markup {tag = "g", atts = Attributes {attMap = fromList [("class","chart")]}, contents = []}),MarkupLeaf (Markup {tag = "g", atts = Attributes {attMap = fromList [("class","hud")]}, contents = []})]}
data Markup = Markup
  { Markup -> ByteString
tag :: ByteString,
    Markup -> Attributes
atts :: Attributes,
    Markup -> [Content]
contents :: [Content]
  }
  deriving (Markup -> Markup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Markup -> Markup -> Bool
$c/= :: Markup -> Markup -> Bool
== :: Markup -> Markup -> Bool
$c== :: Markup -> Markup -> Bool
Eq, Int -> Markup -> ShowS
[Markup] -> ShowS
Markup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Markup] -> ShowS
$cshowList :: [Markup] -> ShowS
show :: Markup -> String
$cshow :: Markup -> String
showsPrec :: Int -> Markup -> ShowS
$cshowsPrec :: Int -> Markup -> ShowS
Show, forall x. Rep Markup x -> Markup
forall x. Markup -> Rep Markup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Markup x -> Markup
$cfrom :: forall x. Markup -> Rep Markup x
Generic)

instance ToExpr Markup

-- | The things that can be inside (form the Content of) a Markup element, especially in a DOM context. Comments are unused by the library representation of a chart and are here to help with parsing arbitrary svg in the wild.
--
-- >>> contents (markupChartOptions c0)
-- [MarkupLeaf (Markup {tag = "style", atts = Attributes {attMap = fromList []}, contents = [Content ""]}),MarkupLeaf (Markup {tag = "g", atts = Attributes {attMap = fromList [("class","chart")]}, contents = []}),MarkupLeaf (Markup {tag = "g", atts = Attributes {attMap = fromList [("class","hud")]}, contents = []})]
data Content = Content ByteString | Comment ByteString | MarkupLeaf Markup deriving (Content -> Content -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Content -> Content -> Bool
$c/= :: Content -> Content -> Bool
== :: Content -> Content -> Bool
$c== :: Content -> Content -> Bool
Eq, Int -> Content -> ShowS
[Content] -> ShowS
Content -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Content] -> ShowS
$cshowList :: [Content] -> ShowS
show :: Content -> String
$cshow :: Content -> String
showsPrec :: Int -> Content -> ShowS
$cshowsPrec :: Int -> Content -> ShowS
Show, forall x. Rep Content x -> Content
forall x. Content -> Rep Content x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Content x -> Content
$cfrom :: forall x. Content -> Rep Content x
Generic)

instance ToExpr Content

-- | render markup to Text compliant with being an SVG object (and XML element)
--
-- >>> renderMarkup (markupChartOptions c0)
-- "<svg height=\"300\" viewBox=\"-0.75 -0.5 1.5 1.0\" width=\"450\" xmlns=\"http://www.w3.org/2000/svg\" xmlns:xlink=\"http://www.w3.org/1999/xlink\"><style></style><g class=\"chart\"/><g class=\"hud\"/></svg>"
renderMarkup :: Markup -> Text
renderMarkup :: Markup -> Text
renderMarkup (Markup ByteString
n Attributes
as [Content]
xs) =
  forall a. a -> a -> Bool -> a
bool [i|<#{na}>#{ls}</#{n}>|] [i|<#{na}/>|] ([Content]
xs forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty)
  where
    na :: ByteString
na = ByteString -> [ByteString] -> ByteString
intercalate ByteString
" " ([ByteString
n] forall a. Semigroup a => a -> a -> a
<> (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> ByteString -> ByteString
encodeAttribute forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Map k a -> [(k, a)]
Map.toList (Attributes -> Map ByteString ByteString
attMap Attributes
as)))
    ls :: ByteString
ls = forall a. Monoid a => [a] -> a
mconcat (Content -> ByteString
encodeContent forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Content]
xs)

-- | render markup to a ByteString compliant with being an SVG object (and XML element)
--
-- >>> encodeMarkup (markupChartOptions c0)
-- "<svg height=\"300\" viewBox=\"-0.75 -0.5 1.5 1.0\" width=\"450\" xmlns=\"http://www.w3.org/2000/svg\" xmlns:xlink=\"http://www.w3.org/1999/xlink\"><style></style><g class=\"chart\"/><g class=\"hud\"/></svg>"
encodeMarkup :: Markup -> ByteString
encodeMarkup :: Markup -> ByteString
encodeMarkup (Markup ByteString
n Attributes
as [Content]
xs) =
  forall a. a -> a -> Bool -> a
bool [i|<#{na}>#{ls}</#{n}>|] [i|<#{na}/>|] ([Content]
xs forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty)
  where
    na :: ByteString
na = ByteString -> [ByteString] -> ByteString
intercalate ByteString
" " ([ByteString
n] forall a. Semigroup a => a -> a -> a
<> (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> ByteString -> ByteString
encodeAttribute forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Map k a -> [(k, a)]
Map.toList (Attributes -> Map ByteString ByteString
attMap Attributes
as)))
    ls :: ByteString
ls = forall a. Monoid a => [a] -> a
mconcat (Content -> ByteString
encodeContent forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Content]
xs)

encodeContent :: Content -> ByteString
encodeContent :: Content -> ByteString
encodeContent (Content ByteString
c) = ByteString
c
encodeContent (Comment ByteString
c) = ByteString -> ByteString
encodeComment ByteString
c
encodeContent (MarkupLeaf Markup
x) = Markup -> ByteString
encodeMarkup Markup
x

encodeComment :: ByteString -> ByteString
encodeComment :: ByteString -> ByteString
encodeComment ByteString
c = ByteString
"<!--" forall a. Semigroup a => a -> a -> a
<> ByteString
c forall a. Semigroup a => a -> a -> a
<> ByteString
"-->"

encodeAttribute :: ByteString -> ByteString -> ByteString
encodeAttribute :: ByteString -> ByteString -> ByteString
encodeAttribute ByteString
a ByteString
b = [i|#{a}="#{b}"|]

-- | Convert a ChartTree to markup
--
-- >>> lineExample & view #charts & markupChartTree
-- [Markup {tag = "g", atts = Attributes {attMap = fromList [("class","line")]}, contents = [MarkupLeaf (Markup {tag = "g", atts = Attributes {attMap = fromList [("fill","none"),("stroke","rgb(2%, 73%, 80%)"),("stroke-opacity","1.0"),("stroke-width","0.0150")]}, contents = [MarkupLeaf (Markup {tag = "polyline", atts = Attributes {attMap = fromList [("points","0,-1.0 1.0,-1.0 2.0,-5.0")]}, contents = []})]}),MarkupLeaf (Markup {tag = "g", atts = Attributes {attMap = fromList [("fill","none"),("stroke","rgb(2%, 29%, 48%)"),("stroke-opacity","1.0"),("stroke-width","0.0150")]}, contents = [MarkupLeaf (Markup {tag = "polyline", atts = Attributes {attMap = fromList [("points","0,0 2.8,-3.0")]}, contents = []})]}),MarkupLeaf (Markup {tag = "g", atts = Attributes {attMap = fromList [("fill","none"),("stroke","rgb(66%, 7%, 55%)"),("stroke-opacity","1.0"),("stroke-width","0.0150")]}, contents = [MarkupLeaf (Markup {tag = "polyline", atts = Attributes {attMap = fromList [("points","0.5,-4.0 0.5,0")]}, contents = []})]})]}]
markupChartTree :: ChartTree -> [Markup]
markupChartTree :: ChartTree -> [Markup]
markupChartTree ChartTree
cs =
  case ([Markup]
xs', Maybe Text
label) of
    ([], Maybe Text
Nothing) -> forall a. Monoid a => a
mempty
    ([Markup]
xs'', Maybe Text
Nothing) -> [Markup]
xs''
    ([Markup]
xs'', Just Text
l) -> [ByteString -> Attributes -> [Content] -> Markup
Markup ByteString
"g" (Map ByteString ByteString -> Attributes
Attributes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. k -> a -> Map k a
Map.singleton ByteString
"class" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 forall a b. (a -> b) -> a -> b
$ Text
l) (Markup -> Content
MarkupLeaf forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Markup]
xs'')]
  where
    (ChartTree (Node (Maybe Text
label, [Chart]
cs') [Tree (Maybe Text, [Chart])]
xs)) = (Chart -> Bool) -> ChartTree -> ChartTree
filterChartTree (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chart -> Bool
isEmptyChart) ChartTree
cs
    xs' :: [Markup]
xs' = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Chart -> Maybe Markup
markupChart [Chart]
cs' forall a. Semigroup a => a -> a -> a
<> (forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ ChartTree -> [Markup]
markupChartTree forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree (Maybe Text, [Chart]) -> ChartTree
ChartTree forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tree (Maybe Text, [Chart])]
xs)

markupText :: TextStyle -> Text -> Point Double -> Markup
markupText :: TextStyle -> Text -> Point Double -> Markup
markupText TextStyle
s Text
t p :: Point Double
p@(Point Double
x Double
y) = ByteString -> Attributes -> [Content] -> Markup
Markup ByteString
"text" Attributes
as ((Markup -> Content
MarkupLeaf forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Markup]
xs) forall a. Semigroup a => a -> a -> a
<> [ByteString -> Content
Content ByteString
c])
  where
    as :: Attributes
as =
      Map ByteString ByteString -> Attributes
Attributes forall a b. (a -> b) -> a -> b
$
        forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$
          [ (ByteString
"x", Double -> ByteString
encodeNum Double
x),
            (ByteString
"y", Double -> ByteString
encodeNum forall a b. (a -> b) -> a -> b
$ -Double
y)
          ]
            forall a. Semigroup a => a -> a -> a
<> forall a. Maybe a -> [a]
maybeToList ((\Double
x' -> (ByteString
"transform", Double -> Point Double -> ByteString
toRotateText Double
x' Point Double
p)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TextStyle
s forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "rotation" a => a
#rotation))
    xs :: [Markup]
xs = case forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "frame" a => a
#frame TextStyle
s of
      Maybe RectStyle
Nothing -> []
      Just RectStyle
f -> forall a. Maybe a -> [a]
maybeToList forall a b. (a -> b) -> a -> b
$ Chart -> Maybe Markup
markupChart (RectStyle -> [Rect Double] -> Chart
RectChart (RectStyle
f forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall a. IsLabel "borderSize" a => a
#borderSize (forall a. Num a => a -> a -> a
* forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "size" a => a
#size TextStyle
s)) [TextStyle -> Text -> Point Double -> Rect Double
styleBoxText TextStyle
s Text
t Point Double
p])
    c :: ByteString
c = Text -> ByteString
encodeUtf8 Text
t

-- | Markup a text rotation about a point in radians.
--
-- includes reference changes:
--
-- - from radians to degrees
--
-- - from counter-clockwise is a positive rotation to clockwise is positive
--
-- - flip y dimension
toRotateText :: Double -> Point Double -> ByteString
toRotateText :: Double -> Point Double -> ByteString
toRotateText Double
r (Point Double
x Double
y) =
  ByteString
"rotate(" forall a. Semigroup a => a -> a -> a
<> Double -> ByteString
encodeNum (-Double
r forall a. Num a => a -> a -> a
* Double
180 forall a. Fractional a => a -> a -> a
/ forall a. Floating a => a
pi) forall a. Semigroup a => a -> a -> a
<> ByteString
", " forall a. Semigroup a => a -> a -> a
<> Double -> ByteString
encodeNum Double
x forall a. Semigroup a => a -> a -> a
<> ByteString
", " forall a. Semigroup a => a -> a -> a
<> Double -> ByteString
encodeNum (-Double
y) forall a. Semigroup a => a -> a -> a
<> ByteString
")"

toScaleText :: Double -> ByteString
toScaleText :: Double -> ByteString
toScaleText Double
x =
  ByteString
"scale(" forall a. Semigroup a => a -> a -> a
<> Double -> ByteString
encodeNum Double
x forall a. Semigroup a => a -> a -> a
<> ByteString
")"

-- | Convert a Rect to Markup
markupRect :: Rect Double -> Markup
markupRect :: Rect Double -> Markup
markupRect (Rect Double
x Double
z Double
y Double
w) =
  ByteString -> Attributes -> [Content] -> Markup
Markup ByteString
"rect" Attributes
as forall a. Monoid a => a
mempty
  where
    as :: Attributes
as =
      Map ByteString ByteString -> Attributes
Attributes forall a b. (a -> b) -> a -> b
$
        forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
          [ (ByteString
"width", Double -> ByteString
encodeNum (Double
z forall a. Num a => a -> a -> a
- Double
x)),
            (ByteString
"height", Double -> ByteString
encodeNum (Double
w forall a. Num a => a -> a -> a
- Double
y)),
            (ByteString
"x", Double -> ByteString
encodeNum Double
x),
            (ByteString
"y", Double -> ByteString
encodeNum (-Double
w))
          ]

-- | Convert a Chart to Markup
--
-- >>> lineExample & view #charts & foldOf charts' & head & markupChart
-- Just (Markup {tag = "g", atts = Attributes {attMap = fromList [("fill","none"),("stroke","rgb(2%, 73%, 80%)"),("stroke-opacity","1.0"),("stroke-width","0.0150")]}, contents = [MarkupLeaf (Markup {tag = "polyline", atts = Attributes {attMap = fromList [("points","0,-1.0 1.0,-1.0 2.0,-5.0")]}, contents = []})]})
markupChart :: Chart -> Maybe Markup
markupChart :: Chart -> Maybe Markup
markupChart (RectChart RectStyle
s [Rect Double]
xs) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ByteString -> Attributes -> [Content] -> Markup
Markup ByteString
"g" (RectStyle -> Attributes
attsRect RectStyle
s) (Markup -> Content
MarkupLeaf forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rect Double -> Markup
markupRect forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Rect Double]
xs)
markupChart (TextChart TextStyle
s [(Text, Point Double)]
xs) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ByteString -> Attributes -> [Content] -> Markup
Markup ByteString
"g" (TextStyle -> Attributes
attsText TextStyle
s) (Markup -> Content
MarkupLeaf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (TextStyle -> Text -> Point Double -> Markup
markupText TextStyle
s) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Point Double)]
xs)
markupChart (GlyphChart GlyphStyle
s [Point Double]
xs) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ByteString -> Attributes -> [Content] -> Markup
Markup ByteString
"g" (GlyphStyle -> Attributes
attsGlyph GlyphStyle
s) (Markup -> Content
MarkupLeaf forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GlyphStyle -> Point Double -> Markup
markupGlyph GlyphStyle
s) [Point Double]
xs)
markupChart (PathChart PathStyle
s [PathData Double]
xs) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ByteString -> Attributes -> [Content] -> Markup
Markup ByteString
"g" (PathStyle -> Attributes
attsPath PathStyle
s) [Markup -> Content
MarkupLeaf forall a b. (a -> b) -> a -> b
$ [PathData Double] -> Markup
markupPath [PathData Double]
xs]
markupChart (LineChart LineStyle
s [[Point Double]]
xs) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ByteString -> Attributes -> [Content] -> Markup
Markup ByteString
"g" (LineStyle -> Attributes
attsLine LineStyle
s) (Markup -> Content
MarkupLeaf forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Point Double]] -> [Markup]
markupLine [[Point Double]]
xs)
markupChart (BlankChart [Rect Double]
_) = forall a. Maybe a
Nothing

markupLine :: [[Point Double]] -> [Markup]
markupLine :: [[Point Double]] -> [Markup]
markupLine [[Point Double]]
lss =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Attributes -> [Content] -> Markup
Markup ByteString
"polyline" forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, ByteString) -> Attributes
attribute forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString
"points",) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Point Double] -> ByteString
toPointsText) [[Point Double]]
lss

toPointsText :: [Point Double] -> ByteString
toPointsText :: [Point Double] -> ByteString
toPointsText [Point Double]
xs = ByteString -> [ByteString] -> ByteString
intercalate ByteString
" " forall a b. (a -> b) -> a -> b
$ (\(Point Double
x Double
y) -> Double -> ByteString
encodeNum Double
x forall a. Semigroup a => a -> a -> a
<> ByteString
"," forall a. Semigroup a => a -> a -> a
<> Double -> ByteString
encodeNum (-Double
y)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Point Double]
xs

-- | Path markup
markupPath :: [PathData Double] -> Markup
markupPath :: [PathData Double] -> Markup
markupPath [PathData Double]
ps =
  ByteString -> Attributes -> [Content] -> Markup
Markup ByteString
"path" (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (ByteString, ByteString) -> Attributes
attribute [(ByteString
"d", [PathData Double] -> ByteString
pathDataToSvg [PathData Double]
ps)]) forall a. Monoid a => a
mempty

-- | GlyphStyle to markup Tree
-- Note rotation on the outside not the inside.
markupGlyph :: GlyphStyle -> Point Double -> Markup
markupGlyph :: GlyphStyle -> Point Double -> Markup
markupGlyph GlyphStyle
s Point Double
p =
  case forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "rotation" a => a
#rotation GlyphStyle
s of
    Maybe Double
Nothing -> Markup
gl
    Just Double
r -> ByteString -> Attributes -> [Content] -> Markup
Markup ByteString
"g" (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (ByteString, ByteString) -> Attributes
attribute [(ByteString
"transform", Double -> Point Double -> ByteString
toRotateText Double
r Point Double
p)]) [Markup -> Content
MarkupLeaf Markup
gl]
  where
    gl :: Markup
gl = GlyphShape -> Double -> Point Double -> Markup
markupShape_ (GlyphStyle
s forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "shape" a => a
#shape) (GlyphStyle
s forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "size" a => a
#size) Point Double
p

-- | Convert a dash representation from a list to text
fromDashArray :: [Double] -> ByteString
fromDashArray :: [Double] -> ByteString
fromDashArray [Double]
xs = ByteString -> [ByteString] -> ByteString
intercalate ByteString
" " forall a b. (a -> b) -> a -> b
$ Double -> ByteString
encodeNum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Double]
xs

fromDashOffset :: Double -> ByteString
fromDashOffset :: Double -> ByteString
fromDashOffset Double
x = Double -> ByteString
encodeNum Double
x

attsLine :: LineStyle -> Attributes
attsLine :: LineStyle -> Attributes
attsLine LineStyle
o =
  forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$
    (ByteString, ByteString) -> Attributes
attribute
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ (ByteString
"stroke-width", Double -> ByteString
encodeNum forall a b. (a -> b) -> a -> b
$ LineStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "size" a => a
#size),
            (ByteString
"stroke", Colour -> ByteString
showRGB forall a b. (a -> b) -> a -> b
$ LineStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "color" a => a
#color),
            (ByteString
"stroke-opacity", Colour -> ByteString
showOpacity forall a b. (a -> b) -> a -> b
$ LineStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "color" a => a
#color),
            (ByteString
"fill", ByteString
"none")
          ]
        forall a. Semigroup a => a -> a -> a
<> forall a. [Maybe a] -> [a]
catMaybes
          [(\LineCap
x -> (ByteString
"stroke-linecap", forall s. IsString s => LineCap -> s
fromLineCap LineCap
x)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (LineStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "linecap" a => a
#linecap)]
        forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\LineJoin
x -> [(ByteString
"stroke-linejoin", forall s. IsString s => LineJoin -> s
fromLineJoin LineJoin
x)]) (LineStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "linejoin" a => a
#linejoin)
        forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\[Double]
x -> [(ByteString
"stroke-dasharray", [Double] -> ByteString
fromDashArray [Double]
x)]) (LineStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "dasharray" a => a
#dasharray)
        forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Double
x -> [(ByteString
"stroke-dashoffset", Double -> ByteString
fromDashOffset Double
x)]) (LineStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "dashoffset" a => a
#dashoffset)

attsRect :: RectStyle -> Attributes
attsRect :: RectStyle -> Attributes
attsRect RectStyle
o =
  forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
    (ByteString, ByteString) -> Attributes
attribute
    [ (ByteString
"stroke-width", Double -> ByteString
encodeNum forall a b. (a -> b) -> a -> b
$ RectStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "borderSize" a => a
#borderSize),
      (ByteString
"stroke", Colour -> ByteString
showRGB forall a b. (a -> b) -> a -> b
$ RectStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "borderColor" a => a
#borderColor),
      (ByteString
"stroke-opacity", Colour -> ByteString
showOpacity forall a b. (a -> b) -> a -> b
$ RectStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "borderColor" a => a
#borderColor),
      (ByteString
"fill", Colour -> ByteString
showRGB forall a b. (a -> b) -> a -> b
$ RectStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "color" a => a
#color),
      (ByteString
"fill-opacity", Colour -> ByteString
showOpacity forall a b. (a -> b) -> a -> b
$ RectStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "color" a => a
#color)
    ]

-- | TextStyle to Attributes
attsText :: TextStyle -> Attributes
attsText :: TextStyle -> Attributes
attsText TextStyle
o =
  Map ByteString ByteString -> Attributes
Attributes forall a b. (a -> b) -> a -> b
$
    forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
      [ (ByteString
"stroke-width", ByteString
"0.0"),
        (ByteString
"stroke", ByteString
"none"),
        (ByteString
"fill", Colour -> ByteString
showRGB forall a b. (a -> b) -> a -> b
$ TextStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "color" a => a
#color),
        (ByteString
"fill-opacity", Colour -> ByteString
showOpacity forall a b. (a -> b) -> a -> b
$ TextStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "color" a => a
#color),
        (ByteString
"font-size", Double -> ByteString
encodeNum forall a b. (a -> b) -> a -> b
$ TextStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "size" a => a
#size),
        (ByteString
"text-anchor", Anchor -> ByteString
toTextAnchor forall a b. (a -> b) -> a -> b
$ TextStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "anchor" a => a
#anchor)
      ]
  where
    toTextAnchor :: Anchor -> ByteString
    toTextAnchor :: Anchor -> ByteString
toTextAnchor Anchor
AnchorMiddle = ByteString
"middle"
    toTextAnchor Anchor
AnchorStart = ByteString
"start"
    toTextAnchor Anchor
AnchorEnd = ByteString
"end"

-- | GlyphStyle to Attributes
attsGlyph :: GlyphStyle -> Attributes
attsGlyph :: GlyphStyle -> Attributes
attsGlyph GlyphStyle
o =
  Map ByteString ByteString -> Attributes
Attributes forall a b. (a -> b) -> a -> b
$
    forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$
      [ (ByteString
"stroke-width", Double -> ByteString
encodeNum Double
sw),
        (ByteString
"stroke", Colour -> ByteString
showRGB forall a b. (a -> b) -> a -> b
$ GlyphStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "borderColor" a => a
#borderColor),
        (ByteString
"stroke-opacity", Colour -> ByteString
showOpacity forall a b. (a -> b) -> a -> b
$ GlyphStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "borderColor" a => a
#borderColor),
        (ByteString
"fill", Colour -> ByteString
showRGB forall a b. (a -> b) -> a -> b
$ GlyphStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "color" a => a
#color),
        (ByteString
"fill-opacity", Colour -> ByteString
showOpacity forall a b. (a -> b) -> a -> b
$ GlyphStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "color" a => a
#color)
      ]
        forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((forall a. a -> [a] -> [a]
: []) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) ByteString
"transform" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point Double -> ByteString
toTranslateText) (GlyphStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "translate" a => a
#translate)
  where
    sw :: Double
sw = case GlyphStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "shape" a => a
#shape of
      PathGlyph ByteString
_ ScaleBorder
NoScaleBorder -> GlyphStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "borderSize" a => a
#borderSize
      PathGlyph ByteString
_ ScaleBorder
ScaleBorder -> forall a. Ord a => a -> a -> a
min Double
0.2 (GlyphStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "borderSize" a => a
#borderSize forall a. Fractional a => a -> a -> a
/ GlyphStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "size" a => a
#size)
      GlyphShape
_ -> GlyphStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "borderSize" a => a
#borderSize

-- | PathStyle to Attributes
attsPath :: PathStyle -> Attributes
attsPath :: PathStyle -> Attributes
attsPath PathStyle
o =
  Map ByteString ByteString -> Attributes
Attributes forall a b. (a -> b) -> a -> b
$
    forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
      [ (ByteString
"stroke-width", Double -> ByteString
encodeNum forall a b. (a -> b) -> a -> b
$ PathStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "borderSize" a => a
#borderSize),
        (ByteString
"stroke", Colour -> ByteString
showRGB forall a b. (a -> b) -> a -> b
$ PathStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "borderColor" a => a
#borderColor),
        (ByteString
"stroke-opacity", Colour -> ByteString
showOpacity forall a b. (a -> b) -> a -> b
$ PathStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "borderColor" a => a
#borderColor),
        (ByteString
"fill", Colour -> ByteString
showRGB forall a b. (a -> b) -> a -> b
$ PathStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "color" a => a
#color),
        (ByteString
"fill-opacity", Colour -> ByteString
showOpacity forall a b. (a -> b) -> a -> b
$ PathStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "color" a => a
#color)
      ]

-- | includes a flip of the y dimension.
toTranslateText :: Point Double -> ByteString
toTranslateText :: Point Double -> ByteString
toTranslateText (Point Double
x Double
y) =
  ByteString
"translate(" forall a. Semigroup a => a -> a -> a
<> Double -> ByteString
encodeNum Double
x forall a. Semigroup a => a -> a -> a
<> ByteString
", " forall a. Semigroup a => a -> a -> a
<> Double -> ByteString
encodeNum (-Double
y) forall a. Semigroup a => a -> a -> a
<> ByteString
")"

-- | GlyphShape to markup Tree
markupShape_ :: GlyphShape -> Double -> Point Double -> Markup
markupShape_ :: GlyphShape -> Double -> Point Double -> Markup
markupShape_ GlyphShape
CircleGlyph Double
s (Point Double
x Double
y) = ByteString -> Attributes -> [Content] -> Markup
Markup ByteString
"circle" Attributes
as forall a. Monoid a => a
mempty
  where
    as :: Attributes
as =
      Map ByteString ByteString -> Attributes
Attributes forall a b. (a -> b) -> a -> b
$
        forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
          [ (ByteString
"cx", Double -> ByteString
encodeNum Double
x),
            (ByteString
"cy", Double -> ByteString
encodeNum forall a b. (a -> b) -> a -> b
$ -Double
y),
            (ByteString
"r", Double -> ByteString
encodeNum forall a b. (a -> b) -> a -> b
$ Double
0.5 forall a. Num a => a -> a -> a
* Double
s)
          ]
markupShape_ GlyphShape
SquareGlyph Double
s Point Double
p =
  Rect Double -> Markup
markupRect (forall s. (Additive (Element s), Space s) => Element s -> s -> s
move Point Double
p ((Double
s forall a. Num a => a -> a -> a
*) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Multiplicative a => a
one :: Rect Double))
markupShape_ (RectSharpGlyph Double
x') Double
s Point Double
p =
  Rect Double -> Markup
markupRect (forall s. (Additive (Element s), Space s) => Element s -> s -> s
move Point Double
p (forall s.
(Multiplicative (Element s), Space s) =>
Element s -> s -> s
scale (forall a. a -> a -> Point a
Point Double
s (Double
x' forall a. Num a => a -> a -> a
* Double
s)) forall a. Multiplicative a => a
one :: Rect Double))
markupShape_ (RectRoundedGlyph Double
x' Double
rx Double
ry) Double
s Point Double
p = ByteString -> Attributes -> [Content] -> Markup
Markup ByteString
"rect" Attributes
as forall a. Monoid a => a
mempty
  where
    as :: Attributes
as =
      Map ByteString ByteString -> Attributes
Attributes forall a b. (a -> b) -> a -> b
$
        forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
          [ (ByteString
"width", Double -> ByteString
encodeNum forall a b. (a -> b) -> a -> b
$ Double
z forall a. Num a => a -> a -> a
- Double
x),
            (ByteString
"height", Double -> ByteString
encodeNum forall a b. (a -> b) -> a -> b
$ Double
w forall a. Num a => a -> a -> a
- Double
y),
            (ByteString
"x", Double -> ByteString
encodeNum Double
x),
            (ByteString
"y", Double -> ByteString
encodeNum forall a b. (a -> b) -> a -> b
$ -Double
w),
            (ByteString
"rx", Double -> ByteString
encodeNum Double
rx),
            (ByteString
"ry", Double -> ByteString
encodeNum Double
ry)
          ]
    (Rect Double
x Double
z Double
y Double
w) = forall s. (Additive (Element s), Space s) => Element s -> s -> s
move Point Double
p (forall s.
(Multiplicative (Element s), Space s) =>
Element s -> s -> s
scale (forall a. a -> a -> Point a
Point Double
s (Double
x' forall a. Num a => a -> a -> a
* Double
s)) forall a. Multiplicative a => a
one)
markupShape_ (TriangleGlyph (Point Double
xa Double
ya) (Point Double
xb Double
yb) (Point Double
xc Double
yc)) Double
s Point Double
p =
  ByteString -> Attributes -> [Content] -> Markup
Markup ByteString
"polygon" Attributes
as forall a. Monoid a => a
mempty
  where
    as :: Attributes
as =
      Map ByteString ByteString -> Attributes
Attributes forall a b. (a -> b) -> a -> b
$
        forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
          [ (ByteString
"transform", Point Double -> ByteString
toTranslateText Point Double
p),
            (ByteString
"points", Double -> ByteString
encodeNum (Double
s forall a. Num a => a -> a -> a
* Double
xa) forall a. Semigroup a => a -> a -> a
<> ByteString
"," forall a. Semigroup a => a -> a -> a
<> Double -> ByteString
encodeNum (-(Double
s forall a. Num a => a -> a -> a
* Double
ya)) forall a. Semigroup a => a -> a -> a
<> ByteString
" " forall a. Semigroup a => a -> a -> a
<> Double -> ByteString
encodeNum (Double
s forall a. Num a => a -> a -> a
* Double
xb) forall a. Semigroup a => a -> a -> a
<> ByteString
"," forall a. Semigroup a => a -> a -> a
<> Double -> ByteString
encodeNum (-(Double
s forall a. Num a => a -> a -> a
* Double
yb)) forall a. Semigroup a => a -> a -> a
<> ByteString
" " forall a. Semigroup a => a -> a -> a
<> Double -> ByteString
encodeNum (Double
s forall a. Num a => a -> a -> a
* Double
xc) forall a. Semigroup a => a -> a -> a
<> ByteString
"," forall a. Semigroup a => a -> a -> a
<> Double -> ByteString
encodeNum (-(Double
s forall a. Num a => a -> a -> a
* Double
yc)))
          ]
markupShape_ (EllipseGlyph Double
x') Double
s (Point Double
x Double
y) =
  ByteString -> Attributes -> [Content] -> Markup
Markup ByteString
"ellipse" Attributes
as forall a. Monoid a => a
mempty
  where
    as :: Attributes
as =
      Map ByteString ByteString -> Attributes
Attributes forall a b. (a -> b) -> a -> b
$
        forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
          [ (ByteString
"cx", (String -> ByteString
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) Double
x),
            (ByteString
"cy", (String -> ByteString
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall a b. (a -> b) -> a -> b
$ -Double
y),
            (ByteString
"rx", (String -> ByteString
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall a b. (a -> b) -> a -> b
$ Double
0.5 forall a. Num a => a -> a -> a
* Double
s),
            (ByteString
"ry", (String -> ByteString
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall a b. (a -> b) -> a -> b
$ Double
0.5 forall a. Num a => a -> a -> a
* Double
s forall a. Num a => a -> a -> a
* Double
x')
          ]
markupShape_ GlyphShape
VLineGlyph Double
s (Point Double
x Double
y) =
  ByteString -> Attributes -> [Content] -> Markup
Markup ByteString
"polyline" (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (ByteString, ByteString) -> Attributes
attribute [(ByteString
"points", Double -> ByteString
encodeNum Double
x forall a. Semigroup a => a -> a -> a
<> ByteString
"," forall a. Semigroup a => a -> a -> a
<> Double -> ByteString
encodeNum (-(Double
y forall a. Num a => a -> a -> a
- Double
s forall a. Fractional a => a -> a -> a
/ Double
2)) forall a. Semigroup a => a -> a -> a
<> ByteString
"\n" forall a. Semigroup a => a -> a -> a
<> Double -> ByteString
encodeNum Double
x forall a. Semigroup a => a -> a -> a
<> ByteString
"," forall a. Semigroup a => a -> a -> a
<> Double -> ByteString
encodeNum (-(Double
y forall a. Num a => a -> a -> a
+ Double
s forall a. Fractional a => a -> a -> a
/ Double
2)))]) forall a. Monoid a => a
mempty
markupShape_ GlyphShape
HLineGlyph Double
s (Point Double
x Double
y) =
  ByteString -> Attributes -> [Content] -> Markup
Markup ByteString
"polyline" (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (ByteString, ByteString) -> Attributes
attribute [(ByteString
"points", Double -> ByteString
encodeNum (Double
x forall a. Num a => a -> a -> a
- Double
s forall a. Fractional a => a -> a -> a
/ Double
2) forall a. Semigroup a => a -> a -> a
<> ByteString
"," forall a. Semigroup a => a -> a -> a
<> Double -> ByteString
encodeNum (-Double
y) forall a. Semigroup a => a -> a -> a
<> ByteString
"\n" forall a. Semigroup a => a -> a -> a
<> Double -> ByteString
encodeNum (Double
x forall a. Num a => a -> a -> a
+ Double
s forall a. Fractional a => a -> a -> a
/ Double
2) forall a. Semigroup a => a -> a -> a
<> ByteString
"," forall a. Semigroup a => a -> a -> a
<> Double -> ByteString
encodeNum (-Double
y))]) forall a. Monoid a => a
mempty
markupShape_ (PathGlyph ByteString
path ScaleBorder
_) Double
s Point Double
p =
  ByteString -> Attributes -> [Content] -> Markup
Markup ByteString
"path" (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (ByteString, ByteString) -> Attributes
attribute [(ByteString
"d", ByteString
path), (ByteString
"transform", Point Double -> ByteString
toTranslateText Point Double
p forall a. Semigroup a => a -> a -> a
<> ByteString
" " forall a. Semigroup a => a -> a -> a
<> Double -> ByteString
toScaleText Double
s)]) forall a. Monoid a => a
mempty

-- | Create the classic SVG element
--
-- >>> header 100 one [Markup "foo" mempty mempty]
-- Markup {tag = "svg", atts = Attributes {attMap = fromList [("height","100"),("viewBox","-0.5 -0.5 1.0 1.0"),("width","100"),("xmlns","http://www.w3.org/2000/svg"),("xmlns:xlink","http://www.w3.org/1999/xlink")]}, contents = [MarkupLeaf (Markup {tag = "foo", atts = Attributes {attMap = fromList []}, contents = []})]}
header :: Double -> Rect Double -> [Markup] -> Markup
header :: Double -> Rect Double -> [Markup] -> Markup
header Double
markupheight Rect Double
viewbox [Markup]
content' =
  ByteString -> Attributes -> [Content] -> Markup
Markup
    ByteString
"svg"
    ( forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
        (ByteString, ByteString) -> Attributes
attribute
        [ (ByteString
"xmlns", ByteString
"http://www.w3.org/2000/svg"),
          (ByteString
"xmlns:xlink", ByteString
"http://www.w3.org/1999/xlink"),
          (ByteString
"width", Double -> ByteString
encodePx Double
w''),
          (ByteString
"height", Double -> ByteString
encodePx Double
h'),
          (ByteString
"viewBox", Double -> ByteString
encodeNum Double
x forall a. Semigroup a => a -> a -> a
<> ByteString
" " forall a. Semigroup a => a -> a -> a
<> Double -> ByteString
encodeNum (-Double
w) forall a. Semigroup a => a -> a -> a
<> ByteString
" " forall a. Semigroup a => a -> a -> a
<> Double -> ByteString
encodeNum (Double
z forall a. Num a => a -> a -> a
- Double
x) forall a. Semigroup a => a -> a -> a
<> ByteString
" " forall a. Semigroup a => a -> a -> a
<> Double -> ByteString
encodeNum (Double
w forall a. Num a => a -> a -> a
- Double
y))
        ]
    )
    (Markup -> Content
MarkupLeaf forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Markup]
content')
  where
    (Rect Double
x Double
z Double
y Double
w) = Rect Double
viewbox
    Point Double
w' Double
h = forall s. (Space s, Subtractive (Element s)) => s -> Element s
width Rect Double
viewbox
    Point Double
w'' Double
h' = forall a. a -> a -> Point a
Point (Double
markupheight forall a. Fractional a => a -> a -> a
/ Double
h forall a. Num a => a -> a -> a
* Double
w') Double
markupheight

-- | CSS prefer-color-scheme text snippet
--
-- >>> cssPreferColorScheme (light, dark) PreferHud
-- "svg {\n  color-scheme: light dark;\n}\n{\n  .canvas g, .title g, .axisbar g, .ticktext g, .tickglyph g, .ticklines g, .legendContent g text {\n    fill: rgb(5%, 5%, 5%);\n  }\n  .ticklines g, .tickglyph g, .legendBorder g {\n    stroke: rgb(5%, 5%, 5%);\n  }\n  .legendBorder g {\n    fill: rgb(94%, 94%, 94%);\n  }\n}\n@media (prefers-color-scheme:dark) {\n  .canvas g, .title g, .axisbar g, .ticktext g, .tickglyph g, .ticklines g, .legendContent g text {\n    fill: rgb(94%, 94%, 94%);\n  }\n  .ticklines g, .tickglyph g, .legendBorder g {\n    stroke: rgb(94%, 94%, 94%);\n  }\n  .legendBorder g {\n    fill: rgb(5%, 5%, 5%);\n  }\n}"
cssPreferColorScheme :: (Colour, Colour) -> CssPreferColorScheme -> ByteString
cssPreferColorScheme :: (Colour, Colour) -> CssPreferColorScheme -> ByteString
cssPreferColorScheme (Colour
cl, Colour
cd) CssPreferColorScheme
PreferHud =
  [i|svg {
  color-scheme: light dark;
}
{
  .canvas g, .title g, .axisbar g, .ticktext g, .tickglyph g, .ticklines g, .legendContent g text {
    fill: #{showRGB cd};
  }
  .ticklines g, .tickglyph g, .legendBorder g {
    stroke: #{showRGB cd};
  }
  .legendBorder g {
    fill: #{showRGB cl};
  }
}
@media (prefers-color-scheme:dark) {
  .canvas g, .title g, .axisbar g, .ticktext g, .tickglyph g, .ticklines g, .legendContent g text {
    fill: #{showRGB cl};
  }
  .ticklines g, .tickglyph g, .legendBorder g {
    stroke: #{showRGB cl};
  }
  .legendBorder g {
    fill: #{showRGB cd};
  }
}|]
cssPreferColorScheme (Colour
cl, Colour
_) CssPreferColorScheme
PreferLight =
  [i|svg {
      color-scheme: light dark;
    }
    @media (prefers-color-scheme:dark) {
      markup {
        background-color: #{showRGB cl};
      }
    }|]
cssPreferColorScheme (Colour
_, Colour
cd) CssPreferColorScheme
PreferDark =
  [i|svg {
      color-scheme: light dark;
    }
    @media (prefers-color-scheme:light) {
      markup {
        background-color: #{showRGB cd};
      }
    }|]
cssPreferColorScheme (Colour, Colour)
_ CssPreferColorScheme
PreferNormal = forall a. Monoid a => a
mempty

-- | CSS snippet to switch between dark and light mode
--
-- > fillSwitch (color1, color2) "dark" "stuff"
--
-- ... will default to color1 for elements of the "stuff" class, but switch to color2 if "dark" mode is preferred by the user.
--
fillSwitch :: (Colour, Colour) -> ByteString -> ByteString -> ByteString
fillSwitch :: (Colour, Colour) -> ByteString -> ByteString -> ByteString
fillSwitch (Colour
colorNormal, Colour
colorPrefer) ByteString
prefer ByteString
item =
  [i|
{
  .#{item} g {
    fill: #{showRGB colorNormal};
  }
}
@media (prefers-color-scheme:#{prefer}) {
  .#{item} g {
    fill: #{showRGB colorPrefer};
  }
}
|]

-- | Markup options.
--
-- >>> defaultMarkupOptions
-- MarkupOptions {markupHeight = 300.0, cssOptions = CssOptions {shapeRendering = NoShapeRendering, preferColorScheme = PreferHud, cssExtra = ""}}
data MarkupOptions = MarkupOptions
  { MarkupOptions -> Double
markupHeight :: Double,
    MarkupOptions -> CssOptions
cssOptions :: CssOptions
  }
  deriving (MarkupOptions -> MarkupOptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MarkupOptions -> MarkupOptions -> Bool
$c/= :: MarkupOptions -> MarkupOptions -> Bool
== :: MarkupOptions -> MarkupOptions -> Bool
$c== :: MarkupOptions -> MarkupOptions -> Bool
Eq, Int -> MarkupOptions -> ShowS
[MarkupOptions] -> ShowS
MarkupOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MarkupOptions] -> ShowS
$cshowList :: [MarkupOptions] -> ShowS
show :: MarkupOptions -> String
$cshow :: MarkupOptions -> String
showsPrec :: Int -> MarkupOptions -> ShowS
$cshowsPrec :: Int -> MarkupOptions -> ShowS
Show, forall x. Rep MarkupOptions x -> MarkupOptions
forall x. MarkupOptions -> Rep MarkupOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MarkupOptions x -> MarkupOptions
$cfrom :: forall x. MarkupOptions -> Rep MarkupOptions x
Generic)

-- | The official markup options
defaultMarkupOptions :: MarkupOptions
defaultMarkupOptions :: MarkupOptions
defaultMarkupOptions = Double -> CssOptions -> MarkupOptions
MarkupOptions Double
300 CssOptions
defaultCssOptions

-- | CSS shape rendering options
data CssShapeRendering = UseGeometricPrecision | UseCssCrisp | NoShapeRendering deriving (Int -> CssShapeRendering -> ShowS
[CssShapeRendering] -> ShowS
CssShapeRendering -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CssShapeRendering] -> ShowS
$cshowList :: [CssShapeRendering] -> ShowS
show :: CssShapeRendering -> String
$cshow :: CssShapeRendering -> String
showsPrec :: Int -> CssShapeRendering -> ShowS
$cshowsPrec :: Int -> CssShapeRendering -> ShowS
Show, CssShapeRendering -> CssShapeRendering -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CssShapeRendering -> CssShapeRendering -> Bool
$c/= :: CssShapeRendering -> CssShapeRendering -> Bool
== :: CssShapeRendering -> CssShapeRendering -> Bool
$c== :: CssShapeRendering -> CssShapeRendering -> Bool
Eq, forall x. Rep CssShapeRendering x -> CssShapeRendering
forall x. CssShapeRendering -> Rep CssShapeRendering x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CssShapeRendering x -> CssShapeRendering
$cfrom :: forall x. CssShapeRendering -> Rep CssShapeRendering x
Generic)

-- | CSS prefer-color-scheme options
data CssPreferColorScheme
  = -- | includes css that switches approriate hud elements between light and dark.
    PreferHud
  | PreferDark
  | PreferLight
  | PreferNormal
  deriving (Int -> CssPreferColorScheme -> ShowS
[CssPreferColorScheme] -> ShowS
CssPreferColorScheme -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CssPreferColorScheme] -> ShowS
$cshowList :: [CssPreferColorScheme] -> ShowS
show :: CssPreferColorScheme -> String
$cshow :: CssPreferColorScheme -> String
showsPrec :: Int -> CssPreferColorScheme -> ShowS
$cshowsPrec :: Int -> CssPreferColorScheme -> ShowS
Show, CssPreferColorScheme -> CssPreferColorScheme -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CssPreferColorScheme -> CssPreferColorScheme -> Bool
$c/= :: CssPreferColorScheme -> CssPreferColorScheme -> Bool
== :: CssPreferColorScheme -> CssPreferColorScheme -> Bool
$c== :: CssPreferColorScheme -> CssPreferColorScheme -> Bool
Eq, forall x. Rep CssPreferColorScheme x -> CssPreferColorScheme
forall x. CssPreferColorScheme -> Rep CssPreferColorScheme x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CssPreferColorScheme x -> CssPreferColorScheme
$cfrom :: forall x. CssPreferColorScheme -> Rep CssPreferColorScheme x
Generic)

-- | css options
--
-- >>> defaultCssOptions
-- CssOptions {shapeRendering = NoShapeRendering, preferColorScheme = PreferHud, cssExtra = ""}
data CssOptions = CssOptions {CssOptions -> CssShapeRendering
shapeRendering :: CssShapeRendering, CssOptions -> CssPreferColorScheme
preferColorScheme :: CssPreferColorScheme, CssOptions -> ByteString
cssExtra :: ByteString} deriving (Int -> CssOptions -> ShowS
[CssOptions] -> ShowS
CssOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CssOptions] -> ShowS
$cshowList :: [CssOptions] -> ShowS
show :: CssOptions -> String
$cshow :: CssOptions -> String
showsPrec :: Int -> CssOptions -> ShowS
$cshowsPrec :: Int -> CssOptions -> ShowS
Show, CssOptions -> CssOptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CssOptions -> CssOptions -> Bool
$c/= :: CssOptions -> CssOptions -> Bool
== :: CssOptions -> CssOptions -> Bool
$c== :: CssOptions -> CssOptions -> Bool
Eq, forall x. Rep CssOptions x -> CssOptions
forall x. CssOptions -> Rep CssOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CssOptions x -> CssOptions
$cfrom :: forall x. CssOptions -> Rep CssOptions x
Generic)

-- | No special shape rendering and default hud responds to user color scheme preferences.
defaultCssOptions :: CssOptions
defaultCssOptions :: CssOptions
defaultCssOptions = CssShapeRendering
-> CssPreferColorScheme -> ByteString -> CssOptions
CssOptions CssShapeRendering
NoShapeRendering CssPreferColorScheme
PreferHud forall a. Monoid a => a
mempty

-- | Convert CssOptions to Markup
--
-- >>> markupCssOptions defaultCssOptions
-- Markup {tag = "style", atts = Attributes {attMap = fromList []}, contents = [Content "svg {\n  color-scheme: light dark;\n}\n{\n  .canvas g, .title g, .axisbar g, .ticktext g, .tickglyph g, .ticklines g, .legendContent g text {\n    fill: rgb(5%, 5%, 5%);\n  }\n  .ticklines g, .tickglyph g, .legendBorder g {\n    stroke: rgb(5%, 5%, 5%);\n  }\n  .legendBorder g {\n    fill: rgb(94%, 94%, 94%);\n  }\n}\n@media (prefers-color-scheme:dark) {\n  .canvas g, .title g, .axisbar g, .ticktext g, .tickglyph g, .ticklines g, .legendContent g text {\n    fill: rgb(94%, 94%, 94%);\n  }\n  .ticklines g, .tickglyph g, .legendBorder g {\n    stroke: rgb(94%, 94%, 94%);\n  }\n  .legendBorder g {\n    fill: rgb(5%, 5%, 5%);\n  }\n}"]}
markupCssOptions :: CssOptions -> Markup
markupCssOptions :: CssOptions -> Markup
markupCssOptions CssOptions
css =
  ByteString -> Attributes -> [Content] -> Markup
Markup
    ByteString
"style"
    forall a. Monoid a => a
mempty
    [ ByteString -> Content
Content forall a b. (a -> b) -> a -> b
$
        (Colour, Colour) -> CssPreferColorScheme -> ByteString
cssPreferColorScheme (Colour
light, Colour
dark) (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "preferColorScheme" a => a
#preferColorScheme CssOptions
css)
          forall a. Semigroup a => a -> a -> a
<> CssShapeRendering -> ByteString
markupShapeRendering (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "shapeRendering" a => a
#shapeRendering CssOptions
css)
          forall a. Semigroup a => a -> a -> a
<> forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "cssExtra" a => a
#cssExtra CssOptions
css
    ]

-- | CSS shape rendering text snippet
markupShapeRendering :: CssShapeRendering -> ByteString
markupShapeRendering :: CssShapeRendering -> ByteString
markupShapeRendering CssShapeRendering
UseGeometricPrecision = ByteString
"svg { shape-rendering: geometricPrecision; }"
markupShapeRendering CssShapeRendering
UseCssCrisp = ByteString
"svg { shape-rendering: crispEdges; }"
markupShapeRendering CssShapeRendering
NoShapeRendering = forall a. Monoid a => a
mempty

-- | A product type representing charts, hud options and markup options, which can be transformed into 'Markup'.
data ChartOptions = ChartOptions
  { ChartOptions -> MarkupOptions
markupOptions :: MarkupOptions,
    ChartOptions -> HudOptions
hudOptions :: HudOptions,
    ChartOptions -> ChartTree
charts :: ChartTree
  }
  deriving (forall x. Rep ChartOptions x -> ChartOptions
forall x. ChartOptions -> Rep ChartOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChartOptions x -> ChartOptions
$cfrom :: forall x. ChartOptions -> Rep ChartOptions x
Generic, ChartOptions -> ChartOptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChartOptions -> ChartOptions -> Bool
$c/= :: ChartOptions -> ChartOptions -> Bool
== :: ChartOptions -> ChartOptions -> Bool
$c== :: ChartOptions -> ChartOptions -> Bool
Eq, Int -> ChartOptions -> ShowS
[ChartOptions] -> ShowS
ChartOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChartOptions] -> ShowS
$cshowList :: [ChartOptions] -> ShowS
show :: ChartOptions -> String
$cshow :: ChartOptions -> String
showsPrec :: Int -> ChartOptions -> ShowS
$cshowsPrec :: Int -> ChartOptions -> ShowS
Show)

-- | Convert ChartOptions to Markup
--
-- >>> markupChartOptions (ChartOptions (defaultMarkupOptions & #cssOptions % #preferColorScheme .~ PreferNormal) mempty mempty)
-- Markup {tag = "svg", atts = Attributes {attMap = fromList [("height","300"),("viewBox","-0.75 -0.5 1.5 1.0"),("width","450"),("xmlns","http://www.w3.org/2000/svg"),("xmlns:xlink","http://www.w3.org/1999/xlink")]}, contents = [MarkupLeaf (Markup {tag = "style", atts = Attributes {attMap = fromList []}, contents = [Content ""]}),MarkupLeaf (Markup {tag = "g", atts = Attributes {attMap = fromList [("class","chart")]}, contents = []}),MarkupLeaf (Markup {tag = "g", atts = Attributes {attMap = fromList [("class","hud")]}, contents = []})]}
markupChartOptions :: ChartOptions -> Markup
markupChartOptions :: ChartOptions -> Markup
markupChartOptions ChartOptions
co =
  Double -> Rect Double -> [Markup] -> Markup
header
    (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (forall a. IsLabel "markupOptions" a => a
#markupOptions forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "markupHeight" a => a
#markupHeight) ChartOptions
co)
    Rect Double
viewbox
    ( [CssOptions -> Markup
markupCssOptions (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (forall a. IsLabel "markupOptions" a => a
#markupOptions forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "cssOptions" a => a
#cssOptions) ChartOptions
co)]
        forall a. Semigroup a => a -> a -> a
<> ChartTree -> [Markup]
markupChartTree ChartTree
csAndHud
    )
  where
    viewbox :: Rect Double
viewbox = Maybe (Rect Double) -> Rect Double
singletonGuard (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Lens' ChartTree (Maybe (Rect Double))
styleBox' ChartTree
csAndHud)
    csAndHud :: ChartTree
csAndHud = HudOptions -> ChartTree -> ChartTree
addHud (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "hudOptions" a => a
#hudOptions ChartOptions
co) (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "charts" a => a
#charts ChartOptions
co)

-- | Render ChartOptions to an SVG ByteString
--
-- >>> encodeChartOptions (ChartOptions (defaultMarkupOptions & #cssOptions % #preferColorScheme .~ PreferNormal) mempty mempty)
-- "<svg height=\"300\" viewBox=\"-0.75 -0.5 1.5 1.0\" width=\"450\" xmlns=\"http://www.w3.org/2000/svg\" xmlns:xlink=\"http://www.w3.org/1999/xlink\"><style></style><g class=\"chart\"/><g class=\"hud\"/></svg>"
encodeChartOptions :: ChartOptions -> ByteString
encodeChartOptions :: ChartOptions -> ByteString
encodeChartOptions = Markup -> ByteString
encodeMarkup forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChartOptions -> Markup
markupChartOptions

-- | Render ChartOptions to an SVG Text snippet
--
-- >>> renderChartOptions (ChartOptions (defaultMarkupOptions & #cssOptions % #preferColorScheme .~ PreferNormal) mempty mempty)
-- "<svg height=\"300\" viewBox=\"-0.75 -0.5 1.5 1.0\" width=\"450\" xmlns=\"http://www.w3.org/2000/svg\" xmlns:xlink=\"http://www.w3.org/1999/xlink\"><style></style><g class=\"chart\"/><g class=\"hud\"/></svg>"
renderChartOptions :: ChartOptions -> Text
renderChartOptions :: ChartOptions -> Text
renderChartOptions = Markup -> Text
renderMarkup forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChartOptions -> Markup
markupChartOptions

instance Semigroup ChartOptions where
  <> :: ChartOptions -> ChartOptions -> ChartOptions
(<>) (ChartOptions MarkupOptions
_ HudOptions
h ChartTree
c) (ChartOptions MarkupOptions
s' HudOptions
h' ChartTree
c') =
    MarkupOptions -> HudOptions -> ChartTree -> ChartOptions
ChartOptions MarkupOptions
s' (HudOptions
h forall a. Semigroup a => a -> a -> a
<> HudOptions
h') (ChartTree
c forall a. Semigroup a => a -> a -> a
<> ChartTree
c')

instance Monoid ChartOptions where
  mempty :: ChartOptions
mempty = MarkupOptions -> HudOptions -> ChartTree -> ChartOptions
ChartOptions MarkupOptions
defaultMarkupOptions forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty

-- | Convert ChartOptions to an SVG ByteString and save to a file
writeChartOptions :: FilePath -> ChartOptions -> IO ()
writeChartOptions :: String -> ChartOptions -> IO ()
writeChartOptions String
fp ChartOptions
co = String -> ByteString -> IO ()
Data.ByteString.writeFile String
fp (ChartOptions -> ByteString
encodeChartOptions ChartOptions
co)