    {-# 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 :: forall (a :: * -> *) n t (v :: * -> *).
    AttributeClass (a n) =>
    (a n -> t) -> Style v n -> Maybe t
    getNumAttr 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 :: forall n.
    SVGFloat n =>
    n
    -> n -> Maybe Element -> [Attribute] -> Bool -> Element -> Element
    svgHeader n
    w n
    h Maybe Element
    defines [Attribute]
    attributes Bool
    genDoctype 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 -> AttributeValue -> Attribute
    <<- n -> AttributeValue
    forall a. RealFloat a => a -> AttributeValue
    toText n
    w
         , AttrTag
    Height_ AttrTag -> AttributeValue -> Attribute
    <<- n -> AttributeValue
    forall a. RealFloat a => a -> AttributeValue
    toText n
    h
         , AttrTag
    Font_size_ AttrTag -> AttributeValue -> Attribute
    <<- AttributeValue
    "1"
         , AttrTag
    ViewBox_ AttrTag -> AttributeValue -> Attribute
    <<- ([Char] -> AttributeValue
    pack ([Char] -> AttributeValue)
    -> ([[Char]] -> [Char]) -> [[Char]] -> AttributeValue
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [[Char]] -> [Char]
    unwords ([[Char]] -> AttributeValue) -> [[Char]] -> AttributeValue
    forall a b. (a -> b) -> a -> b
    $ (n -> [Char]) -> [n] -> [[Char]]
    forall a b. (a -> b) -> [a] -> [b]
    map n -> [Char]
    forall a. Show a => a -> [Char]
    show [n
    0, n
    0, n
    w, n
    h])
         , AttrTag
    Stroke_ AttrTag -> AttributeValue -> Attribute
    <<- AttributeValue
    "rgb(0,0,0)"
         , AttrTag
    Stroke_opacity_ AttrTag -> AttributeValue -> Attribute
    <<- AttributeValue
    "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 :: forall n. SVGFloat n => Path V2 n -> Element
    renderPath Path V2 n
    trs = if AttributeValue
    makePath AttributeValue -> AttributeValue -> Bool
    forall a. Eq a => a -> a -> Bool
    == AttributeValue
    T.empty then Element
    forall a. Monoid a => a
    mempty else [Attribute] -> Element
    forall result. Term result => [Attribute] -> result
    path_ [AttrTag
    D_ AttrTag -> AttributeValue -> Attribute
    <<- AttributeValue
    makePath]
      where
        makePath :: AttributeValue
    makePath = (Located (Trail V2 n) -> AttributeValue)
    -> [Located (Trail V2 n)] -> AttributeValue
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap Located (Trail V2 n) -> AttributeValue
    forall n. SVGFloat n => Located (Trail V2 n) -> AttributeValue
    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 [Located (Trail V2 n)] -> Path V2 n
    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 :: forall n. SVGFloat n => Located (Trail V2 n) -> AttributeValue
    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 n
    x n
    y), Trail V2 n
    t)) =
      n -> n -> AttributeValue
    forall a. RealFloat a => a -> a -> AttributeValue
    mA n
    x n
    y AttributeValue -> AttributeValue -> AttributeValue
    forall a. Semigroup a => a -> a -> a
    <> (Trail' Line V2 n -> AttributeValue)
    -> (Trail' Loop V2 n -> AttributeValue)
    -> Trail V2 n
    -> AttributeValue
    forall (v :: * -> *) n r.
    (Trail' Line v n -> r) -> (Trail' Loop v n -> r) -> Trail v n -> r
    withTrail Trail' Line V2 n -> AttributeValue
    renderLine Trail' Loop V2 n -> AttributeValue
    forall {n}.
    (Show n, Typeable n, RealFloat n) =>
    Trail' Loop V2 n -> AttributeValue
    renderLoop Trail V2 n
    t
      where
        renderLine :: Trail' Line V2 n -> AttributeValue
    renderLine = (Segment Closed V2 n -> AttributeValue)
    -> [Segment Closed V2 n] -> AttributeValue
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap Segment Closed V2 n -> AttributeValue
    forall n. SVGFloat n => Segment Closed V2 n -> AttributeValue
    renderSeg ([Segment Closed V2 n] -> AttributeValue)
    -> (Trail' Line V2 n -> [Segment Closed V2 n])
    -> Trail' Line V2 n
    -> AttributeValue
    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 -> AttributeValue
    renderLoop 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
            ([Segment Closed V2 n]
    segs, Linear Offset Open V2 n
    _) -> (Segment Closed V2 n -> AttributeValue)
    -> [Segment Closed V2 n] -> AttributeValue
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap Segment Closed V2 n -> AttributeValue
    forall n. SVGFloat n => Segment Closed V2 n -> AttributeValue
    renderSeg [Segment Closed V2 n]
    segs

            -- otherwise we have to emit it explicitly
            ([Segment Closed V2 n], Segment Open V2 n)
    _ -> (Segment Closed V2 n -> AttributeValue)
    -> [Segment Closed V2 n] -> AttributeValue
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap Segment Closed V2 n -> AttributeValue
    forall n. SVGFloat n => Segment Closed V2 n -> AttributeValue
    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)
          AttributeValue -> AttributeValue -> AttributeValue
    forall a. Semigroup a => a -> a -> a
    <> AttributeValue
    z

    renderSeg :: SVGFloat n => Segment Closed V2 n -> AttributeValue
    renderSeg :: forall n. SVGFloat n => Segment Closed V2 n -> AttributeValue
    renderSeg (Linear (OffsetClosed (V2 n
    x n
    0))) = n -> AttributeValue
    forall a. RealFloat a => a -> AttributeValue
    hR n
    x
    renderSeg (Linear (OffsetClosed (V2 n
    0 n
    y))) = n -> AttributeValue
    forall a. RealFloat a => a -> AttributeValue
    vR n
    y
    renderSeg (Linear (OffsetClosed (V2 n
    x n
    y))) = n -> n -> AttributeValue
    forall a. RealFloat a => a -> a -> AttributeValue
    lR n
    x n
    y
    renderSeg (Cubic  (V2 n
    x0 n
    y0)
                      (V2 n
    x1 n
    y1)
                      (OffsetClosed (V2 n
    x2 n
    y2))) = n -> n -> n -> n -> n -> n -> AttributeValue
    forall a.
    RealFloat a =>
    a -> a -> a -> a -> a -> a -> AttributeValue
    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 :: forall n.
    SVGFloat n =>
    Path V2 n -> AttributeValue -> Int -> Element -> Element
    renderClip Path V2 n
    p AttributeValue
    prefix Int
    ident 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 -> AttributeValue -> Attribute
    <<- (Int -> AttributeValue
    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 -> AttributeValue -> Attribute
    <<- (AttributeValue
    "url(#" AttributeValue -> AttributeValue -> AttributeValue
    forall a. Semigroup a => a -> a -> a
    <> Int -> AttributeValue
    clipPathId Int
    ident AttributeValue -> AttributeValue -> AttributeValue
    forall a. Semigroup a => a -> a -> a
    <> AttributeValue
    ")")] Element
    svg
        where
          clipPathId :: Int -> AttributeValue
    clipPathId Int
    i = AttributeValue
    prefix AttributeValue -> AttributeValue -> AttributeValue
    forall a. Semigroup a => a -> a -> a
    <> AttributeValue
    "myClip" AttributeValue -> AttributeValue -> AttributeValue
    forall a. Semigroup a => a -> a -> a
    <> ([Char] -> AttributeValue
    pack ([Char] -> AttributeValue)
    -> (Int -> [Char]) -> Int -> AttributeValue
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> [Char]
    forall a. Show a => a -> [Char]
    show (Int -> AttributeValue) -> Int -> AttributeValue
    forall a b. (a -> b) -> a -> b
    $ Int
    i)

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

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

    renderLinearGradient :: SVGFloat n => LGradient n -> Int -> Element
    renderLinearGradient :: forall n. SVGFloat n => LGradient n -> Int -> Element
    renderLinearGradient LGradient n
    g Int
    i = [Attribute] -> Element -> Element
    forall result. Term result => [Attribute] -> result
    linearGradient_
        [ AttrTag
    Id_ AttrTag -> AttributeValue -> Attribute
    <<- ([Char] -> AttributeValue
    pack ([Char] -> AttributeValue) -> [Char] -> AttributeValue
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "gradient" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    i)
        , AttrTag
    X1_ AttrTag -> AttributeValue -> Attribute
    <<- n -> AttributeValue
    forall a. RealFloat a => a -> AttributeValue
    toText n
    x1
        , AttrTag
    Y1_ AttrTag -> AttributeValue -> Attribute
    <<- n -> AttributeValue
    forall a. RealFloat a => a -> AttributeValue
    toText n
    y1
        , AttrTag
    X2_ AttrTag -> AttributeValue -> Attribute
    <<- n -> AttributeValue
    forall a. RealFloat a => a -> AttributeValue
    toText n
    x2
        , AttrTag
    Y2_ AttrTag -> AttributeValue -> Attribute
    <<- n -> AttributeValue
    forall a. RealFloat a => a -> AttributeValue
    toText n
    y2
        , AttrTag
    GradientTransform_ AttrTag -> AttributeValue -> Attribute
    <<- AttributeValue
    mx
        , AttrTag
    GradientUnits_ AttrTag -> AttributeValue -> Attribute
    <<- AttributeValue
    "userSpaceOnUse"
        , AttrTag
    SpreadMethod_ AttrTag -> AttributeValue -> Attribute
    <<- SpreadMethod -> AttributeValue
    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 (f :: * -> *).
    Functor f =>
    (SpreadMethod -> f SpreadMethod) -> LGradient n -> f (LGradient n)
    lGradSpreadMethod) ]
        (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $ (GradientStop n -> Element) -> [GradientStop n] -> Element
    forall m a. Monoid m => (a -> m) -> [a] -> m
    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 (f :: * -> *).
    Functor f =>
    ([GradientStop n] -> f [GradientStop n])
    -> LGradient n -> f (LGradient n)
    lGradStops)
      where
        mx :: AttributeValue
    mx = n -> n -> n -> n -> n -> n -> AttributeValue
    forall a.
    RealFloat a =>
    a -> a -> a -> a -> a -> a -> AttributeValue
    matrix n
    a1 n
    a2 n
    b1 n
    b2 n
    c1 n
    c2
        [[n
    a1, n
    a2], [n
    b1, n
    b2], [n
    c1, 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 (f :: * -> *).
    Functor f =>
    (Transformation V2 n -> f (Transformation V2 n))
    -> LGradient n -> f (LGradient n)
    lGradTrans)
        P (V2 n
    x1 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 (f :: * -> *).
    Functor f =>
    (Point V2 n -> f (Point V2 n)) -> LGradient n -> f (LGradient n)
    lGradStart
        P (V2 n
    x2 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 (f :: * -> *).
    Functor f =>
    (Point V2 n -> f (Point V2 n)) -> LGradient n -> f (LGradient n)
    lGradEnd

    renderRadialGradient :: SVGFloat n => RGradient n -> Int -> Element
    renderRadialGradient :: forall n. SVGFloat n => RGradient n -> Int -> Element
    renderRadialGradient RGradient n
    g Int
    i = [Attribute] -> Element -> Element
    forall result. Term result => [Attribute] -> result
    radialGradient_
        [ AttrTag
    Id_ AttrTag -> AttributeValue -> Attribute
    <<- ([Char] -> AttributeValue
    pack ([Char] -> AttributeValue) -> [Char] -> AttributeValue
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "gradient" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    i)
        , AttrTag
    R_  AttrTag -> AttributeValue -> Attribute
    <<- n -> AttributeValue
    forall a. RealFloat a => a -> AttributeValue
    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 (f :: * -> *).
    Functor f =>
    (n -> f n) -> RGradient n -> f (RGradient n)
    rGradRadius1)
        , AttrTag
    Cx_ AttrTag -> AttributeValue -> Attribute
    <<- n -> AttributeValue
    forall a. RealFloat a => a -> AttributeValue
    toText n
    cx
        , AttrTag
    Cy_ AttrTag -> AttributeValue -> Attribute
    <<- n -> AttributeValue
    forall a. RealFloat a => a -> AttributeValue
    toText n
    cy
        , AttrTag
    Fx_ AttrTag -> AttributeValue -> Attribute
    <<- n -> AttributeValue
    forall a. RealFloat a => a -> AttributeValue
    toText n
    fx
        , AttrTag
    Fy_ AttrTag -> AttributeValue -> Attribute
    <<- n -> AttributeValue
    forall a. RealFloat a => a -> AttributeValue
    toText n
    fy
        , AttrTag
    GradientTransform_ AttrTag -> AttributeValue -> Attribute
    <<- AttributeValue
    mx
        , AttrTag
    GradientUnits_ AttrTag -> AttributeValue -> Attribute
    <<- AttributeValue
    "userSpaceOnUse"
        , AttrTag
    SpreadMethod_ AttrTag -> AttributeValue -> Attribute
    <<- SpreadMethod -> AttributeValue
    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 (f :: * -> *).
    Functor f =>
    (SpreadMethod -> f SpreadMethod) -> RGradient n -> f (RGradient n)
    rGradSpreadMethod) ]
        ( (GradientStop n -> Element) -> [GradientStop n] -> Element
    forall m a. Monoid m => (a -> m) -> [a] -> m
    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 :: AttributeValue
    mx = n -> n -> n -> n -> n -> n -> AttributeValue
    forall a.
    RealFloat a =>
    a -> a -> a -> a -> a -> a -> AttributeValue
    matrix n
    a1 n
    a2 n
    b1 n
    b2 n
    c1 n
    c2
        [[n
    a1, n
    a2], [n
    b1, n
    b2], [n
    c1, 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 (f :: * -> *).
    Functor f =>
    (Transformation V2 n -> f (Transformation V2 n))
    -> RGradient n -> f (RGradient n)
    rGradTrans)
        P (V2 n
    cx 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 (f :: * -> *).
    Functor f =>
    (Point V2 n -> f (Point V2 n)) -> RGradient n -> f (RGradient n)
    rGradCenter1
        P (V2 n
    fx 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 (f :: * -> *).
    Functor f =>
    (Point V2 n -> f (Point V2 n)) -> RGradient n -> f (RGradient 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 (f :: * -> *).
    Functor f =>
    (n -> f n) -> RGradient n -> f (RGradient 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 (f :: * -> *).
    Functor f =>
    (n -> f n) -> RGradient n -> f (RGradient 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 (\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 (f :: * -> *).
    Functor f =>
    (n -> f n) -> GradientStop n -> f (GradientStop 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 (f :: * -> *).
    Functor f =>
    ([GradientStop n] -> f [GradientStop n])
    -> RGradient n -> f (RGradient 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 (f :: * -> *).
    Functor f =>
    ([GradientStop n] -> f [GradientStop n])
    -> RGradient n -> f (RGradient n)
    rGradStops of
          []       -> []
          xs :: [GradientStop n]
    xs@(GradientStop n
    x:[GradientStop n]
    _) -> 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 (\GradientStop n
    gs 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 (f :: * -> *).
    Functor f =>
    (n -> f n) -> GradientStop n -> f (GradientStop 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 :: forall n (v :: * -> *). SVGFloat n => Int -> Style v n -> Element
    renderFillTextureDefs Int
    i 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 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 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
        Maybe (Texture n)
    _           -> 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 :: forall n (v :: * -> *).
    SVGFloat n =>
    Int -> Style v n -> [Attribute]
    renderFillTexture Int
    ident 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)) -> AttrTag -> Maybe AttributeValue -> [Attribute]
    renderTextAttr AttrTag
    Fill_ Maybe AttributeValue
    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 AttributeValue
    fillColorRgb     = AttributeValue -> Maybe AttributeValue
    forall a. a -> Maybe a
    Just (AttributeValue -> Maybe AttributeValue)
    -> AttributeValue -> Maybe AttributeValue
    forall a b. (a -> b) -> a -> b
    $ c -> AttributeValue
    forall c. Color c => c -> AttributeValue
    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 LGradient n
    _) -> [AttrTag
    Fill_ AttrTag -> AttributeValue -> Attribute
    <<- (AttributeValue
    "url(#gradient" AttributeValue -> AttributeValue -> AttributeValue
    forall a. Semigroup a => a -> a -> a
    <> ([Char] -> AttributeValue
    pack ([Char] -> AttributeValue)
    -> (Int -> [Char]) -> Int -> AttributeValue
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> [Char]
    forall a. Show a => a -> [Char]
    show (Int -> AttributeValue) -> Int -> AttributeValue
    forall a b. (a -> b) -> a -> b
    $ Int
    ident)
                                                 AttributeValue -> AttributeValue -> AttributeValue
    forall a. Semigroup a => a -> a -> a
    <> AttributeValue
    ")"), AttrTag
    Fill_opacity_ AttrTag -> AttributeValue -> Attribute
    <<- AttributeValue
    "1"]
      Just (RG RGradient n
    _) -> [AttrTag
    Fill_ AttrTag -> AttributeValue -> Attribute
    <<- (AttributeValue
    "url(#gradient" AttributeValue -> AttributeValue -> AttributeValue
    forall a. Semigroup a => a -> a -> a
    <> ([Char] -> AttributeValue
    pack ([Char] -> AttributeValue)
    -> (Int -> [Char]) -> Int -> AttributeValue
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> [Char]
    forall a. Show a => a -> [Char]
    show (Int -> AttributeValue) -> Int -> AttributeValue
    forall a b. (a -> b) -> a -> b
    $ Int
    ident)
                                                 AttributeValue -> AttributeValue -> AttributeValue
    forall a. Semigroup a => a -> a -> a
    <> AttributeValue
    ")"), AttrTag
    Fill_opacity_ AttrTag -> AttributeValue -> Attribute
    <<- AttributeValue
    "1"]
      Maybe (Texture n)
    Nothing     -> []

    renderLineTextureDefs :: SVGFloat n => Int -> Style v n -> Element
    renderLineTextureDefs :: forall n (v :: * -> *). SVGFloat n => Int -> Style v n -> Element
    renderLineTextureDefs Int
    i 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 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 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
        Maybe (Texture n)
    _           -> Element
    forall a. Monoid a => a
    mempty

    renderLineTexture :: SVGFloat n => Int -> Style v n -> [Attribute]
    renderLineTexture :: forall n (v :: * -> *).
    SVGFloat n =>
    Int -> Style v n -> [Attribute]
    renderLineTexture Int
    ident 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)) -> AttrTag -> Maybe AttributeValue -> [Attribute]
    renderTextAttr AttrTag
    Stroke_ Maybe AttributeValue
    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 AttributeValue
    lineColorRgb     = AttributeValue -> Maybe AttributeValue
    forall a. a -> Maybe a
    Just (AttributeValue -> Maybe AttributeValue)
    -> AttributeValue -> Maybe AttributeValue
    forall a b. (a -> b) -> a -> b
    $ c -> AttributeValue
    forall c. Color c => c -> AttributeValue
    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 LGradient n
    _) -> [AttrTag
    Stroke_ AttrTag -> AttributeValue -> Attribute
    <<- (AttributeValue
    "url(#gradient" AttributeValue -> AttributeValue -> AttributeValue
    forall a. Semigroup a => a -> a -> a
    <> ([Char] -> AttributeValue
    pack ([Char] -> AttributeValue)
    -> (Int -> [Char]) -> Int -> AttributeValue
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> [Char]
    forall a. Show a => a -> [Char]
    show (Int -> AttributeValue) -> Int -> AttributeValue
    forall a b. (a -> b) -> a -> b
    $ Int
    ident)
                                                   AttributeValue -> AttributeValue -> AttributeValue
    forall a. Semigroup a => a -> a -> a
    <> AttributeValue
    ")"), AttrTag
    Stroke_opacity_ AttrTag -> AttributeValue -> Attribute
    <<- AttributeValue
    "1"]
      Just (RG RGradient n
    _) -> [AttrTag
    Stroke_ AttrTag -> AttributeValue -> Attribute
    <<- (AttributeValue
    "url(#gradient" AttributeValue -> AttributeValue -> AttributeValue
    forall a. Semigroup a => a -> a -> a
    <> ([Char] -> AttributeValue
    pack ([Char] -> AttributeValue)
    -> (Int -> [Char]) -> Int -> AttributeValue
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> [Char]
    forall a. Show a => a -> [Char]
    show (Int -> AttributeValue) -> Int -> AttributeValue
    forall a b. (a -> b) -> a -> b
    $ Int
    ident)
                                                   AttributeValue -> AttributeValue -> AttributeValue
    forall a. Semigroup a => a -> a -> a
    <> AttributeValue
    ")"), AttrTag
    Stroke_opacity_ AttrTag -> AttributeValue -> Attribute
    <<- AttributeValue
    "1"]
      Maybe (Texture n)
    Nothing     -> []

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

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

    renderDImage :: SVGFloat n => DImage n any -> AttributeValue -> Element
    renderDImage :: forall n any.
    SVGFloat n =>
    DImage n any -> AttributeValue -> Element
    renderDImage (DImage ImageData any
    _ Int
    w Int
    h Transformation V2 n
    tr) AttributeValue
    uridata =
      [Attribute] -> Element
    forall result. Term result => [Attribute] -> result
    image_
        [ AttrTag
    Transform_ AttrTag -> AttributeValue -> Attribute
    <<- AttributeValue
    transformMatrix
        , AttrTag
    Width_ AttrTag -> AttributeValue -> Attribute
    <<-  ([Char] -> AttributeValue
    pack ([Char] -> AttributeValue)
    -> (Int -> [Char]) -> Int -> AttributeValue
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> [Char]
    forall a. Show a => a -> [Char]
    show (Int -> AttributeValue) -> Int -> AttributeValue
    forall a b. (a -> b) -> a -> b
    $ Int
    w)
        , AttrTag
    Height_ AttrTag -> AttributeValue -> Attribute
    <<- ([Char] -> AttributeValue
    pack ([Char] -> AttributeValue)
    -> (Int -> [Char]) -> Int -> AttributeValue
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> [Char]
    forall a. Show a => a -> [Char]
    show (Int -> AttributeValue) -> Int -> AttributeValue
    forall a b. (a -> b) -> a -> b
    $ Int
    h)
        , AttrTag
    XlinkHref_ AttrTag -> AttributeValue -> Attribute
    <<- AttributeValue
    uridata ]
      where
        [[n
    a,n
    b],[n
    c,n
    d],[n
    e,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 :: AttributeValue
    transformMatrix = n -> n -> n -> n -> n -> n -> AttributeValue
    forall a.
    RealFloat a =>
    a -> a -> a -> a -> a -> a -> AttributeValue
    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
    /n
    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
    /n
    2

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

    renderStyles :: SVGFloat n => Int -> Int -> Style v n -> [Attribute]
    renderStyles :: forall n (v :: * -> *).
    SVGFloat n =>
    Int -> Int -> Style v n -> [Attribute]
    renderStyles Int
    fillId Int
    lineId 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 :: forall (v :: * -> *) n. Style v n -> [Attribute]
    renderMiterLimit 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 :: forall (v :: * -> *) n. Style v n -> [Attribute]
    renderOpacity 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 :: forall (v :: * -> *) n. Style v n -> [Attribute]
    renderFillRule Style v n
    s = AttrTag -> Maybe AttributeValue -> [Attribute]
    renderTextAttr AttrTag
    Fill_rule_ Maybe AttributeValue
    fr
      where fr :: Maybe AttributeValue
    fr = (FillRule -> AttributeValue
    fillRuleToText (FillRule -> AttributeValue)
    -> (FillRule -> FillRule) -> FillRule -> AttributeValue
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FillRule -> FillRule
    getFillRule) (FillRule -> AttributeValue)
    -> Maybe FillRule -> Maybe AttributeValue
    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 -> AttributeValue
    fillRuleToText FillRule
    Winding = AttributeValue
    "nonzero"
            fillRuleToText FillRule
    EvenOdd = AttributeValue
    "evenodd"

    renderLineWidth :: SVGFloat n => Style v n -> [Attribute]
    renderLineWidth :: forall n (v :: * -> *). SVGFloat n => Style v n -> [Attribute]
    renderLineWidth 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 :: forall (v :: * -> *) n. Style v n -> [Attribute]
    renderLineCap Style v n
    s = AttrTag -> Maybe AttributeValue -> [Attribute]
    renderTextAttr AttrTag
    Stroke_linecap_ Maybe AttributeValue
    lCap
      where lCap :: Maybe AttributeValue
    lCap = (LineCap -> AttributeValue
    lineCapToText (LineCap -> AttributeValue)
    -> (LineCap -> LineCap) -> LineCap -> AttributeValue
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LineCap -> LineCap
    getLineCap) (LineCap -> AttributeValue)
    -> Maybe LineCap -> Maybe AttributeValue
    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 -> AttributeValue
    lineCapToText LineCap
    LineCapButt   = AttributeValue
    "butt"
            lineCapToText LineCap
    LineCapRound  = AttributeValue
    "round"
            lineCapToText LineCap
    LineCapSquare = AttributeValue
    "square"

    renderLineJoin :: Style v n -> [Attribute]
    renderLineJoin :: forall (v :: * -> *) n. Style v n -> [Attribute]
    renderLineJoin Style v n
    s = AttrTag -> Maybe AttributeValue -> [Attribute]
    renderTextAttr AttrTag
    Stroke_linejoin_ Maybe AttributeValue
    lj
      where lj :: Maybe AttributeValue
    lj = (LineJoin -> AttributeValue
    lineJoinToText (LineJoin -> AttributeValue)
    -> (LineJoin -> LineJoin) -> LineJoin -> AttributeValue
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LineJoin -> LineJoin
    getLineJoin) (LineJoin -> AttributeValue)
    -> Maybe LineJoin -> Maybe AttributeValue
    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 -> AttributeValue
    lineJoinToText LineJoin
    LineJoinMiter = AttributeValue
    "miter"
            lineJoinToText LineJoin
    LineJoinRound = AttributeValue
    "round"
            lineJoinToText LineJoin
    LineJoinBevel = AttributeValue
    "bevel"

    renderDashing :: SVGFloat n => Style v n -> [Attribute]
    renderDashing :: forall n (v :: * -> *). SVGFloat n => Style v n -> [Attribute]
    renderDashing Style v n
    s = AttrTag -> Maybe AttributeValue -> [Attribute]
    renderTextAttr AttrTag
    Stroke_dasharray_ Maybe AttributeValue
    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 [n]
    a n
    _) = [n]
    a
      getDashoffset :: Dashing n -> n
    getDashoffset (Dashing [n]
    _ n
    o) = n
    o
      dashArrayToStr :: [n] -> [Char]
    dashArrayToStr = [Char] -> [[Char]] -> [Char]
    forall a. [a] -> [[a]] -> [a]
    intercalate [Char]
    "," ([[Char]] -> [Char]) -> ([n] -> [[Char]]) -> [n] -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (n -> [Char]) -> [n] -> [[Char]]
    forall a b. (a -> b) -> [a] -> [b]
    map n -> [Char]
    forall a. Show a => a -> [Char]
    show
      -- Ignore dashing if dashing array is empty
      checkEmpty :: Maybe (Dashing n) -> Maybe (Dashing n)
    checkEmpty (Just (Dashing [] n
    _)) = Maybe (Dashing n)
    forall a. Maybe a
    Nothing
      checkEmpty 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 AttributeValue
    arr = ([Char] -> AttributeValue
    pack ([Char] -> AttributeValue)
    -> (Dashing n -> [Char]) -> Dashing n -> AttributeValue
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [n] -> [Char]
    dashArrayToStr ([n] -> [Char]) -> (Dashing n -> [n]) -> Dashing n -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Dashing n -> [n]
    forall {n}. Dashing n -> [n]
    getDasharray) (Dashing n -> AttributeValue)
    -> Maybe (Dashing n) -> Maybe AttributeValue
    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 :: forall n (v :: * -> *). SVGFloat n => Style v n -> [Attribute]
    renderFontSize Style v n
    s = AttrTag -> Maybe AttributeValue -> [Attribute]
    renderTextAttr AttrTag
    Font_size_ Maybe AttributeValue
    fs
     where
      fs :: Maybe AttributeValue
    fs = [Char] -> AttributeValue
    pack ([Char] -> AttributeValue) -> Maybe [Char] -> Maybe AttributeValue
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (FontSize n -> [Char]) -> Style v n -> Maybe [Char]
    forall (a :: * -> *) n t (v :: * -> *).
    AttributeClass (a n) =>
    (a n -> t) -> Style v n -> Maybe t
    getNumAttr (([Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "px") ([Char] -> [Char])
    -> (FontSize n -> [Char]) -> FontSize n -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . n -> [Char]
    forall a. Show a => a -> [Char]
    show (n -> [Char]) -> (FontSize n -> n) -> FontSize n -> [Char]
    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 :: forall (v :: * -> *) n. Style v n -> [Attribute]
    renderFontSlant Style v n
    s = AttrTag -> Maybe AttributeValue -> [Attribute]
    renderTextAttr AttrTag
    Font_style_ Maybe AttributeValue
    fs
     where
      fs :: Maybe AttributeValue
    fs = (FontSlant -> AttributeValue
    fontSlantAttr (FontSlant -> AttributeValue)
    -> (FontSlant -> FontSlant) -> FontSlant -> AttributeValue
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FontSlant -> FontSlant
    getFontSlant) (FontSlant -> AttributeValue)
    -> Maybe FontSlant -> Maybe AttributeValue
    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 -> AttributeValue
    fontSlantAttr FontSlant
    FontSlantItalic  = AttributeValue
    "italic"
      fontSlantAttr FontSlant
    FontSlantOblique = AttributeValue
    "oblique"
      fontSlantAttr FontSlant
    FontSlantNormal  = AttributeValue
    "normal"

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

    renderFontFamily :: Style v n -> [Attribute]
    renderFontFamily :: forall (v :: * -> *) n. Style v n -> [Attribute]
    renderFontFamily Style v n
    s = AttrTag -> Maybe AttributeValue -> [Attribute]
    renderTextAttr AttrTag
    Font_family_ Maybe AttributeValue
    ff
     where
      ff :: Maybe AttributeValue
    ff = ([Char] -> AttributeValue
    pack ([Char] -> AttributeValue)
    -> (Font -> [Char]) -> Font -> AttributeValue
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Font -> [Char]
    getFont) (Font -> AttributeValue) -> Maybe Font -> Maybe AttributeValue
    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 :: forall s. Show s => AttrTag -> Maybe s -> [Attribute]
    renderAttr AttrTag
    attr Maybe s
    valM = [Attribute] -> (s -> [Attribute]) -> Maybe s -> [Attribute]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [] (\s
    v -> [(AttrTag -> AttributeValue -> Attribute
    bindAttr AttrTag
    attr) ([Char] -> AttributeValue
    pack ([Char] -> AttributeValue) -> (s -> [Char]) -> s -> AttributeValue
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . s -> [Char]
    forall a. Show a => a -> [Char]
    show (s -> AttributeValue) -> s -> AttributeValue
    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 AttributeValue -> [Attribute]
    renderTextAttr AttrTag
    attr Maybe AttributeValue
    valM = [Attribute]
    -> (AttributeValue -> [Attribute])
    -> Maybe AttributeValue
    -> [Attribute]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [] (\AttributeValue
    v -> [(AttrTag -> AttributeValue -> Attribute
    bindAttr AttrTag
    attr) AttributeValue
    v]) Maybe AttributeValue
    valM

    colorToRgbText :: forall c . Color c => c -> AttributeValue
    colorToRgbText :: forall c. Color c => c -> AttributeValue
    colorToRgbText c
    c = [AttributeValue] -> AttributeValue
    T.concat
      [ AttributeValue
    "rgb("
      , Double -> AttributeValue
    forall {a}. RealFrac a => a -> AttributeValue
    int Double
    r, AttributeValue
    ","
      , Double -> AttributeValue
    forall {a}. RealFrac a => a -> AttributeValue
    int Double
    g, AttributeValue
    ","
      , Double -> AttributeValue
    forall {a}. RealFrac a => a -> AttributeValue
    int Double
    b
      , AttributeValue
    ")" ]
     where
       int :: a -> AttributeValue
    int a
    d     = [Char] -> AttributeValue
    pack ([Char] -> AttributeValue)
    -> (Int -> [Char]) -> Int -> AttributeValue
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> [Char]
    forall a. Show a => a -> [Char]
    show (Int -> AttributeValue) -> Int -> AttributeValue
    forall a b. (a -> b) -> a -> b
    $ (a -> Int
    forall b. Integral b => a -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    round (a
    d a -> a -> a
    forall a. Num a => a -> a -> a
    * a
    255) :: Int)
       (Double
    r,Double
    g,Double
    b,Double
    _) = 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 :: forall c. Color c => c -> Double
    colorToOpacity c
    c = Double
    a
     where (Double
    _,Double
    _,Double
    _,Double
    a) = c -> (Double, Double, Double, Double)
    forall c. Color c => c -> (Double, Double, Double, Double)
    colorToSRGBA c
    c