diagrams-svg 1.3.1.10 → 1.4

raw patch · 5 files changed

+178/−219 lines, 5 filesdep +svg-builderdep −lucid-svgdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: svg-builder

Dependencies removed: lucid-svg

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−2
• diagrams-svg.cabal +3/−4
• src/Diagrams/Backend/SVG.hs +71/−40
• src/Diagrams/Backend/SVG/Attributes.hs +0/−64
• src/Graphics/Rendering/SVG.hs +97/−109

@@ -1,6 +1,11 @@-## [v1.3.1.10](https://github.com/diagrams/diagrams-svg/tree/v1.3.1.10) (2015-11-10)+## [v1.4](https://github.com/diagrams/diagrams-svg/tree/v1.3.1.8) (2016-02-14) -- Fix pretty printing so that it is not the default.+-- Changes for `svg-builder`+-- Deprecate `svgId` and `svgClass`++## [v1.3.1.8](https://github.com/diagrams/diagrams-svg/tree/v1.3.1.8) (2015-11-14)++- allow `lucid-svg-0.6`  ## [v1.3.1.7](https://github.com/diagrams/diagrams-svg/tree/v1.3.1.7) (2015-11-10) 

@@ -1,5 +1,5 @@ Name:                diagrams-svg-Version:             1.3.1.10+Version:             1.4 Synopsis:            SVG backend for diagrams drawing EDSL. Homepage:            http://projects.haskell.org/diagrams/ License:             BSD3@@ -38,10 +38,9 @@ Library   Exposed-modules:     Diagrams.Backend.SVG                        Diagrams.Backend.SVG.CmdLine-                       Diagrams.Backend.SVG.Attributes   Other-modules:       Graphics.Rendering.SVG   Hs-source-dirs:      src-  Build-depends:       base                 >= 4.3   && < 4.9+  Build-depends:       base                 >= 4.3   && < 4.10                      , old-time                      , process                      , directory@@ -53,7 +52,7 @@                      , diagrams-core        >= 1.3   && < 1.4                      , diagrams-lib         >= 1.3   && < 1.4                      , monoid-extras        >= 0.3   && < 0.5-                     , lucid-svg            >= 0.5   && < 0.7+                     , svg-builder          >= 0.1   && < 0.2                      , text                 >= 0.11  && < 1.3                      , JuicyPixels          >= 3.1.5 && < 3.3                      , split                >= 0.1.2 && < 0.3

