{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# OPTIONS_GHC -Wall #-}
module Chart.Svg
(
ChartSvg (..),
toChartTree,
writeChartSvg,
chartSvg,
initialCanvas,
SvgOptions (..),
defaultSvgOptions,
CssOptions (..),
defaultCssOptions,
CssShapeRendering (..),
CssPreferColorScheme (..),
cssShapeRendering,
cssPreferColorScheme,
)
where
import Chart.Data
import Chart.Hud
import Chart.Primitive
import Chart.Style
import Data.Colour
import Data.Maybe
import Data.Path
import Data.Path.Parser
import Data.Text (Text, pack, unpack)
import qualified Data.Text as Text
import qualified Data.Text.Lazy as Lazy
import Data.Tree
import GHC.Generics
import Lucid
import Lucid.Base
import NeatInterpolation
import Optics.Core
import Prelude
draw :: Chart -> Html ()
draw :: Chart -> Html ()
draw (RectChart RectStyle
_ [Rect Double]
a) = [Html ()] -> Html ()
forall a. Monoid a => [a] -> a
mconcat ([Html ()] -> Html ()) -> [Html ()] -> Html ()
forall a b. (a -> b) -> a -> b
$ Rect Double -> Html ()
svgRect_ (Rect Double -> Html ()) -> [Rect Double] -> [Html ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Rect Double]
a
draw (TextChart TextStyle
s [(Text, Point Double)]
a) = [Html ()] -> Html ()
forall a. Monoid a => [a] -> a
mconcat ([Html ()] -> Html ()) -> [Html ()] -> Html ()
forall a b. (a -> b) -> a -> b
$ (Text -> Point Double -> Html ())
-> (Text, Point Double) -> Html ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (TextStyle -> Text -> Point Double -> Html ()
svgText_ TextStyle
s) ((Text, Point Double) -> Html ())
-> [(Text, Point Double)] -> [Html ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Point Double)]
a
draw (LineChart LineStyle
_ [[Point Double]]
as) = [[Point Double]] -> Html ()
svgLine_ [[Point Double]]
as
draw (GlyphChart GlyphStyle
s [Point Double]
a) = [Html ()] -> Html ()
forall a. Monoid a => [a] -> a
mconcat ([Html ()] -> Html ()) -> [Html ()] -> Html ()
forall a b. (a -> b) -> a -> b
$ GlyphStyle -> Point Double -> Html ()
svgGlyph_ GlyphStyle
s (Point Double -> Html ()) -> [Point Double] -> [Html ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Point Double]
a
draw (PathChart PathStyle
_ [PathData Double]
a) = [PathData Double] -> Html ()
svgPath_ [PathData Double]
a
draw (BlankChart [Rect Double]
_) = Html ()
forall a. Monoid a => a
mempty
atts :: Chart -> [Attribute]
atts :: Chart -> [Attribute]
atts (RectChart RectStyle
s [Rect Double]
_) = RectStyle -> [Attribute]
attsRect RectStyle
s
atts (TextChart TextStyle
s [(Text, Point Double)]
_) = TextStyle -> [Attribute]
attsText TextStyle
s
atts (LineChart LineStyle
s [[Point Double]]
_) = LineStyle -> [Attribute]
attsLine LineStyle
s
atts (GlyphChart GlyphStyle
s [Point Double]
_) = GlyphStyle -> [Attribute]
attsGlyph GlyphStyle
s
atts (PathChart PathStyle
s [PathData Double]
_) = PathStyle -> [Attribute]
attsPath PathStyle
s
atts (BlankChart [Rect Double]
_) = [Attribute]
forall a. Monoid a => a
mempty
svgChartTree :: ChartTree -> Lucid.Html ()
svgChartTree :: ChartTree -> Html ()
svgChartTree ChartTree
cs
| Maybe Text -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Text
label Bool -> Bool -> Bool
&& [Chart] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Chart]
cs' = [Html ()] -> Html ()
forall a. Monoid a => [a] -> a
mconcat ([Html ()] -> Html ()) -> [Html ()] -> Html ()
forall a b. (a -> b) -> a -> b
$ ChartTree -> Html ()
svgChartTree (ChartTree -> Html ())
-> (Tree (Maybe Text, [Chart]) -> ChartTree)
-> Tree (Maybe Text, [Chart])
-> Html ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree (Maybe Text, [Chart]) -> ChartTree
ChartTree (Tree (Maybe Text, [Chart]) -> Html ())
-> [Tree (Maybe Text, [Chart])] -> [Html ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tree (Maybe Text, [Chart])]
xs
| Bool
otherwise = Text -> [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => Text -> arg -> result
term Text
"g" ((Text -> [Attribute]) -> Maybe Text -> [Attribute]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Text
x -> [Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"class" Text
x]) Maybe Text
label) Html ()
content'
where
(ChartTree (Node (Maybe Text
label, [Chart]
cs') [Tree (Maybe Text, [Chart])]
xs)) = (Chart -> Bool) -> ChartTree -> ChartTree
filterChartTree (Bool -> Bool
not (Bool -> Bool) -> (Chart -> Bool) -> Chart -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chart -> Bool
isEmptyChart) ChartTree
cs
content' :: Html ()
content' = ([Html ()] -> Html ()
forall a. Monoid a => [a] -> a
mconcat ([Html ()] -> Html ()) -> [Html ()] -> Html ()
forall a b. (a -> b) -> a -> b
$ Chart -> Html ()
svg (Chart -> Html ()) -> [Chart] -> [Html ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Chart]
cs') Html () -> Html () -> Html ()
forall a. Semigroup a => a -> a -> a
<> ([Html ()] -> Html ()
forall a. Monoid a => [a] -> a
mconcat ([Html ()] -> Html ()) -> [Html ()] -> Html ()
forall a b. (a -> b) -> a -> b
$ ChartTree -> Html ()
svgChartTree (ChartTree -> Html ())
-> (Tree (Maybe Text, [Chart]) -> ChartTree)
-> Tree (Maybe Text, [Chart])
-> Html ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree (Maybe Text, [Chart]) -> ChartTree
ChartTree (Tree (Maybe Text, [Chart]) -> Html ())
-> [Tree (Maybe Text, [Chart])] -> [Html ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tree (Maybe Text, [Chart])]
xs)
data ChartSvg = ChartSvg
{ ChartSvg -> SvgOptions
svgOptions :: SvgOptions,
ChartSvg -> HudOptions
hudOptions :: HudOptions,
:: [Hud],
ChartSvg -> ChartTree
charts :: ChartTree
}
deriving ((forall x. ChartSvg -> Rep ChartSvg x)
-> (forall x. Rep ChartSvg x -> ChartSvg) -> Generic ChartSvg
forall x. Rep ChartSvg x -> ChartSvg
forall x. ChartSvg -> Rep ChartSvg x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChartSvg x -> ChartSvg
$cfrom :: forall x. ChartSvg -> Rep ChartSvg x
Generic)
instance Semigroup ChartSvg where
<> :: ChartSvg -> ChartSvg -> ChartSvg
(<>) (ChartSvg SvgOptions
_ HudOptions
o [Hud]
h ChartTree
c) (ChartSvg SvgOptions
s' HudOptions
o' [Hud]
h' ChartTree
c') =
SvgOptions -> HudOptions -> [Hud] -> ChartTree -> ChartSvg
ChartSvg SvgOptions
s' (HudOptions
o HudOptions -> HudOptions -> HudOptions
forall a. Semigroup a => a -> a -> a
<> HudOptions
o') ([Hud]
h [Hud] -> [Hud] -> [Hud]
forall a. Semigroup a => a -> a -> a
<> [Hud]
h') (ChartTree
c ChartTree -> ChartTree -> ChartTree
forall a. Semigroup a => a -> a -> a
<> ChartTree
c')
instance Monoid ChartSvg where
mempty :: ChartSvg
mempty = SvgOptions -> HudOptions -> [Hud] -> ChartTree -> ChartSvg
ChartSvg SvgOptions
defaultSvgOptions HudOptions
forall a. Monoid a => a
mempty [Hud]
forall a. Monoid a => a
mempty ChartTree
forall a. Monoid a => a
mempty
svg2Tag :: Term [Attribute] (s -> t) => s -> t
svg2Tag :: s -> t
svg2Tag s
m =
[Attribute] -> s -> t
forall arg result. Term arg result => arg -> result
svg_
[ Text -> Text -> Attribute
makeAttribute Text
"xmlns" Text
"http://www.w3.org/2000/svg",
Text -> Text -> Attribute
makeAttribute Text
"xmlns:xlink" Text
"http://www.w3.org/1999/xlink"
]
s
m
renderToText :: Html () -> Text
renderToText :: Html () -> Text
renderToText = Text -> Text
Lazy.toStrict (Text -> Text) -> (Html () -> Text) -> Html () -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html () -> Text
forall a. Html a -> Text
renderText
renderToSvg :: SvgOptions -> ChartTree -> Html ()
renderToSvg :: SvgOptions -> ChartTree -> Html ()
renderToSvg SvgOptions
so ChartTree
cs =
Html () -> [Attribute] -> Html ()
forall a. With a => a -> [Attribute] -> a
with
(Html () -> Html ()
forall s t. Term [Attribute] (s -> t) => s -> t
svg2Tag (CssOptions -> Html ()
cssText (Optic' A_Lens NoIx SvgOptions CssOptions
-> SvgOptions -> CssOptions
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel "cssOptions" (Optic' A_Lens NoIx SvgOptions CssOptions)
Optic' A_Lens NoIx SvgOptions CssOptions
#cssOptions SvgOptions
so) Html () -> Html () -> Html ()
forall a. Semigroup a => a -> a -> a
<> ChartTree -> Html ()
svgChartTree ChartTree
cs))
[ Text -> Attribute
width_ (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show Double
w''),
Text -> Attribute
height_ (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show Double
h''),
Text -> Text -> Attribute
makeAttribute Text
"viewBox" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show Double
x String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Double -> String
forall a. Show a => a -> String
show (-Double
w) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Double -> String
forall a. Show a => a -> String
show (Double
z Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
x) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Double -> String
forall a. Show a => a -> String
show (Double
w Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
y))
]
where
r :: Rect Double
r@(Rect Double
x Double
z Double
y Double
w) = Maybe (Rect Double) -> Rect Double
singletonGuard (Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
-> ChartTree -> Maybe (Rect Double)
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
styleBox' ChartTree
cs)
Point Double
w' Double
h' = Rect Double -> Element (Rect Double)
forall s. (Space s, Subtractive (Element s)) => s -> Element s
width Rect Double
r
Point Double
w'' Double
h'' = Double -> Double -> Point Double
forall a. a -> a -> Point a
Point ((SvgOptions
so SvgOptions -> Optic' A_Lens NoIx SvgOptions Double -> Double
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "svgHeight" (Optic' A_Lens NoIx SvgOptions Double)
Optic' A_Lens NoIx SvgOptions Double
#svgHeight) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
h' Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
w') (SvgOptions
so SvgOptions -> Optic' A_Lens NoIx SvgOptions Double -> Double
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "svgHeight" (Optic' A_Lens NoIx SvgOptions Double)
Optic' A_Lens NoIx SvgOptions Double
#svgHeight)
svg :: Chart -> Lucid.Html ()
svg :: Chart -> Html ()
svg (BlankChart [Rect Double]
_) = Html ()
forall a. Monoid a => a
mempty
svg Chart
c = Text -> [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => Text -> arg -> result
term Text
"g" (Chart -> [Attribute]
atts Chart
c) (Chart -> Html ()
draw Chart
c)
cssText :: CssOptions -> Html ()
cssText :: CssOptions -> Html ()
cssText CssOptions
csso =
[Attribute] -> Text -> Html ()
forall arg result. TermRaw arg result => arg -> result
style_ [] (Text -> Html ()) -> Text -> Html ()
forall a b. (a -> b) -> a -> b
$
CssShapeRendering -> Text
cssShapeRendering (CssOptions
csso CssOptions
-> Optic' A_Lens NoIx CssOptions CssShapeRendering
-> CssShapeRendering
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
"shapeRendering" (Optic' A_Lens NoIx CssOptions CssShapeRendering)
Optic' A_Lens NoIx CssOptions CssShapeRendering
#shapeRendering)
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Colour, Colour) -> CssPreferColorScheme -> Text
cssPreferColorScheme (Colour
light, Colour
dark) (CssOptions
csso CssOptions
-> Optic' A_Lens NoIx CssOptions CssPreferColorScheme
-> CssPreferColorScheme
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
"preferColorScheme"
(Optic' A_Lens NoIx CssOptions CssPreferColorScheme)
Optic' A_Lens NoIx CssOptions CssPreferColorScheme
#preferColorScheme)
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> CssOptions
csso CssOptions -> Optic' A_Lens NoIx CssOptions Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "cssExtra" (Optic' A_Lens NoIx CssOptions Text)
Optic' A_Lens NoIx CssOptions Text
#cssExtra
cssShapeRendering :: CssShapeRendering -> Text
cssShapeRendering :: CssShapeRendering -> Text
cssShapeRendering CssShapeRendering
UseGeometricPrecision = Text
"svg { shape-rendering: geometricPrecision; }"
cssShapeRendering CssShapeRendering
UseCssCrisp = Text
"svg { shape-rendering: crispEdges; }"
cssShapeRendering CssShapeRendering
NoShapeRendering = Text
forall a. Monoid a => a
mempty
cssPreferColorScheme :: (Colour, Colour) -> CssPreferColorScheme -> Text
cssPreferColorScheme :: (Colour, Colour) -> CssPreferColorScheme -> Text
cssPreferColorScheme (Colour
cl, Colour
cd) CssPreferColorScheme
PreferHud =
[trimming|
svg {
color-scheme: light dark;
}
{
.canvas g, .title g, .axisbar g, .ticktext g, .tickglyph g, .ticklines g, .legendContent g text {
fill: $hexDark;
}
.ticklines g, .tickglyph g, .legendBorder g {
stroke: $hexDark;
}
.legendBorder g {
fill: $hexLight;
}
}
@media (prefers-color-scheme:dark) {
.canvas g, .title g, .axisbar g, .ticktext g, .tickglyph g, .ticklines g, .legendContent g text {
fill: $hexLight;
}
.ticklines g, .tickglyph g, .legendBorder g {
stroke: $hexLight;
}
.legendBorder g {
fill: $hexDark;
}
}
|]
where
hexLight :: Text
hexLight = Colour -> Text
hex Colour
cl
hexDark :: Text
hexDark = Colour -> Text
hex Colour
cd
cssPreferColorScheme (Colour
bglight, Colour
_) CssPreferColorScheme
PreferLight =
[trimming|
svg {
color-scheme: light dark;
}
@media (prefers-color-scheme:dark) {
svg {
background-color: $c;
}
}
|]
where
c :: Text
c = Colour -> Text
hex Colour
bglight
cssPreferColorScheme (Colour
_, Colour
bgdark) CssPreferColorScheme
PreferDark =
[trimming|
svg {
color-scheme: light dark;
}
@media (prefers-color-scheme:light) {
svg {
background-color: $c;
}
}
|]
where
c :: Text
c = Colour -> Text
hex Colour
bgdark
cssPreferColorScheme (Colour, Colour)
_ CssPreferColorScheme
PreferNormal = Text
forall a. Monoid a => a
mempty
toChartTree :: ChartSvg -> ChartTree
toChartTree :: ChartSvg -> ChartTree
toChartTree ChartSvg
cs =
Rect Double -> Rect Double -> [Hud] -> ChartTree -> ChartTree
runHudWith
(ChartAspect -> ChartTree -> Rect Double
initialCanvas (Optic' A_Lens NoIx ChartSvg ChartAspect -> ChartSvg -> ChartAspect
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (IsLabel
"hudOptions"
(Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions)
Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
-> Optic A_Lens NoIx HudOptions HudOptions ChartAspect ChartAspect
-> Optic' A_Lens NoIx ChartSvg ChartAspect
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
% IsLabel
"chartAspect"
(Optic A_Lens NoIx HudOptions HudOptions ChartAspect ChartAspect)
Optic A_Lens NoIx HudOptions HudOptions ChartAspect ChartAspect
#chartAspect) ChartSvg
cs) (Optic' A_Lens NoIx ChartSvg ChartTree -> ChartSvg -> ChartTree
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel "charts" (Optic' A_Lens NoIx ChartSvg ChartTree)
Optic' A_Lens NoIx ChartSvg ChartTree
#charts ChartSvg
cs))
Rect Double
db'
[Hud]
hs'
(Optic' A_Lens NoIx ChartSvg ChartTree -> ChartSvg -> ChartTree
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel "charts" (Optic' A_Lens NoIx ChartSvg ChartTree)
Optic' A_Lens NoIx ChartSvg ChartTree
#charts ChartSvg
cs ChartTree -> ChartTree -> ChartTree
forall a. Semigroup a => a -> a -> a
<> Rect Double -> ChartTree
blank Rect Double
db')
where
([Hud]
hs, Rect Double
db') = HudOptions -> Rect Double -> ([Hud], Rect Double)
toHuds (Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
-> ChartSvg -> HudOptions
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel
"hudOptions"
(Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions)
Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
#hudOptions ChartSvg
cs) (Maybe (Rect Double) -> Rect Double
singletonGuard (Maybe (Rect Double) -> Rect Double)
-> Maybe (Rect Double) -> Rect Double
forall a b. (a -> b) -> a -> b
$ Optic' A_Lens NoIx ChartSvg (Maybe (Rect Double))
-> ChartSvg -> Maybe (Rect Double)
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (IsLabel "charts" (Optic' A_Lens NoIx ChartSvg ChartTree)
Optic' A_Lens NoIx ChartSvg ChartTree
#charts Optic' A_Lens NoIx ChartSvg ChartTree
-> Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
-> Optic' A_Lens NoIx ChartSvg (Maybe (Rect Double))
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
% Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
box') ChartSvg
cs)
hs' :: [Hud]
hs' =
[Hud]
hs
[Hud] -> [Hud] -> [Hud]
forall a. Semigroup a => a -> a -> a
<> Optic' A_Lens NoIx ChartSvg [Hud] -> ChartSvg -> [Hud]
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel "extraHuds" (Optic' A_Lens NoIx ChartSvg [Hud])
Optic' A_Lens NoIx ChartSvg [Hud]
#extraHuds ChartSvg
cs
initialCanvas :: ChartAspect -> ChartTree -> CanvasBox
initialCanvas :: ChartAspect -> ChartTree -> Rect Double
initialCanvas (FixedAspect Double
a) ChartTree
_ = Double -> Rect Double
aspect Double
a
initialCanvas (CanvasAspect Double
a) ChartTree
_ = Double -> Rect Double
aspect Double
a
initialCanvas ChartAspect
ChartAspect ChartTree
cs = Maybe (Rect Double) -> Rect Double
singletonGuard (Maybe (Rect Double) -> Rect Double)
-> Maybe (Rect Double) -> Rect Double
forall a b. (a -> b) -> a -> b
$ Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
-> ChartTree -> Maybe (Rect Double)
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
box' ChartTree
cs
chartSvg :: ChartSvg -> Text
chartSvg :: ChartSvg -> Text
chartSvg ChartSvg
cs = Html () -> Text
renderToText (SvgOptions -> ChartTree -> Html ()
renderToSvg (Optic' A_Lens NoIx ChartSvg SvgOptions -> ChartSvg -> SvgOptions
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel "svgOptions" (Optic' A_Lens NoIx ChartSvg SvgOptions)
Optic' A_Lens NoIx ChartSvg SvgOptions
#svgOptions ChartSvg
cs) (ChartSvg -> ChartTree
toChartTree ChartSvg
cs))
writeChartSvg :: FilePath -> ChartSvg -> IO ()
writeChartSvg :: String -> ChartSvg -> IO ()
writeChartSvg String
fp ChartSvg
cs =
String -> String -> IO ()
writeFile String
fp (Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ ChartSvg -> Text
chartSvg ChartSvg
cs)
terms :: Text -> [Lucid.Attribute] -> Lucid.Html ()
terms :: Text -> [Attribute] -> Html ()
terms Text
t = Html () -> [Attribute] -> Html ()
forall a. With a => a -> [Attribute] -> a
with (Html () -> [Attribute] -> Html ())
-> Html () -> [Attribute] -> Html ()
forall a b. (a -> b) -> a -> b
$ Text -> Html ()
forall (m :: * -> *). Applicative m => Text -> HtmlT m ()
makeXmlElementNoEnd Text
t
svgRect_ :: Rect Double -> Lucid.Html ()
svgRect_ :: Rect Double -> Html ()
svgRect_ (Rect Double
x Double
z Double
y Double
w) =
Text -> [Attribute] -> Html ()
terms
Text
"rect"
[ Text -> Attribute
width_ (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ Double
z Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
x),
Text -> Attribute
height_ (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ Double
w Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
y),
Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"x" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show Double
x),
Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"y" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ -Double
w)
]
svgText_ :: TextStyle -> Text -> Point Double -> Lucid.Html ()
svgText_ :: TextStyle -> Text -> Point Double -> Html ()
svgText_ TextStyle
s Text
t p :: Point Double
p@(Point Double
x Double
y) =
Text -> [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => Text -> arg -> result
term
Text
"text"
( [ Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"x" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show Double
x),
Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"y" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ -Double
y)
]
[Attribute] -> [Attribute] -> [Attribute]
forall a. Semigroup a => a -> a -> a
<> (Double -> [Attribute]) -> Maybe Double -> [Attribute]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Double
x' -> [Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"transform" (Double -> Point Double -> Text
toRotateText Double
x' Point Double
p)]) (TextStyle
s TextStyle
-> Optic' A_Lens NoIx TextStyle (Maybe Double) -> Maybe Double
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "rotation" (Optic' A_Lens NoIx TextStyle (Maybe Double))
Optic' A_Lens NoIx TextStyle (Maybe Double)
#rotation)
)
(Text -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtmlRaw Text
t)
Html () -> Html () -> Html ()
forall a. Semigroup a => a -> a -> a
<> case Optic' A_Lens NoIx TextStyle (Maybe RectStyle)
-> TextStyle -> Maybe RectStyle
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel "frame" (Optic' A_Lens NoIx TextStyle (Maybe RectStyle))
Optic' A_Lens NoIx TextStyle (Maybe RectStyle)
#frame TextStyle
s of
Maybe RectStyle
Nothing -> Html ()
forall a. Monoid a => a
mempty
Just RectStyle
f -> Chart -> Html ()
svg (RectStyle -> [Rect Double] -> Chart
RectChart (RectStyle
f RectStyle -> (RectStyle -> RectStyle) -> RectStyle
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx RectStyle RectStyle Double Double
-> (Double -> Double) -> RectStyle -> RectStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over IsLabel
"borderSize" (Optic A_Lens NoIx RectStyle RectStyle Double Double)
Optic A_Lens NoIx RectStyle RectStyle Double Double
#borderSize (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Optic' A_Lens NoIx TextStyle Double -> TextStyle -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel "size" (Optic' A_Lens NoIx TextStyle Double)
Optic' A_Lens NoIx TextStyle Double
#size TextStyle
s)) [TextStyle -> Text -> Point Double -> Rect Double
styleBoxText TextStyle
s Text
t Point Double
p])
svgLine_ :: [[Point Double]] -> Lucid.Html ()
svgLine_ :: [[Point Double]] -> Html ()
svgLine_ [[Point Double]]
xss =
[Html ()] -> Html ()
forall a. Monoid a => [a] -> a
mconcat ([Html ()] -> Html ()) -> [Html ()] -> Html ()
forall a b. (a -> b) -> a -> b
$
(\[Point Double]
xs -> Text -> [Attribute] -> Html ()
terms Text
"polyline" [Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"points" ([Point Double] -> Text
forall a. (Show a, Num a) => [Point a] -> Text
toPointsText [Point Double]
xs)]) ([Point Double] -> Html ()) -> [[Point Double]] -> [Html ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Point Double]]
xss
where
toPointsText :: [Point a] -> Text
toPointsText [Point a]
xs' = Text -> [Text] -> Text
Text.intercalate Text
"\n" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (\(Point a
x a
y) -> String -> Text
pack (a -> String
forall a. Show a => a -> String
show a
x String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"," String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show (-a
y))) (Point a -> Text) -> [Point a] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Point a]
xs'
svgShape_ :: GlyphShape -> Double -> Point Double -> Lucid.Html ()
svgShape_ :: GlyphShape -> Double -> Point Double -> Html ()
svgShape_ GlyphShape
CircleGlyph Double
s (Point Double
x Double
y) =
Text -> [Attribute] -> Html ()
terms
Text
"circle"
[ Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"cx" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show Double
x),
Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"cy" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ -Double
y),
Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"r" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ Double
0.5 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
s)
]
svgShape_ GlyphShape
SquareGlyph Double
s Point Double
p =
Rect Double -> Html ()
svgRect_ (Element (Rect Double) -> Rect Double -> Rect Double
forall s. (Additive (Element s), Space s) => Element s -> s -> s
move Point Double
Element (Rect Double)
p ((Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
*) (Double -> Double) -> Rect Double -> Rect Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rect Double
forall a. Multiplicative a => a
one))
svgShape_ (RectSharpGlyph Double
x') Double
s Point Double
p =
Rect Double -> Html ()
svgRect_ (Element (Rect Double) -> Rect Double -> Rect Double
forall s. (Additive (Element s), Space s) => Element s -> s -> s
move Point Double
Element (Rect Double)
p (Element (Rect Double) -> Rect Double -> Rect Double
forall s.
(Multiplicative (Element s), Space s) =>
Element s -> s -> s
scale (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
s (Double
x' Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
s)) Rect Double
forall a. Multiplicative a => a
one))
svgShape_ (RectRoundedGlyph Double
x' Double
rx Double
ry) Double
s Point Double
p =
Text -> [Attribute] -> Html ()
terms
Text
"rect"
[ Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"width" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ Double
z Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
x),
Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"height" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ Double
w Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
y),
Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"x" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show Double
x),
Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"y" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ -Double
w),
Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"rx" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show Double
rx),
Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"ry" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show Double
ry)
]
where
(Rect Double
x Double
z Double
y Double
w) = Element (Rect Double) -> Rect Double -> Rect Double
forall s. (Additive (Element s), Space s) => Element s -> s -> s
move Point Double
Element (Rect Double)
p (Element (Rect Double) -> Rect Double -> Rect Double
forall s.
(Multiplicative (Element s), Space s) =>
Element s -> s -> s
scale (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
s (Double
x' Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
s)) Rect Double
forall a. Multiplicative a => a
one)
svgShape_ (TriangleGlyph (Point Double
xa Double
ya) (Point Double
xb Double
yb) (Point Double
xc Double
yc)) Double
s Point Double
p =
Text -> [Attribute] -> Html ()
terms
Text
"polygon"
[ Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"transform" (Point Double -> Text
toTranslateText Point Double
p),
Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"points" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show (Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
xa) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"," String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Double -> String
forall a. Show a => a -> String
show (-(Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
ya)) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Double -> String
forall a. Show a => a -> String
show (Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
xb) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"," String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Double -> String
forall a. Show a => a -> String
show (-(Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
yb)) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Double -> String
forall a. Show a => a -> String
show (Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
xc) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"," String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Double -> String
forall a. Show a => a -> String
show (-(Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
yc)))
]
svgShape_ (EllipseGlyph Double
x') Double
s (Point Double
x Double
y) =
Text -> [Attribute] -> Html ()
terms
Text
"ellipse"
[ Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"cx" ((String -> Text
pack (String -> Text) -> (Double -> String) -> Double -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> String
forall a. Show a => a -> String
show) Double
x),
Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"cy" ((String -> Text
pack (String -> Text) -> (Double -> String) -> Double -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> String
forall a. Show a => a -> String
show) (Double -> Text) -> Double -> Text
forall a b. (a -> b) -> a -> b
$ -Double
y),
Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"rx" ((String -> Text
pack (String -> Text) -> (Double -> String) -> Double -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> String
forall a. Show a => a -> String
show) (Double -> Text) -> Double -> Text
forall a b. (a -> b) -> a -> b
$ Double
0.5 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
s),
Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"ry" ((String -> Text
pack (String -> Text) -> (Double -> String) -> Double -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> String
forall a. Show a => a -> String
show) (Double -> Text) -> Double -> Text
forall a b. (a -> b) -> a -> b
$ Double
0.5 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x')
]
svgShape_ GlyphShape
VLineGlyph Double
s (Point Double
x Double
y) =
Text -> [Attribute] -> Html ()
terms Text
"polyline" [Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"points" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show Double
x String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"," String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Double -> String
forall a. Show a => a -> String
show (-(Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
s Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2)) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Double -> String
forall a. Show a => a -> String
show Double
x String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"," String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Double -> String
forall a. Show a => a -> String
show (-(Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
s Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2)))]
svgShape_ GlyphShape
HLineGlyph Double
s (Point Double
x Double
y) =
Text -> [Attribute] -> Html ()
terms Text
"polyline" [Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"points" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
s Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"," String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Double -> String
forall a. Show a => a -> String
show (-Double
y) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Double -> String
forall a. Show a => a -> String
show (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
s Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"," String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Double -> String
forall a. Show a => a -> String
show (-Double
y))]
svgShape_ (PathGlyph Text
path ScaleBorder
_) Double
s Point Double
p =
Text -> [Attribute] -> Html ()
terms Text
"path" [Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"d" Text
path, Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"transform" (Point Double -> Text
toTranslateText Point Double
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
toScaleText Double
s)]
svgGlyph_ :: GlyphStyle -> Point Double -> Lucid.Html ()
svgGlyph_ :: GlyphStyle -> Point Double -> Html ()
svgGlyph_ GlyphStyle
s Point Double
p =
GlyphShape -> Double -> Point Double -> Html ()
svgShape_ (GlyphStyle
s GlyphStyle
-> Optic' A_Lens NoIx GlyphStyle GlyphShape -> GlyphShape
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "shape" (Optic' A_Lens NoIx GlyphStyle GlyphShape)
Optic' A_Lens NoIx GlyphStyle GlyphShape
#shape) (GlyphStyle
s GlyphStyle -> Optic' A_Lens NoIx GlyphStyle Double -> Double
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "size" (Optic' A_Lens NoIx GlyphStyle Double)
Optic' A_Lens NoIx GlyphStyle Double
#size) Point Double
p
Html () -> (Html () -> Html ()) -> Html ()
forall a b. a -> (a -> b) -> b
& (Html () -> Html ())
-> (Double -> Html () -> Html ())
-> Maybe Double
-> Html ()
-> Html ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Html () -> Html ()
forall a. a -> a
id (\Double
r -> Text -> [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => Text -> arg -> result
term Text
"g" [Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"transform" (Double -> Point Double -> Text
toRotateText Double
r Point Double
p)]) (GlyphStyle
s GlyphStyle
-> Optic' A_Lens NoIx GlyphStyle (Maybe Double) -> Maybe Double
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "rotation" (Optic' A_Lens NoIx GlyphStyle (Maybe Double))
Optic' A_Lens NoIx GlyphStyle (Maybe Double)
#rotation)
svgPath_ :: [PathData Double] -> Lucid.Html ()
svgPath_ :: [PathData Double] -> Html ()
svgPath_ [PathData Double]
ps =
Text -> [Attribute] -> Html ()
terms Text
"path" [Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"d" ([PathData Double] -> Text
pathDataToSvg [PathData Double]
ps)]
attsRect :: RectStyle -> [Lucid.Attribute]
attsRect :: RectStyle -> [Attribute]
attsRect RectStyle
o =
[ Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke-width" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ RectStyle
o RectStyle
-> Optic A_Lens NoIx RectStyle RectStyle Double Double -> Double
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
"borderSize" (Optic A_Lens NoIx RectStyle RectStyle Double Double)
Optic A_Lens NoIx RectStyle RectStyle Double Double
#borderSize),
Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke" (Colour -> Text
showRGB (Colour -> Text) -> Colour -> Text
forall a b. (a -> b) -> a -> b
$ RectStyle
o RectStyle -> Optic' A_Lens NoIx RectStyle Colour -> Colour
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "borderColor" (Optic' A_Lens NoIx RectStyle Colour)
Optic' A_Lens NoIx RectStyle Colour
#borderColor),
Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke-opacity" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ Colour -> Double
opac (Colour -> Double) -> Colour -> Double
forall a b. (a -> b) -> a -> b
$ RectStyle
o RectStyle -> Optic' A_Lens NoIx RectStyle Colour -> Colour
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "borderColor" (Optic' A_Lens NoIx RectStyle Colour)
Optic' A_Lens NoIx RectStyle Colour
#borderColor),
Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"fill" (Colour -> Text
showRGB (Colour -> Text) -> Colour -> Text
forall a b. (a -> b) -> a -> b
$ RectStyle
o RectStyle -> Optic' A_Lens NoIx RectStyle Colour -> Colour
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "color" (Optic' A_Lens NoIx RectStyle Colour)
Optic' A_Lens NoIx RectStyle Colour
#color),
Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"fill-opacity" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ Colour -> Double
opac (Colour -> Double) -> Colour -> Double
forall a b. (a -> b) -> a -> b
$ RectStyle
o RectStyle -> Optic' A_Lens NoIx RectStyle Colour -> Colour
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "color" (Optic' A_Lens NoIx RectStyle Colour)
Optic' A_Lens NoIx RectStyle Colour
#color)
]
attsText :: TextStyle -> [Lucid.Attribute]
attsText :: TextStyle -> [Attribute]
attsText TextStyle
o =
[ Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke-width" Text
"0.0",
Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke" Text
"none",
Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"fill" (Colour -> Text
showRGB (Colour -> Text) -> Colour -> Text
forall a b. (a -> b) -> a -> b
$ TextStyle
o TextStyle -> Optic' A_Lens NoIx TextStyle Colour -> Colour
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "color" (Optic' A_Lens NoIx TextStyle Colour)
Optic' A_Lens NoIx TextStyle Colour
#color),
Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"fill-opacity" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ Colour -> Double
opac (Colour -> Double) -> Colour -> Double
forall a b. (a -> b) -> a -> b
$ TextStyle
o TextStyle -> Optic' A_Lens NoIx TextStyle Colour -> Colour
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "color" (Optic' A_Lens NoIx TextStyle Colour)
Optic' A_Lens NoIx TextStyle Colour
#color),
Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"font-size" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ TextStyle
o TextStyle -> Optic' A_Lens NoIx TextStyle Double -> Double
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "size" (Optic' A_Lens NoIx TextStyle Double)
Optic' A_Lens NoIx TextStyle Double
#size),
Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"text-anchor" (Anchor -> Text
toTextAnchor (Anchor -> Text) -> Anchor -> Text
forall a b. (a -> b) -> a -> b
$ TextStyle
o TextStyle -> Optic' A_Lens NoIx TextStyle Anchor -> Anchor
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "anchor" (Optic' A_Lens NoIx TextStyle Anchor)
Optic' A_Lens NoIx TextStyle Anchor
#anchor)
]
where
toTextAnchor :: Anchor -> Text
toTextAnchor :: Anchor -> Text
toTextAnchor Anchor
AnchorMiddle = Text
"middle"
toTextAnchor Anchor
AnchorStart = Text
"start"
toTextAnchor Anchor
AnchorEnd = Text
"end"
attsGlyph :: GlyphStyle -> [Lucid.Attribute]
attsGlyph :: GlyphStyle -> [Attribute]
attsGlyph GlyphStyle
o =
[ Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke-width" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show Double
sw),
Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke" (Colour -> Text
showRGB (Colour -> Text) -> Colour -> Text
forall a b. (a -> b) -> a -> b
$ GlyphStyle
o GlyphStyle -> Optic' A_Lens NoIx GlyphStyle Colour -> Colour
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "borderColor" (Optic' A_Lens NoIx GlyphStyle Colour)
Optic' A_Lens NoIx GlyphStyle Colour
#borderColor),
Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke-opacity" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ Colour -> Double
opac (Colour -> Double) -> Colour -> Double
forall a b. (a -> b) -> a -> b
$ GlyphStyle
o GlyphStyle -> Optic' A_Lens NoIx GlyphStyle Colour -> Colour
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "borderColor" (Optic' A_Lens NoIx GlyphStyle Colour)
Optic' A_Lens NoIx GlyphStyle Colour
#borderColor),
Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"fill" (Colour -> Text
showRGB (Colour -> Text) -> Colour -> Text
forall a b. (a -> b) -> a -> b
$ GlyphStyle
o GlyphStyle -> Optic' A_Lens NoIx GlyphStyle Colour -> Colour
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "color" (Optic' A_Lens NoIx GlyphStyle Colour)
Optic' A_Lens NoIx GlyphStyle Colour
#color),
Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"fill-opacity" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ Colour -> Double
opac (Colour -> Double) -> Colour -> Double
forall a b. (a -> b) -> a -> b
$ GlyphStyle
o GlyphStyle -> Optic' A_Lens NoIx GlyphStyle Colour -> Colour
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "color" (Optic' A_Lens NoIx GlyphStyle Colour)
Optic' A_Lens NoIx GlyphStyle Colour
#color)
]
[Attribute] -> [Attribute] -> [Attribute]
forall a. Semigroup a => a -> a -> a
<> (Point Double -> [Attribute])
-> Maybe (Point Double) -> [Attribute]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Attribute -> [Attribute] -> [Attribute]
forall a. a -> [a] -> [a]
: []) (Attribute -> [Attribute])
-> (Point Double -> Attribute) -> Point Double -> [Attribute]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"transform" (Text -> Attribute)
-> (Point Double -> Text) -> Point Double -> Attribute
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point Double -> Text
toTranslateText) (GlyphStyle
o GlyphStyle
-> Optic' A_Lens NoIx GlyphStyle (Maybe (Point Double))
-> Maybe (Point Double)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
"translate" (Optic' A_Lens NoIx GlyphStyle (Maybe (Point Double)))
Optic' A_Lens NoIx GlyphStyle (Maybe (Point Double))
#translate)
where
sw :: Double
sw = case GlyphStyle
o GlyphStyle
-> Optic' A_Lens NoIx GlyphStyle GlyphShape -> GlyphShape
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "shape" (Optic' A_Lens NoIx GlyphStyle GlyphShape)
Optic' A_Lens NoIx GlyphStyle GlyphShape
#shape of
PathGlyph Text
_ ScaleBorder
NoScaleBorder -> GlyphStyle
o GlyphStyle -> Optic' A_Lens NoIx GlyphStyle Double -> Double
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "borderSize" (Optic' A_Lens NoIx GlyphStyle Double)
Optic' A_Lens NoIx GlyphStyle Double
#borderSize
PathGlyph Text
_ ScaleBorder
ScaleBorder -> Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
0.2 (GlyphStyle
o GlyphStyle -> Optic' A_Lens NoIx GlyphStyle Double -> Double
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "borderSize" (Optic' A_Lens NoIx GlyphStyle Double)
Optic' A_Lens NoIx GlyphStyle Double
#borderSize Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ GlyphStyle
o GlyphStyle -> Optic' A_Lens NoIx GlyphStyle Double -> Double
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "size" (Optic' A_Lens NoIx GlyphStyle Double)
Optic' A_Lens NoIx GlyphStyle Double
#size)
GlyphShape
_ -> GlyphStyle
o GlyphStyle -> Optic' A_Lens NoIx GlyphStyle Double -> Double
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "borderSize" (Optic' A_Lens NoIx GlyphStyle Double)
Optic' A_Lens NoIx GlyphStyle Double
#borderSize
attsLine :: LineStyle -> [Lucid.Attribute]
attsLine :: LineStyle -> [Attribute]
attsLine LineStyle
o =
[ Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke-width" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ LineStyle
o LineStyle -> Optic' A_Lens NoIx LineStyle Double -> Double
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "size" (Optic' A_Lens NoIx LineStyle Double)
Optic' A_Lens NoIx LineStyle Double
#size),
Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke" (Colour -> Text
showRGB (Colour -> Text) -> Colour -> Text
forall a b. (a -> b) -> a -> b
$ LineStyle
o LineStyle -> Optic' A_Lens NoIx LineStyle Colour -> Colour
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "color" (Optic' A_Lens NoIx LineStyle Colour)
Optic' A_Lens NoIx LineStyle Colour
#color),
Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke-opacity" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ Colour -> Double
opac (Colour -> Double) -> Colour -> Double
forall a b. (a -> b) -> a -> b
$ LineStyle
o LineStyle -> Optic' A_Lens NoIx LineStyle Colour -> Colour
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "color" (Optic' A_Lens NoIx LineStyle Colour)
Optic' A_Lens NoIx LineStyle Colour
#color),
Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"fill" Text
"none"
]
[Attribute] -> [Attribute] -> [Attribute]
forall a. Semigroup a => a -> a -> a
<> (LineCap -> [Attribute]) -> Maybe LineCap -> [Attribute]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\LineCap
x -> [Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke-linecap" (LineCap -> Text
forall s. IsString s => LineCap -> s
fromLineCap LineCap
x)]) (LineStyle
o LineStyle
-> Optic' A_Lens NoIx LineStyle (Maybe LineCap) -> Maybe LineCap
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "linecap" (Optic' A_Lens NoIx LineStyle (Maybe LineCap))
Optic' A_Lens NoIx LineStyle (Maybe LineCap)
#linecap)
[Attribute] -> [Attribute] -> [Attribute]
forall a. Semigroup a => a -> a -> a
<> (LineJoin -> [Attribute]) -> Maybe LineJoin -> [Attribute]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\LineJoin
x -> [Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke-linejoin" (LineJoin -> Text
forall s. IsString s => LineJoin -> s
fromLineJoin LineJoin
x)]) (LineStyle
o LineStyle
-> Optic' A_Lens NoIx LineStyle (Maybe LineJoin) -> Maybe LineJoin
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "linejoin" (Optic' A_Lens NoIx LineStyle (Maybe LineJoin))
Optic' A_Lens NoIx LineStyle (Maybe LineJoin)
#linejoin)
[Attribute] -> [Attribute] -> [Attribute]
forall a. Semigroup a => a -> a -> a
<> ([Double] -> [Attribute]) -> Maybe [Double] -> [Attribute]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\[Double]
x -> [Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke-dasharray" ([Double] -> Text
fromDashArray [Double]
x)]) (LineStyle
o LineStyle
-> Optic' A_Lens NoIx LineStyle (Maybe [Double]) -> Maybe [Double]
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "dasharray" (Optic' A_Lens NoIx LineStyle (Maybe [Double]))
Optic' A_Lens NoIx LineStyle (Maybe [Double])
#dasharray)
[Attribute] -> [Attribute] -> [Attribute]
forall a. Semigroup a => a -> a -> a
<> (Double -> [Attribute]) -> Maybe Double -> [Attribute]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Double
x -> [Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke-dashoffset" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show Double
x)]) (LineStyle
o LineStyle
-> Optic' A_Lens NoIx LineStyle (Maybe Double) -> Maybe Double
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "dashoffset" (Optic' A_Lens NoIx LineStyle (Maybe Double))
Optic' A_Lens NoIx LineStyle (Maybe Double)
#dashoffset)
attsPath :: PathStyle -> [Lucid.Attribute]
attsPath :: PathStyle -> [Attribute]
attsPath PathStyle
o =
[ Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke-width" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ PathStyle
o PathStyle -> Optic' A_Lens NoIx PathStyle Double -> Double
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "borderSize" (Optic' A_Lens NoIx PathStyle Double)
Optic' A_Lens NoIx PathStyle Double
#borderSize),
Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke" (Colour -> Text
showRGB (Colour -> Text) -> Colour -> Text
forall a b. (a -> b) -> a -> b
$ PathStyle
o PathStyle -> Optic' A_Lens NoIx PathStyle Colour -> Colour
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "borderColor" (Optic' A_Lens NoIx PathStyle Colour)
Optic' A_Lens NoIx PathStyle Colour
#borderColor),
Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke-opacity" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ Colour -> Double
opac (Colour -> Double) -> Colour -> Double
forall a b. (a -> b) -> a -> b
$ PathStyle
o PathStyle -> Optic' A_Lens NoIx PathStyle Colour -> Colour
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "borderColor" (Optic' A_Lens NoIx PathStyle Colour)
Optic' A_Lens NoIx PathStyle Colour
#borderColor),
Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"fill" (Colour -> Text
showRGB (Colour -> Text) -> Colour -> Text
forall a b. (a -> b) -> a -> b
$ PathStyle
o PathStyle -> Optic' A_Lens NoIx PathStyle Colour -> Colour
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "color" (Optic' A_Lens NoIx PathStyle Colour)
Optic' A_Lens NoIx PathStyle Colour
#color),
Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"fill-opacity" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ Colour -> Double
opac (Colour -> Double) -> Colour -> Double
forall a b. (a -> b) -> a -> b
$ PathStyle
o PathStyle -> Optic' A_Lens NoIx PathStyle Colour -> Colour
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "color" (Optic' A_Lens NoIx PathStyle Colour)
Optic' A_Lens NoIx PathStyle Colour
#color)
]
toTranslateText :: Point Double -> Text
toTranslateText :: Point Double -> Text
toTranslateText (Point Double
x Double
y) =
String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$
String
"translate(" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Double -> String
forall a. Show a => a -> String
show Double
x String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
", " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Double -> String
forall a. Show a => a -> String
show (-Double
y) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
")"
toRotateText :: Double -> Point Double -> Text
toRotateText :: Double -> Point Double -> Text
toRotateText Double
r (Point Double
x Double
y) =
String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$
String
"rotate(" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Double -> String
forall a. Show a => a -> String
show (-Double
r Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
180 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
forall a. Floating a => a
pi) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
", " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Double -> String
forall a. Show a => a -> String
show Double
x String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
", " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Double -> String
forall a. Show a => a -> String
show (-Double
y) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
")"
toScaleText :: Double -> Text
toScaleText :: Double -> Text
toScaleText Double
x =
String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$
String
"scale(" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Double -> String
forall a. Show a => a -> String
show Double
x String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
")"
data SvgOptions = SvgOptions
{ SvgOptions -> Double
svgHeight :: Double,
SvgOptions -> CssOptions
cssOptions :: CssOptions
}
deriving (SvgOptions -> SvgOptions -> Bool
(SvgOptions -> SvgOptions -> Bool)
-> (SvgOptions -> SvgOptions -> Bool) -> Eq SvgOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SvgOptions -> SvgOptions -> Bool
$c/= :: SvgOptions -> SvgOptions -> Bool
== :: SvgOptions -> SvgOptions -> Bool
$c== :: SvgOptions -> SvgOptions -> Bool
Eq, Int -> SvgOptions -> String -> String
[SvgOptions] -> String -> String
SvgOptions -> String
(Int -> SvgOptions -> String -> String)
-> (SvgOptions -> String)
-> ([SvgOptions] -> String -> String)
-> Show SvgOptions
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [SvgOptions] -> String -> String
$cshowList :: [SvgOptions] -> String -> String
show :: SvgOptions -> String
$cshow :: SvgOptions -> String
showsPrec :: Int -> SvgOptions -> String -> String
$cshowsPrec :: Int -> SvgOptions -> String -> String
Show, (forall x. SvgOptions -> Rep SvgOptions x)
-> (forall x. Rep SvgOptions x -> SvgOptions) -> Generic SvgOptions
forall x. Rep SvgOptions x -> SvgOptions
forall x. SvgOptions -> Rep SvgOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SvgOptions x -> SvgOptions
$cfrom :: forall x. SvgOptions -> Rep SvgOptions x
Generic)
defaultSvgOptions :: SvgOptions
defaultSvgOptions :: SvgOptions
defaultSvgOptions = Double -> CssOptions -> SvgOptions
SvgOptions Double
300 CssOptions
defaultCssOptions
data CssShapeRendering = UseGeometricPrecision | UseCssCrisp | NoShapeRendering deriving (Int -> CssShapeRendering -> String -> String
[CssShapeRendering] -> String -> String
CssShapeRendering -> String
(Int -> CssShapeRendering -> String -> String)
-> (CssShapeRendering -> String)
-> ([CssShapeRendering] -> String -> String)
-> Show CssShapeRendering
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [CssShapeRendering] -> String -> String
$cshowList :: [CssShapeRendering] -> String -> String
show :: CssShapeRendering -> String
$cshow :: CssShapeRendering -> String
showsPrec :: Int -> CssShapeRendering -> String -> String
$cshowsPrec :: Int -> CssShapeRendering -> String -> String
Show, CssShapeRendering -> CssShapeRendering -> Bool
(CssShapeRendering -> CssShapeRendering -> Bool)
-> (CssShapeRendering -> CssShapeRendering -> Bool)
-> Eq CssShapeRendering
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. CssShapeRendering -> Rep CssShapeRendering x)
-> (forall x. Rep CssShapeRendering x -> CssShapeRendering)
-> Generic CssShapeRendering
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 -> String -> String
[CssPreferColorScheme] -> String -> String
CssPreferColorScheme -> String
(Int -> CssPreferColorScheme -> String -> String)
-> (CssPreferColorScheme -> String)
-> ([CssPreferColorScheme] -> String -> String)
-> Show CssPreferColorScheme
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [CssPreferColorScheme] -> String -> String
$cshowList :: [CssPreferColorScheme] -> String -> String
show :: CssPreferColorScheme -> String
$cshow :: CssPreferColorScheme -> String
showsPrec :: Int -> CssPreferColorScheme -> String -> String
$cshowsPrec :: Int -> CssPreferColorScheme -> String -> String
Show, CssPreferColorScheme -> CssPreferColorScheme -> Bool
(CssPreferColorScheme -> CssPreferColorScheme -> Bool)
-> (CssPreferColorScheme -> CssPreferColorScheme -> Bool)
-> Eq CssPreferColorScheme
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. CssPreferColorScheme -> Rep CssPreferColorScheme x)
-> (forall x. Rep CssPreferColorScheme x -> CssPreferColorScheme)
-> Generic CssPreferColorScheme
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, :: Text} deriving (Int -> CssOptions -> String -> String
[CssOptions] -> String -> String
CssOptions -> String
(Int -> CssOptions -> String -> String)
-> (CssOptions -> String)
-> ([CssOptions] -> String -> String)
-> Show CssOptions
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [CssOptions] -> String -> String
$cshowList :: [CssOptions] -> String -> String
show :: CssOptions -> String
$cshow :: CssOptions -> String
showsPrec :: Int -> CssOptions -> String -> String
$cshowsPrec :: Int -> CssOptions -> String -> String
Show, CssOptions -> CssOptions -> Bool
(CssOptions -> CssOptions -> Bool)
-> (CssOptions -> CssOptions -> Bool) -> Eq CssOptions
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. CssOptions -> Rep CssOptions x)
-> (forall x. Rep CssOptions x -> CssOptions) -> Generic CssOptions
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 -> Text -> CssOptions
CssOptions CssShapeRendering
NoShapeRendering CssPreferColorScheme
PreferHud Text
forall a. Monoid a => a
mempty