{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module Chart.Markup
( Markup (..),
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.Maybe
import Data.Path
import Data.Path.Parser
import Data.String.Interpolate
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Text.Encoding (encodeUtf8)
import Data.Tree (Tree (..))
import FlatParse.Basic (utf8ToStr)
import GHC.Generics
import MarkupParse
import Optics.Core hiding (element)
import Prelude
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
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)
markupChartTree :: ChartTree -> [Tree Token]
markupChartTree :: ChartTree -> [Tree Token]
markupChartTree ChartTree
cs =
case ([Tree Token]
xs', Maybe Text
label) of
([], Maybe Text
Nothing) -> forall a. Monoid a => a
mempty
([Tree Token]
xs'', Maybe Text
Nothing) -> [Tree Token]
xs''
([Tree Token]
xs'', Just Text
l) -> [forall a. a -> [Tree a] -> Tree a
Node (ByteString -> [Attr] -> Token
StartTag ByteString
"g" [ByteString -> ByteString -> Attr
Attr ByteString
"class" (Text -> ByteString
encodeUtf8 Text
l)]) [Tree Token]
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' :: [Tree Token]
xs' = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Chart -> [Tree Token]
markupChart [Chart]
cs' forall a. Semigroup a => a -> a -> a
<> (ChartTree -> [Tree Token]
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 -> Tree Token
markupText :: TextStyle -> Text -> Point Double -> Tree Token
markupText TextStyle
s Text
t p :: Point Double
p@(Point Double
x Double
y) = forall a. a -> [Tree a] -> Tree a
Node (ByteString -> [Attr] -> Token
StartTag ByteString
"text" [Attr]
as) ([Tree Token]
xs forall a. Semigroup a => a -> a -> a
<> [forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Token
Content ByteString
c)])
where
as :: [Attr]
as =
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> ByteString -> Attr
Attr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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 :: [Tree Token]
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 -> Chart -> [Tree Token]
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
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
")"
markupRect :: Rect Double -> Token
markupRect :: Rect Double -> Token
markupRect (Rect Double
x Double
z Double
y Double
w) =
ByteString -> [Attr] -> Token
EmptyElemTag ByteString
"rect" [Attr]
as
where
as :: [Attr]
as =
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> ByteString -> Attr
Attr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ (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))
]
markupChart :: Chart -> [Tree Token]
markupChart :: Chart -> [Tree Token]
markupChart (RectChart RectStyle
s [Rect Double]
xs) =
[forall a. a -> [Tree a] -> Tree a
Node (ByteString -> [Attr] -> Token
StartTag ByteString
"g" (RectStyle -> [Attr]
attsRect RectStyle
s)) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rect Double -> Token
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 -> [Tree a] -> Tree a
Node (ByteString -> [Attr] -> Token
StartTag ByteString
"g" (TextStyle -> [Attr]
attsText TextStyle
s)) (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (TextStyle -> Text -> Point Double -> Tree Token
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 -> [Tree a] -> Tree a
Node (ByteString -> [Attr] -> Token
StartTag ByteString
"g" (GlyphStyle -> [Attr]
attsGlyph GlyphStyle
s)) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GlyphStyle -> Point Double -> Tree Token
markupGlyph GlyphStyle
s) [Point Double]
xs)]
markupChart (PathChart PathStyle
s [PathData Double]
xs) =
[forall a. a -> [Tree a] -> Tree a
Node (ByteString -> [Attr] -> Token
StartTag ByteString
"g" (PathStyle -> [Attr]
attsPath PathStyle
s)) [forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [PathData Double] -> Token
markupPath [PathData Double]
xs]]
markupChart (LineChart LineStyle
s [[Point Double]]
xs) =
[forall a. a -> [Tree a] -> Tree a
Node (ByteString -> [Attr] -> Token
StartTag ByteString
"g" (LineStyle -> [Attr]
attsLine LineStyle
s)) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Point Double]] -> [Token]
markupLine [[Point Double]]
xs)]
markupChart (BlankChart [Rect Double]
_) = []
markupLine :: [[Point Double]] -> [Token]
markupLine :: [[Point Double]] -> [Token]
markupLine [[Point Double]]
lss =
ByteString -> [Attr] -> Token
EmptyElemTag ByteString
"polyline" forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
: []) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> Attr
Attr ByteString
"points" forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Point Double] -> ByteString
toPointsText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[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
markupPath :: [PathData Double] -> Token
markupPath :: [PathData Double] -> Token
markupPath [PathData Double]
ps =
ByteString -> [Attr] -> Token
EmptyElemTag ByteString
"path" [ByteString -> ByteString -> Attr
Attr ByteString
"d" ([PathData Double] -> ByteString
pathDataToSvg [PathData Double]
ps)]
markupGlyph :: GlyphStyle -> Point Double -> Tree Token
markupGlyph :: GlyphStyle -> Point Double -> Tree Token
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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Token
gl
Just Double
r -> forall a. a -> [Tree a] -> Tree a
Node (ByteString -> [Attr] -> Token
StartTag ByteString
"g" [ByteString -> ByteString -> Attr
Attr ByteString
"transform" (Double -> Point Double -> ByteString
toRotateText Double
r Point Double
p)]) [forall (f :: * -> *) a. Applicative f => a -> f a
pure Token
gl]
where
gl :: Token
gl = GlyphShape -> Double -> Point Double -> Token
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
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 -> [Attr]
attsLine :: LineStyle -> [Attr]
attsLine LineStyle
o =
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> ByteString -> Attr
Attr
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 -> [Attr]
attsRect :: RectStyle -> [Attr]
attsRect RectStyle
o =
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> ByteString -> Attr
Attr
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
$ 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)
]
attsText :: TextStyle -> [Attr]
attsText :: TextStyle -> [Attr]
attsText TextStyle
o =
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> ByteString -> Attr
Attr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ (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"
attsGlyph :: GlyphStyle -> [Attr]
attsGlyph :: GlyphStyle -> [Attr]
attsGlyph GlyphStyle
o =
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> ByteString -> Attr
Attr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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
attsPath :: PathStyle -> [Attr]
attsPath :: PathStyle -> [Attr]
attsPath PathStyle
o =
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> ByteString -> Attr
Attr
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
$ 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)
]
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
")"
markupShape_ :: GlyphShape -> Double -> Point Double -> Token
markupShape_ :: GlyphShape -> Double -> Point Double -> Token
markupShape_ GlyphShape
CircleGlyph Double
s (Point Double
x Double
y) = ByteString -> [Attr] -> Token
EmptyElemTag ByteString
"circle" [Attr]
as
where
as :: [Attr]
as =
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> ByteString -> Attr
Attr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ (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 -> Token
markupRect (forall s. (Additive (Element s), Space s) => Element s -> s -> s
move Point Double
p ((Double
s *) 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 -> Token
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 -> [Attr] -> Token
EmptyElemTag ByteString
"rect" [Attr]
as
where
as :: [Attr]
as =
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> ByteString -> Attr
Attr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ (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 -> [Attr] -> Token
EmptyElemTag ByteString
"polygon" [Attr]
as
where
as :: [Attr]
as =
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> ByteString -> Attr
Attr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ (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 -> [Attr] -> Token
EmptyElemTag ByteString
"ellipse" [Attr]
as
where
as :: [Attr]
as =
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> ByteString -> Attr
Attr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ (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 -> [Attr] -> Token
EmptyElemTag ByteString
"polyline" [ByteString -> ByteString -> Attr
Attr ByteString
"points" forall a b. (a -> b) -> a -> b
$ 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))]
markupShape_ GlyphShape
HLineGlyph Double
s (Point Double
x Double
y) =
ByteString -> [Attr] -> Token
EmptyElemTag ByteString
"polyline" [ByteString -> ByteString -> Attr
Attr ByteString
"points" forall a b. (a -> b) -> a -> b
$ 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)]
markupShape_ (PathGlyph ByteString
path ScaleBorder
_) Double
s Point Double
p =
ByteString -> [Attr] -> Token
EmptyElemTag ByteString
"path" (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> ByteString -> Attr
Attr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(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)])
header :: Double -> Rect Double -> [Tree Token] -> Tree Token
Double
markupheight Rect Double
viewbox [Tree Token]
content' =
forall a. a -> [Tree a] -> Tree a
Node
( ByteString -> [Attr] -> Token
StartTag
ByteString
"svg"
( forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> ByteString -> Attr
Attr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ (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))
]
)
)
[Tree Token]
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
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
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};
}
}
|]
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)
defaultMarkupOptions :: MarkupOptions
defaultMarkupOptions :: MarkupOptions
defaultMarkupOptions = Double -> CssOptions -> MarkupOptions
MarkupOptions Double
300 CssOptions
defaultCssOptions
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)
data CssPreferColorScheme
=
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)
data CssOptions = CssOptions {CssOptions -> CssShapeRendering
shapeRendering :: CssShapeRendering, CssOptions -> CssPreferColorScheme
preferColorScheme :: CssPreferColorScheme, :: 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)
defaultCssOptions :: CssOptions
defaultCssOptions :: CssOptions
defaultCssOptions = CssShapeRendering
-> CssPreferColorScheme -> ByteString -> CssOptions
CssOptions CssShapeRendering
NoShapeRendering CssPreferColorScheme
PreferHud forall a. Monoid a => a
mempty
markupCssOptions :: CssOptions -> Tree Token
markupCssOptions :: CssOptions -> Tree Token
markupCssOptions CssOptions
css =
forall a. a -> [Tree a] -> Tree a
Node
(ByteString -> [Attr] -> Token
StartTag ByteString
"style" [])
[ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
ByteString -> Token
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
]
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
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)
markupChartOptions :: ChartOptions -> Markup
markupChartOptions :: ChartOptions -> Markup
markupChartOptions ChartOptions
co =
Standard -> [Tree Token] -> Markup
Markup Standard
Xml forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
: []) forall a b. (a -> b) -> a -> b
$
Double -> Rect Double -> [Tree Token] -> Tree Token
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 -> Tree Token
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 -> [Tree Token]
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)
encodeChartOptions :: ChartOptions -> ByteString
encodeChartOptions :: ChartOptions -> ByteString
encodeChartOptions = RenderStyle -> Markup -> ByteString
markdown RenderStyle
Compact forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChartOptions -> Markup
markupChartOptions
renderChartOptions :: ChartOptions -> Text
renderChartOptions :: ChartOptions -> Text
renderChartOptions = String -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
utf8ToStr forall b c a. (b -> c) -> (a -> b) -> a -> c
. RenderStyle -> Markup -> ByteString
markdown RenderStyle
Compact 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
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)