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

-- | Conversion between 'ChartOptions' and 'Markup' representations.
module Chart.Markup
  ( Markup (..),
    ChartOptions (..),
    forgetHud,
    asChartTree,
    vertCO,
    horiCO,
    stackCO,
    markupChartOptions,
    markupChartTree,
    markupChart,
    header,
    renderChartOptions,
    encodeChartOptions,
    writeChartOptions,
    CssOptions (..),
    defaultCssOptions,
    PreferColorScheme (..),
    cssPreferColorScheme,
    fillSwitch,
    ShapeRendering (..),
    markupCssOptions,
    MarkupOptions (..),
    defaultMarkupOptions,
    encodeNum,
    encodePx,
    defaultCssFontFamilies,
  )
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.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.Encoding (decodeUtf8, encodeUtf8)
import GHC.Generics
import MarkupParse
import NumHask.Space
import Optics.Core hiding (element)
import Prelude

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

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

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

-- | Convert a ChartTree to markup
--
-- >>> lineExample & view #chartTree & markupChartTree & markdown_ Compact Xml
-- "<g class=\"line\"><g stroke-width=\"0.0150\" stroke=\"rgb(2%, 73%, 80%)\" stroke-opacity=\"1.0\" fill=\"none\"><polyline points=\"0,-1.0 1.0,-1.0 2.0,-5.0\"/></g><g stroke-width=\"0.0150\" stroke=\"rgb(2%, 29%, 48%)\" stroke-opacity=\"1.0\" fill=\"none\"><polyline points=\"0,0 2.8,-3.0\"/></g><g stroke-width=\"0.0150\" stroke=\"rgb(66%, 7%, 55%)\" stroke-opacity=\"1.0\" fill=\"none\"><polyline points=\"0.5,-4.0 0.5,0\"/></g></g>"
markupChartTree :: ChartTree -> Markup
markupChartTree :: ChartTree -> Markup
markupChartTree ChartTree
cs =
  Markup -> (Text -> Markup) -> Maybe Text -> Markup
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Markup
xs' (\Text
l -> ByteString -> [Attr] -> Markup -> Markup
element ByteString
"g" [ByteString -> ByteString -> Attr
Attr ByteString
"class" (Text -> ByteString
encodeUtf8 Text
l)] Markup
xs') Maybe Text
label
  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
. ChartData -> Bool
isEmptyChart (ChartData -> Bool) -> (Chart -> ChartData) -> Chart -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chart -> ChartData
chartData) ChartTree
cs
    xs' :: Markup
xs' = [Markup] -> Markup
forall a. Monoid a => [a] -> a
mconcat ([Markup] -> Markup) -> [Markup] -> Markup
forall a b. (a -> b) -> a -> b
$ (Chart -> Markup) -> [Chart] -> [Markup]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Chart -> Markup
markupChart [Chart]
cs' [Markup] -> [Markup] -> [Markup]
forall a. Semigroup a => a -> a -> a
<> (ChartTree -> Markup
markupChartTree (ChartTree -> Markup)
-> (Tree (Maybe Text, [Chart]) -> ChartTree)
-> Tree (Maybe Text, [Chart])
-> Markup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree (Maybe Text, [Chart]) -> ChartTree
ChartTree (Tree (Maybe Text, [Chart]) -> Markup)
-> [Tree (Maybe Text, [Chart])] -> [Markup]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tree (Maybe Text, [Chart])]
xs)

markupText :: Style -> Text -> Point Double -> Markup
markupText :: Style -> Text -> Point Double -> Markup
markupText Style
s Text
t p :: Point Double
p@(Point Double
x Double
y) = Markup
frame' Markup -> Markup -> Markup
forall a. Semigroup a => a -> a -> a
<> ByteString -> [Attr] -> Markup -> Markup
element ByteString
"text" [Attr]
as (Markup -> Markup -> Bool -> Markup
forall a. a -> a -> Bool -> a
bool (ByteString -> Markup
contentRaw ByteString
c) (ByteString -> Markup
content ByteString
c) (EscapeText
EscapeText EscapeText -> EscapeText -> Bool
forall a. Eq a => a -> a -> Bool
== Optic' A_Lens NoIx Style EscapeText -> Style -> EscapeText
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Style EscapeText
#escapeText Style
s))
  where
    as :: [Attr]
as =
      (ByteString -> ByteString -> Attr)
-> (ByteString, ByteString) -> Attr
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> ByteString -> Attr
Attr
        ((ByteString, ByteString) -> Attr)
-> [(ByteString, ByteString)] -> [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 (Double -> ByteString) -> Double -> ByteString
forall a b. (a -> b) -> a -> b
$ -Double
y)
            ]
          [(ByteString, ByteString)]
-> [(ByteString, ByteString)] -> [(ByteString, ByteString)]
forall a. Semigroup a => a -> a -> a
<> Maybe (ByteString, ByteString) -> [(ByteString, ByteString)]
forall a. Maybe a -> [a]
maybeToList ((\Double
x' -> (ByteString
"transform", Double -> Point Double -> ByteString
toRotateText Double
x' Point Double
p)) (Double -> (ByteString, ByteString))
-> Maybe Double -> Maybe (ByteString, ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Optic' A_Lens NoIx Style (Maybe Double) -> Style -> Maybe Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Style (Maybe Double)
#rotation Style
s)
    -- This is very late for a chart creation. It is here so that the chart doesn't undergo scaling and thus picks up the local size of the text, less the border size of the frame.
    frame' :: Markup
frame' = case Optic' A_Lens NoIx Style (Maybe Style) -> Style -> Maybe Style
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Style (Maybe Style)
#frame Style
s of
      Maybe Style
Nothing -> [Element] -> Markup
Markup [Element]
forall a. Monoid a => a
mempty
      Just Style
f -> Chart -> Markup
markupChart (Style -> ChartData -> Chart
Chart (Style
f Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic' A_Lens NoIx Style Double
-> (Double -> Double) -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic' A_Lens NoIx Style Double
#borderSize (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Optic' A_Lens NoIx Style Double -> Style -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Style Double
#size Style
s)) ([Rect Double] -> ChartData
RectData [Style -> Text -> Point Double -> Rect Double
styleBoxText (Style
s Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic' A_Lens NoIx Style (Maybe Style)
-> Maybe Style -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic' A_Lens NoIx Style (Maybe Style)
#frame Maybe Style
forall a. Maybe a
Nothing) Text
t Point Double
p]))
    c :: ByteString
c = Text -> ByteString
encodeUtf8 Text
t

-- | Markup a text rotation about a point in radians.
--
-- includes reference changes:
--
-- - from radians to degrees
--
-- - from counter-clockwise is a positive rotation to clockwise is positive
--
-- - flip y dimension
toRotateText :: Double -> Point Double -> ByteString
toRotateText :: Double -> Point Double -> ByteString
toRotateText Double
r (Point Double
x Double
y) =
  ByteString
"rotate(" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Double -> ByteString
encodeNum (-(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)) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
", " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Double -> ByteString
encodeNum Double
x ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
", " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Double -> ByteString
encodeNum (-Double
y) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
")"

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