@@ -6,7 +6,9 @@ {-# LANGUAGE FlexibleInstances          #-} {-# LANGUAGE GADTs                      #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE InstanceSigs               #-} {-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE MultiWayIf                 #-} {-# LANGUAGE NondecreasingIndentation   #-} {-# LANGUAGE OverloadedStrings          #-} {-# LANGUAGE ScopedTypeVariables        #-}@@ -56,44 +58,48 @@ -- type of option records and rendering results specific to any -- particular backend.  For @b ~ SVG@, @v ~ V2@, we have ----- > data Options SVG V2 n = SVGOptions--- >     { _size           :: SizeSpec V2 n   -- ^ The requested size.--- >     , _svgDefinitions :: Maybe SvgM--- >                           -- ^ Custom definitions that will be added to the @defs@--- >                           --   section of the output.--- >     , _idPrefix       :: T.Text--- >     }+-- >data    Options SVG V2 n = SVGOptions+-- >    { _size            :: SizeSpec V2 n   -- ^ The requested size.+-- >    , _svgDefinitions  :: Maybe Element+-- >                          -- ^ Custom definitions that will be added to the @defs@+-- >                          --   section of the output.+-- >    , _idPrefix        :: T.Text+-- >    , _svgAttributes   :: [Attribute]+-- >                          -- ^ Attriubtes to apply to the entire svg element.+-- >    , _generateDoctype :: Bool+-- >    } -- -- @ -- data family Render SVG V2 n = R 'SvgRenderM n' -- @ -- -- @--- type family Result SVG V2 n = 'Graphics.Rendering.SVG.SvgM'+-- type family Result SVG V2 n = 'Element' -- @ -- -- So the type of 'renderDia' resolves to -- -- @--- renderDia :: SVG -> Options SVG V2 n -> QDiagram SVG V2 n m -> 'Graphics.Rendering.SVG.SvgM'+-- renderDia :: SVG -> Options SVG V2 n -> QDiagram SVG V2 n m -> 'Graphics.Rendering.SVG.Element' -- @ -- -- which you could call like @renderDia SVG (SVGOptions (mkWidth 250)--- Nothing "") myDiagram@ (if you have the 'OverloadedStrings' extension+-- Nothing "" [] True) myDiagram@ (if you have the 'OverloadedStrings' extension -- enabled; otherwise you can use 'Text.pack ""').  (In some -- situations GHC may not be able to infer the type @m@, in which case -- you can use a type annotation to specify it; it may be useful to -- simply use the type synonym @Diagram SVG = QDiagram SVG V2 Double--- Any@.) This returns an 'Graphics.Rendering.SVG.SvgM' value, which+-- Any@.) This returns an 'Graphics.Rendering.SVG.Element' value, which -- you can, /e.g./ render to a 'ByteString' using 'Lucid.Svg.renderBS'--- from the 'lucid' package.+-- from the 'lucid-svg' package. -- -----------------------------------------------------------------------------  module Diagrams.Backend.SVG   ( SVG(..) -- rendering token   , B-  , Options(..), sizeSpec, svgDefinitions, idPrefix -- for rendering options specific to SVG+    -- for rendering options specific to SVG+  , Options(..), sizeSpec, svgDefinitions, idPrefix, svgAttributes, generateDoctype   , SVGFloat    , renderSVG@@ -142,11 +148,11 @@ import           Diagrams.TwoD.Path       (Clip (Clip)) import           Diagrams.TwoD.Text --- from lucid-svg-import           Lucid.Svg+-- from svg-builder+import           Graphics.Svg             hiding ((<>))  -- from this package-import           Graphics.Rendering.SVG   (SVGFloat, SvgM)+import           Graphics.Rendering.SVG   (SVGFloat) import qualified Graphics.Rendering.SVG   as R  -- | @SVG@ is simply a token used to identify this rendering backend@@ -182,9 +188,9 @@ initialSvgRenderState = SvgRenderState 0 0 1  -- | Monad to keep track of environment and state when rendering an SVG.-type SvgRenderM n = ReaderT (Environment n) (State SvgRenderState) SvgM+type SvgRenderM n = ReaderT (Environment n) (State SvgRenderState) Element -runRenderM :: SVGFloat n => T.Text -> SvgRenderM n -> SvgM+runRenderM :: SVGFloat n => T.Text -> SvgRenderM n -> Element runRenderM o s = flip evalState initialSvgRenderState                $ runReaderT  s (initialEnvironment o) @@ -199,7 +205,7 @@ -- renderSvgWithClipping :: forall n. SVGFloat n                       => T.Text-                      -> SvgM          -- ^ Input SVG+                      -> Element       -- ^ Input SVG                       -> Style V2 n    -- ^ Styles                       -> SvgRenderM n  -- ^ Resulting svg @@ -231,31 +237,38 @@  instance SVGFloat n => Backend SVG V2 n where   newtype Render  SVG V2 n = R (SvgRenderM n)-  type    Result  SVG V2 n = SvgM+  type    Result  SVG V2 n = Element   data    Options SVG V2 n = SVGOptions-    { _size           :: SizeSpec V2 n   -- ^ The requested size.-    , _svgDefinitions :: Maybe SvgM+    { _size            :: SizeSpec V2 n   -- ^ The requested size.+    , _svgDefinitions  :: Maybe Element                           -- ^ Custom definitions that will be added to the @defs@                           --   section of the output.-    , _idPrefix       :: T.Text+    , _idPrefix        :: T.Text+    , _svgAttributes   :: [Attribute]+                          -- ^ Attriubtes to apply to the entire svg element.+    , _generateDoctype :: Bool     } +  renderRTree :: SVG -> Options SVG V2 n -> RTree SVG V2 n Annotation -> Result SVG V2 n   renderRTree _ opts rt = runRenderM (opts ^.idPrefix) svgOutput     where       svgOutput = do         let R r    = rtree (splitTextureFills rt)             V2 w h = specToSize 100 (opts^.sizeSpec)         svg <- r-        return $ R.svgHeader w h (opts^.svgDefinitions) svg+        return $ R.svgHeader w h (opts^.svgDefinitions)+                                 (opts^.svgAttributes)+                                 (opts^.generateDoctype) svg -  adjustDia c opts d = adjustDia2D sizeSpec c opts (d # reflectY)+  adjustDia c opts d = ( sz, t <> reflectionY, d' ) where+    (sz, t, d') = adjustDia2D sizeSpec c opts (d # reflectY)  rtree :: SVGFloat n => RTree SVG V2 n Annotation -> Render SVG V2 n rtree (Node n rs) = case n of   RPrim p                 -> render SVG p   RStyle sty              -> R $ local (over style (<> sty)) r-  RAnnot (OpacityGroup o) -> R $ g_ [opacity_ $ toText o] <$> r-  RAnnot (Href uri)       -> R $ a_ [xlinkHref_ $ T.pack uri] <$> r+  RAnnot (OpacityGroup o) -> R $ g_ [Opacity_ <<- toText o] <$> r+  RAnnot (Href uri)       -> R $ a_ [XlinkHref_ <<- T.pack uri] <$> r   _                       -> R r   where     R r = foldMap rtree rs@@ -265,7 +278,7 @@ sizeSpec f opts = f (_size opts) <&> \s -> opts { _size = s }  -- | Lens onto the svg definitions of the svg options.-svgDefinitions :: SVGFloat n => Lens' (Options SVG V2 n) (Maybe SvgM)+svgDefinitions :: SVGFloat n => Lens' (Options SVG V2 n) (Maybe Element) svgDefinitions f opts =   f (_svgDefinitions opts) <&> \ds -> opts { _svgDefinitions = ds } @@ -275,9 +288,21 @@ idPrefix :: SVGFloat n => Lens' (Options SVG V2 n) T.Text idPrefix f opts = f (_idPrefix opts) <&> \i -> opts { _idPrefix = i } +-- | Lens onto the svgAttributes field of the svg options. This field+--   is provided to supply SVG attributes to the entire diagram.+svgAttributes :: SVGFloat n => Lens' (Options SVG V2 n) [Attribute]+svgAttributes f opts =+  f (_svgAttributes opts) <&> \ds -> opts { _svgAttributes = ds }++-- | Lens onto the generateDoctype field of the svg options. Set+--   to False if you don't want a doctype tag included in the output.+generateDoctype :: SVGFloat n => Lens' (Options SVG V2 n) Bool+generateDoctype f opts =+  f (_generateDoctype opts) <&> \ds -> opts { _generateDoctype = ds }+ -- paths --------------------------------------------------------------- -attributedRender :: SVGFloat n => SvgM -> SvgRenderM n+attributedRender :: SVGFloat n => Element -> SvgRenderM n attributedRender svg = do   SvgRenderState _idClip idFill idLine <- get   Environment sty preT <- ask@@ -285,8 +310,8 @@   lineGradDefs <- lineTextureDefs sty   fillGradDefs <- fillTextureDefs sty   return $ do-    defs_ $ fillGradDefs >> lineGradDefs-    g_ (R.renderStyles idFill idLine sty) clippedSvg+    let gDefs = mappend fillGradDefs lineGradDefs+    gDefs `mappend` g_ (R.renderStyles idFill idLine sty) clippedSvg  instance SVGFloat n => Renderable (Path V2 n) SVG where   render _ = R . attributedRender . R.renderPath@@ -300,11 +325,11 @@ -- | Render a diagram as an SVG, writing to the specified output file --   and using the requested size. renderSVG :: SVGFloat n => FilePath -> SizeSpec V2 n -> QDiagram SVG V2 n Any -> IO ()-renderSVG outFile spec = renderSVG' outFile (SVGOptions spec Nothing (mkPrefix outFile))+renderSVG outFile spec = renderSVG' outFile (SVGOptions spec Nothing (mkPrefix outFile) [] True)  -- | Render a diagram as a pretty printed SVG. renderPretty :: SVGFloat n => FilePath -> SizeSpec V2 n -> QDiagram SVG V2 n Any -> IO ()-renderPretty outFile spec = renderPretty' outFile (SVGOptions spec Nothing (mkPrefix outFile))+renderPretty outFile spec = renderPretty' outFile (SVGOptions spec Nothing (mkPrefix outFile)[] True)  -- Create a prefile using the basename of the output file. Only standard -- letters are considered.@@ -334,11 +359,11 @@     let pic t d = return $ image (DImage (ImageNative (Img t d))                                    (dynamicMap imageWidth dyn)                                    (dynamicMap imageHeight dyn) mempty)-    if pngHeader `SBS.isPrefixOf` raw then pic 'P' dat else do-    if jpgHeader `SBS.isPrefixOf` raw then pic 'J' dat else do-    case dyn of-      (ImageYCbCr8 _) -> pic 'J' dat-      _               -> pic 'P' =<< eIO (encodeDynamicPng dyn)+    if | pngHeader `SBS.isPrefixOf` raw -> pic 'P' dat+       | jpgHeader `SBS.isPrefixOf` raw -> pic 'J' dat+       | otherwise -> case dyn of+           (ImageYCbCr8 _) -> pic 'J' dat+           _               -> pic 'P' =<< eIO (encodeDynamicPng dyn)   where pngHeader :: SBS.ByteString         pngHeader = SBS.pack [137, 80, 78, 71, 13, 10, 26, 10]         jpgHeader :: SBS.ByteString@@ -355,5 +380,11 @@     return $ R.renderDImage di $ R.dataUri mime d  instance (Hashable n, SVGFloat n) => Hashable (Options SVG V2 n) where-  hashWithSalt s  (SVGOptions sz defs _) = s `hashWithSalt` sz `hashWithSalt` ds-    where ds = fmap renderBS defs+  hashWithSalt s  (SVGOptions sz defs ia sa gd) =+    s  `hashWithSalt`+    sz `hashWithSalt`+    ds `hashWithSalt`+    ia `hashWithSalt`+    sa `hashWithSalt`+    gd+      where ds = fmap renderBS defs

@@ -1,64 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}---------------------------------------------------------------------------------- |--- Module      :  Diagrams.Backend.SVG.Attributes--- Copyright   :  (c) 2015 Diagrams team (see LICENSE)--- License     :  BSD-style (see LICENSE)--- Maintainer  :  diagrams-discuss@googlegroups.com------ Attributes that are specific to the SVG backend. The intent--- of this module is to allow adding the attributes class,--- and id attributes to an SVG. For those embedding--- the resulting SVG into a webpage, this allows some--- interactivity with javascript and stylesheets.-----------------------------------------------------------------------------------module Diagrams.Backend.SVG.Attributes (-  -- * Id-    SvgId(..)-  , svgId--  -- * Class-  , SvgClass(..)-  , svgClass--  ) where--import         Diagrams.Core.Style (AttributeClass, HasStyle, applyAttr)-import         Data.Semigroup-import         Data.Typeable       (Typeable)----------------------------------------------------------------------  Id---------------------------------------------------------------------- | The SVG id attribute.-newtype SvgId = SvgId {getSvgId :: String}-  deriving Typeable--instance Semigroup SvgId where-  _ <> a = a-instance AttributeClass SvgId---- | Set the Id attribute.-svgId :: HasStyle a => String -> a -> a-svgId = applyAttr . SvgId----------------------------------------------------------------------  Class---------------------------------------------------------------------- | The SVG class attribute.-newtype SvgClass = SvgClass {getSvgClass :: String}-  deriving Typeable--instance Semigroup SvgClass where-  _ <> a = a--instance AttributeClass SvgClass---- | Set the class attribute.-svgClass :: HasStyle a => String -> a -> a-svgClass = applyAttr . SvgClass

