    {-# LANGUAGE CPP               #-}
    {-# LANGUAGE ConstraintKinds   #-}
    {-# LANGUAGE FlexibleContexts  #-}
    {-# LANGUAGE GADTs             #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE RankNTypes        #-}
    {-# LANGUAGE ViewPatterns      #-}
    {-# LANGUAGE DeriveDataTypeable #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Graphics.Rendering.SVG
    -- Copyright   :  (c) 2011 diagrams-svg team (see LICENSE)
    -- License     :  BSD-style (see LICENSE)
    -- Maintainer  :  diagrams-discuss@googlegroups.com
    --
    -- Generic tools for generating SVG files.
    --
    -----------------------------------------------------------------------------

    module Graphics.Rendering.SVG
        ( SVGFloat
        , Element
        , AttributeValue
        , svgHeader
        , renderPath
        , renderClip
        , renderText
        , renderDImage
        , renderDImageEmb
        , renderStyles
        , renderMiterLimit
        , renderFillTextureDefs
        , renderFillTexture
        , renderLineTextureDefs
        , renderLineTexture
        , dataUri
        , getNumAttr
        ) where

    -- from base
    import           Data.List                   (intercalate)
    #if __GLASGOW_HASKELL__ < 710
    import           Data.Foldable               (foldMap)
    #endif

    import           Data.Maybe                  (fromMaybe)
    #if !MIN_VERSION_base(4,11,0)
    import           Data.Monoid
    #endif

    -- from diagrams-core
    import           Diagrams.Core.Transform     (matrixHomRep)

    -- from diagrams-lib
    import           Diagrams.Prelude            hiding (Attribute, Render, with, (<>))
    import           Diagrams.TwoD.Path          (getFillRule)
    import           Diagrams.TwoD.Text

    -- from text
    import           Data.Text                   (pack)
    import qualified Data.Text                   as T

    -- from lucid-svg
    import           Graphics.Svg                hiding (renderText)

    -- from base64-bytestring, bytestring
    import qualified Data.ByteString.Base64.Lazy as BS64
    import qualified Data.ByteString.Lazy.Char8  as BS8

    -- from JuicyPixels
    import           Codec.Picture

    -- | Constaint on number type that diagrams-svg can use to render an SVG. This
    --   includes the common number types: Double, Float
    type SVGFloat n = (Show n, TypeableFloat n)
    -- Could we change Text.Blaze.SVG to use
    --   showFFloat :: RealFloat a => Maybe Int -> a -> ShowS
    -- or something similar for all numbers so we need TypeableFloat constraint.

    type AttributeValue = T.Text

    getNumAttr :: AttributeClass (a n) => (a n -> t) -> Style v n -> Maybe t
    getNumAttr :: (a n -> t) -> Style v n -> Maybe t
    getNumAttr f :: a n -> t
    f = (a n -> t
    f (a n -> t) -> Maybe (a n) -> Maybe t
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>) (Maybe (a n) -> Maybe t)
    -> (Style v n -> Maybe (a n)) -> Style v n -> Maybe t
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Style v n -> Maybe (a n)
    forall a (v :: * -> *) n. AttributeClass a => Style v n -> Maybe a
    getAttr

    -- | @svgHeader w h defs s@: @w@ width, @h@ height,
    --   @defs@ global definitions for defs sections, @s@ actual SVG content.
    svgHeader :: SVGFloat n => n -> n -> Maybe Element -> [Attribute] -> Bool
                            -> Element -> Element
    svgHeader :: n
    -> n -> Maybe Element -> [Attribute] -> Bool -> Element -> Element
    svgHeader w :: n
    w h :: n
    h defines :: Maybe Element
    defines attributes :: [Attribute]
    attributes genDoctype :: Bool
    genDoctype s :: Element
    s =
      Element
    dt Element -> Element -> Element
    forall a. Semigroup a => a -> a -> a
    <> Element -> [Attribute] -> Element
    with (Element -> Element
    svg11_ ([Attribute] -> Element -> Element
    forall result. Term result => [Attribute] -> result
    defs_ [] Element
    ds Element -> Element -> Element
    forall a. Semigroup a => a -> a -> a
    <> Element
    s))
        ([ AttrTag
    Width_ AttrTag -> Text -> Attribute
    <<- n -> Text
    forall a. RealFloat a => a -> Text
    toText n
    w
         , AttrTag
    Height_ AttrTag -> Text -> Attribute
    <<- n -> Text
    forall a. RealFloat a => a -> Text
    toText n
    h
         , AttrTag
    Font_size_ AttrTag -> Text -> Attribute
    <<- "1"
         , AttrTag
    ViewBox_ AttrTag -> Text -> Attribute
    <<- (String -> Text
    pack (String -> Text) -> ([String] -> String) -> [String] -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> String
    unwords ([String] -> Text) -> [String] -> Text
    forall a b. (a -> b) -> a -> b
    $ (n -> String) -> [n] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map n -> String
    forall a. Show a => a -> String
    show [0, 0, n
    w, n
    h])
         , AttrTag
    Stroke_ AttrTag -> Text -> Attribute
    <<- "rgb(0,0,0)"
         , AttrTag
    Stroke_opacity_ AttrTag -> Text -> Attribute
    <<- "1" ]
         [Attribute] -> [Attribute] -> [Attribute]
    forall a. [a] -> [a] -> [a]
    ++ [Attribute]
    attributes )
      where
        ds :: Element
    ds = Element -> Maybe Element -> Element
    forall a. a -> Maybe a -> a
    fromMaybe Element
    forall a. Monoid a => a
    mempty Maybe Element
    defines
        dt :: Element
    dt = if Bool
    genDoctype then Element
    doctype else Element
    forall a. Monoid a => a
    mempty

    renderPath :: SVGFloat n => Path V2 n -> Element
    renderPath :: Path V2 n -> Element
    renderPath trs :: Path V2 n
    trs = if Text
    makePath Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    T.empty then Element
    forall a. Monoid a => a
    mempty else [Attribute] -> Element
    forall result. Term result => [Attribute] -> result
    path_ [AttrTag
    D_ AttrTag -> Text -> Attribute
    <<- Text
    makePath]
      where
        makePath :: Text
    makePath = (Located (Trail V2 n) -> Text) -> [Located (Trail V2 n)] -> Text
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap Located (Trail V2 n) -> Text
    forall n. SVGFloat n => Located (Trail V2 n) -> Text
    renderTrail ((Unwrapped (Path V2 n) -> Path V2 n)
    -> Path V2 n -> Unwrapped (Path V2 n)
    forall s. Wrapped s => (Unwrapped s -> s) -> s -> Unwrapped s
    op Unwrapped (Path V2 n) -> Path V2 n
    forall (v :: * -> *) n. [Located (Trail v n)] -> Path v n
    Path Path V2 n
    trs)

    renderTrail :: SVGFloat n => Located (Trail V2 n) -> AttributeValue
    renderTrail :: Located (Trail V2 n) -> Text
    renderTrail (Located (Trail V2 n)
    -> (Point (V (Trail V2 n)) (N (Trail V2 n)), Trail V2 n)
    forall a. Located a -> (Point (V a) (N a), a)
    viewLoc -> (P (V2 x y), t :: Trail V2 n
    t)) =
      n -> n -> Text
    forall a. RealFloat a => a -> a -> Text
    mA n
    x n
    y Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> (Trail' Line V2 n -> Text)
    -> (Trail' Loop V2 n -> Text) -> Trail V2 n -> Text
    forall (v :: * -> *) n r.
    (Trail' Line v n -> r) -> (Trail' Loop v n -> r) -> Trail v n -> r
    withTrail Trail' Line V2 n -> Text
    renderLine Trail' Loop V2 n -> Text
    forall n.
    (Show n, Typeable n, RealFloat n) =>
    Trail' Loop V2 n -> Text
    renderLoop Trail V2 n
    t
      where
        renderLine :: Trail' Line V2 n -> Text
    renderLine = (Segment Closed V2 n -> Text) -> [Segment Closed V2 n] -> Text
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap Segment Closed V2 n -> Text
    forall n. SVGFloat n => Segment Closed V2 n -> Text
    renderSeg ([Segment Closed V2 n] -> Text)
    -> (Trail' Line V2 n -> [Segment Closed V2 n])
    -> Trail' Line V2 n
    -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Trail' Line V2 n -> [Segment Closed V2 n]
    forall (v :: * -> *) n. Trail' Line v n -> [Segment Closed v n]
    lineSegments
        renderLoop :: Trail' Loop V2 n -> Text
    renderLoop lp :: Trail' Loop V2 n
    lp =
          case Trail' Loop V2 n -> ([Segment Closed V2 n], Segment Open V2 n)
    forall (v :: * -> *) n.
    Trail' Loop v n -> ([Segment Closed v n], Segment Open v n)
    loopSegments Trail' Loop V2 n
    lp of
            -- let z handle the last segment if it is linear
            (segs :: [Segment Closed V2 n]
    segs, Linear _) -> (Segment Closed V2 n -> Text) -> [Segment Closed V2 n] -> Text
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap Segment Closed V2 n -> Text
    forall n. SVGFloat n => Segment Closed V2 n -> Text
    renderSeg [Segment Closed V2 n]
    segs

            -- otherwise we have to emit it explicitly
            _ -> (Segment Closed V2 n -> Text) -> [Segment Closed V2 n] -> Text
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap Segment Closed V2 n -> Text
    forall n. SVGFloat n => Segment Closed V2 n -> Text
    renderSeg (Trail' Line V2 n -> [Segment Closed V2 n]
    forall (v :: * -> *) n. Trail' Line v n -> [Segment Closed v n]
    lineSegments (Trail' Line V2 n -> [Segment Closed V2 n])
    -> (Trail' Loop V2 n -> Trail' Line V2 n)
    -> Trail' Loop V2 n
    -> [Segment Closed V2 n]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Trail' Loop V2 n -> Trail' Line V2 n
    forall (v :: * -> *) n.
    (Metric v, OrderedField n) =>
    Trail' Loop v n -> Trail' Line v n
    cutLoop (Trail' Loop V2 n -> [Segment Closed V2 n])
    -> Trail' Loop V2 n -> [Segment Closed V2 n]
    forall a b. (a -> b) -> a -> b
    $ Trail' Loop V2 n
    lp)
          Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    z

    renderSeg :: SVGFloat n => Segment Closed V2 n -> AttributeValue
    renderSeg :: Segment Closed V2 n -> Text
    renderSeg (Linear (OffsetClosed (V2 x :: n
    x 0))) = n -> Text
    forall a. RealFloat a => a -> Text
    hR n
    x
    renderSeg (Linear (OffsetClosed (V2 0 y :: n
    y))) = n -> Text
    forall a. RealFloat a => a -> Text
    vR n
    y
    renderSeg (Linear (OffsetClosed (V2 x :: n
    x y :: n
    y))) = n -> n -> Text
    forall a. RealFloat a => a -> a -> Text
    lR n
    x n
    y
    renderSeg (Cubic  (V2 x0 :: n
    x0 y0 :: n
    y0)
                      (V2 x1 :: n
    x1 y1 :: n
    y1)
                      (OffsetClosed (V2 x2 :: n
    x2 y2 :: n
    y2))) = n -> n -> n -> n -> n -> n -> Text
    forall a. RealFloat a => a -> a -> a -> a -> a -> a -> Text
    cR n
    x0 n
    y0 n
    x1 n
    y1 n
    x2 n
    y2

    renderClip :: SVGFloat n => Path V2 n -> T.Text -> Int -> Element -> Element
    renderClip :: Path V2 n -> Text -> Int -> Element -> Element
    renderClip p :: Path V2 n
    p prefix :: Text
    prefix ident :: Int
    ident svg :: Element
    svg = do
         [Attribute] -> Element -> Element
    forall result. Term result => [Attribute] -> result
    defs_ [] (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $ [Attribute] -> Element -> Element
    forall result. Term result => [Attribute] -> result
    clipPath_ [AttrTag
    Id_ AttrTag -> Text -> Attribute
    <<- (Int -> Text
    clipPathId Int
    ident)] (Path V2 n -> Element
    forall n. SVGFloat n => Path V2 n -> Element
    renderPath Path V2 n
    p)
      Element -> Element -> Element
    forall a. Semigroup a => a -> a -> a
    <> [Attribute] -> Element -> Element
    forall result. Term result => [Attribute] -> result
    g_  [AttrTag
    Clip_path_ AttrTag -> Text -> Attribute
    <<- ("url(#" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Int -> Text
    clipPathId Int
    ident Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> ")")] Element
    svg
        where
          clipPathId :: Int -> Text
    clipPathId i :: Int
    i = Text
    prefix Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> "myClip" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> (String -> Text
    pack (String -> Text) -> (Int -> String) -> Int -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> String
    forall a. Show a => a -> String
    show (Int -> Text) -> Int -> Text
    forall a b. (a -> b) -> a -> b
    $ Int
    i)

    renderStop :: SVGFloat n => GradientStop n -> Element
    renderStop :: GradientStop n -> Element
    renderStop (GradientStop c :: SomeColor
    c v :: n
    v)
      = [Attribute] -> Element
    forall result. Term result => [Attribute] -> result
    stop_ [ AttrTag
    Stop_color_ AttrTag -> Text -> Attribute
    <<- (SomeColor -> Text
    forall c. Color c => c -> Text
    colorToRgbText SomeColor
    c)
              , AttrTag
    Offset_ AttrTag -> Text -> Attribute
    <<- (n -> Text
    forall a. RealFloat a => a -> Text
    toText n
    v)
              , AttrTag
    Stop_opacity_ AttrTag -> Text -> Attribute
    <<- (Double -> Text
    forall a. RealFloat a => a -> Text
    toText (Double -> Text) -> Double -> Text
    forall a b. (a -> b) -> a -> b
    $ SomeColor -> Double
    forall c. Color c => c -> Double
    colorToOpacity SomeColor
    c) ]

    spreadMethodText :: SpreadMethod -> AttributeValue
    spreadMethodText :: SpreadMethod -> Text
    spreadMethodText GradPad      = "pad"
    spreadMethodText GradReflect  = "reflect"
    spreadMethodText GradRepeat   = "repeat"

    renderLinearGradient :: SVGFloat n => LGradient n -> Int -> Element
    renderLinearGradient :: LGradient n -> Int -> Element
    renderLinearGradient g :: LGradient n
    g i :: Int
    i = [Attribute] -> Element -> Element
    forall result. Term result => [Attribute] -> result
    linearGradient_
        [ AttrTag
    Id_ AttrTag -> Text -> Attribute
    <<- (String -> Text
    pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ "gradient" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    i)
        , AttrTag
    X1_ AttrTag -> Text -> Attribute
    <<- n -> Text
    forall a. RealFloat a => a -> Text
    toText n
    x1
        , AttrTag
    Y1_ AttrTag -> Text -> Attribute
    <<- n -> Text
    forall a. RealFloat a => a -> Text
    toText n
    y1
        , AttrTag
    X2_ AttrTag -> Text -> Attribute
    <<- n -> Text
    forall a. RealFloat a => a -> Text
    toText n
    x2
        , AttrTag
    Y2_ AttrTag -> Text -> Attribute
    <<- n -> Text
    forall a. RealFloat a => a -> Text
    toText n
    y2
        , AttrTag
    GradientTransform_ AttrTag -> Text -> Attribute
    <<- Text
    mx
        , AttrTag
    GradientUnits_ AttrTag -> Text -> Attribute
    <<- "userSpaceOnUse"
        , AttrTag
    SpreadMethod_ AttrTag -> Text -> Attribute
    <<- SpreadMethod -> Text
    spreadMethodText (LGradient n
    g LGradient n
    -> Getting SpreadMethod (LGradient n) SpreadMethod -> SpreadMethod
    forall s a. s -> Getting a s a -> a
    ^. Getting SpreadMethod (LGradient n) SpreadMethod
    forall n. Lens' (LGradient n) SpreadMethod
    lGradSpreadMethod) ]
        (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $ (GradientStop n -> Element) -> [GradientStop n] -> Element
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap GradientStop n -> Element
    forall n. SVGFloat n => GradientStop n -> Element
    renderStop (LGradient n
    gLGradient n
    -> Getting [GradientStop n] (LGradient n) [GradientStop n]
    -> [GradientStop n]
    forall s a. s -> Getting a s a -> a
    ^.Getting [GradientStop n] (LGradient n) [GradientStop n]
    forall n. Lens' (LGradient n) [GradientStop n]
    lGradStops)
      where
        mx :: Text
    mx = n -> n -> n -> n -> n -> n -> Text
    forall a. RealFloat a => a -> a -> a -> a -> a -> a -> Text
    matrix n
    a1 n
    a2 n
    b1 n
    b2 n
    c1 n
    c2
        [[a1 :: n
    a1, a2 :: n
    a2], [b1 :: n
    b1, b2 :: n
    b2], [c1 :: n
    c1, c2 :: n
    c2]] = Transformation V2 n -> [[n]]
    forall (v :: * -> *) n.
    (Additive v, Traversable v, Num n) =>
    Transformation v n -> [[n]]
    matrixHomRep (LGradient n
    g LGradient n
    -> Getting
         (Transformation V2 n) (LGradient n) (Transformation V2 n)
    -> Transformation V2 n
    forall s a. s -> Getting a s a -> a
    ^. Getting (Transformation V2 n) (LGradient n) (Transformation V2 n)
    forall n. Lens' (LGradient n) (Transformation V2 n)
    lGradTrans)
        P (V2 x1 :: n
    x1 y1 :: n
    y1) = LGradient n
    g LGradient n
    -> Getting (Point V2 n) (LGradient n) (Point V2 n) -> Point V2 n
    forall s a. s -> Getting a s a -> a
    ^. Getting (Point V2 n) (LGradient n) (Point V2 n)
    forall n. Lens' (LGradient n) (Point V2 n)
    lGradStart
        P (V2 x2 :: n
    x2 y2 :: n
    y2) = LGradient n
    g LGradient n
    -> Getting (Point V2 n) (LGradient n) (Point V2 n) -> Point V2 n
    forall s a. s -> Getting a s a -> a
    ^. Getting (Point V2 n) (LGradient n) (Point V2 n)
    forall n. Lens' (LGradient n) (Point V2 n)
    lGradEnd

    renderRadialGradient :: SVGFloat n => RGradient n -> Int -> Element
    renderRadialGradient :: RGradient n -> Int -> Element
    renderRadialGradient g :: RGradient n
    g i :: Int
    i = [Attribute] -> Element -> Element
    forall result. Term result => [Attribute] -> result
    radialGradient_
        [ AttrTag
    Id_ AttrTag -> Text -> Attribute
    <<- (String -> Text
    pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ "gradient" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    i)
        , AttrTag
    R_  AttrTag -> Text -> Attribute
    <<- n -> Text
    forall a. RealFloat a => a -> Text
    toText (RGradient n
    g RGradient n -> Getting n (RGradient n) n -> n
    forall s a. s -> Getting a s a -> a
    ^. Getting n (RGradient n) n
    forall n. Lens' (RGradient n) n
    rGradRadius1)
        , AttrTag
    Cx_ AttrTag -> Text -> Attribute
    <<- n -> Text
    forall a. RealFloat a => a -> Text
    toText n
    cx
        , AttrTag
    Cy_ AttrTag -> Text -> Attribute
    <<- n -> Text
    forall a. RealFloat a => a -> Text
    toText n
    cy
        , AttrTag
    Fx_ AttrTag -> Text -> Attribute
    <<- n -> Text
    forall a. RealFloat a => a -> Text
    toText n
    fx
        , AttrTag
    Fy_ AttrTag -> Text -> Attribute
    <<- n -> Text
    forall a. RealFloat a => a -> Text
    toText n
    fy
        , AttrTag
    GradientTransform_ AttrTag -> Text -> Attribute
    <<- Text
    mx
        , AttrTag
    GradientUnits_ AttrTag -> Text -> Attribute
    <<- "userSpaceOnUse"
        , AttrTag
    SpreadMethod_ AttrTag -> Text -> Attribute
    <<- SpreadMethod -> Text
    spreadMethodText (RGradient n
    g RGradient n
    -> Getting SpreadMethod (RGradient n) SpreadMethod -> SpreadMethod
    forall s a. s -> Getting a s a -> a
    ^. Getting SpreadMethod (RGradient n) SpreadMethod
    forall n. Lens' (RGradient n) SpreadMethod
    rGradSpreadMethod) ]
        ( (GradientStop n -> Element) -> [GradientStop n] -> Element
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap GradientStop n -> Element
    forall n. SVGFloat n => GradientStop n -> Element
    renderStop [GradientStop n]
    ss )
      where
        mx :: Text
    mx = n -> n -> n -> n -> n -> n -> Text
    forall a. RealFloat a => a -> a -> a -> a -> a -> a -> Text
    matrix n
    a1 n
    a2 n
    b1 n
    b2 n
    c1 n
    c2
        [[a1 :: n
    a1, a2 :: n
    a2], [b1 :: n
    b1, b2 :: n
    b2], [c1 :: n
    c1, c2 :: n
    c2]] = Transformation V2 n -> [[n]]
    forall (v :: * -> *) n.
    (Additive v, Traversable v, Num n) =>
    Transformation v n -> [[n]]
    matrixHomRep (RGradient n
    g RGradient n
    -> Getting
         (Transformation V2 n) (RGradient n) (Transformation V2 n)
    -> Transformation V2 n
    forall s a. s -> Getting a s a -> a
    ^.Getting (Transformation V2 n) (RGradient n) (Transformation V2 n)
    forall n. Lens' (RGradient n) (Transformation V2 n)
    rGradTrans)
        P (V2 cx :: n
    cx cy :: n
    cy) = RGradient n
    g RGradient n
    -> Getting (Point V2 n) (RGradient n) (Point V2 n) -> Point V2 n
    forall s a. s -> Getting a s a -> a
    ^. Getting (Point V2 n) (RGradient n) (Point V2 n)
    forall n. Lens' (RGradient n) (Point V2 n)
    rGradCenter1
        P (V2 fx :: n
    fx fy :: n
    fy) = RGradient n
    g RGradient n
    -> Getting (Point V2 n) (RGradient n) (Point V2 n) -> Point V2 n
    forall s a. s -> Getting a s a -> a
    ^. Getting (Point V2 n) (RGradient n) (Point V2 n)
    forall n. Lens' (RGradient n) (Point V2 n)
    rGradCenter0 -- SVGs focal point is our inner center.

        -- Adjust the stops so that the gradient begins at the perimeter of
        -- the inner circle (center0, radius0) and ends at the outer circle.
        r0 :: n
    r0 = RGradient n
    g RGradient n -> Getting n (RGradient n) n -> n
    forall s a. s -> Getting a s a -> a
    ^. Getting n (RGradient n) n
    forall n. Lens' (RGradient n) n
    rGradRadius0
        r1 :: n
    r1 = RGradient n
    g RGradient n -> Getting n (RGradient n) n -> n
    forall s a. s -> Getting a s a -> a
    ^. Getting n (RGradient n) n
    forall n. Lens' (RGradient n) n
    rGradRadius1
        stopFracs :: [n]
    stopFracs = n
    r0 n -> n -> n
    forall a. Fractional a => a -> a -> a
    / n
    r1 n -> [n] -> [n]
    forall a. a -> [a] -> [a]
    : (GradientStop n -> n) -> [GradientStop n] -> [n]
    forall a b. (a -> b) -> [a] -> [b]
    map (\s :: GradientStop n
    s -> (n
    r0 n -> n -> n
    forall a. Num a => a -> a -> a
    + (GradientStop n
    s GradientStop n -> Getting n (GradientStop n) n -> n
    forall s a. s -> Getting a s a -> a
    ^. Getting n (GradientStop n) n
    forall n. Lens' (GradientStop n) n
    stopFraction) n -> n -> n
    forall a. Num a => a -> a -> a
    * (n
    r1 n -> n -> n
    forall a. Num a => a -> a -> a
    - n
    r0)) n -> n -> n
    forall a. Fractional a => a -> a -> a
    / n
    r1)
                    (RGradient n
    g RGradient n
    -> Getting [GradientStop n] (RGradient n) [GradientStop n]
    -> [GradientStop n]
    forall s a. s -> Getting a s a -> a
    ^. Getting [GradientStop n] (RGradient n) [GradientStop n]
    forall n. Lens' (RGradient n) [GradientStop n]
    rGradStops)
        gradStops :: [GradientStop n]
    gradStops = case RGradient n
    g RGradient n
    -> Getting [GradientStop n] (RGradient n) [GradientStop n]
    -> [GradientStop n]
    forall s a. s -> Getting a s a -> a
    ^. Getting [GradientStop n] (RGradient n) [GradientStop n]
    forall n. Lens' (RGradient n) [GradientStop n]
    rGradStops of
          []       -> []
          xs :: [GradientStop n]
    xs@(x :: GradientStop n
    x:_) -> GradientStop n
    x GradientStop n -> [GradientStop n] -> [GradientStop n]
    forall a. a -> [a] -> [a]
    : [GradientStop n]
    xs
        ss :: [GradientStop n]
    ss = (GradientStop n -> n -> GradientStop n)
    -> [GradientStop n] -> [n] -> [GradientStop n]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (\gs :: GradientStop n
    gs sf :: n
    sf -> GradientStop n
    gs GradientStop n
    -> (GradientStop n -> GradientStop n) -> GradientStop n
    forall a b. a -> (a -> b) -> b
    & (n -> Identity n) -> GradientStop n -> Identity (GradientStop n)
    forall n. Lens' (GradientStop n) n
    stopFraction ((n -> Identity n) -> GradientStop n -> Identity (GradientStop n))
    -> n -> GradientStop n -> GradientStop n
    forall s t a b. ASetter s t a b -> b -> s -> t
    .~ n
    sf ) [GradientStop n]
    gradStops [n]
    stopFracs

    -- Create a gradient element so that it can be used as an attribute value for fill.
    renderFillTextureDefs :: SVGFloat n => Int -> Style v n -> Element
    renderFillTextureDefs :: Int -> Style v n -> Element
    renderFillTextureDefs i :: Int
    i s :: Style v n
    s =
      case (FillTexture n -> Texture n) -> Style v n -> Maybe (Texture n)
    forall (a :: * -> *) n t (v :: * -> *).
    AttributeClass (a n) =>
    (a n -> t) -> Style v n -> Maybe t
    getNumAttr FillTexture n -> Texture n
    forall n. FillTexture n -> Texture n
    getFillTexture Style v n
    s of
        Just (LG g :: LGradient n
    g) -> [Attribute] -> Element -> Element
    forall result. Term result => [Attribute] -> result
    defs_ [] (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $ LGradient n -> Int -> Element
    forall n. SVGFloat n => LGradient n -> Int -> Element
    renderLinearGradient LGradient n
    g Int
    i
        Just (RG g :: RGradient n
    g) -> [Attribute] -> Element -> Element
    forall result. Term result => [Attribute] -> result
    defs_ [] (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $ RGradient n -> Int -> Element
    forall n. SVGFloat n => RGradient n -> Int -> Element
    renderRadialGradient RGradient n
    g Int
    i
        _           -> Element
    forall a. Monoid a => a
    mempty

    -- Render the gradient using the id set up in renderFillTextureDefs.
    renderFillTexture :: SVGFloat n => Int -> Style v n -> [Attribute]
    renderFillTexture :: Int -> Style v n -> [Attribute]
    renderFillTexture ident :: Int
    ident s :: Style v n
    s = case (FillTexture n -> Texture n) -> Style v n -> Maybe (Texture n)
    forall (a :: * -> *) n t (v :: * -> *).
    AttributeClass (a n) =>
    (a n -> t) -> Style v n -> Maybe t
    getNumAttr FillTexture n -> Texture n
    forall n. FillTexture n -> Texture n
    getFillTexture Style v n
    s of
      Just (SC (SomeColor c :: c
    c)) -> AttrTag -> Maybe Text -> [Attribute]
    renderTextAttr AttrTag
    Fill_ Maybe Text
    fillColorRgb [Attribute] -> [Attribute] -> [Attribute]
    forall a. Semigroup a => a -> a -> a
    <>
                                 AttrTag -> Maybe Double -> [Attribute]
    forall s. Show s => AttrTag -> Maybe s -> [Attribute]
    renderAttr AttrTag
    Fill_opacity_ Maybe Double
    fillColorOpacity
        where
          fillColorRgb :: Maybe Text
    fillColorRgb     = Text -> Maybe Text
    forall a. a -> Maybe a
    Just (Text -> Maybe Text) -> Text -> Maybe Text
    forall a b. (a -> b) -> a -> b
    $ c -> Text
    forall c. Color c => c -> Text
    colorToRgbText c
    c
          fillColorOpacity :: Maybe Double
    fillColorOpacity = Double -> Maybe Double
    forall a. a -> Maybe a
    Just (Double -> Maybe Double) -> Double -> Maybe Double
    forall a b. (a -> b) -> a -> b
    $ c -> Double
    forall c. Color c => c -> Double
    colorToOpacity c
    c
      Just (LG _) -> [AttrTag
    Fill_ AttrTag -> Text -> Attribute
    <<- ("url(#gradient" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> (String -> Text
    pack (String -> Text) -> (Int -> String) -> Int -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> String
    forall a. Show a => a -> String
    show (Int -> Text) -> Int -> Text
    forall a b. (a -> b) -> a -> b
    $ Int
    ident)
                                                 Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> ")"), AttrTag
    Fill_opacity_ AttrTag -> Text -> Attribute
    <<- "1"]
      Just (RG _) -> [AttrTag
    Fill_ AttrTag -> Text -> Attribute
    <<- ("url(#gradient" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> (String -> Text
    pack (String -> Text) -> (Int -> String) -> Int -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> String
    forall a. Show a => a -> String
    show (Int -> Text) -> Int -> Text
    forall a b. (a -> b) -> a -> b
    $ Int
    ident)
                                                 Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> ")"), AttrTag
    Fill_opacity_ AttrTag -> Text -> Attribute
    <<- "1"]
      Nothing     -> []

    renderLineTextureDefs :: SVGFloat n => Int -> Style v n -> Element
    renderLineTextureDefs :: Int -> Style v n -> Element
    renderLineTextureDefs i :: Int
    i s :: Style v n
    s =
      case (LineTexture n -> Texture n) -> Style v n -> Maybe (Texture n)
    forall (a :: * -> *) n t (v :: * -> *).
    AttributeClass (a n) =>
    (a n -> t) -> Style v n -> Maybe t
    getNumAttr LineTexture n -> Texture n
    forall n. LineTexture n -> Texture n
    getLineTexture Style v n
    s of
        Just (LG g :: LGradient n
    g) -> [Attribute] -> Element -> Element
    forall result. Term result => [Attribute] -> result
    defs_ [] (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $ LGradient n -> Int -> Element
    forall n. SVGFloat n => LGradient n -> Int -> Element
    renderLinearGradient LGradient n
    g Int
    i
        Just (RG g :: RGradient n
    g) -> [Attribute] -> Element -> Element
    forall result. Term result => [Attribute] -> result
    defs_ [] (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $ RGradient n -> Int -> Element
    forall n. SVGFloat n => RGradient n -> Int -> Element
    renderRadialGradient RGradient n
    g Int
    i
        _           -> Element
    forall a. Monoid a => a
    mempty

    renderLineTexture :: SVGFloat n => Int -> Style v n -> [Attribute]
    renderLineTexture :: Int -> Style v n -> [Attribute]
    renderLineTexture ident :: Int
    ident s :: Style v n
    s = case (LineTexture n -> Texture n) -> Style v n -> Maybe (Texture n)
    forall (a :: * -> *) n t (v :: * -> *).
    AttributeClass (a n) =>
    (a n -> t) -> Style v n -> Maybe t
    getNumAttr LineTexture n -> Texture n
    forall n. LineTexture n -> Texture n
    getLineTexture Style v n
    s of
      Just (SC (SomeColor c :: c
    c)) -> AttrTag -> Maybe Text -> [Attribute]
    renderTextAttr AttrTag
    Stroke_ Maybe Text
    lineColorRgb [Attribute] -> [Attribute] -> [Attribute]
    forall a. Semigroup a => a -> a -> a
    <>
                                 AttrTag -> Maybe Double -> [Attribute]
    forall s. Show s => AttrTag -> Maybe s -> [Attribute]
    renderAttr AttrTag
    Stroke_opacity_ Maybe Double
    lineColorOpacity
        where
          lineColorRgb :: Maybe Text
    lineColorRgb     = Text -> Maybe Text
    forall a. a -> Maybe a
    Just (Text -> Maybe Text) -> Text -> Maybe Text
    forall a b. (a -> b) -> a -> b
    $ c -> Text
    forall c. Color c => c -> Text
    colorToRgbText c
    c
          lineColorOpacity :: Maybe Double
    lineColorOpacity = Double -> Maybe Double
    forall a. a -> Maybe a
    Just (Double -> Maybe Double) -> Double -> Maybe Double
    forall a b. (a -> b) -> a -> b
    $ c -> Double
    forall c. Color c => c -> Double
    colorToOpacity c
    c
      Just (LG _) -> [AttrTag
    Stroke_ AttrTag -> Text -> Attribute
    <<- ("url(#gradient" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> (String -> Text
    pack (String -> Text) -> (Int -> String) -> Int -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> String
    forall a. Show a => a -> String
    show (Int -> Text) -> Int -> Text
    forall a b. (a -> b) -> a -> b
    $ Int
    ident)
                                                   Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> ")"), AttrTag
    Stroke_opacity_ AttrTag -> Text -> Attribute
    <<- "1"]
      Just (RG _) -> [AttrTag
    Stroke_ AttrTag -> Text -> Attribute
    <<- ("url(#gradient" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> (String -> Text
    pack (String -> Text) -> (Int -> String) -> Int -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> String
    forall a. Show a => a -> String
    show (Int -> Text) -> Int -> Text
    forall a b. (a -> b) -> a -> b
    $ Int
    ident)
                                                   Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> ")"), AttrTag
    Stroke_opacity_ AttrTag -> Text -> Attribute
    <<- "1"]
      Nothing     -> []

    dataUri :: String -> BS8.ByteString -> AttributeValue
    dataUri :: String -> ByteString -> Text
    dataUri mime :: String
    mime dat :: ByteString
    dat = String -> Text
    pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ "data:"String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    mimeString -> String -> String
    forall a. [a] -> [a] -> [a]
    ++";base64," String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ByteString -> String
    BS8.unpack (ByteString -> ByteString
    BS64.encode ByteString
    dat)

    renderDImageEmb :: SVGFloat n => DImage n Embedded -> Element
    renderDImageEmb :: DImage n Embedded -> Element
    renderDImageEmb di :: DImage n Embedded
    di@(DImage (ImageRaster dImg :: DynamicImage
    dImg) _ _ _) =
      DImage n Embedded -> Text -> Element
    forall n any. SVGFloat n => DImage n any -> Text -> Element
    renderDImage DImage n Embedded
    di (Text -> Element) -> Text -> Element
    forall a b. (a -> b) -> a -> b
    $ String -> ByteString -> Text
    dataUri "image/png" ByteString
    img
      where
        img :: ByteString
    img = case DynamicImage -> Either String ByteString
    encodeDynamicPng DynamicImage
    dImg of
                Left str :: String
    str   -> String -> ByteString
    forall a. HasCallStack => String -> a
    error String
    str
                Right img' :: ByteString
    img' -> ByteString
    img'

    renderDImage :: SVGFloat n => DImage n any -> AttributeValue -> Element
    renderDImage :: DImage n any -> Text -> Element
    renderDImage (DImage _ w :: Int
    w h :: Int
    h tr :: Transformation V2 n
    tr) uridata :: Text
    uridata =
      [Attribute] -> Element
    forall result. Term result => [Attribute] -> result
    image_
        [ AttrTag
    Transform_ AttrTag -> Text -> Attribute
    <<- Text
    transformMatrix
        , AttrTag
    Width_ AttrTag -> Text -> Attribute
    <<-  (String -> Text
    pack (String -> Text) -> (Int -> String) -> Int -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> String
    forall a. Show a => a -> String
    show (Int -> Text) -> Int -> Text
    forall a b. (a -> b) -> a -> b
    $ Int
    w)
        , AttrTag
    Height_ AttrTag -> Text -> Attribute
    <<- (String -> Text
    pack (String -> Text) -> (Int -> String) -> Int -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> String
    forall a. Show a => a -> String
    show (Int -> Text) -> Int -> Text
    forall a b. (a -> b) -> a -> b
    $ Int
    h)
        , AttrTag
    XlinkHref_ AttrTag -> Text -> Attribute
    <<- Text
    uridata ]
      where
        [[a :: n
    a,b :: n
    b],[c :: n
    c,d :: n
    d],[e :: n
    e,f :: n
    f]] = Transformation V2 n -> [[n]]
    forall (v :: * -> *) n.
    (Additive v, Traversable v, Num n) =>
    Transformation v n -> [[n]]
    matrixHomRep (Transformation V2 n
    tr Transformation V2 n -> Transformation V2 n -> Transformation V2 n
    forall a. Monoid a => a -> a -> a
    `mappend` Transformation V2 n
    forall (v :: * -> *) n.
    (Additive v, R2 v, Num n) =>
    Transformation v n
    reflectionY
                                               Transformation V2 n -> Transformation V2 n -> Transformation V2 n
    forall a. Monoid a => a -> a -> a
    `mappend` Transformation V2 n
    tX Transformation V2 n -> Transformation V2 n -> Transformation V2 n
    forall a. Monoid a => a -> a -> a
    `mappend` Transformation V2 n
    tY)
        transformMatrix :: Text
    transformMatrix = n -> n -> n -> n -> n -> n -> Text
    forall a. RealFloat a => a -> a -> a -> a -> a -> a -> Text
    matrix n
    a n
    b n
    c n
    d n
    e n
    f
        tX :: Transformation V2 n
    tX = n -> Transformation V2 n
    forall (v :: * -> *) n.
    (Additive v, R1 v, Num n) =>
    n -> Transformation v n
    translationX (n -> Transformation V2 n) -> n -> Transformation V2 n
    forall a b. (a -> b) -> a -> b
    $ Int -> n
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (-Int
    w)n -> n -> n
    forall a. Fractional a => a -> a -> a
    /2
        tY :: Transformation V2 n
    tY = n -> Transformation V2 n
    forall (v :: * -> *) n.
    (Additive v, R2 v, Num n) =>
    n -> Transformation v n
    translationY (n -> Transformation V2 n) -> n -> Transformation V2 n
    forall a b. (a -> b) -> a -> b
    $ Int -> n
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (-Int
    h)n -> n -> n
    forall a. Fractional a => a -> a -> a
    /2

    renderText :: SVGFloat n => Text n -> Element
    renderText :: Text n -> Element
    renderText (Text tt :: T2 n
    tt tAlign :: TextAlignment n
    tAlign str :: String
    str) =
      [Attribute] -> Element -> Element
    forall result. Term result => [Attribute] -> result
    text_
        [ AttrTag
    Transform_ AttrTag -> Text -> Attribute
    <<- Text
    transformMatrix
        , AttrTag
    Dominant_baseline_ AttrTag -> Text -> Attribute
    <<- Text
    vAlign
        , AttrTag
    Text_anchor_ AttrTag -> Text -> Attribute
    <<- Text
    hAlign
        , AttrTag
    Stroke_ AttrTag -> Text -> Attribute
    <<- "none" ]
        (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $ String -> Element
    forall a. ToElement a => a -> Element
    toElement String
    str
     where
      vAlign :: Text
    vAlign = case TextAlignment n
    tAlign of
                 BaselineText -> "alphabetic"
                 BoxAlignedText _ h :: n
    h -> case n
    h of -- A mere approximation
                   h' :: n
    h' | n
    h' n -> n -> Bool
    forall a. Ord a => a -> a -> Bool
    <= 0.25 -> "text-after-edge"
                   h' :: n
    h' | n
    h' n -> n -> Bool
    forall a. Ord a => a -> a -> Bool
    >= 0.75 -> "text-before-edge"
                   _ -> "middle"
      hAlign :: Text
    hAlign = case TextAlignment n
    tAlign of
                 BaselineText -> "start"
                 BoxAlignedText w :: n
    w _ -> case n
    w of -- A mere approximation
                   w' :: n
    w' | n
    w' n -> n -> Bool
    forall a. Ord a => a -> a -> Bool
    <= 0.25 -> "start"
                   w' :: n
    w' | n
    w' n -> n -> Bool
    forall a. Ord a => a -> a -> Bool
    >= 0.75 -> "end"
                   _ -> "middle"
      t :: T2 n
    t                   = T2 n
    tt T2 n -> T2 n -> T2 n
    forall a. Monoid a => a -> a -> a
    `mappend` T2 n
    forall (v :: * -> *) n.
    (Additive v, R2 v, Num n) =>
    Transformation v n
    reflectionY
      [[a :: n
    a,b :: n
    b],[c :: n
    c,d :: n
    d],[e :: n
    e,f :: n
    f]] = T2 n -> [[n]]
    forall (v :: * -> *) n.
    (Additive v, Traversable v, Num n) =>
    Transformation v n -> [[n]]
    matrixHomRep T2 n
    t
      transformMatrix :: Text
    transformMatrix     = n -> n -> n -> n -> n -> n -> Text
    forall a. RealFloat a => a -> a -> a -> a -> a -> a -> Text
    matrix n
    a n
    b n
    c n
    d n
    e n
    f

    renderStyles :: SVGFloat n => Int -> Int -> Style v n -> [Attribute]
    renderStyles :: Int -> Int -> Style v n -> [Attribute]
    renderStyles fillId :: Int
    fillId lineId :: Int
    lineId s :: Style v n
    s = ((Style v n -> [Attribute]) -> [Attribute])
    -> [Style v n -> [Attribute]] -> [Attribute]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap ((Style v n -> [Attribute]) -> Style v n -> [Attribute]
    forall a b. (a -> b) -> a -> b
    $ Style v n
    s) ([Style v n -> [Attribute]] -> [Attribute])
    -> [Style v n -> [Attribute]] -> [Attribute]
    forall a b. (a -> b) -> a -> b
    $
      [ Int -> Style v n -> [Attribute]
    forall n (v :: * -> *).
    SVGFloat n =>
    Int -> Style v n -> [Attribute]
    renderLineTexture Int
    lineId
      , Int -> Style v n -> [Attribute]
    forall n (v :: * -> *).
    SVGFloat n =>
    Int -> Style v n -> [Attribute]
    renderFillTexture Int
    fillId
      , Style v n -> [Attribute]
    forall n (v :: * -> *). SVGFloat n => Style v n -> [Attribute]
    renderLineWidth
      , Style v n -> [Attribute]
    forall (v :: * -> *) n. Style v n -> [Attribute]
    renderLineCap
      , Style v n -> [Attribute]
    forall (v :: * -> *) n. Style v n -> [Attribute]
    renderLineJoin
      , Style v n -> [Attribute]
    forall (v :: * -> *) n. Style v n -> [Attribute]
    renderFillRule
      , Style v n -> [Attribute]
    forall n (v :: * -> *). SVGFloat n => Style v n -> [Attribute]
    renderDashing
      , Style v n -> [Attribute]
    forall (v :: * -> *) n. Style v n -> [Attribute]
    renderOpacity
      , Style v n -> [Attribute]
    forall n (v :: * -> *). SVGFloat n => Style v n -> [Attribute]
    renderFontSize
      , Style v n -> [Attribute]
    forall (v :: * -> *) n. Style v n -> [Attribute]
    renderFontSlant
      , Style v n -> [Attribute]
    forall (v :: * -> *) n. Style v n -> [Attribute]
    renderFontWeight
      , Style v n -> [Attribute]
    forall (v :: * -> *) n. Style v n -> [Attribute]
    renderFontFamily
      , Style v n -> [Attribute]
    forall (v :: * -> *) n. Style v n -> [Attribute]
    renderMiterLimit ]

    renderMiterLimit :: Style v n -> [Attribute]
    renderMiterLimit :: Style v n -> [Attribute]
    renderMiterLimit s :: Style v n
    s = AttrTag -> Maybe Double -> [Attribute]
    forall s. Show s => AttrTag -> Maybe s -> [Attribute]
    renderAttr AttrTag
    Stroke_miterlimit_ Maybe Double
    miterLimit
     where miterLimit :: Maybe Double
    miterLimit = LineMiterLimit -> Double
    getLineMiterLimit (LineMiterLimit -> Double) -> Maybe LineMiterLimit -> Maybe Double
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Style v n -> Maybe LineMiterLimit
    forall a (v :: * -> *) n. AttributeClass a => Style v n -> Maybe a
    getAttr Style v n
    s

    renderOpacity :: Style v n -> [Attribute]
    renderOpacity :: Style v n -> [Attribute]
    renderOpacity s :: Style v n
    s = AttrTag -> Maybe Double -> [Attribute]
    forall s. Show s => AttrTag -> Maybe s -> [Attribute]
    renderAttr AttrTag
    Opacity_ Maybe Double
    o
     where o :: Maybe Double
    o = Opacity -> Double
    getOpacity (Opacity -> Double) -> Maybe Opacity -> Maybe Double
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Style v n -> Maybe Opacity
    forall a (v :: * -> *) n. AttributeClass a => Style v n -> Maybe a
    getAttr Style v n
    s

    renderFillRule :: Style v n -> [Attribute]
    renderFillRule :: Style v n -> [Attribute]
    renderFillRule s :: Style v n
    s = AttrTag -> Maybe Text -> [Attribute]
    renderTextAttr AttrTag
    Fill_rule_ Maybe Text
    fr
      where fr :: Maybe Text
    fr = (FillRule -> Text
    fillRuleToText (FillRule -> Text) -> (FillRule -> FillRule) -> FillRule -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FillRule -> FillRule
    getFillRule) (FillRule -> Text) -> Maybe FillRule -> Maybe Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Style v n -> Maybe FillRule
    forall a (v :: * -> *) n. AttributeClass a => Style v n -> Maybe a
    getAttr Style v n
    s
            fillRuleToText :: FillRule -> AttributeValue
            fillRuleToText :: FillRule -> Text
    fillRuleToText Winding = "nonzero"
            fillRuleToText EvenOdd = "evenodd"

    renderLineWidth :: SVGFloat n => Style v n -> [Attribute]
    renderLineWidth :: Style v n -> [Attribute]
    renderLineWidth s :: Style v n
    s = AttrTag -> Maybe n -> [Attribute]
    forall s. Show s => AttrTag -> Maybe s -> [Attribute]
    renderAttr AttrTag
    Stroke_width_ Maybe n
    lWidth
      where lWidth :: Maybe n
    lWidth = (LineWidth n -> n) -> Style v n -> Maybe n
    forall (a :: * -> *) n t (v :: * -> *).
    AttributeClass (a n) =>
    (a n -> t) -> Style v n -> Maybe t
    getNumAttr LineWidth n -> n
    forall n. LineWidth n -> n
    getLineWidth Style v n
    s

    renderLineCap :: Style v n -> [Attribute]
    renderLineCap :: Style v n -> [Attribute]
    renderLineCap s :: Style v n
    s = AttrTag -> Maybe Text -> [Attribute]
    renderTextAttr AttrTag
    Stroke_linecap_ Maybe Text
    lCap
      where lCap :: Maybe Text
    lCap = (LineCap -> Text
    lineCapToText (LineCap -> Text) -> (LineCap -> LineCap) -> LineCap -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LineCap -> LineCap
    getLineCap) (LineCap -> Text) -> Maybe LineCap -> Maybe Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Style v n -> Maybe LineCap
    forall a (v :: * -> *) n. AttributeClass a => Style v n -> Maybe a
    getAttr Style v n
    s
            lineCapToText :: LineCap -> AttributeValue
            lineCapToText :: LineCap -> Text
    lineCapToText LineCapButt   = "butt"
            lineCapToText LineCapRound  = "round"
            lineCapToText LineCapSquare = "square"

    renderLineJoin :: Style v n -> [Attribute]
    renderLineJoin :: Style v n -> [Attribute]
    renderLineJoin s :: Style v n
    s = AttrTag -> Maybe Text -> [Attribute]
    renderTextAttr AttrTag
    Stroke_linejoin_ Maybe Text
    lj
      where lj :: Maybe Text
    lj = (LineJoin -> Text
    lineJoinToText (LineJoin -> Text) -> (LineJoin -> LineJoin) -> LineJoin -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LineJoin -> LineJoin
    getLineJoin) (LineJoin -> Text) -> Maybe LineJoin -> Maybe Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Style v n -> Maybe LineJoin
    forall a (v :: * -> *) n. AttributeClass a => Style v n -> Maybe a
    getAttr Style v n
    s
            lineJoinToText :: LineJoin -> AttributeValue
            lineJoinToText :: LineJoin -> Text
    lineJoinToText LineJoinMiter = "miter"
            lineJoinToText LineJoinRound = "round"
            lineJoinToText LineJoinBevel = "bevel"

    renderDashing :: SVGFloat n => Style v n -> [Attribute]
    renderDashing :: Style v n -> [Attribute]
    renderDashing s :: Style v n
    s = AttrTag -> Maybe Text -> [Attribute]
    renderTextAttr AttrTag
    Stroke_dasharray_ Maybe Text
    arr [Attribute] -> [Attribute] -> [Attribute]
    forall a. Semigroup a => a -> a -> a
    <>
                      AttrTag -> Maybe n -> [Attribute]
    forall s. Show s => AttrTag -> Maybe s -> [Attribute]
    renderAttr AttrTag
    Stroke_dashoffset_ Maybe n
    dOffset
     where
      getDasharray :: Dashing n -> [n]
    getDasharray  (Dashing a :: [n]
    a _) = [n]
    a
      getDashoffset :: Dashing n -> n
    getDashoffset (Dashing _ o :: n
    o) = n
    o
      dashArrayToStr :: [n] -> String
    dashArrayToStr = String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate "," ([String] -> String) -> ([n] -> [String]) -> [n] -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (n -> String) -> [n] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map n -> String
    forall a. Show a => a -> String
    show
      -- Ignore dashing if dashing array is empty
      checkEmpty :: Maybe (Dashing n) -> Maybe (Dashing n)
    checkEmpty (Just (Dashing [] _)) = Maybe (Dashing n)
    forall a. Maybe a
    Nothing
      checkEmpty other :: Maybe (Dashing n)
    other = Maybe (Dashing n)
    other
      dashing' :: Maybe (Dashing n)
    dashing' = Maybe (Dashing n) -> Maybe (Dashing n)
    forall n. Maybe (Dashing n) -> Maybe (Dashing n)
    checkEmpty (Maybe (Dashing n) -> Maybe (Dashing n))
    -> Maybe (Dashing n) -> Maybe (Dashing n)
    forall a b. (a -> b) -> a -> b
    $ (Dashing n -> Dashing n) -> Style v n -> Maybe (Dashing n)
    forall (a :: * -> *) n t (v :: * -> *).
    AttributeClass (a n) =>
    (a n -> t) -> Style v n -> Maybe t
    getNumAttr Dashing n -> Dashing n
    forall n. Dashing n -> Dashing n
    getDashing Style v n
    s
      arr :: Maybe Text
    arr = (String -> Text
    pack (String -> Text) -> (Dashing n -> String) -> Dashing n -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [n] -> String
    dashArrayToStr ([n] -> String) -> (Dashing n -> [n]) -> Dashing n -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Dashing n -> [n]
    forall n. Dashing n -> [n]
    getDasharray) (Dashing n -> Text) -> Maybe (Dashing n) -> Maybe Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe (Dashing n)
    dashing'
      dOffset :: Maybe n
    dOffset = Dashing n -> n
    forall n. Dashing n -> n
    getDashoffset (Dashing n -> n) -> Maybe (Dashing n) -> Maybe n
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe (Dashing n)
    dashing'

    renderFontSize :: SVGFloat n => Style v n -> [Attribute]
    renderFontSize :: Style v n -> [Attribute]
    renderFontSize s :: Style v n
    s = AttrTag -> Maybe Text -> [Attribute]
    renderTextAttr AttrTag
    Font_size_ Maybe Text
    fs
     where
      fs :: Maybe Text
    fs = String -> Text
    pack (String -> Text) -> Maybe String -> Maybe Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (FontSize n -> String) -> Style v n -> Maybe String
    forall (a :: * -> *) n t (v :: * -> *).
    AttributeClass (a n) =>
    (a n -> t) -> Style v n -> Maybe t
    getNumAttr ((String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "px") (String -> String)
    -> (FontSize n -> String) -> FontSize n -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . n -> String
    forall a. Show a => a -> String
    show (n -> String) -> (FontSize n -> n) -> FontSize n -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FontSize n -> n
    forall n. FontSize n -> n
    getFontSize) Style v n
    s

    renderFontSlant :: Style v n -> [Attribute]
    renderFontSlant :: Style v n -> [Attribute]
    renderFontSlant s :: Style v n
    s = AttrTag -> Maybe Text -> [Attribute]
    renderTextAttr AttrTag
    Font_style_ Maybe Text
    fs
     where
      fs :: Maybe Text
    fs = (FontSlant -> Text
    fontSlantAttr (FontSlant -> Text)
    -> (FontSlant -> FontSlant) -> FontSlant -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FontSlant -> FontSlant
    getFontSlant) (FontSlant -> Text) -> Maybe FontSlant -> Maybe Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Style v n -> Maybe FontSlant
    forall a (v :: * -> *) n. AttributeClass a => Style v n -> Maybe a
    getAttr Style v n
    s
      fontSlantAttr :: FontSlant -> AttributeValue
      fontSlantAttr :: FontSlant -> Text
    fontSlantAttr FontSlantItalic  = "italic"
      fontSlantAttr FontSlantOblique = "oblique"
      fontSlantAttr FontSlantNormal  = "normal"

    renderFontWeight :: Style v n -> [Attribute]
    renderFontWeight :: Style v n -> [Attribute]
    renderFontWeight s :: Style v n
    s = AttrTag -> Maybe Text -> [Attribute]
    renderTextAttr AttrTag
    Font_weight_ Maybe Text
    fw
     where
      fw :: Maybe Text
    fw = (FontWeight -> Text
    fontWeightAttr (FontWeight -> Text)
    -> (FontWeight -> FontWeight) -> FontWeight -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FontWeight -> FontWeight
    getFontWeight) (FontWeight -> Text) -> Maybe FontWeight -> Maybe Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Style v n -> Maybe FontWeight
    forall a (v :: * -> *) n. AttributeClass a => Style v n -> Maybe a
    getAttr Style v n
    s
      fontWeightAttr :: FontWeight -> AttributeValue
      fontWeightAttr :: FontWeight -> Text
    fontWeightAttr FontWeightNormal = "normal"
      fontWeightAttr FontWeightBold   = "bold"
      fontWeightAttr FontWeightLighter = "lighter"
      fontWeightAttr FontWeightBolder  = "bolder"
      fontWeightAttr FontWeightThin = "100"
      fontWeightAttr FontWeightUltraLight = "200"
      fontWeightAttr FontWeightLight = "300"
      fontWeightAttr FontWeightMedium = "400"
      fontWeightAttr FontWeightSemiBold = "600"
      fontWeightAttr FontWeightUltraBold = "800"
      fontWeightAttr FontWeightHeavy = "900"

    renderFontFamily :: Style v n -> [Attribute]
    renderFontFamily :: Style v n -> [Attribute]
    renderFontFamily s :: Style v n
    s = AttrTag -> Maybe Text -> [Attribute]
    renderTextAttr AttrTag
    Font_family_ Maybe Text
    ff
     where
      ff :: Maybe Text
    ff = (String -> Text
    pack (String -> Text) -> (Font -> String) -> Font -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Font -> String
    getFont) (Font -> Text) -> Maybe Font -> Maybe Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Style v n -> Maybe Font
    forall a (v :: * -> *) n. AttributeClass a => Style v n -> Maybe a
    getAttr Style v n
    s

    -- | Render a style attribute if available, empty otherwise.
    renderAttr :: Show s => AttrTag -> Maybe s -> [Attribute]
    renderAttr :: AttrTag -> Maybe s -> [Attribute]
    renderAttr attr :: AttrTag
    attr valM :: Maybe s
    valM = [Attribute] -> (s -> [Attribute]) -> Maybe s -> [Attribute]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [] (\v :: s
    v -> [(AttrTag -> Text -> Attribute
    bindAttr AttrTag
    attr) (String -> Text
    pack (String -> Text) -> (s -> String) -> s -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . s -> String
    forall a. Show a => a -> String
    show (s -> Text) -> s -> Text
    forall a b. (a -> b) -> a -> b
    $ s
    v)]) Maybe s
    valM

    -- renderTextAttr :: (AttributeValue -> Attribute) -> Maybe AttributeValue -> [Attribute]
    renderTextAttr :: AttrTag -> Maybe AttributeValue -> [Attribute]
    renderTextAttr :: AttrTag -> Maybe Text -> [Attribute]
    renderTextAttr attr :: AttrTag
    attr valM :: Maybe Text
    valM = [Attribute] -> (Text -> [Attribute]) -> Maybe Text -> [Attribute]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [] (\v :: Text
    v -> [(AttrTag -> Text -> Attribute
    bindAttr AttrTag
    attr) Text
    v]) Maybe Text
    valM

    colorToRgbText :: forall c . Color c => c -> AttributeValue
    colorToRgbText :: c -> Text
    colorToRgbText c :: c
    c = [Text] -> Text
    T.concat
      [ "rgb("
      , Double -> Text
    forall a. RealFrac a => a -> Text
    int Double
    r, ","
      , Double -> Text
    forall a. RealFrac a => a -> Text
    int Double
    g, ","
      , Double -> Text
    forall a. RealFrac a => a -> Text
    int Double
    b
      , ")" ]
     where
       int :: a -> Text
    int d :: a
    d     = String -> Text
    pack (String -> Text) -> (Int -> String) -> Int -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> String
    forall a. Show a => a -> String
    show (Int -> Text) -> Int -> Text
    forall a b. (a -> b) -> a -> b
    $ (a -> Int
    forall a b. (RealFrac a, Integral b) => a -> b
    round (a
    d a -> a -> a
    forall a. Num a => a -> a -> a
    * 255) :: Int)
       (r :: Double
    r,g :: Double
    g,b :: Double
    b,_) = c -> (Double, Double, Double, Double)
    forall c. Color c => c -> (Double, Double, Double, Double)
    colorToSRGBA c
    c

    colorToOpacity :: forall c . Color c => c -> Double
    colorToOpacity :: c -> Double
    colorToOpacity c :: c
    c = Double
    a
     where (_,_,_,a :: Double
    a) = c -> (Double, Double, Double, Double)
    forall c. Color c => c -> (Double, Double, Double, Double)
    colorToSRGBA c
    c