-- | Convert a Rect to Markup
markupRect :: Rect Double -> Markup
markupRect :: Rect Double -> Markup
markupRect (Rect Double
x Double
z Double
y Double
w) =
  ByteString -> [Attr] -> Markup
emptyElem ByteString
"rect" [Attr]
as
  where
    as :: [Attr]
as =
      (ByteString -> ByteString -> Attr)
-> (ByteString, ByteString) -> Attr
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> ByteString -> Attr
Attr
        ((ByteString, ByteString) -> Attr)
-> [(ByteString, ByteString)] -> [Attr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ (ByteString
"width", Double -> ByteString
encodeNum (Double
z Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
x)),
              (ByteString
"height", Double -> ByteString
encodeNum (Double
w Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
y)),
              (ByteString
"x", Double -> ByteString
encodeNum Double
x),
              (ByteString
"y", Double -> ByteString
encodeNum (-Double
w))
            ]

-- | Convert a Chart to Markup
--
-- >>> import MarkupParse
-- >>> import Optics.Core
-- >>> import Control.Category ((>>>))
-- >>> lineExample & toListOf (#chartTree % charts') & mconcat & fmap (markupChart >>> markdown_ Compact Xml)
-- ["<g stroke-width=\"0.0150\" stroke=\"rgb(2%, 73%, 80%)\" stroke-opacity=\"1.0\" fill=\"none\"><polyline points=\"0,-1.0 1.0,-1.0 2.0,-5.0\"/></g>","<g stroke-width=\"0.0150\" stroke=\"rgb(2%, 29%, 48%)\" stroke-opacity=\"1.0\" fill=\"none\"><polyline points=\"0,0 2.8,-3.0\"/></g>","<g stroke-width=\"0.0150\" stroke=\"rgb(66%, 7%, 55%)\" stroke-opacity=\"1.0\" fill=\"none\"><polyline points=\"0.5,-4.0 0.5,0\"/></g>"]
markupChart :: Chart -> Markup
markupChart :: Chart -> Markup
markupChart = ([Attr] -> Markup -> Markup) -> ([Attr], Markup) -> Markup
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (ByteString -> [Attr] -> Markup -> Markup
element ByteString
"g") (([Attr], Markup) -> Markup)
-> (Chart -> ([Attr], Markup)) -> Chart -> Markup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chart -> ([Attr], Markup)
f
  where
    f :: Chart -> ([Attr], Markup)
f (Chart Style
s (RectData [Rect Double]
xs)) = (Style -> [Attr]
attsRect Style
s, [Markup] -> Markup
forall a. Monoid a => [a] -> a
mconcat (Rect Double -> Markup
markupRect (Rect Double -> Markup) -> [Rect Double] -> [Markup]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Rect Double]
xs))
    f (Chart Style
s (TextData [(Text, Point Double)]
xs)) = (Style -> [Attr]
attsText Style
s, [Markup] -> Markup
forall a. Monoid a => [a] -> a
mconcat ((Text -> Point Double -> Markup) -> (Text, Point Double) -> Markup
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Style -> Text -> Point Double -> Markup
markupText Style
s) ((Text, Point Double) -> Markup)
-> [(Text, Point Double)] -> [Markup]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Point Double)]
xs))
    f (Chart Style
s (GlyphData [Point Double]
xs)) = (Style -> [Attr]
attsGlyph Style
s, [Markup] -> Markup
forall a. Monoid a => [a] -> a
mconcat (Style -> Point Double -> Markup
markupGlyph Style
s (Point Double -> Markup) -> [Point Double] -> [Markup]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Point Double]
xs))
    f (Chart Style
s (PathData [PathData Double]
xs)) = (Style -> [Attr]
attsPath Style
s, [PathData Double] -> Markup
markupPath [PathData Double]
xs)
    f (Chart Style
s (LineData [[Point Double]]
xs)) = (Style -> [Attr]
attsLine Style
s, [[Point Double]] -> Markup
markupLine [[Point Double]]
xs)
    f (Chart Style
_ (BlankData [Rect Double]
_)) = ([], Markup
forall a. Monoid a => a
mempty)

markupLine :: [[Point Double]] -> Markup
markupLine :: [[Point Double]] -> Markup
markupLine [[Point Double]]
lss =
  [Markup] -> Markup
forall a. Monoid a => [a] -> a
mconcat ([Markup] -> Markup) -> [Markup] -> Markup
forall a b. (a -> b) -> a -> b
$ ByteString -> [Attr] -> Markup
emptyElem ByteString
"polyline" ([Attr] -> Markup)
-> ([Point Double] -> [Attr]) -> [Point Double] -> Markup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Attr -> [Attr] -> [Attr]
forall a. a -> [a] -> [a]
: []) (Attr -> [Attr])
-> ([Point Double] -> Attr) -> [Point Double] -> [Attr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> Attr
Attr ByteString
"points" (ByteString -> Attr)
-> ([Point Double] -> ByteString) -> [Point Double] -> Attr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Point Double] -> ByteString
toPointsText ([Point Double] -> Markup) -> [[Point Double]] -> [Markup]
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
" " ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ (\(Point Double
x Double
y) -> Double -> ByteString
encodeNum Double
x ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"," ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Double -> ByteString
encodeNum (-Double
y)) (Point Double -> ByteString) -> [Point Double] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Point Double]
xs

-- | Path markup
markupPath :: [PathData Double] -> Markup
markupPath :: [PathData Double] -> Markup
markupPath [PathData Double]
ps =
  ByteString -> [Attr] -> Markup
emptyElem ByteString
"path" [ByteString -> ByteString -> Attr
Attr ByteString
"d" ([PathData Double] -> ByteString
pathDataToSvg [PathData Double]
ps)]

-- | GlyphStyle to markup Tree
-- Note rotation on the outside not the inside.
markupGlyph :: Style -> Point Double -> Markup
markupGlyph :: Style -> Point Double -> Markup
markupGlyph Style
s Point Double
p =
  case Optic' A_Lens NoIx Style (Maybe Double) -> Style -> Maybe Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Style (Maybe Double)
#rotation Style
s of
    Maybe Double
Nothing -> Markup
gl
    Just Double
r -> ByteString -> [Attr] -> Markup -> Markup
element ByteString
"g" [ByteString -> ByteString -> Attr
Attr ByteString
"transform" (Double -> Point Double -> ByteString
toRotateText Double
r Point Double
p)] Markup
gl
  where
    gl :: Markup
gl = GlyphShape -> Double -> Point Double -> Markup
markupShape_ (Optic' A_Lens NoIx Style GlyphShape -> Style -> GlyphShape
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Style GlyphShape
#glyphShape Style
s) (Optic' A_Lens NoIx Style Double -> Style -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Style Double
#size Style
s) Point Double
p

-- | Convert a dash representation from a list to text
fromDashArray :: [Double] -> ByteString
fromDashArray :: [Double] -> ByteString
fromDashArray [Double]
xs = ByteString -> [ByteString] -> ByteString
intercalate ByteString
" " ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ Double -> ByteString
encodeNum (Double -> ByteString) -> [Double] -> [ByteString]
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 :: Style -> [Attr]
attsLine :: Style -> [Attr]
attsLine Style
o =
  (ByteString -> ByteString -> Attr)