@@ -20,7 +20,7 @@  module Graphics.Rendering.SVG     ( SVGFloat-    , SvgM+    , Element     , AttributeValue     , svgHeader     , renderPath@@ -51,8 +51,7 @@ import           Diagrams.Core.Transform     (matrixHomRep)  -- from diagrams-lib-import           Diagrams.Prelude            hiding (Attribute, Render, with,-                                              (<>))+import           Diagrams.Prelude            hiding (Attribute, Render, with, (<>)) import           Diagrams.TwoD.Path          (getFillRule) import           Diagrams.TwoD.Text @@ -61,7 +60,7 @@ import qualified Data.Text                   as T  -- from lucid-svg-import           Lucid.Svg                   hiding (renderText)+import           Graphics.Svg                hiding (renderText)  -- from base64-bytestring, bytestring import qualified Data.ByteString.Base64.Lazy as BS64@@ -70,9 +69,6 @@ -- from JuicyPixels import           Codec.Picture --- from same package-import Diagrams.Backend.SVG.Attributes       (SvgId(..),SvgClass(..))- -- | 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)@@ -80,9 +76,6 @@ --   showFFloat :: RealFloat a => Maybe Int -> a -> ShowS -- or something similar for all numbers so we need TypeableFloat constraint. --- | The Svg monad, synonym for @HtmlT m ()@ Lucid.Base.-type SvgM = Svg ()- type AttributeValue = T.Text  getNumAttr :: AttributeClass (a n) => (a n -> t) -> Style v n -> Maybe t@@ -90,24 +83,29 @@  -- | @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 SvgM -> SvgM -> SvgM-svgHeader w h defines s =  doctype_ <> with (svg11_ (defs_  ds <> s))-  [ width_  (toText w)-  , height_ (toText h)-  , font_size_ "1"-  , viewBox_ (pack . unwords $ map show ([0, 0, round w, round h] :: [Int]))-  , stroke_ "rgb(0,0,0)"-  , stroke_opacity_ "1" ]+svgHeader :: SVGFloat n => n -> n -> Maybe Element -> [Attribute] -> Bool+                        -> Element -> Element+svgHeader w h defines attributes genDoctype s =+  dt <> with (svg11_ (defs_ [] ds <> s))+    ([ Width_ <<- toText w+     , Height_ <<- toText h+     , Font_size_ <<- "1"+     , ViewBox_ <<- (pack . unwords $ map show ([0, 0, round w, round h] :: [Int]))+     , Stroke_ <<- "rgb(0,0,0)"+     , Stroke_opacity_ <<- "1" ]+     ++ attributes )   where     ds = fromMaybe mempty defines+    dt = if genDoctype then doctype else mempty -renderPath :: SVGFloat n => Path V2 n -> SvgM-renderPath trs = if makePath == T.empty then mempty else path_ [d_ makePath]+renderPath :: SVGFloat n => Path V2 n -> Element+renderPath trs = if makePath == T.empty then mempty else path_ [D_ <<- makePath]   where     makePath = foldMap renderTrail (op Path trs)  renderTrail :: SVGFloat n => Located (Trail V2 n) -> AttributeValue-renderTrail (viewLoc -> (P (V2 x y), t)) = mA x y <> withTrail renderLine renderLoop t+renderTrail (viewLoc -> (P (V2 x y), t)) =+  mA x y <> withTrail renderLine renderLoop t   where     renderLine = foldMap renderSeg . lineSegments     renderLoop lp =@@ -127,34 +125,34 @@                   (V2 x1 y1)                   (OffsetClosed (V2 x2 y2))) = cR x0 y0 x1 y1 x2 y2 -renderClip :: SVGFloat n => Path V2 n -> T.Text -> Int -> SvgM -> SvgM+renderClip :: SVGFloat n => Path V2 n -> T.Text -> Int -> Element -> Element renderClip p prefix ident svg = do-  defs_ $ clipPath_ [id_ (clipPathId ident)] (renderPath p)-  g_  [clip_path_ $ ("url(#" <> clipPathId ident <> ")")] svg+     defs_ [] $ clipPath_ [Id_ <<- (clipPathId ident)] (renderPath p)+  <> g_  [Clip_path_ <<- ("url(#" <> clipPathId ident <> ")")] svg     where       clipPathId i = prefix <> "myClip" <> (pack . show $ i) -renderStop :: SVGFloat n => GradientStop n -> SvgM+renderStop :: SVGFloat n => GradientStop n -> Element renderStop (GradientStop c v)-  = stop_ [ stop_color_   (colorToRgbText c)-          , offset_      (toText v)-          , stop_opacity_ (toText $ colorToOpacity c) ]+  = stop_ [ Stop_color_ <<- (colorToRgbText c)+          , Offset_ <<- (toText v)+          , Stop_opacity_ <<- (toText $ colorToOpacity c) ]  spreadMethodText :: SpreadMethod -> AttributeValue spreadMethodText GradPad      = "pad" spreadMethodText GradReflect  = "reflect" spreadMethodText GradRepeat   = "repeat" -renderLinearGradient :: SVGFloat n => LGradient n -> Int -> SvgM+renderLinearGradient :: SVGFloat n => LGradient n -> Int -> Element renderLinearGradient g i = linearGradient_-    [ id_ (pack $ "gradient" ++ show i)-    , x1_ (toText x1)-    , y1_ (toText y1)-    , x2_ (toText x2)-    , y2_ (toText y2)-    , gradientTransform_ mx-    , gradientUnits_ "userSpaceOnUse"-    , spreadMethod_ (spreadMethodText (g ^. lGradSpreadMethod)) ]+    [ Id_ <<- (pack $ "gradient" ++ show i)+    , X1_ <<- toText x1+    , Y1_ <<- toText y1+    , X2_ <<- toText x2+    , Y2_ <<- toText y2+    , GradientTransform_ <<- mx+    , GradientUnits_ <<- "userSpaceOnUse"+    , SpreadMethod_ <<- spreadMethodText (g ^. lGradSpreadMethod) ]     $ foldMap renderStop (g^.lGradStops)   where     mx = matrix a1 a2 b1 b2 c1 c2@@ -162,17 +160,17 @@     P (V2 x1 y1) = g ^. lGradStart     P (V2 x2 y2) = g ^. lGradEnd -renderRadialGradient :: SVGFloat n => RGradient n -> Int -> SvgM+renderRadialGradient :: SVGFloat n => RGradient n -> Int -> Element renderRadialGradient g i = radialGradient_-    [ id_ (pack $ "gradient" ++ show i)-    , r_ (toText (g ^. rGradRadius1))-    , cx_ (toText cx)-    , cy_ (toText cy)-    , fx_ (toText fx)-    , fy_ (toText fy)-    , gradientTransform_ mx-    , gradientUnits_ "userSpaceOnUse"-    , spreadMethod_ (spreadMethodText (g ^. rGradSpreadMethod)) ]+    [ Id_ <<- (pack $ "gradient" ++ show i)+    , R_  <<- toText (g ^. rGradRadius1)+    , Cx_ <<- toText cx+    , Cy_ <<- toText cy+    , Fx_ <<- toText fx+    , Fy_ <<- toText fy+    , GradientTransform_ <<- mx+    , GradientUnits_ <<- "userSpaceOnUse"+    , SpreadMethod_ <<- spreadMethodText (g ^. rGradSpreadMethod) ]     ( foldMap renderStop ss )   where     mx = matrix a1 a2 b1 b2 c1 c2@@ -192,51 +190,51 @@     ss = zipWith (\gs sf -> gs & stopFraction .~ sf ) gradStops stopFracs  -- Create a gradient element so that it can be used as an attribute value for fill.-renderFillTextureDefs :: SVGFloat n => Int -> Style v n -> SvgM+renderFillTextureDefs :: SVGFloat n => Int -> Style v n -> Element renderFillTextureDefs i s =   case getNumAttr getFillTexture s of-    Just (LG g) -> renderLinearGradient g i-    Just (RG g) -> renderRadialGradient g i+    Just (LG g) -> defs_ [] $ renderLinearGradient g i+    Just (RG g) -> defs_ [] $ renderRadialGradient g i     _           -> mempty  -- Render the gradient using the id set up in renderFillTextureDefs. renderFillTexture :: SVGFloat n => Int -> Style v n -> [Attribute] renderFillTexture ident s = case getNumAttr getFillTexture s of-  Just (SC (SomeColor c)) -> renderTextAttr fill_ fillColorRgb <>-                             renderAttr fill_opacity_ fillColorOpacity+  Just (SC (SomeColor c)) -> renderTextAttr Fill_ fillColorRgb <>+                             renderAttr Fill_opacity_ fillColorOpacity     where       fillColorRgb     = Just $ colorToRgbText c       fillColorOpacity = Just $ colorToOpacity c-  Just (LG _) -> [fill_ ("url(#gradient" <> (pack . show $ ident)-                                         <> ")"), fill_opacity_ "1"]-  Just (RG _) -> [fill_ ("url(#gradient" <> (pack . show $ ident)-                                         <> ")"), fill_opacity_ "1"]+  Just (LG _) -> [Fill_ <<- ("url(#gradient" <> (pack . show $ ident)+                                             <> ")"), Fill_opacity_ <<- "1"]+  Just (RG _) -> [Fill_ <<- ("url(#gradient" <> (pack . show $ ident)+                                             <> ")"), Fill_opacity_ <<- "1"]   Nothing     -> [] -renderLineTextureDefs :: SVGFloat n => Int -> Style v n -> SvgM+renderLineTextureDefs :: SVGFloat n => Int -> Style v n -> Element renderLineTextureDefs i s =   case getNumAttr getLineTexture s of-    Just (LG g) -> renderLinearGradient g i-    Just (RG g) -> renderRadialGradient g i+    Just (LG g) -> defs_ [] $ renderLinearGradient g i+    Just (RG g) -> defs_ [] $ renderRadialGradient g i     _           -> mempty  renderLineTexture :: SVGFloat n => Int -> Style v n -> [Attribute] renderLineTexture ident s = case getNumAttr getLineTexture s of-  Just (SC (SomeColor c)) -> renderTextAttr stroke_ lineColorRgb <>-                             renderAttr stroke_opacity_ lineColorOpacity+  Just (SC (SomeColor c)) -> renderTextAttr Stroke_ lineColorRgb <>+                             renderAttr Stroke_opacity_ lineColorOpacity     where       lineColorRgb     = Just $ colorToRgbText c       lineColorOpacity = Just $ colorToOpacity c-  Just (LG _) -> [stroke_ ("url(#gradient" <> (pack . show $ ident)-                                           <> ")"), stroke_opacity_ "1"]-  Just (RG _) -> [stroke_ ("url(#gradient" <> (pack . show $ ident)-                                           <> ")"), stroke_opacity_ "1"]+  Just (LG _) -> [Stroke_ <<- ("url(#gradient" <> (pack . show $ ident)+                                               <> ")"), Stroke_opacity_ <<- "1"]+  Just (RG _) -> [Stroke_ <<- ("url(#gradient" <> (pack . show $ ident)+                                               <> ")"), Stroke_opacity_ <<- "1"]   Nothing     -> []  dataUri :: String -> BS8.ByteString -> AttributeValue dataUri mime dat = pack $ "data:"++mime++";base64," ++ BS8.unpack (BS64.encode dat) -renderDImageEmb :: SVGFloat n => DImage n Embedded -> SvgM+renderDImageEmb :: SVGFloat n => DImage n Embedded -> Element renderDImageEmb di@(DImage (ImageRaster dImg) _ _ _) =   renderDImage di $ dataUri "image/png" img   where@@ -244,13 +242,13 @@             Left str   -> error str             Right img' -> img' -renderDImage :: SVGFloat n => DImage n any -> AttributeValue -> SvgM+renderDImage :: SVGFloat n => DImage n any -> AttributeValue -> Element renderDImage (DImage _ w h tr) uridata =   image_-    [ transform_ transformMatrix-    , width_  (pack . show $ w)-    , height_ (pack . show $ h)-    , xlinkHref_ uridata ]+    [ Transform_ <<- transformMatrix+    , Width_ <<-  (pack . show $ w)+    , Height_ <<- (pack . show $ h)+    , XlinkHref_ <<- uridata ]   where     [[a,b],[c,d],[e,f]] = matrixHomRep (tr `mappend` reflectionY                                            `mappend` tX `mappend` tY)@@ -258,14 +256,14 @@     tX = translationX $ fromIntegral (-w)/2     tY = translationY $ fromIntegral (-h)/2 -renderText :: SVGFloat n => Text n -> SvgM+renderText :: SVGFloat n => Text n -> Element renderText (Text tt tAlign str) =   text_-    [ transform_ transformMatrix-    , dominant_baseline_ vAlign-    , text_anchor_ hAlign-    , stroke_ "none" ]-    $ toHtml str+    [ Transform_ <<- transformMatrix+    , Dominant_baseline_ <<- vAlign+    , Text_anchor_ <<- hAlign+    , Stroke_ <<- "none" ]+    $ toElement str  where   vAlign = case tAlign of              BaselineText -> "alphabetic"@@ -297,40 +295,29 @@   , renderFontSlant   , renderFontWeight   , renderFontFamily-  , renderSvgId-  , renderSvgClass   , renderMiterLimit ] --renderSvgId :: SVGFloat n => Style v n -> [Attribute]-renderSvgId s = renderTextAttr id_ svgIdAttr- where svgIdAttr = pack . getSvgId <$> getAttr s--renderSvgClass :: SVGFloat n => Style v n -> [Attribute]-renderSvgClass s = renderTextAttr class_ svgClassAttr- where svgClassAttr = pack . getSvgClass <$> getAttr s- renderMiterLimit :: SVGFloat n => Style v n -> [Attribute]-renderMiterLimit s = renderAttr stroke_miterlimit_ miterLimit+renderMiterLimit s = renderAttr Stroke_miterlimit_ miterLimit  where miterLimit = getLineMiterLimit <$> getAttr s  renderOpacity :: SVGFloat n => Style v n -> [Attribute]-renderOpacity s = renderAttr opacity_ o+renderOpacity s = renderAttr Opacity_ o  where o = getOpacity <$> getAttr s  renderFillRule :: SVGFloat n => Style v n -> [Attribute]-renderFillRule s = renderTextAttr fill_rule_ fr+renderFillRule s = renderTextAttr Fill_rule_ fr   where fr = (fillRuleToText . getFillRule) <$> getAttr s         fillRuleToText :: FillRule -> AttributeValue         fillRuleToText Winding = "nonzero"         fillRuleToText EvenOdd = "evenodd"  renderLineWidth :: SVGFloat n => Style v n -> [Attribute]-renderLineWidth s = renderAttr stroke_width_ lWidth+renderLineWidth s = renderAttr Stroke_width_ lWidth   where lWidth = getNumAttr getLineWidth s  renderLineCap :: SVGFloat n => Style v n -> [Attribute]-renderLineCap s = renderTextAttr stroke_linecap_ lCap+renderLineCap s = renderTextAttr Stroke_linecap_ lCap   where lCap = (lineCapToText . getLineCap) <$> getAttr s         lineCapToText :: LineCap -> AttributeValue         lineCapToText LineCapButt   = "butt"@@ -338,7 +325,7 @@         lineCapToText LineCapSquare = "square"  renderLineJoin :: SVGFloat n => Style v n -> [Attribute]-renderLineJoin s = renderTextAttr stroke_linejoin_ lj+renderLineJoin s = renderTextAttr Stroke_linejoin_ lj   where lj = (lineJoinToText . getLineJoin) <$> getAttr s         lineJoinToText :: LineJoin -> AttributeValue         lineJoinToText LineJoinMiter = "miter"@@ -346,26 +333,26 @@         lineJoinToText LineJoinBevel = "bevel"  renderDashing :: SVGFloat n => Style v n -> [Attribute]-renderDashing s = renderTextAttr stroke_dasharray_ arr <>-                  renderAttr stroke_dashoffset_ dOffset+renderDashing s = renderTextAttr Stroke_dasharray_ arr <>+                  renderAttr Stroke_dashoffset_ dOffset  where   getDasharray  (Dashing a _) = a   getDashoffset (Dashing _ o) = o-  dashArrayToStr              = intercalate "," . map show+  dashArrayToStr = intercalate "," . map show   -- Ignore dashing if dashing array is empty   checkEmpty (Just (Dashing [] _)) = Nothing-  checkEmpty other                 = other-  dashing'                    = checkEmpty $ getNumAttr getDashing s-  arr                         = (pack . dashArrayToStr . getDasharray) <$> dashing'-  dOffset                     = getDashoffset <$> dashing'+  checkEmpty other = other+  dashing' = checkEmpty $ getNumAttr getDashing s+  arr = (pack . dashArrayToStr . getDasharray) <$> dashing'+  dOffset = getDashoffset <$> dashing'  renderFontSize :: SVGFloat n => Style v n -> [Attribute]-renderFontSize s = renderTextAttr font_size_ fs+renderFontSize s = renderTextAttr Font_size_ fs  where   fs = pack <$> getNumAttr ((++ "px") . show . getFontSize) s  renderFontSlant :: SVGFloat n => Style v n -> [Attribute]-renderFontSlant s = renderTextAttr font_style_ fs+renderFontSlant s = renderTextAttr Font_style_ fs  where   fs = (fontSlantAttr . getFontSlant) <$> getAttr s   fontSlantAttr :: FontSlant -> AttributeValue@@ -374,7 +361,7 @@   fontSlantAttr FontSlantNormal  = "normal"  renderFontWeight :: SVGFloat n => Style v n -> [Attribute]-renderFontWeight s = renderTextAttr font_weight_ fw+renderFontWeight s = renderTextAttr Font_weight_ fw  where   fw = (fontWeightAttr . getFontWeight) <$> getAttr s   fontWeightAttr :: FontWeight -> AttributeValue@@ -382,16 +369,17 @@   fontWeightAttr FontWeightBold   = "bold"  renderFontFamily :: SVGFloat n => Style v n -> [Attribute]-renderFontFamily s = renderTextAttr  font_family_ ff+renderFontFamily s = renderTextAttr Font_family_ ff  where   ff = (pack . getFont) <$> getAttr s  -- | Render a style attribute if available, empty otherwise.-renderAttr :: Show s => (AttributeValue -> Attribute) -> Maybe s -> [Attribute]-renderAttr attr valM = maybe [] (\v -> [attr (pack . show $ v)]) valM+renderAttr :: Show s => AttrTag -> Maybe s -> [Attribute]+renderAttr attr valM = maybe [] (\v -> [(bindAttr attr) (pack . show $ v)]) valM -renderTextAttr :: (AttributeValue -> Attribute) -> Maybe AttributeValue -> [Attribute]-renderTextAttr attr valM = maybe [] (\v -> [attr v]) valM+-- renderTextAttr :: (AttributeValue -> Attribute) -> Maybe AttributeValue -> [Attribute]+renderTextAttr :: AttrTag -> Maybe AttributeValue -> [Attribute]+renderTextAttr attr valM = maybe [] (\v -> [(bindAttr attr) v]) valM  colorToRgbText :: forall c . Color c => c -> AttributeValue colorToRgbText c = T.concat