-> (ByteString, ByteString) -> Attr
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> ByteString -> Attr
Attr
    ((ByteString, ByteString) -> Attr)
-> [(ByteString, ByteString)] -> [Attr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ (ByteString
"stroke-width", Double -> ByteString
encodeNum (Double -> ByteString) -> Double -> ByteString
forall a b. (a -> b) -> a -> b
$ Optic' A_Lens NoIx Style Double -> Style -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Style Double
#size Style
o),
          (ByteString
"stroke", Colour -> ByteString
showRGB (Colour -> ByteString) -> Colour -> ByteString
forall a b. (a -> b) -> a -> b
$ Optic' A_Lens NoIx Style Colour -> Style -> Colour
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Style Colour
#color Style
o),
          (ByteString
"stroke-opacity", Colour -> ByteString
showOpacity (Colour -> ByteString) -> Colour -> ByteString
forall a b. (a -> b) -> a -> b
$ Optic' A_Lens NoIx Style Colour -> Style -> Colour
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Style Colour
#color Style
o),
          (ByteString
"fill", ByteString
"none")
        ]
      [(ByteString, ByteString)]
-> [(ByteString, ByteString)] -> [(ByteString, ByteString)]
forall a. Semigroup a => a -> a -> a
<> [Maybe (ByteString, ByteString)] -> [(ByteString, ByteString)]
forall a. [Maybe a] -> [a]
catMaybes
        [(\LineCap
x -> (ByteString
"stroke-linecap", LineCap -> ByteString
forall s. IsString s => LineCap -> s
fromLineCap LineCap
x)) (LineCap -> (ByteString, ByteString))
-> Maybe LineCap -> Maybe (ByteString, ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Optic' A_Lens NoIx Style (Maybe LineCap) -> Style -> Maybe LineCap
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Style (Maybe LineCap)
#lineCap Style
o]
      [(ByteString, ByteString)]
-> [(ByteString, ByteString)] -> [(ByteString, ByteString)]
forall a. Semigroup a => a -> a -> a
<> (LineJoin -> [(ByteString, ByteString)])
-> Maybe LineJoin -> [(ByteString, ByteString)]
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\LineJoin
x -> [(ByteString
"stroke-linejoin", LineJoin -> ByteString
forall s. IsString s => LineJoin -> s
fromLineJoin LineJoin
x)]) (Optic' A_Lens NoIx Style (Maybe LineJoin)
-> Style -> Maybe LineJoin
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Style (Maybe LineJoin)
#lineJoin Style
o)
      [(ByteString, ByteString)]
-> [(ByteString, ByteString)] -> [(ByteString, ByteString)]
forall a. Semigroup a => a -> a -> a
<> ([Double] -> [(ByteString, ByteString)])
-> Maybe [Double] -> [(ByteString, ByteString)]
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\[Double]
x -> [(ByteString
"stroke-dasharray", [Double] -> ByteString
fromDashArray [Double]
x)]) (Optic' A_Lens NoIx Style (Maybe [Double])
-> Style -> Maybe [Double]
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Style (Maybe [Double])
#dasharray Style
o)
      [(ByteString, ByteString)]
-> [(ByteString, ByteString)] -> [(ByteString, ByteString)]
forall a. Semigroup a => a -> a -> a
<> (Double -> [(ByteString, ByteString)])
-> Maybe Double -> [(ByteString, ByteString)]
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Double
x -> [(ByteString
"stroke-dashoffset", Double -> ByteString
fromDashOffset Double
x)]) (Optic' A_Lens NoIx Style (Maybe Double) -> Style -> Maybe Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Style (Maybe Double)
#dashoffset Style
o)

attsRect :: Style -> [Attr]
attsRect :: Style -> [Attr]
attsRect Style
o =
  (ByteString -> ByteString -> Attr)
-> (ByteString, ByteString) -> Attr
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> ByteString -> Attr
Attr
    ((ByteString, ByteString) -> Attr)
-> [(ByteString, ByteString)] -> [Attr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ (ByteString
"stroke-width", Double -> ByteString
encodeNum (Double -> ByteString) -> Double -> ByteString
forall a b. (a -> b) -> a -> b
$ Optic' A_Lens NoIx Style Double -> Style -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Style Double
#borderSize Style
o),
          (ByteString
"stroke", Colour -> ByteString
showRGB (Colour -> ByteString) -> Colour -> ByteString
forall a b. (a -> b) -> a -> b
$ Optic' A_Lens NoIx Style Colour -> Style -> Colour
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Style Colour
#borderColor Style
o),
          (ByteString
"stroke-opacity", Colour -> ByteString
showOpacity (Colour -> ByteString) -> Colour -> ByteString
forall a b. (a -> b) -> a -> b
$ Optic' A_Lens NoIx Style Colour -> Style -> Colour
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Style Colour
#borderColor Style
o),
          (ByteString
"fill", Colour -> ByteString
showRGB (Colour -> ByteString) -> Colour -> ByteString
forall a b. (a -> b) -> a -> b
$ Optic' A_Lens NoIx Style Colour -> Style -> Colour
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Style Colour
#color Style
o),
          (ByteString
"fill-opacity", Colour -> ByteString
showOpacity (Colour -> ByteString) -> Colour -> ByteString
forall a b. (a -> b) -> a -> b
$ Optic' A_Lens NoIx Style Colour -> Style -> Colour
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Style Colour
#color Style
o)
        ]

-- | TextStyle to [Attr]
attsText :: Style -> [Attr]
attsText :: Style -> [Attr]
attsText Style
o =
  (ByteString -> ByteString -> Attr)
-> (ByteString, ByteString) -> Attr
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> ByteString -> Attr
Attr
    ((ByteString, ByteString) -> Attr)
-> [(ByteString, ByteString)] -> [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 (Colour -> ByteString) -> Colour -> ByteString
forall a b. (a -> b) -> a -> b
$ Optic' A_Lens NoIx Style Colour -> Style -> Colour
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Style Colour
#color Style
o),
          (ByteString
"fill-opacity", Colour -> ByteString
showOpacity (Colour -> ByteString) -> Colour -> ByteString
forall a b. (a -> b) -> a -> b
$ Optic' A_Lens NoIx Style Colour -> Style -> Colour
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Style Colour
#color Style
o),
          (ByteString
"font-size", Double -> ByteString
encodeNum (Double -> ByteString) -> Double -> ByteString
forall a b. (a -> b) -> a -> b
$ Optic' A_Lens NoIx Style Double -> Style -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Style Double
#size Style
o),
          (ByteString
"text-anchor", TextAnchor -> ByteString
fromTextAnchor (TextAnchor -> ByteString) -> TextAnchor -> ByteString
forall a b. (a -> b) -> a -> b
$ Optic' A_Lens NoIx Style TextAnchor -> Style -> TextAnchor
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Style TextAnchor
#textAnchor Style
o)
        ]

-- | GlyphStyle to [Attr]
attsGlyph :: Style -> [Attr]
attsGlyph :: Style -> [Attr]
attsGlyph Style
o =
  (ByteString -> ByteString -> Attr)
-> (ByteString, ByteString) -> Attr
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> ByteString -> Attr
Attr
    ((ByteString, ByteString) -> Attr)
-> [(ByteString, ByteString)] -> [Attr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ (ByteString
"stroke-width", Double -> ByteString
encodeNum (Double -> ByteString) -> Double -> ByteString
forall a b. (a -> b) -> a -> b
$ Optic' A_Lens NoIx Style Double -> Style -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Style Double
#borderSize Style
o),
          (ByteString
"stroke", Colour -> ByteString
showRGB (Colour -> ByteString) -> Colour -> ByteString
forall a b. (a -> b) -> a -> b
$ Optic' A_Lens NoIx Style Colour -> Style -> Colour
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Style Colour
#borderColor Style
o),
          (ByteString
"stroke-opacity", Colour -> ByteString
showOpacity (Colour -> ByteString) -> Colour -> ByteString
forall a b. (a -> b) -> a -> b
$ Optic' A_Lens NoIx Style Colour -> Style -> Colour
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Style Colour
#borderColor Style
o),
          (ByteString
"fill", Colour -> ByteString
showRGB (Colour -> ByteString) -> Colour -> ByteString
forall a b. (a -> b) -> a -> b
$ Optic' A_Lens NoIx Style Colour -> Style -> Colour
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Style Colour
#color Style
o),
          (ByteString
"fill-opacity", Colour -> ByteString
showOpacity (Colour -> ByteString) -> Colour -> ByteString
forall a b. (a -> b) -> a -> b
$ Optic' A_Lens NoIx Style Colour -> Style -> Colour
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Style Colour
#color Style
o)
        ]
      [(ByteString, ByteString)]
-> [(ByteString, ByteString)] -> [(ByteString, ByteString)]
forall a. Semigroup a => a -> a -> a
<> (Point Double -> [(ByteString, ByteString)])
-> Maybe (Point Double) -> [(ByteString, ByteString)]
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (((ByteString, ByteString)
-> [(ByteString, ByteString)] -> [(ByteString, ByteString)]
forall a. a -> [a] -> [a]
: []) ((ByteString, ByteString) -> [(ByteString, ByteString)])
-> (Point Double -> (ByteString, ByteString))
-> Point Double
-> [(ByteString, ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) ByteString
"transform" (ByteString -> (ByteString, ByteString))
-> (Point Double -> ByteString)
-> Point Double
-> (ByteString, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point Double -> ByteString
toTranslateText) (Optic' A_Lens NoIx Style (Maybe (Point Double))
-> Style -> Maybe (Point Double)
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Style (Maybe (Point Double))
#translate Style
o)

-- | PathStyle to [Attr]
attsPath :: Style -> [Attr]
attsPath :: Style -> [Attr]
attsPath Style
o =
  (ByteString -> ByteString -> Attr)
-> (ByteString, ByteString) -> Attr
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> ByteString -> Attr
Attr
    ((ByteString, ByteString) -> Attr)
-> [(ByteString, ByteString)] -> [Attr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ (ByteString
"stroke-width", Double -> ByteString
encodeNum (Double -> ByteString) -> Double -> ByteString
forall a b. (a -> b) -> a -> b
$ Optic' A_Lens NoIx Style Double -> Style -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Style Double
#borderSize Style
o),
          (ByteString
"stroke", Colour -> ByteString
showRGB (Colour -> ByteString) -> Colour -> ByteString
forall a b. (a -> b) -> a -> b
$ Optic' A_Lens NoIx Style Colour -> Style -> Colour
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Style Colour
#borderColor Style
o),
          (ByteString
"stroke-opacity", Colour -> ByteString
showOpacity (Colour -> ByteString) -> Colour -> ByteString
forall a b. (a -> b) -> a -> b
$ Optic' A_Lens NoIx Style Colour -> Style -> Colour
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Style Colour
#borderColor Style
o),
          (ByteString
"fill", Colour -> ByteString
showRGB (Colour -> ByteString) -> Colour -> ByteString
forall a b. (a -> b) -> a -> b
$ Optic' A_Lens NoIx Style Colour -> Style -> Colour
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Style Colour
#color Style
o),
          (ByteString
"fill-opacity", Colour -> ByteString
showOpacity (Colour -> ByteString) -> Colour -> ByteString
forall a b. (a -> b) -> a -> b
$ Optic' A_Lens NoIx Style Colour -> Style -> Colour
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Style Colour
#color Style
o)
        ]

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

-- | GlyphShape to markup Tree
markupShape_ :: GlyphShape -> Double -> Point Double -> Markup
markupShape_ :: GlyphShape -> Double -> Point Double -> Markup
markupShape_ GlyphShape
CircleGlyph Double
s (Point Double
x Double
y) = ByteString -> [Attr] -> Markup
emptyElem ByteString
"circle" [Attr]
as
  where
    as :: [Attr]
as =
      (ByteString -> ByteString -> Attr)
-> (ByteString, ByteString) -> Attr
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> ByteString -> Attr
Attr
        ((ByteString, ByteString) -> Attr)
-> [(ByteString, ByteString)] -> [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 (Double -> ByteString) -> Double -> ByteString
forall a b. (a -> b) -> a -> b
$ -Double
y),
              (ByteString
"r", Double -> ByteString
encodeNum (Double -> ByteString) -> Double -> ByteString
forall a b. (a -> b) -> a -> b
$ Double
0.5 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
s)
            ]
markupShape_ GlyphShape
SquareGlyph Double
s Point Double
p =
  Rect Double -> Markup
markupRect (Element (Rect Double) -> Rect Double -> Rect Double
forall s. (Additive (Element s), Space s) => Element s -> s -> s
move Element (Rect Double)
Point Double
p ((Double
s *) (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 :: Rect Double))
markupShape_ (RectSharpGlyph Double
x') Double
s Point Double
p =
  Rect Double -> Markup
markupRect (Element (Rect Double) -> Rect Double -> Rect Double
forall s. (Additive (Element s), Space s) => Element s -> s -> s
move Element (Rect Double)
Point 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 :: Rect Double))
markupShape_ (RectRoundedGlyph Double
x' Double
rx' Double
ry') Double
s Point Double
p = ByteString -> [Attr] -> Markup
emptyElem ByteString
"rect" [Attr]
as
  where
    as :: [Attr]
as =
      (ByteString -> ByteString -> Attr)
-> (ByteString, ByteString) -> Attr
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> ByteString -> Attr
Attr
        ((ByteString, ByteString) -> Attr)
-> [(ByteString, ByteString)] -> [Attr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ (ByteString
"width", Double -> ByteString
encodeNum (Double -> ByteString) -> Double -> ByteString
forall a b. (a -> b) -> a -> b
$ Double
z Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
x),
              (ByteString
"height", Double -> ByteString
encodeNum (Double -> ByteString) -> Double -> ByteString
forall a b. (a -> b) -> a -> b
$ Double
w Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
y),
              (ByteString
"x", Double -> ByteString
encodeNum Double
x),
              (ByteString
"y", Double -> ByteString
encodeNum (Double -> ByteString) -> Double -> ByteString
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) = Element (Rect Double) -> Rect Double -> Rect Double
forall s. (Additive (Element s), Space s) => Element s -> s -> s
move Element (Rect Double)
Point 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)
markupShape_ (TriangleGlyph (Point Double
xa Double
ya) (Point Double
xb Double
yb) (Point Double
xc Double
yc)) Double
s Point Double
p =
  ByteString -> [Attr] -> Markup
emptyElem ByteString
"polygon" [Attr]
as
  where
    as :: [Attr]
as =
      (ByteString -> ByteString -> Attr)
-> (ByteString, ByteString) -> Attr
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> ByteString -> Attr
Attr
        ((ByteString, ByteString) -> Attr)
-> [(ByteString, ByteString)] -> [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 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
xa) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"," ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Double -> ByteString
encodeNum (-(Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
ya)) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Double -> ByteString
encodeNum (Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
xb) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"," ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Double -> ByteString
encodeNum (-(Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
yb)) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Double -> ByteString
encodeNum (Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
xc) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"," ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Double -> ByteString
encodeNum (-(Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
yc)))
            ]
markupShape_ (EllipseGlyph Double
x') Double
s (Point Double
x Double
y) =
  ByteString -> [Attr] -> Markup
emptyElem ByteString
"ellipse" [Attr]
as
  where
    as :: [Attr]
as =
      (ByteString -> ByteString -> Attr)
-> (ByteString, ByteString) -> Attr
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> ByteString -> Attr
Attr
        ((ByteString, ByteString) -> Attr)
-> [(ByteString, ByteString)] -> [Attr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ (ByteString
"cx", (String -> ByteString
strToUtf8 (String -> ByteString)
-> (Double -> String) -> Double -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> String
forall a. Show a => a -> String
show) Double
x),
              (ByteString
"cy", (String -> ByteString
strToUtf8 (String -> ByteString)
-> (Double -> String) -> Double -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> String
forall a. Show a => a -> String
show) (Double -> ByteString) -> Double -> ByteString
forall a b. (a -> b) -> a -> b
$ -Double
y),
              (ByteString
"rx", (String -> ByteString
strToUtf8 (String -> ByteString)
-> (Double -> String) -> Double -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> String
forall a. Show a => a -> String
show) (Double -> ByteString) -> Double -> ByteString
forall a b. (a -> b) -> a -> b
$ Double
0.5 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
s),
              (ByteString
"ry", (String -> ByteString
strToUtf8 (String -> ByteString)
-> (Double -> String) -> Double -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> String
forall a. Show a => a -> String
show) (Double -> ByteString) -> Double -> ByteString
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')
            ]
markupShape_ GlyphShape
VLineGlyph Double
s (Point Double
x Double
y) =
  ByteString -> [Attr] -> Markup
emptyElem ByteString
"polyline" [ByteString -> ByteString -> Attr
Attr ByteString
"points" (ByteString -> Attr) -> ByteString -> Attr
forall a b. (a -> b) -> a -> b
$ Double -> ByteString
encodeNum Double
x ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"," ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Double -> ByteString
encodeNum (-(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)) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\n" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Double -> ByteString
encodeNum Double
x ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"," ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Double -> ByteString
encodeNum (-(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))]
markupShape_ GlyphShape
HLineGlyph Double
s (Point Double
x Double
y) =
  ByteString -> [Attr] -> Markup
emptyElem ByteString
"polyline" [ByteString -> ByteString -> Attr
Attr ByteString
"points" (ByteString -> Attr) -> ByteString -> Attr
forall a b. (a -> b) -> a -> b
$ Double -> ByteString
encodeNum (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) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"," ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Double -> ByteString
encodeNum (-Double
y) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\n" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Double -> ByteString
encodeNum (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) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"," ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Double -> ByteString
encodeNum (-Double
y)]
markupShape_ (PathGlyph ByteString
path) Double
s Point Double
p =
  ByteString -> [Attr] -> Markup
emptyElem ByteString
"path" ((ByteString -> ByteString -> Attr)
-> (ByteString, ByteString) -> Attr
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> ByteString -> Attr
Attr ((ByteString, ByteString) -> Attr)
-> [(ByteString, ByteString)] -> [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 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Double -> ByteString
toScaleText Double
s)])

-- | Create the classic SVG element
--
-- >>> header (Just 300) (Rect (-0.75) 0.75 (-0.5) 0.5) (element_ "foo" []) & markdown_ Compact Xml
-- "<svg xmlns=\"http://www.w3.org/2000/svg\" xmlns:xlink=\"http://www.w3.org/1999/xlink\" width=\"450\" height=\"300\" viewBox=\"-0.75 -0.5 1.5 1.0\"><foo></foo></svg>"
header :: Maybe Double -> Rect Double -> Markup -> Markup
header :: Maybe Double -> Rect Double -> Markup -> Markup
header Maybe Double
markupheight Rect Double
viewbox Markup
content' =
  ByteString -> [Attr] -> Markup -> Markup
element
    ByteString
"svg"
    ( (ByteString -> ByteString -> Attr)
-> (ByteString, ByteString) -> Attr
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> ByteString -> Attr
Attr
        ((ByteString, ByteString) -> Attr)
-> [(ByteString, ByteString)] -> [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, ByteString)]
-> [(ByteString, ByteString)] -> [(ByteString, ByteString)]
forall a. Semigroup a => a -> a -> a
<> [(ByteString, ByteString)]
widthAndHeight
                [(ByteString, ByteString)]
-> [(ByteString, ByteString)] -> [(ByteString, ByteString)]
forall a. Semigroup a => a -> a -> a
<> [ (ByteString
"viewBox", Double -> ByteString
encodeNum Double
x ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Double -> ByteString
encodeNum (-Double
w) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Double -> ByteString
encodeNum (Double
z Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
x) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Double -> ByteString
encodeNum (Double
w Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
y))
                   ]
            )
    )
    Markup
content'
  where
    (Rect Double
x Double
z Double
y Double
w) = Rect Double
viewbox
    Point Double
w' Double
h = Rect Double -> Element (Rect Double)
forall s. (Space s, Subtractive (Element s)) => s -> Element s
width Rect Double
viewbox
    widthAndHeight :: [(ByteString, ByteString)]
widthAndHeight = case Maybe Double
markupheight of
      Maybe Double
Nothing -> []
      Just Double
h' ->
        [ (ByteString
"width", Double -> ByteString
encodePx Double
w''),
          (ByteString
"height", Double -> ByteString
encodePx Double
h')
        ]
        where
          w'' :: Double
w'' = Double
h' Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
h Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
w'

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

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

-- | Markup options.
--
-- >>> defaultMarkupOptions
-- MarkupOptions {markupHeight = Just 300.0, chartAspect = FixedAspect 1.5, cssOptions = CssOptions {shapeRendering = NoShapeRendering, preferColorScheme = PreferHud, fontFamilies = "\nsvg { font-family: system-ui,-apple-system,\"Segoe UI\",Roboto,\"Helvetica Neue\",Arial,\"Noto Sans\",\"Liberation Sans\",sans-serif,\"Apple Color Emoji\",\"Segoe UI Emoji\",\"Segoe UI Symbol\",\"Noto Color Emoji\";\n}\n\nticktext { font-family: SFMono-Regular,Menlo,Monaco,Consolas,\"Liberation Mono\",\"Courier New\",monospace;\n}\n\n", cssExtra = ""}, renderStyle = Compact}
data MarkupOptions = MarkupOptions
  { MarkupOptions -> Maybe Double
markupHeight :: Maybe Double,
    MarkupOptions -> ChartAspect
chartAspect :: ChartAspect,
    MarkupOptions -> CssOptions
cssOptions :: CssOptions,
    MarkupOptions -> RenderStyle
renderStyle :: RenderStyle
  }
  deriving (MarkupOptions -> MarkupOptions -> Bool
(MarkupOptions -> MarkupOptions -> Bool)
-> (MarkupOptions -> MarkupOptions -> Bool) -> Eq MarkupOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MarkupOptions -> MarkupOptions -> Bool
== :: MarkupOptions -> MarkupOptions -> Bool
$c/= :: MarkupOptions -> MarkupOptions -> Bool
/= :: MarkupOptions -> MarkupOptions -> Bool
Eq, Int -> MarkupOptions -> ShowS
[MarkupOptions] -> ShowS
MarkupOptions -> String
(Int -> MarkupOptions -> ShowS)
-> (MarkupOptions -> String)
-> ([MarkupOptions] -> ShowS)
-> Show MarkupOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MarkupOptions -> ShowS
showsPrec :: Int -> MarkupOptions -> ShowS
$cshow :: MarkupOptions -> String
show :: MarkupOptions -> String
$cshowList :: [MarkupOptions] -> ShowS
showList :: [MarkupOptions] -> ShowS
Show, (forall x. MarkupOptions -> Rep MarkupOptions x)
-> (forall x. Rep MarkupOptions x -> MarkupOptions)
-> Generic MarkupOptions
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
$cfrom :: forall x. MarkupOptions -> Rep MarkupOptions x
from :: forall x. MarkupOptions -> Rep MarkupOptions x
$cto :: forall x. Rep MarkupOptions x -> MarkupOptions
to :: forall x. Rep MarkupOptions x -> MarkupOptions
Generic)

-- | The official markup options
defaultMarkupOptions :: MarkupOptions
defaultMarkupOptions :: MarkupOptions
defaultMarkupOptions = Maybe Double
-> ChartAspect -> CssOptions -> RenderStyle -> MarkupOptions
MarkupOptions (Double -> Maybe Double
forall a. a -> Maybe a
Just Double
300) (Double -> ChartAspect
FixedAspect Double
1.5) CssOptions
defaultCssOptions RenderStyle
Compact

-- | default fonts.
defaultCssFontFamilies :: ByteString
defaultCssFontFamilies :: ByteString
defaultCssFontFamilies =
  [i|
svg { font-family: system-ui,-apple-system,"Segoe UI",Roboto,"Helvetica Neue",Arial,"Noto Sans","Liberation Sans",sans-serif,"Apple Color Emoji","Segoe UI Emoji","Segoe UI Symbol","Noto Color Emoji";
}

ticktext { font-family: SFMono-Regular,Menlo,Monaco,Consolas,"Liberation Mono","Courier New",monospace;
}

|]

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

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

-- | css options
--
-- >>> defaultCssOptions
-- CssOptions {shapeRendering = NoShapeRendering, preferColorScheme = PreferHud, fontFamilies = "\nsvg { font-family: system-ui,-apple-system,\"Segoe UI\",Roboto,\"Helvetica Neue\",Arial,\"Noto Sans\",\"Liberation Sans\",sans-serif,\"Apple Color Emoji\",\"Segoe UI Emoji\",\"Segoe UI Symbol\",\"Noto Color Emoji\";\n}\n\nticktext { font-family: SFMono-Regular,Menlo,Monaco,Consolas,\"Liberation Mono\",\"Courier New\",monospace;\n}\n\n", cssExtra = ""}
data CssOptions = CssOptions {CssOptions -> ShapeRendering
shapeRendering :: ShapeRendering, CssOptions -> PreferColorScheme
preferColorScheme :: PreferColorScheme, CssOptions -> ByteString
fontFamilies :: ByteString, CssOptions -> ByteString
cssExtra :: ByteString} deriving (Int -> CssOptions -> ShowS
[CssOptions] -> ShowS
CssOptions -> String
(Int -> CssOptions -> ShowS)
-> (CssOptions -> String)
-> ([CssOptions] -> ShowS)
-> Show CssOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CssOptions -> ShowS
showsPrec :: Int -> CssOptions -> ShowS
$cshow :: CssOptions -> String
show :: CssOptions -> String
$cshowList :: [CssOptions] -> ShowS
showList :: [CssOptions] -> ShowS
Show, CssOptions -> CssOptions -> Bool
(CssOptions -> CssOptions -> Bool)
-> (CssOptions -> CssOptions -> Bool) -> Eq CssOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CssOptions -> CssOptions -> Bool
== :: CssOptions -> CssOptions -> Bool
$c/= :: CssOptions -> CssOptions -> Bool
/= :: 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
$cfrom :: forall x. CssOptions -> Rep CssOptions x
from :: forall x. CssOptions -> Rep CssOptions x
$cto :: forall x. Rep CssOptions x -> CssOptions
to :: forall x. Rep CssOptions x -> CssOptions
Generic)

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

-- | Convert CssOptions to Markup
markupCssOptions :: CssOptions -> Markup
markupCssOptions :: CssOptions -> Markup
markupCssOptions CssOptions
css =
  ByteString -> [Attr] -> ByteString -> Markup
elementc ByteString
"style" [] (ByteString -> Markup) -> ByteString -> Markup
forall a b. (a -> b) -> a -> b
$
    (Colour, Colour) -> PreferColorScheme -> ByteString
cssPreferColorScheme (Colour
light, Colour
dark) (Optic' A_Lens NoIx CssOptions PreferColorScheme
-> CssOptions -> PreferColorScheme
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx CssOptions PreferColorScheme
#preferColorScheme CssOptions
css)
      ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ShapeRendering -> ByteString
markupShapeRendering (Optic' A_Lens NoIx CssOptions ShapeRendering
-> CssOptions -> ShapeRendering
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx CssOptions ShapeRendering
#shapeRendering CssOptions
css)
      ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Optic' A_Lens NoIx CssOptions ByteString
-> CssOptions -> ByteString
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx CssOptions ByteString
#fontFamilies CssOptions
css
      ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Optic' A_Lens NoIx CssOptions ByteString
-> CssOptions -> ByteString
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx CssOptions ByteString
#cssExtra CssOptions
css

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

-- | A product type consisting of a 'ChartTree', 'HudOptions' and 'MarkupOptions', which is what you need to create 'Markup'.
data ChartOptions = ChartOptions
  { ChartOptions -> MarkupOptions
markupOptions :: MarkupOptions,
    ChartOptions -> HudOptions
hudOptions :: HudOptions,
    ChartOptions -> ChartTree
chartTree :: ChartTree
  }
  deriving ((forall x. ChartOptions -> Rep ChartOptions x)
-> (forall x. Rep ChartOptions x -> ChartOptions)
-> Generic ChartOptions
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
$cfrom :: forall x. ChartOptions -> Rep ChartOptions x
from :: forall x. ChartOptions -> Rep ChartOptions x
$cto :: forall x. Rep ChartOptions x -> ChartOptions
to :: forall x. Rep ChartOptions x -> ChartOptions
Generic, ChartOptions -> ChartOptions -> Bool
(ChartOptions -> ChartOptions -> Bool)
-> (ChartOptions -> ChartOptions -> Bool) -> Eq ChartOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChartOptions -> ChartOptions -> Bool
== :: ChartOptions -> ChartOptions -> Bool
$c/= :: ChartOptions -> ChartOptions -> Bool
/= :: ChartOptions -> ChartOptions -> Bool
Eq, Int -> ChartOptions -> ShowS
[ChartOptions] -> ShowS
ChartOptions -> String
(Int -> ChartOptions -> ShowS)
-> (ChartOptions -> String)
-> ([ChartOptions] -> ShowS)
-> Show ChartOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChartOptions -> ShowS
showsPrec :: Int -> ChartOptions -> ShowS
$cshow :: ChartOptions -> String
show :: ChartOptions -> String
$cshowList :: [ChartOptions] -> ShowS
showList :: [ChartOptions] -> ShowS
Show)

-- | Processes the hud options and turns them into charts, rescales the existing charts, resets the hud options to mempty, and turns on 'ScalePArea' in chart styles.
--
-- Note that this is a destructive operation, and, in particular, that
--
-- > view #chartTree (forgetHud (mempty & set #chartTree c)) /= c
forgetHud :: ChartOptions -> ChartOptions
forgetHud :: ChartOptions -> ChartOptions
forgetHud ChartOptions
co =
  ChartOptions
co
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> HudOptions -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions HudOptions
forall a. Monoid a => a
mempty
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
-> ChartTree -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
#chartTree (ChartAspect -> HudOptions -> ChartTree -> ChartTree
addHud (Optic' A_Lens NoIx ChartOptions ChartAspect
-> ChartOptions -> ChartAspect
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
#markupOptions Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
-> Optic
     A_Lens NoIx MarkupOptions MarkupOptions ChartAspect ChartAspect
-> Optic' A_Lens NoIx ChartOptions 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
% Optic
  A_Lens NoIx MarkupOptions MarkupOptions ChartAspect ChartAspect
#chartAspect) ChartOptions
co) (Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> ChartOptions -> HudOptions
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions ChartOptions
co) (Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
-> ChartOptions -> ChartTree
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
#chartTree ChartOptions
co))
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Traversal (Int : NoIx) ChartOptions ChartOptions ScaleP ScaleP
-> ScaleP -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
#chartTree Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
-> Optic A_Traversal NoIx ChartTree ChartTree [Chart] [Chart]
-> Optic A_Traversal NoIx ChartOptions ChartOptions [Chart] [Chart]
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_Traversal NoIx ChartTree ChartTree [Chart] [Chart]
charts' Optic A_Traversal NoIx ChartOptions ChartOptions [Chart] [Chart]
-> Optic A_Traversal (Int : NoIx) [Chart] [Chart] Chart Chart
-> Optic
     A_Traversal (Int : NoIx) ChartOptions ChartOptions Chart Chart
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_Traversal (Int : NoIx) [Chart] [Chart] Chart Chart
forall i s t a b. Each i s t a b => IxTraversal i s t a b
each Optic
  A_Traversal (Int : NoIx) ChartOptions ChartOptions Chart Chart
-> Optic A_Lens NoIx Chart Chart Style Style
-> Optic
     A_Traversal (Int : NoIx) ChartOptions ChartOptions Style Style
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 Chart Chart Style Style
#chartStyle Optic
  A_Traversal (Int : NoIx) ChartOptions ChartOptions Style Style
-> Optic A_Lens NoIx Style Style ScaleP ScaleP
-> Optic
     A_Traversal (Int : NoIx) ChartOptions ChartOptions ScaleP ScaleP
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 Style Style ScaleP ScaleP
#scaleP) ScaleP
ScalePArea

-- | Convert ChartOptions to a ChartTree, forgetting the original hud and chart data
asChartTree :: ChartOptions -> ChartTree
asChartTree :: ChartOptions -> ChartTree
asChartTree = Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
-> ChartOptions -> ChartTree
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
#chartTree (ChartOptions -> ChartTree)
-> (ChartOptions -> ChartOptions) -> ChartOptions -> ChartTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChartOptions -> ChartOptions
forgetHud

-- | Horizontally stack a list of ChartOptions (proceeding to the right), at the supplied Align and with the supplied gap intercalated.
horiCO :: Align -> Double -> [ChartOptions] -> ChartOptions
horiCO :: Align -> Double -> [ChartOptions] -> ChartOptions
horiCO Align
align Double
gap [ChartOptions]
cs = forall a. Monoid a => a
mempty @ChartOptions ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
-> ChartTree -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
#chartTree (Align -> Double -> [ChartTree] -> ChartTree
hori Align
align Double
gap (ChartOptions -> ChartTree
asChartTree (ChartOptions -> ChartTree) -> [ChartOptions] -> [ChartTree]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ChartOptions]
cs))

-- | Vertically stack a list of ChartOptions (proceeding upwards), at the supplied Align and with the supplied gap intercalated.
vertCO :: Align -> Double -> [ChartOptions] -> ChartOptions
vertCO :: Align -> Double -> [ChartOptions] -> ChartOptions
vertCO Align
align Double
gap [ChartOptions]
cs = forall a. Monoid a => a
mempty @ChartOptions ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
-> ChartTree -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
#chartTree (Align -> Double -> [ChartTree] -> ChartTree
vert Align
align Double
gap (ChartOptions -> ChartTree
asChartTree (ChartOptions -> ChartTree) -> [ChartOptions] -> [ChartTree]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ChartOptions]
cs))

-- | Stack a list of ChartOptions horizontally, then vertically (proceeding downwards which is opposite to the usual coordinate reference system but intuitively the way people read charts)
stackCO :: Int -> Align -> Align -> Double -> [ChartOptions] -> ChartOptions
stackCO :: Int -> Align -> Align -> Double -> [ChartOptions] -> ChartOptions
stackCO Int
n Align
alignV Align
alignH Double
gap [ChartOptions]
cs = forall a. Monoid a => a
mempty @ChartOptions ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
-> ChartTree -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
#chartTree (Int -> Align -> Align -> Double -> [ChartTree] -> ChartTree
stack Int
n Align
alignV Align
alignH Double
gap (ChartOptions -> ChartTree
asChartTree (ChartOptions -> ChartTree) -> [ChartOptions] -> [ChartTree]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ChartOptions]
cs))

-- | Convert ChartOptions to Markup
--
-- >>> markupChartOptions (ChartOptions (defaultMarkupOptions & #cssOptions % #preferColorScheme .~ PreferNormal) mempty mempty) & markdown_ Compact Xml
-- "<svg xmlns=\"http://www.w3.org/2000/svg\" xmlns:xlink=\"http://www.w3.org/1999/xlink\" width=\"300\" height=\"300\" viewBox=\"-0.5 -0.5 1.0 1.0\"><style>\nsvg { font-family: system-ui,-apple-system,\"Segoe UI\",Roboto,\"Helvetica Neue\",Arial,\"Noto Sans\",\"Liberation Sans\",sans-serif,\"Apple Color Emoji\",\"Segoe UI Emoji\",\"Segoe UI Symbol\",\"Noto Color Emoji\";\n}\n\nticktext { font-family: SFMono-Regular,Menlo,Monaco,Consolas,\"Liberation Mono\",\"Courier New\",monospace;\n}\n\n</style><g class=\"chart\"></g><g class=\"hud\"></g></svg>"
markupChartOptions :: ChartOptions -> Markup
markupChartOptions :: ChartOptions -> Markup
markupChartOptions ChartOptions
co =
  Maybe Double -> Rect Double -> Markup -> Markup
header
    (Optic' A_Lens NoIx ChartOptions (Maybe Double)
-> ChartOptions -> Maybe Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
#markupOptions Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
-> Optic
     A_Lens
     NoIx
     MarkupOptions
     MarkupOptions
     (Maybe Double)
     (Maybe Double)
-> Optic' A_Lens NoIx ChartOptions (Maybe 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
  MarkupOptions
  MarkupOptions
  (Maybe Double)
  (Maybe Double)
#markupHeight) ChartOptions
co)
    Rect Double
viewbox
    ( CssOptions -> Markup
markupCssOptions (Optic' A_Lens NoIx ChartOptions CssOptions
-> ChartOptions -> CssOptions
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
#markupOptions Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
-> Optic
     A_Lens NoIx MarkupOptions MarkupOptions CssOptions CssOptions
-> Optic' A_Lens NoIx ChartOptions CssOptions
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 MarkupOptions MarkupOptions CssOptions CssOptions
#cssOptions) ChartOptions
co)
        Markup -> Markup -> Markup
forall a. Semigroup a => a -> a -> a
<> ChartTree -> Markup
markupChartTree ChartTree
ctFinal
    )
  where
    viewbox :: Rect Double
viewbox = Optic' A_Getter NoIx ChartTree (Rect Double)
-> ChartTree -> Rect Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Getter NoIx ChartTree (Rect Double)
safeStyleBox' ChartTree
ctFinal
    ctFinal :: ChartTree
ctFinal =
      ChartAspect -> HudOptions -> ChartTree -> ChartTree
projectChartTreeWith
        (Optic' A_Lens NoIx ChartOptions ChartAspect
-> ChartOptions -> ChartAspect
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
#markupOptions Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
-> Optic
     A_Lens NoIx MarkupOptions MarkupOptions ChartAspect ChartAspect
-> Optic' A_Lens NoIx ChartOptions 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
% Optic
  A_Lens NoIx MarkupOptions MarkupOptions ChartAspect ChartAspect
#chartAspect) ChartOptions
co)
        (Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> ChartOptions -> HudOptions
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions ChartOptions
co)
        (Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
-> ChartOptions -> ChartTree
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
#chartTree ChartOptions
co)

-- | Render ChartOptions to an SVG ByteString
--
-- >>> encodeChartOptions (ChartOptions (defaultMarkupOptions & #cssOptions % #preferColorScheme .~ PreferNormal) mempty mempty)
-- "<svg xmlns=\"http://www.w3.org/2000/svg\" xmlns:xlink=\"http://www.w3.org/1999/xlink\" width=\"300\" height=\"300\" viewBox=\"-0.5 -0.5 1.0 1.0\"><style>\nsvg { font-family: system-ui,-apple-system,\"Segoe UI\",Roboto,\"Helvetica Neue\",Arial,\"Noto Sans\",\"Liberation Sans\",sans-serif,\"Apple Color Emoji\",\"Segoe UI Emoji\",\"Segoe UI Symbol\",\"Noto Color Emoji\";\n}\n\nticktext { font-family: SFMono-Regular,Menlo,Monaco,Consolas,\"Liberation Mono\",\"Courier New\",monospace;\n}\n\n</style><g class=\"chart\"></g><g class=\"hud\"></g></svg>"
encodeChartOptions :: ChartOptions -> ByteString
encodeChartOptions :: ChartOptions -> ByteString
encodeChartOptions ChartOptions
co = RenderStyle -> Standard -> Markup -> ByteString
markdown_ (Optic' A_Lens NoIx ChartOptions RenderStyle
-> ChartOptions -> RenderStyle
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
#markupOptions Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
-> Optic
     A_Lens NoIx MarkupOptions MarkupOptions RenderStyle RenderStyle
-> Optic' A_Lens NoIx ChartOptions RenderStyle
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 MarkupOptions MarkupOptions RenderStyle RenderStyle
#renderStyle) ChartOptions
co) Standard
Xml (Markup -> ByteString) -> Markup -> ByteString
forall a b. (a -> b) -> a -> b
$ ChartOptions -> Markup
markupChartOptions ChartOptions
co

-- | Render ChartOptions to an SVG Text snippet
--
-- >>> renderChartOptions (ChartOptions (defaultMarkupOptions & #cssOptions % #preferColorScheme .~ PreferNormal) mempty mempty)
-- "<svg xmlns=\"http://www.w3.org/2000/svg\" xmlns:xlink=\"http://www.w3.org/1999/xlink\" width=\"300\" height=\"300\" viewBox=\"-0.5 -0.5 1.0 1.0\"><style>\nsvg { font-family: system-ui,-apple-system,\"Segoe UI\",Roboto,\"Helvetica Neue\",Arial,\"Noto Sans\",\"Liberation Sans\",sans-serif,\"Apple Color Emoji\",\"Segoe UI Emoji\",\"Segoe UI Symbol\",\"Noto Color Emoji\";\n}\n\nticktext { font-family: SFMono-Regular,Menlo,Monaco,Consolas,\"Liberation Mono\",\"Courier New\",monospace;\n}\n\n</style><g class=\"chart\"></g><g class=\"hud\"></g></svg>"
renderChartOptions :: ChartOptions -> Text
renderChartOptions :: ChartOptions -> Text
renderChartOptions = ByteString -> Text
decodeUtf8 (ByteString -> Text)
-> (ChartOptions -> ByteString) -> ChartOptions -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChartOptions -> ByteString
encodeChartOptions

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 HudOptions -> HudOptions -> HudOptions
forall a. Semigroup a => a -> a -> a
<> HudOptions
h') (ChartTree
c ChartTree -> ChartTree -> ChartTree
forall a. Semigroup a => a -> a -> a
<> ChartTree
c')

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

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