reanimate-svg 0.10.3.0 → 0.11.0.0

raw patch · 19 files changed

+3056/−3265 lines, 19 filesdep −faildep −hspecdep −semigroupsdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies removed: fail, hspec, semigroups, svg-tree

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• changelog.md +9/−0
• reanimate-svg.cabal +24/−38
• src/Graphics/SvgTree.hs +51/−52
• src/Graphics/SvgTree/ColorParser.hs +13/−16
• src/Graphics/SvgTree/CssParser.hs +3/−9
• src/Graphics/SvgTree/CssTypes.hs +0/−7
• src/Graphics/SvgTree/Memo.hs +9/−15
• src/Graphics/SvgTree/PathParser.hs +5/−10
• src/Graphics/SvgTree/Printer.hs +31/−34
• src/Graphics/SvgTree/Types.hs +362/−2971
• src/Graphics/SvgTree/Types/Basic.hs +95/−0
• src/Graphics/SvgTree/Types/Constructors.hs +70/−0
• src/Graphics/SvgTree/Types/Fold.hs +105/−0
• src/Graphics/SvgTree/Types/Hashable.hs +247/−0
• src/Graphics/SvgTree/Types/Instances.hs +211/−0
• src/Graphics/SvgTree/Types/Internal.hs +1767/−0
• src/Graphics/SvgTree/XmlParser.hs +54/−94
• test/PathParserSpec.hs +0/−18
• test/Spec.hs +0/−1

@@ -1,5 +1,14 @@ -*-change-log-*- +v0.11.0.0++ * Drop support for GHC 7.+ * Remove toPoint, isPathArc, isPathWithArc++v0.10.3.0 September 2020++ * Generic and Hashable instances.+ v0.9.0.0 April 2019   * Performance optimizations.

@@ -1,5 +1,6 @@+cabal-version:       2.2 name:                reanimate-svg-version:             0.10.3.0+version:             0.11.0.0 synopsis:            SVG file loader and serializer description:   reanimate-svg provides types representing a SVG document,@@ -10,14 +11,13 @@   look after `lucid-svg`.  -license:             BSD3+license:             BSD-3-Clause license-file:        LICENSE author:              Vincent Berthoux, David Himmelstrup maintainer:          David Himmelstrup <lemmih@gmail.com> -- copyright: category:            Graphics, Svg build-type:          Simple-cabal-version:       >=1.10  extra-source-files: changelog.md @@ -27,7 +27,7 @@  library   hs-source-dirs: src-  Ghc-options: -O3 -Wall+  ghc-options: -Wall   default-language: Haskell2010   exposed-modules: Graphics.SvgTree                  , Graphics.SvgTree.CssTypes@@ -41,39 +41,25 @@                , Graphics.SvgTree.CssParser                , Graphics.SvgTree.ColorParser                , Graphics.SvgTree.Misc--  if impl(ghc >= 8.0)-    ghc-options: -Wcompat -Wnoncanonical-monad-instances -Wnoncanonical-monadfail-instances-  else-    -- provide/emulate `Control.Monad.Fail` and `Data.Semigroups` API for pre-GHC8-    build-depends: fail == 4.9.*, semigroups == 0.18.*+               , Graphics.SvgTree.Types.Hashable+               , Graphics.SvgTree.Types.Basic+               , Graphics.SvgTree.Types.Fold+               , Graphics.SvgTree.Types.Internal+               , Graphics.SvgTree.Types.Constructors+               , Graphics.SvgTree.Types.Instances -  build-depends: base >= 4.5 && < 6-               , JuicyPixels >= 3.2-               , attoparsec >= 0.12-               , scientific >= 0.3-               , containers >= 0.4-               , xml        >= 1.3-               , bytestring >= 0.10-               , linear     >= 1.20-               , vector     >= 0.10-               , text       >= 1.1-               , transformers >= 0.3 && < 0.6-               , mtl        >= 2.1 && < 2.3-               , lens       >= 4.6 && < 5+  build-depends: base              >= 4.5 && < 6+               , JuicyPixels       >= 3.2+               , attoparsec        >= 0.12+               , scientific        >= 0.3+               , containers        >= 0.4+               , xml               >= 1.3+               , bytestring        >= 0.10+               , linear            >= 1.20+               , vector            >= 0.10+               , text              >= 1.1+               , transformers      >= 0.3 && < 0.6+               , mtl               >= 2.1 && < 2.3+               , lens              >= 4.6 && < 5                , double-conversion >= 2.0.0.0 && < 3.0.0.0-               , hashable >= 1.3.0.0--test-suite test-  default-language: Haskell2010-  hs-source-dirs: test-  main-is: Spec.hs-  type: exitcode-stdio-1.0-  build-depends: base-               , svg-tree-               , attoparsec >= 0.12-               , scientific >= 0.3-               , linear     >= 1.20-               , hspec-  ghc-options: -Wall -threaded-  other-modules: PathParserSpec+               , hashable          >= 1.3.0.0

@@ -1,43 +1,35 @@-{-# LANGUAGE CPP #-} -- | Module providing basic input/output for the SVG document, -- for document building, please refer to Graphics.Svg.Types. module Graphics.SvgTree   ( -- * Saving/Loading functions-    loadSvgFile-  , parseSvgFile-  , unparse-  , xmlOfDocument-  , xmlOfTree-  , saveXmlFile+    loadSvgFile,+    parseSvgFile,+    unparse,+    xmlOfDocument,+    xmlOfTree,+    saveXmlFile,      -- * Manipulation functions-  , cssApply-  , cssRulesOfText-  -- , applyCSSRules-  -- , resolveUses+    cssApply,+    cssRulesOfText,+    -- , applyCSSRules+    -- , resolveUses      -- * Type definitions-  , module Graphics.SvgTree.Types-  ) where--#if !MIN_VERSION_base(4,8,0)-import           Control.Applicative        ((<$>))-#endif--import           Control.Lens-import qualified Data.ByteString            as B-import           Data.List                  (foldl')--- import qualified Data.Map                   as M-import qualified Data.Text                  as T-import           Text.XML.Light.Input       (parseXMLDoc)-import           Text.XML.Light.Output      (ppcTopElement, prettyConfigPP)--import           Graphics.SvgTree.CssParser (cssRulesOfText)-import           Graphics.SvgTree.CssTypes-import           Graphics.SvgTree.Types-import           Graphics.SvgTree.XmlParser+    module Graphics.SvgTree.Types,+  )+where -{-import Graphics.Svg.CssParser-}+import Control.Lens+import qualified Data.ByteString as B+import Data.List (foldl')+import qualified Data.Text as T+import Graphics.SvgTree.CssParser (cssRulesOfText)+import Graphics.SvgTree.CssTypes+import Graphics.SvgTree.Types+import Graphics.SvgTree.XmlParser+import Text.XML.Light.Input (parseXMLDoc)+import Text.XML.Light.Output (ppcTopElement, prettyConfigPP)  -- | Try to load an svg file on disc and parse it as -- a SVG Document.@@ -46,42 +38,49 @@   parseSvgFile filename <$> B.readFile filename  -- | Parse an in-memory SVG file-parseSvgFile :: FilePath    -- ^ Source path/URL of the document, used-                            -- to resolve relative links.-             -> B.ByteString-             -> Maybe Document+parseSvgFile ::+  -- | Source path/URL of the document, used+  -- to resolve relative links.+  FilePath ->+  B.ByteString ->+  Maybe Document parseSvgFile filename fileContent =   parseXMLDoc fileContent >>= unparseDocument filename  -- | Save a svg Document on a file on disk. saveXmlFile :: FilePath -> Document -> IO () saveXmlFile filePath =-    writeFile filePath . ppcTopElement prettyConfigPP . xmlOfDocument+  writeFile filePath . ppcTopElement prettyConfigPP . xmlOfDocument -cssDeclApplyer :: DrawAttributes -> CssDeclaration-               -> DrawAttributes+cssDeclApplyer ::+  DrawAttributes ->+  CssDeclaration ->+  DrawAttributes cssDeclApplyer value (CssDeclaration txt elems) =-   case lookup txt cssUpdaters of-     Nothing -> value-     Just f  -> f value elems+  case lookup txt cssUpdaters of+    Nothing -> value+    Just f -> f value elems   where-    cssUpdaters = [(T.pack $ _attributeName n, u) |-                            (n, u) <- drawAttributesList]+    cssUpdaters =+      [ (T.pack $ _attributeName n, u)+        | (n, u) <- drawAttributesList+      ]  -- | Rewrite a SVG Tree using some CSS rules. -- -- This action will propagate the definition of the -- css directly in each matched element. cssApply :: [CssRule] -> Tree -> Tree-cssApply rules = zipTree go where-  go [] = None-  go ([]:_) = None-  go context@((t:_):_) = t & drawAttributes .~ attr'-   where-     matchingDeclarations =-         findMatchingDeclarations rules context-     attr = view drawAttributes t-     attr' = foldl' cssDeclApplyer attr matchingDeclarations+cssApply rules = zipTree go+  where+    go [] = defaultSvg+    go ([] : _) = defaultSvg+    go context@((t : _) : _) = t & drawAttributes .~ attr'+      where+        matchingDeclarations =+          findMatchingDeclarations rules context+        attr = view drawAttributes t+        attr' = foldl' cssDeclApplyer attr matchingDeclarations  -- For every 'use' tag, try to resolve the geometry associated -- with it and place it in the scene Tree. It is important to

@@ -1,4 +1,3 @@-{-# LANGUAGE CPP               #-} {-# LANGUAGE OverloadedStrings #-} module Graphics.SvgTree.ColorParser   ( colorParser@@ -8,26 +7,24 @@   , urlRef   ) where -#if !MIN_VERSION_base(4,8,0)-import           Control.Applicative      ((*>), (<$), (<$>), (<*), (<*>))-#endif--import           Control.Applicative      ((<|>))-import           Data.Attoparsec.Text     (Parser, char, digit, inClass, letter,-                                           many1, option, satisfy, scientific,-                                           skipSpace, string, takeWhile1)-import           Data.Bits                (unsafeShiftL, (.|.))+import           Control.Applicative          ((<|>))+import           Data.Attoparsec.Text         (Parser, char, digit, inClass,+                                               letter, many1, option, satisfy,+                                               scientific, skipSpace, string,+                                               takeWhile1)+import           Data.Bits                    (unsafeShiftL, (.|.)) -import           Codec.Picture            (PixelRGBA8 (..))-import qualified Data.Map                 as M-import           Data.Scientific          (toRealFloat)-import           Data.Word                (Word8)+import           Codec.Picture                (PixelRGBA8 (..))+import           Data.Functor+import qualified Data.Map                     as M+import           Data.Scientific              (toRealFloat)+import           Data.Word                    (Word8) import           Graphics.SvgTree.NamedColors import           Graphics.SvgTree.Types-import           Text.Printf              (printf)+import           Text.Printf                  (printf)  commaWsp :: Parser ()-commaWsp = skipSpace *> option () (string "," *> return ())+commaWsp = skipSpace *> option () (string "," $> ())                      <* skipSpace  

@@ -1,4 +1,3 @@-{-# LANGUAGE CPP               #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternGuards     #-} module Graphics.SvgTree.CssParser@@ -13,11 +12,6 @@   , cssRulesOfText   ) where -#if !MIN_VERSION_base(4,8,0)-import           Control.Applicative        (pure, (*>), (<$), (<$>), (<*),-                                             (<*>))-#endif- import           Control.Applicative        (many, (<|>)) import           Data.Attoparsec.Text       (Parser, char, digit, double,                                              letter, notChar, parseOnly, sepBy1,@@ -100,7 +94,7 @@ ruleSet = cleanSpace *> rule where   rule = CssRule       <$> selector `sepBy1` commaWsp-      <*> (between '{' '}' styleString)+      <*> between '{' '}' styleString       <?> "cssrule"  styleString :: Parser [CssDeclaration]@@ -119,7 +113,7 @@      combOpt = cleanSpace *> option id ((:) <$> combinator)     next :: Parser [CssSelector]-    next = id <$> combOpt <*> selector+    next = combOpt <*> selector  simpleSelector :: Parser [CssDescriptor] simpleSelector = (:) <$> elementName <*> many whole@@ -226,6 +220,6 @@  -- | Parse CSS text into rules. cssRulesOfText :: T.Text -> [CssRule]-cssRulesOfText txt = case parseOnly (many1 ruleSet) $ txt of+cssRulesOfText txt = case parseOnly (many1 ruleSet) txt of     Left _      -> []     Right rules -> rules

@@ -1,6 +1,5 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE CPP               #-} {-# LANGUAGE OverloadedStrings #-} -- | Define the types used to describes CSS elements module Graphics.SvgTree.CssTypes@@ -22,13 +21,8 @@   , tserialize   ) where -#if !MIN_VERSION_base(4,8,0)-import           Data.Monoid            (mconcat)-#endif- import           Data.Hashable          (Hashable) import           Data.List              (intersperse)-import           Data.Monoid            ((<>)) import qualified Data.Text              as T import qualified Data.Text.Lazy.Builder as TB import           GHC.Generics           (Generic)@@ -214,7 +208,6 @@   Point n   -> Point $ f n   Inches n  -> Inches $ f n --- XXX: Compress unused precision. -- | Encode the number to string which can be used in a -- CSS or a svg attributes. serializeNumber :: Number -> String

@@ -1,17 +1,14 @@ module Graphics.SvgTree.Memo   ( memo-  , preRender   ) where -import           Control.Lens-import           Data.IORef-import           Data.Map                 (Map)-import qualified Data.Map                 as Map-import           Data.Maybe-import           Data.Typeable-import           Graphics.SvgTree.Printer-import           Graphics.SvgTree.Types   (Tree, preRendered)-import           System.IO.Unsafe+import           Data.IORef             (IORef, atomicModifyIORef, newIORef)+import           Data.Map               (Map)+import qualified Data.Map               as Map+import           Data.Maybe             (catMaybes, listToMaybe)+import           Data.Typeable          (TypeRep, Typeable, cast, typeOf)+import           Graphics.SvgTree.Types (Tree)+import           System.IO.Unsafe       (unsafePerformIO)  {-# NOINLINE intCache #-} intCache :: IORef (Map Int Tree)@@ -37,7 +34,7 @@ memoUsing :: Ord a => IORef (Map a Tree) -> (a -> Tree) -> (a -> Tree) memoUsing cache fn a = unsafePerformIO $   atomicModifyIORef cache $ \m ->-    let newVal = preRender $ fn a+    let newVal = fn a         notFound =           (Map.insert a newVal m, newVal) in     case Map.lookup a m of@@ -47,15 +44,12 @@ memoAny :: (Typeable a, Show a) => (a -> Tree) -> (a -> Tree) memoAny fn a = unsafePerformIO $   atomicModifyIORef anyCache $ \m ->-    let newVal = preRender $ fn a+    let newVal = fn a         notFound =           (Map.insert (typeOf a, show a) newVal m, newVal) in     case Map.lookup (typeOf a, show a) m of       Nothing -> notFound       Just t  -> (m, t)--preRender :: Tree -> Tree-preRender t = t & preRendered .~ Just (ppTree t)  -- {-# INLINE memo #-} -- memo :: (a -> b) -> (a -> b)

@@ -1,4 +1,3 @@-{-# LANGUAGE CPP               #-} {-# LANGUAGE OverloadedStrings #-} module Graphics.SvgTree.PathParser   ( transformParser@@ -14,18 +13,14 @@   , serializeViewBox   ) where -#if !MIN_VERSION_base(4,8,0)-import           Control.Applicative        ((*>), (<$), (<$>), (<*), (<*>))-#endif- import           Control.Applicative        ((<|>)) import           Data.Attoparsec.Combinator (option, sepBy, sepBy1) import           Data.Attoparsec.Text       (Parser, char, digit, many1,                                              parseOnly, scientific, skipSpace,                                              string)-import           Data.Scientific            (toRealFloat)-+import           Data.Functor import           Data.List+import           Data.Scientific            (toRealFloat) import qualified Data.Text                  as T import           Graphics.SvgTree.Misc import           Graphics.SvgTree.Types@@ -54,7 +49,7 @@ serializeViewBox (a, b, c, d) = printf "%s %s %s %s" (ppD a) (ppD b) (ppD c) (ppD d)  commaWsp :: Parser ()-commaWsp = skipSpace *> option () (string "," *> return ()) <* skipSpace+commaWsp = skipSpace *> option () (string "," $> ()) <* skipSpace  point :: Parser RPoint point = V2 <$> num <* commaWsp <*> num@@ -99,8 +94,8 @@           ellipticalArgs = (,,,,,) <$> numComma                                    <*> numComma                                    <*> numComma-                                   <*> (fmap (/= 0) numComma)-                                   <*> (fmap (/= 0) numComma)+                                   <*> fmap (/= 0) numComma+                                   <*> fmap (/= 0) numComma                                    <*> point  unwordsS :: [ShowS] -> ShowS

@@ -1,58 +1,55 @@ module Graphics.SvgTree.Printer-  ( ppTree-  , ppDocument-  ) where+  ( ppTree,+    ppDocument,+  )+where -import           Control.Lens               ((^.))-import           Data.List-import           Graphics.SvgTree.Types     (Document (..),-                                             Tree (..), clipPathContent,-                                             groupChildren, markerElements,-                                             maskContent, patternElements,-                                             preRendered)-import           Graphics.SvgTree.XmlParser-import           Text.XML.Light             hiding (showAttr)+import Control.Lens ((^.))+import Data.List+import Graphics.SvgTree.Types hiding (Element)+import Graphics.SvgTree.XmlParser+import Text.XML.Light hiding (showAttr)  ppDocument :: Document -> String ppDocument doc =-  ppElementS_ (_elements doc) (xmlOfDocument doc) ""+  ppElementS_ (_documentElements doc) (xmlOfDocument doc) ""  ppTree :: Tree -> String ppTree t = ppTreeS t ""  ppTreeS :: Tree -> ShowS ppTreeS tree =-  case tree ^. preRendered of-    Nothing ->-      case xmlOfTree tree of-        Just x  -> ppElementS_ (treeChildren tree) x-        Nothing -> id-    Just s -> showString s+  case xmlOfTree tree of+    Just x -> ppElementS_ (treeChildren tree) x+    Nothing -> id  treeChildren :: Tree -> [Tree]-treeChildren (GroupTree g)      = g^.groupChildren-treeChildren (SymbolTree g)     = g^.groupChildren-treeChildren (DefinitionTree g) = g^.groupChildren-treeChildren (ClipPathTree c)   = c^.clipPathContent-treeChildren (PatternTree p)    = p^.patternElements-treeChildren (MarkerTree m)     = m^.markerElements-treeChildren (MaskTree m)       = m^.maskContent-treeChildren _                  = []+treeChildren t = case t of+  GroupTree g -> g ^. groupChildren+  SymbolTree g -> g ^. groupChildren+  DefinitionTree g -> g ^. groupChildren+  ClipPathTree c -> c ^. clipPathContent+  PatternTree p -> p ^. patternElements+  MarkerTree m -> m ^. markerElements+  MaskTree m -> m ^. maskContent+  _ -> [] -ppElementS_         :: [Tree] -> Element -> ShowS+ppElementS_ :: [Tree] -> Element -> ShowS ppElementS_ [] e xs | not (null (elContent e)) = ppElement e ++ xs ppElementS_ children e xs = tagStart name (elAttribs e) $   case children of-    [] | "?" `isPrefixOf` qName name -> showString " ?>" xs-       | otherwise                   -> showString " />" xs+    []+      | "?" `isPrefixOf` qName name -> showString " ?>" xs+      | otherwise -> showString " />" xs     _ -> showChar '>' (foldr ppTreeS (tagEnd name xs) children)   where     name = elName e  ---------------------------------------------------------------------------------tagStart           :: QName -> [Attr] -> ShowS-tagStart qn as rs   = '<':showQName qn ++ as_str ++ rs- where as_str       = if null as then "" else ' ' : unwords (map showAttr as)+tagStart :: QName -> [Attr] -> ShowS+tagStart qn as rs = '<' : showQName qn ++ as_str ++ rs+  where+    as_str = if null as then "" else ' ' : unwords (map showAttr as) -showAttr           :: Attr -> String+showAttr :: Attr -> String showAttr (Attr qn v) = showQName qn ++ '=' : '"' : v ++ "\""

@@ -1,2971 +1,362 @@-{-# OPTIONS_GHC -Wno-orphans -O0 #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE CPP                    #-}-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE FlexibleInstances      #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE MultiParamTypeClasses  #-}-{-# LANGUAGE OverloadedStrings      #-}-{-# LANGUAGE RankNTypes             #-}-{-# LANGUAGE TemplateHaskell        #-}--- | This module define all the types used in the definition--- of a svg scene.------ Most of the types are lensified.-module Graphics.SvgTree.Types-    ( -- * Basic building types-      Coord-    , Origin( .. )-    , Point-    , RPoint-    , PathCommand( .. )-    , Transformation( .. )-    , ElementRef( .. )-    , CoordinateUnits( .. )--      -- ** Building helpers-    , toPoint-    , serializeNumber-    , serializeTransformation-    , serializeTransformations--      -- * Drawing control types-    , Cap( .. )-    , LineJoin( .. )-    , Tree( .. )-    , Number( .. )-    , Spread( .. )-    , Texture( .. )-    , Element( .. )-    , FillRule( .. )-    , FontStyle( .. )-    , Dpi--    , WithDefaultSvg( .. )--      -- * Main type-    , Document( .. )-    , HasDocument( .. )-    , documentSize--      -- * Drawing attributes-    , DrawAttributes( .. )-    , HasDrawAttributes( .. )--      -- * Filters-    , FilterElement(..)-    , FilterAttributes(..)-    , HasFilterAttributes(..)-    , FilterSource(..)-    , ColorMatrixType(..)-    , HasColorMatrix(..)-    , ColorMatrix(..)-    , HasComposite(..)-    , Composite(..)-    , CompositeOperator(..)-    , EdgeMode(..)-    , HasGaussianBlur(..)-    , GaussianBlur(..)-    , HasTurbulence(..)-    , Turbulence(..)-    , TurbulenceType(..)-    , StitchTiles(..)-    , HasDisplacementMap(..)-    , DisplacementMap(..)-    , ChannelSelector(..)--      -- * SVG drawing primitives-      -- ** Rectangle-    , Rectangle( .. )-    , HasRectangle( .. )--      -- ** Line-    , Line( .. )-    , HasLine( .. )--      -- ** Polygon-    , Polygon( .. )-    , HasPolygon( .. )--      -- ** Polyline-    , PolyLine( .. )-    , HasPolyLine( .. )--      -- ** Path-    , Path( .. )-    , HasPath( .. )--      -- ** Circle-    , Circle( .. )-    , HasCircle( .. )--      -- ** Ellipse-    , Ellipse( .. )-    , HasEllipse( .. )--      -- ** Mesh (gradient mesh)-    , GradientPathCommand( .. )-    , MeshGradientType( .. )--    , MeshGradient( .. )-    , HasMeshGradient( .. )--    , MeshGradientRow( .. )-    , HasMeshGradientRow( .. )--    , MeshGradientPatch( .. )-    , HasMeshGradientPatch( .. )--      -- ** Image-    , Image( .. )-    , HasImage( .. )--      -- ** Use-    , Use( .. )-    , HasUse( .. )--      -- * Grouping primitives-      -- ** Group-    , Group( .. )-    , HasGroup( .. )--      -- ** Symbol-    , Symbol( .. )-    , groupOfSymbol--      -- ** Definitions-    , Definitions( .. )-    , groupOfDefinitions--    -- ** Filter-    , Filter( .. )-    , filterChildren--      -- * Text related types-      -- ** Text-    , Text( .. )-    , HasText( .. )-    , TextAnchor( .. )-    , textAt--      -- ** Text path-    , TextPath( .. )-    , HasTextPath( .. )--    , TextPathSpacing( .. )-    , TextPathMethod( .. )--      -- ** Text span.-    , TextSpanContent( .. )--    , TextSpan( .. )-    , HasTextSpan( .. )--    , TextInfo( .. )-    , HasTextInfo( .. )--    , TextAdjust( .. )--      -- * Marker definition-    , Marker( .. )-    , Overflow( .. )-    , MarkerOrientation( .. )-    , MarkerUnit( .. )-    , HasMarker( .. )--      -- * Gradient definition-    , GradientStop( .. )-    , HasGradientStop( .. )--      -- ** Linear Gradient-    , LinearGradient( .. )-    , HasLinearGradient( .. )--      -- ** Radial Gradient-    , RadialGradient( .. )-    , HasRadialGradient( .. )--      -- * Pattern definition-    , Pattern( .. )-    , HasPattern( .. )--      -- * Mask definition-    , Mask( .. )-    , HasMask( .. )--      -- * Clip path definition-    , ClipPath( .. )-    , HasClipPath( .. )--      -- * Aspect Ratio description-    , PreserveAspectRatio( .. )-    , Alignment( .. )-    , MeetSlice( .. )-    , HasPreserveAspectRatio( .. )--      -- * MISC functions-    , isPathArc-    , isPathWithArc-    , nameOfTree-    , zipTree-    , mapTree-    , foldTree-    , toUserUnit-    , mapNumber-    ) where--#if !MIN_VERSION_base(4,8,0)-import           Data.Foldable             (Foldable)-import           Data.Monoid               (Monoid (..))-#endif--import           Codec.Picture             (PixelRGBA8 (..))-import           Control.Lens              (Lens, Lens', lens, view, (&), (.~),-                                            (^.))-import           Control.Lens.TH-import qualified Data.Foldable             as F-import           Data.Function             (on)-import           Data.Hashable             (Hashable)-import           Data.List                 (inits)-import           Data.Monoid               (Last (..))-import           Data.Semigroup            (Semigroup (..))-import qualified Data.Text                 as T-import           GHC.Generics              (Generic)-import           Graphics.SvgTree.CssTypes-import           Graphics.SvgTree.Misc-import           Linear                    hiding (angle)--import           Text.Printf----- Orphan instances :(-instance Hashable a => Hashable (Last a)--deriving instance Generic PixelRGBA8-instance Hashable PixelRGBA8---- | Basic coordinate type.-type Coord = Double---- | Real Point, fully determined and not--- dependant of the rendering context.-type RPoint = V2 Coord---- | Possibly context dependant point.-type Point = (Number, Number)---- | Tell if a path command is absolute (in the current--- user coordiante) or relative to the previous poitn.-data Origin-  = OriginAbsolute -- ^ Next point in absolute coordinate-  | OriginRelative -- ^ Next point relative to the previous-  deriving (Eq, Show, Generic, Hashable)---data MeshGradientType-  = GradientBilinear-  | GradientBicubic-  deriving (Eq, Show, Generic, Hashable)---- | Path command definition.-data PathCommand-      -- | 'M' or 'm' command-    = MoveTo !Origin ![RPoint]-      -- | Line to, 'L' or 'l' Svg path command.-    | LineTo !Origin ![RPoint]--      -- | Equivalent to the 'H' or 'h' svg path command.-    | HorizontalTo  !Origin ![Coord]-      -- | Equivalent to the 'V' or 'v' svg path command.-    | VerticalTo    !Origin ![Coord]--    -- | Cubic bezier, 'C' or 'c' command-    | CurveTo  !Origin ![(RPoint, RPoint, RPoint)]-    -- | Smooth cubic bezier, equivalent to 'S' or 's' command-    | SmoothCurveTo  !Origin ![(RPoint, RPoint)]-    -- | Quadratic bezier, 'Q' or 'q' command-    | QuadraticBezier !Origin ![(RPoint, RPoint)]-    -- | Quadratic bezier, 'T' or 't' command-    | SmoothQuadraticBezierCurveTo  !Origin ![RPoint]-      -- | Eliptical arc, 'A' or 'a' command.-    | EllipticalArc !Origin ![(Coord, Coord, Coord, Bool, Bool, RPoint)]-      -- | Close the path, 'Z' or 'z' svg path command.-    | EndPath-    deriving (Eq, Show, Generic, Hashable)---- | Description of path used in meshgradient tag-data GradientPathCommand-      -- | Line to, 'L' or 'l' Svg path command.-    = GLine !Origin !(Maybe RPoint)-      -- | Cubic bezier, 'C' or 'c' command-    | GCurve !Origin !RPoint !RPoint !(Maybe RPoint)-      -- | 'Z' command-    | GClose-    deriving (Eq, Show, Generic, Hashable)---- | Little helper function to build a point.-toPoint :: Number -> Number -> Point-toPoint = (,)---- | Tell if the path command is an EllipticalArc.-isPathArc :: PathCommand -> Bool-isPathArc (EllipticalArc _ _) = True-isPathArc _                   = False---- | Tell if a full path contain an EllipticalArc.-isPathWithArc :: Foldable f => f PathCommand -> Bool-isPathWithArc = F.any isPathArc---- | Define the possible values of various *units attributes--- used in the definition of the gradients and masks.-data CoordinateUnits-    = CoordUserSpace   -- ^ `userSpaceOnUse` value-    | CoordBoundingBox -- ^ `objectBoundingBox` value-    deriving (Eq, Show, Generic, Hashable)---- | This type represent the align information of the--- preserveAspectRatio SVGattribute-data Alignment-  = AlignNone -- ^ "none" value-  | AlignxMinYMin -- "xMinYMin" value-  | AlignxMidYMin -- ^ "xMidYMin" value-  | AlignxMaxYMin -- ^ "xMaxYMin" value-  | AlignxMinYMid -- ^ "xMinYMid" value-  | AlignxMidYMid -- ^ "xMidYMid" value-  | AlignxMaxYMid -- ^ "xMaxYMid" value-  | AlignxMinYMax -- ^ "xMinYMax" value-  | AlignxMidYMax -- ^ "xMidYMax" value-  | AlignxMaxYMax -- ^ "xMaxYMax" value-  deriving (Eq, Show, Generic, Hashable)---- | This type represent the "meet or slice" information--- of the preserveAspectRatio SVGattribute-data MeetSlice = Meet | Slice-    deriving (Eq, Show, Generic, Hashable)---- | Describe the content of the preserveAspectRatio attribute.-data PreserveAspectRatio = PreserveAspectRatio-  { _aspectRatioDefer     :: !Bool-  , _aspectRatioAlign     :: !Alignment-  , _aspectRatioMeetSlice :: !(Maybe MeetSlice)-  }-  deriving (Eq, Show, Generic, Hashable)--instance WithDefaultSvg PreserveAspectRatio where-  defaultSvg = PreserveAspectRatio-    { _aspectRatioDefer     = False-    , _aspectRatioAlign     = AlignxMidYMid-    , _aspectRatioMeetSlice = Nothing-    }---- | Describe how the line should be terminated--- when stroking them. Describe the values of the--- `stroke-linecap` attribute.--- See `_strokeLineCap`-data Cap-  = CapRound -- ^ End with a round (`round` value)-  | CapButt  -- ^ Define straight just at the end (`butt` value)-  | CapSquare -- ^ Straight further of the ends (`square` value)-  deriving (Eq, Show, Generic, Hashable)---- | Define the possible values of the `stroke-linejoin`--- attribute.--- see `_strokeLineJoin`-data LineJoin-    = JoinMiter -- ^ `miter` value-    | JoinBevel -- ^ `bevel` value-    | JoinRound -- ^ `round` value-    deriving (Eq, Show, Generic, Hashable)---- | Describe the different value which can be used--- in the `fill` or `stroke` attributes.-data Texture-  = ColorRef   PixelRGBA8 -- ^ Direct solid color (#rrggbb, #rgb)-  | TextureRef String     -- ^ Link to a complex texture (url(#name))-  | FillNone              -- ^ Equivalent to the `none` value.-  deriving (Eq, Show, Generic, Hashable)---- | Describe the possile filling algorithms.--- Map the values of the `fill-rule` attributes.-data FillRule-    = FillEvenOdd -- ^ Correspond to the `evenodd` value.-    | FillNonZero -- ^ Correspond to the `nonzero` value.-    deriving (Eq, Show, Generic, Hashable)---- | Describe the content of the `transformation` attribute.--- see `_transform` and `transform`.-data Transformation-    = -- | Directly encode the translation matrix.-      TransformMatrix !Coord !Coord !Coord-                      !Coord !Coord !Coord-      -- | Translation along a vector-    | Translate !Double !Double-      -- | Scaling on both axis or on X axis and Y axis.-    | Scale !Double !(Maybe Double)-      -- | Rotation around `(0, 0)` or around an optional-      -- point.-    | Rotate !Double !(Maybe (Double, Double))-      -- | Skew transformation along the X axis.-    | SkewX !Double-      -- | Skew transformation along the Y axis.-    | SkewY !Double-      -- | Unkown transformation, like identity.-    | TransformUnknown-    deriving (Eq, Show, Generic, Hashable)---- | Convert the Transformation to a string which can be--- directly used in a svg attributes.-serializeTransformation :: Transformation -> String-serializeTransformation t = case t of-  TransformUnknown -> ""-  TransformMatrix a b c d e f ->-      printf "matrix(%s, %s, %s, %s, %s, %s)"-        (ppD a) (ppD b) (ppD c) (ppD d) (ppD e) (ppD f)-  Translate x y -> printf "translate(%s, %s)" (ppD x) (ppD y)-  Scale x Nothing -> printf "scale(%s)" (ppD x)-  Scale x (Just y) -> printf "scale(%s, %s)" (ppD x) (ppD y)-  Rotate angle Nothing -> printf "rotate(%s)" (ppD angle)-  Rotate angle (Just (x, y))-> printf "rotate(%s, %s, %s)"-    (ppD angle) (ppD x) (ppD y)-  SkewX x -> printf "skewX(%s)" (ppD x)-  SkewY y -> printf "skewY(%s)" (ppD y)---- | Transform a list of transformations to a string for svg--- `transform` attributes.-serializeTransformations :: [Transformation] -> String-serializeTransformations =-    unwords . fmap serializeTransformation---- | Define an empty 'default' element for the SVG tree.--- It is used as base when parsing the element from XML.-class WithDefaultSvg a where-    -- | The default element.-    defaultSvg :: a---- | Classify the font style, used to search a matching--- font in the FontCache.-data FontStyle-  = FontStyleNormal-  | FontStyleItalic-  | FontStyleOblique-  deriving (Eq, Show, Generic, Hashable)---- | Tell where to anchor the text, where the position--- given is realative to the text.-data TextAnchor-    -- | The text with left aligned, or start at the postion-    -- If the point is the '*' then the text will be printed-    -- this way:-    ---    -- >  *THE_TEXT_TO_PRINT-    ---    -- Equivalent to the `start` value.-  = TextAnchorStart-    -- | The text is middle aligned, so the text will be at-    -- the left and right of the position:-    ---    -- >   THE_TEXT*TO_PRINT-    ---    -- Equivalent to the `middle` value.-  | TextAnchorMiddle-    -- | The text is right aligned.-    ---    -- >   THE_TEXT_TO_PRINT*-    ---    -- Equivalent to the `end` value.-  | TextAnchorEnd-  deriving (Eq, Show, Generic, Hashable)----- | Correspond to the possible values of the--- the attributes which are either `none` or--- `url(#elem)`-data ElementRef-  = RefNone  -- ^ Value for `none`-  | Ref String -- ^ Equivalent to `url()` attribute.-  deriving (Eq, Show, Generic, Hashable)--data FilterSource-  = SourceGraphic-  | SourceAlpha-  | BackgroundImage-  | BackgroundAlpha-  | FillPaint-  | StrokePaint-  | SourceRef String-  deriving (Eq, Show, Generic, Hashable)--data FilterAttributes = FilterAttributes-  { _filterHeight :: !(Last Number)-  , _filterResult :: !(Maybe String)-  , _filterWidth  :: !(Last Number)-  , _filterX      :: !(Last Number)-  , _filterY      :: !(Last Number)-  } deriving (Eq, Show, Generic, Hashable)--instance WithDefaultSvg FilterAttributes where-  defaultSvg = FilterAttributes-    { _filterHeight = Last Nothing-    , _filterResult = Nothing-    , _filterWidth  = Last Nothing-    , _filterX      = Last Nothing-    , _filterY      = Last Nothing }---- | This type define how to draw any primitives,--- which color to use, how to stroke the primitives--- and the potential transformations to use.------ All these attributes are propagated to the children.-data DrawAttributes = DrawAttributes-    { -- | Attribute corresponding to the `stroke-width`-      -- SVG attribute.-      _strokeWidth      :: !(Last Number)-      -- | Correspond to the `stroke` attribute.-    , _strokeColor      :: !(Last Texture)-      -- | Define the `stroke-opacity` attribute, the transparency-      -- for the "border".-    , _strokeOpacity    :: !(Maybe Float)-      -- | Correspond to the `stroke-linecap` SVG-      -- attribute-    , _strokeLineCap    :: !(Last Cap)-      -- | Correspond to the `stroke-linejoin` SVG-      -- attribute-    , _strokeLineJoin   :: !(Last LineJoin)-      -- | Define the distance of the miter join, correspond-      -- to the `stroke-miterlimit` attritbue.-    , _strokeMiterLimit :: !(Last Double)-      -- | Define the filling color of the elements. Corresponding-      -- to the `fill` attribute.-    , _fillColor        :: !(Last Texture)-      -- | Define the `fill-opacity` attribute, the transparency-      -- for the "content".-    , _fillOpacity      :: !(Maybe Float)-      -- | Define the global or group opacity attribute.-    , _groupOpacity     :: !(Maybe Float)-      -- | Content of the `transform` attribute-    , _transform        :: !(Maybe [Transformation])-      -- | Define the `fill-rule` used during the rendering.-    , _fillRule         :: !(Last FillRule)-      -- | Define the `mask` attribute.-    , _maskRef          :: !(Last ElementRef)-      -- | Define the `clip-path` attribute.-    , _clipPathRef      :: !(Last ElementRef)-      -- | Define the `clip-rule` attribute.-    , _clipRule         :: !(Last FillRule)-      -- | Map to the `class` attribute. Used for the CSS-      -- rewriting.-    , _attrClass        :: ![T.Text]-      -- | Map to the `id` attribute. Used for the CSS-      -- rewriting.-    , _attrId           :: !(Maybe String)-      -- | Define the start distance of the dashing pattern.-      -- Correspond to the `stroke-dashoffset` attribute.-    , _strokeOffset     :: !(Last Number)-      -- | Define the dashing pattern for the lines. Correspond-      -- to the `stroke-dasharray` attribute.-    , _strokeDashArray  :: !(Last [Number])-      -- | Current size of the text, correspond to the-      -- `font-size` SVG attribute.-    , _fontSize         :: !(Last Number)-      -- | Define the possible fonts to be used for text rendering.-      -- Map to the `font-family` attribute.-    , _fontFamily       :: !(Last [String])-      -- | Map to the `font-style` attribute.-    , _fontStyle        :: !(Last FontStyle)-      -- | Define how to interpret the text position, correspond-      -- to the `text-anchor` attribute.-    , _textAnchor       :: !(Last TextAnchor)-      -- | Define the marker used for the start of the line.-      -- Correspond to the `marker-start` attribute.-    , _markerStart      :: !(Last ElementRef)-      -- | Define the marker used for every point of the-      -- polyline/path Correspond to the `marker-mid`-      -- attribute.-    , _markerMid        :: !(Last ElementRef)-      -- | Define the marker used for the end of the line.-      -- Correspond to the `marker-end` attribute.-    , _markerEnd        :: !(Last ElementRef)-    , _filterRef        :: !(Last ElementRef)-    , _preRendered      :: !(Maybe String)-    }-    deriving (Eq, Show, Generic, Hashable)--makeClassy ''DrawAttributes---- | This primitive describe an unclosed suite of--- segments. Correspond to the `<polyline>` tag.-data PolyLine = PolyLine-  { -- | drawing attributes of the polyline.-    _polyLineDrawAttributes :: !DrawAttributes--    -- | Geometry definition of the polyline.-    -- correspond to the `points` attribute-  , _polyLinePoints         :: ![RPoint]-  }-  deriving (Eq, Show, Generic, Hashable)---instance WithDefaultSvg PolyLine where-  defaultSvg = PolyLine-    { _polyLineDrawAttributes = mempty-    , _polyLinePoints = []-    }---- makeClassy ''PolyLine--- | Lenses for the PolyLine type.-class HasPolyLine a where-  polyLine :: Lens' a PolyLine-  polyLineDrawAttributes :: Lens' a DrawAttributes-  {-# INLINE polyLineDrawAttributes #-}-  polyLineDrawAttributes = polyLine . polyLineDrawAttributes--  polyLinePoints :: Lens' a [RPoint]-  {-# INLINE polyLinePoints #-}-  polyLinePoints = polyLine . polyLinePoints--instance HasPolyLine PolyLine where-  polyLine = id-  {-# INLINE polyLineDrawAttributes #-}-  polyLineDrawAttributes f p =-    fmap (\y -> p { _polyLineDrawAttributes = y }) (f $ _polyLineDrawAttributes p)-  {-# INLINE polyLinePoints #-}-  polyLinePoints f p =-    fmap (\y -> p { _polyLinePoints = y }) (f $ _polyLinePoints p)--instance HasDrawAttributes PolyLine where-    drawAttributes = polyLineDrawAttributes---- | Primitive decriving polygon composed--- of segements. Correspond to the `<polygon>`--- tag-data Polygon = Polygon-  { -- | Drawing attributes for the polygon.-    _polygonDrawAttributes :: !DrawAttributes-    -- | Points of the polygon. Correspond to-    -- the `points` attributes.-  , _polygonPoints         :: ![RPoint]-  }-  deriving (Eq, Show, Generic, Hashable)---- makeClassy ''Polygon--- | Lenses for the Polygon type-class HasPolygon a where-  polygon :: Lens' a Polygon-  polygonDrawAttributes :: Lens' a DrawAttributes-  {-# INLINE polygonDrawAttributes #-}-  polygonPoints :: Lens' a [RPoint]-  {-# INLINE polygonPoints #-}-  polygonDrawAttributes = polygon . polygonDrawAttributes-  polygonPoints = polygon . polygonPoints--instance HasPolygon Polygon where-  polygon = id-  {-# INLINE polygonDrawAttributes #-}-  polygonDrawAttributes f p =-    fmap (\y -> p { _polygonDrawAttributes = y }) (f $ _polygonDrawAttributes p)-  {-# INLINE polygonPoints #-}-  polygonPoints f p =-    fmap (\y -> p { _polygonPoints = y }) (f $ _polygonPoints p)--instance HasDrawAttributes Polygon where-    drawAttributes = polygonDrawAttributes--instance WithDefaultSvg Polygon where-  defaultSvg = Polygon-    { _polygonDrawAttributes = mempty-    , _polygonPoints = []-    }---- | Define a simple line. Correspond to the--- `<line>` tag.-data Line = Line-  { -- | Drawing attributes of line.-    _lineDrawAttributes :: !DrawAttributes-    -- | First point of the the line, correspond-    -- to the `x1` and `y1` attributes.-  , _linePoint1         :: !Point-    -- | Second point of the the line, correspond-    -- to the `x2` and `y2` attributes.-  , _linePoint2         :: !Point-  }-  deriving (Eq, Show, Generic, Hashable)---- makeClassy ''Line--- | Lenses for the Line type.-class HasLine a where-  line :: Lens' a Line-  lineDrawAttributes :: Lens' a DrawAttributes-  lineDrawAttributes = line . lineDrawAttributes-  {-# INLINE lineDrawAttributes #-}-  linePoint1 :: Lens' a Point-  linePoint1 = line . linePoint1-  {-# INLINE linePoint1 #-}-  linePoint2 :: Lens' a Point-  linePoint2 = line . linePoint2-  {-# INLINE linePoint2 #-}--instance HasLine Line where-  line = id-  {-# INLINE lineDrawAttributes #-}-  lineDrawAttributes f l =-      fmap (\y -> l { _lineDrawAttributes = y }) (f (_lineDrawAttributes l))-  {-# INLINE linePoint1 #-}-  linePoint1 f l =-      fmap (\y -> l { _linePoint1 = y }) (f (_linePoint1 l))-  {-# INLINE linePoint2 #-}-  linePoint2 f l =-      fmap (\y -> l { _linePoint2 = y }) (f (_linePoint2 l))--instance HasDrawAttributes Line where-    drawAttributes = lineDrawAttributes--instance WithDefaultSvg Line where-  defaultSvg = Line-    { _lineDrawAttributes = mempty-    , _linePoint1 = zeroPoint-    , _linePoint2 = zeroPoint-    }-    where zeroPoint = (Num 0, Num 0)---- | Define a rectangle. Correspond to--- `<rectangle>` svg tag.-data Rectangle = Rectangle-  { -- | Rectangle drawing attributes.-    _rectDrawAttributes  :: !DrawAttributes-    -- | Upper left corner of the rectangle, correspond-    -- to the attributes `x` and `y`.-  , _rectUpperLeftCorner :: !Point-    -- | Rectangle width, correspond, strangely, to-    -- the `width` attribute.-  , _rectWidth           :: !(Maybe Number)-    -- | Rectangle height, correspond, amazingly, to-    -- the `height` attribute.-  , _rectHeight          :: !(Maybe Number)-    -- | Define the rounded corner radius radius-    -- of the rectangle. Correspond to the `rx` and-    -- `ry` attributes.-  , _rectCornerRadius    :: !(Maybe Number, Maybe Number)-  }-  deriving (Eq, Show, Generic, Hashable)---- makeClassy ''Rectangle--- | Lenses for the Rectangle type.-class HasRectangle a where-  rectangle :: Lens' a Rectangle-  rectCornerRadius :: Lens' a (Maybe Number, Maybe Number)-  {-# INLINE rectCornerRadius #-}-  rectCornerRadius = rectangle . rectCornerRadius--  rectDrawAttributes :: Lens' a DrawAttributes-  {-# INLINE rectDrawAttributes #-}-  rectDrawAttributes = rectangle . rectDrawAttributes--  rectHeight :: Lens' a (Maybe Number)-  {-# INLINE rectHeight #-}-  rectHeight = rectangle . rectHeight--  rectUpperLeftCorner :: Lens' a Point-  {-# INLINE rectUpperLeftCorner #-}-  rectUpperLeftCorner = rectangle . rectUpperLeftCorner--  rectWidth :: Lens' a (Maybe Number)-  {-# INLINE rectWidth #-}-  rectWidth = rectangle . rectWidth--instance HasRectangle Rectangle where-  rectangle = id-  {-# INLINE rectCornerRadius #-}-  rectCornerRadius f attr =-    fmap (\y -> attr { _rectCornerRadius = y }) (f $ _rectCornerRadius attr)-  {-# INLINE rectDrawAttributes #-}-  rectDrawAttributes f attr =-    fmap (\y -> attr { _rectDrawAttributes = y }) (f $ _rectDrawAttributes attr)-  {-# INLINE rectHeight #-}-  rectHeight f attr =-    fmap (\y -> attr { _rectHeight = y }) (f $ _rectHeight attr)-  {-# INLINE rectUpperLeftCorner #-}-  rectUpperLeftCorner f attr =-    fmap (\y -> attr { _rectUpperLeftCorner = y }) (f $ _rectUpperLeftCorner attr)-  {-# INLINE rectWidth #-}-  rectWidth f attr =-    fmap (\y -> attr { _rectWidth = y }) (f $ _rectWidth attr)--instance HasDrawAttributes Rectangle where-    drawAttributes = rectDrawAttributes--instance WithDefaultSvg Rectangle where-  defaultSvg = Rectangle-    { _rectDrawAttributes  = mempty-    , _rectUpperLeftCorner = (Num 0, Num 0)-    , _rectWidth           = Nothing-    , _rectHeight          = Nothing-    , _rectCornerRadius    = (Nothing, Nothing)-    }---- | Type mapping the `<path>` svg tag.-data Path = Path-  { -- | Drawing attributes of the path.-    _pathDrawAttributes :: !DrawAttributes-    -- | Definition of the path, correspond to the-    -- `d` attributes.-  , _pathDefinition     :: ![PathCommand]-  }-  deriving (Eq, Show, Generic, Hashable)---- makeClassy ''Path--- | Lenses for the Path type-class HasPath c_alhy where-  path :: Lens' c_alhy Path-  pathDefinition :: Lens' c_alhy [PathCommand]-  {-# INLINE pathDefinition #-}-  pathDefinition = path . pathDefinition--  pathDrawAttributes :: Lens' c_alhy DrawAttributes-  {-# INLINE pathDrawAttributes #-}-  pathDrawAttributes = path . pathDrawAttributes--instance HasPath Path where-  path = id-  {-# INLINE pathDefinition #-}-  pathDefinition f attr =-    fmap (\y -> attr { _pathDefinition = y }) (f $ _pathDefinition attr)-  {-# INLINE pathDrawAttributes #-}-  pathDrawAttributes f attr =-    fmap (\y -> attr { _pathDrawAttributes = y }) (f $ _pathDrawAttributes attr)--instance HasDrawAttributes Path where-  drawAttributes = pathDrawAttributes--instance WithDefaultSvg Path where-  defaultSvg = Path-    { _pathDrawAttributes = mempty-    , _pathDefinition = []-    }---- | Define a SVG group, corresponding `<g>` tag.-data Group a = Group-  { -- | Group drawing attributes, propagated to all of its-    -- children.-    _groupDrawAttributes :: !DrawAttributes-    -- | Content of the group, corresponding to all the tags-    -- inside the `<g>` tag.-  , _groupChildren       :: ![a]-    -- | Mapped to the attribute `viewBox`-  , _groupViewBox        :: !(Maybe (Double, Double, Double, Double))-    -- | used for symbols only-  , _groupAspectRatio    :: !PreserveAspectRatio-  }-  deriving (Eq, Show, Generic, Hashable)---- makeClassy ''Group--- | Lenses associated to the Group type.-class HasGroup g a | g -> a where-  group :: Lens' g (Group a)-  groupAspectRatio :: Lens' g PreserveAspectRatio-  {-# INLINE groupAspectRatio #-}-  groupAspectRatio = group . groupAspectRatio--  groupChildren :: Lens' g [a]-  {-# INLINE groupChildren #-}-  groupChildren = group . groupChildren--  groupDrawAttributes :: Lens' g DrawAttributes-  {-# INLINE groupDrawAttributes #-}-  groupDrawAttributes = group . groupDrawAttributes--  groupViewBox :: Lens' g (Maybe (Double, Double, Double, Double))-  {-# INLINE groupViewBox #-}-  groupViewBox = group . groupViewBox--instance HasGroup (Group a) a where-  group = id-  {-# INLINE groupAspectRatio #-}-  groupAspectRatio f attr =-    fmap (\y -> attr { _groupAspectRatio = y }) (f $ _groupAspectRatio attr)--  {-# INLINE groupChildren #-}-  groupChildren f attr =-    fmap (\y -> attr { _groupChildren = y }) (f $ _groupChildren attr)--  {-# INLINE groupDrawAttributes #-}-  groupDrawAttributes f attr =-    fmap (\y -> attr { _groupDrawAttributes = y }) (f $ _groupDrawAttributes attr)--  {-# INLINE groupViewBox #-}-  groupViewBox f attr =-    fmap (\y -> attr { _groupViewBox = y }) (f $ _groupViewBox attr)--instance HasDrawAttributes (Group a) where-  drawAttributes = groupDrawAttributes--instance WithDefaultSvg (Group a) where-  defaultSvg = Group-    { _groupDrawAttributes = mempty-    , _groupChildren  = []-    , _groupViewBox = Nothing-    , _groupAspectRatio = defaultSvg-    }---- | Define the `<symbol>` tag, equivalent to--- a hidden named group.-newtype Symbol a =-    Symbol { _groupOfSymbol :: Group a }-  deriving (Eq, Show, Generic, Hashable)--instance HasGroup (Symbol a) a where-  group = groupOfSymbol---- makeLenses ''Symbol--- | Lenses associated with the Symbol type.-groupOfSymbol :: Lens (Symbol s) (Symbol t) (Group s) (Group t)-{-# INLINE groupOfSymbol #-}-groupOfSymbol f = fmap Symbol . f . _groupOfSymbol--instance HasDrawAttributes (Symbol a) where-  drawAttributes = groupOfSymbol . drawAttributes--instance WithDefaultSvg (Symbol a) where-  defaultSvg = Symbol defaultSvg---- | Define the `<defs>` tag, equivalent to--- a named symbol.-newtype Definitions a =-    Definitions { _groupOfDefinitions :: Group a }-  deriving (Eq, Show, Generic, Hashable)--instance HasGroup (Definitions a) a where-  group = groupOfDefinitions---- makeLenses ''Definitions--- | Lenses associated with the Definitions type.-groupOfDefinitions :: Lens (Definitions s) (Definitions t) (Group s) (Group t)-{-# INLINE groupOfDefinitions #-}-groupOfDefinitions f = fmap Definitions . f . _groupOfDefinitions--instance HasDrawAttributes (Definitions a) where-  drawAttributes = groupOfDefinitions . drawAttributes--instance WithDefaultSvg (Definitions a) where-  defaultSvg = Definitions defaultSvg---- | Define the `<filter>` tag.-data Filter = Filter-  { _filterDrawAttributes :: !DrawAttributes-  , _filterSelfAttributes :: !FilterAttributes-  , _filterChildren       :: ![FilterElement]-  }-  deriving (Eq, Show, Generic, Hashable)--instance WithDefaultSvg Filter where-  defaultSvg = Filter-    { _filterDrawAttributes = defaultSvg-    , _filterSelfAttributes     = defaultSvg-    , _filterChildren       = []-    }---- | Define a `<circle>`.-data Circle = Circle-  { -- | Drawing attributes of the circle.-    _circleDrawAttributes :: !DrawAttributes-    -- | Define the center of the circle, describe-    -- the `cx` and `cy` attributes.-  , _circleCenter         :: !Point-    -- | Radius of the circle, equivalent to the `r`-    -- attribute.-  , _circleRadius         :: !Number-  }-  deriving (Eq, Show, Generic, Hashable)---- makeClassy ''Circle--- | Lenses for the Circle type.-class HasCircle a where-  circle :: Lens' a Circle-  circleCenter :: Lens' a Point-  {-# INLINE circleCenter #-}-  circleCenter = circle . circleCenter--  circleDrawAttributes :: Lens' a DrawAttributes-  {-# INLINE circleDrawAttributes #-}-  circleDrawAttributes = circle . circleDrawAttributes--  circleRadius :: Lens' a Number-  {-# INLINE circleRadius #-}-  circleRadius = circle . circleRadius--instance HasCircle Circle where-  circle = id-  {-# INLINE circleCenter #-}-  circleCenter f attr =-    fmap (\y -> attr { _circleCenter = y }) (f $ _circleCenter attr)-  {-# INLINE circleDrawAttributes #-}-  circleDrawAttributes f attr =-    fmap (\y -> attr { _circleDrawAttributes = y }) (f $ _circleDrawAttributes attr)-  {-# INLINE circleRadius #-}-  circleRadius f attr =-    fmap (\y -> attr { _circleRadius = y }) (f $ _circleRadius attr)--instance HasDrawAttributes Circle where-    drawAttributes = circleDrawAttributes--instance WithDefaultSvg Circle where-  defaultSvg = Circle-    { _circleDrawAttributes = mempty-    , _circleCenter = (Num 0, Num 0)-    , _circleRadius = Num 0-    }---- | Define an `<ellipse>`-data Ellipse = Ellipse-  {  -- | Drawing attributes of the ellipse.-    _ellipseDrawAttributes :: !DrawAttributes-    -- | Center of the ellipse, map to the `cx`-    -- and `cy` attributes.-  , _ellipseCenter         :: !Point-    -- | Radius along the X axis, map the-    -- `rx` attribute.-  , _ellipseXRadius        :: !Number-    -- | Radius along the Y axis, map the-    -- `ry` attribute.-  , _ellipseYRadius        :: !Number-  }-  deriving (Eq, Show, Generic, Hashable)---- makeClassy ''Ellipse--- | Lenses for the ellipse type.-class HasEllipse c_amWt where-  ellipse :: Lens' c_amWt Ellipse-  ellipseCenter :: Lens' c_amWt Point-  {-# INLINE ellipseCenter #-}-  ellipseDrawAttributes :: Lens' c_amWt DrawAttributes-  {-# INLINE ellipseDrawAttributes #-}-  ellipseXRadius :: Lens' c_amWt Number-  {-# INLINE ellipseXRadius #-}-  ellipseYRadius :: Lens' c_amWt Number-  {-# INLINE ellipseYRadius #-}-  ellipseCenter = ((.) ellipse) ellipseCenter-  ellipseDrawAttributes = ((.) ellipse) ellipseDrawAttributes-  ellipseXRadius = ((.) ellipse) ellipseXRadius-  ellipseYRadius = ((.) ellipse) ellipseYRadius--instance HasEllipse Ellipse where-  {-# INLINE ellipseCenter #-}-  {-# INLINE ellipseDrawAttributes #-}-  {-# INLINE ellipseXRadius #-}-  {-# INLINE ellipseYRadius #-}-  ellipse = id-  ellipseCenter f attr =-    fmap (\y -> attr { _ellipseCenter = y }) (f $ _ellipseCenter attr)-  ellipseDrawAttributes f attr =-    fmap (\y -> attr { _ellipseDrawAttributes = y }) (f $ _ellipseDrawAttributes attr)-  ellipseXRadius f attr =-    fmap (\y -> attr { _ellipseXRadius = y }) (f $ _ellipseXRadius attr)-  ellipseYRadius f attr =-    fmap (\y -> attr { _ellipseYRadius = y }) (f $ _ellipseYRadius attr)--instance HasDrawAttributes Ellipse where-  drawAttributes = ellipseDrawAttributes--instance WithDefaultSvg Ellipse where-  defaultSvg = Ellipse-    { _ellipseDrawAttributes = mempty-    , _ellipseCenter = (Num 0, Num 0)-    , _ellipseXRadius = Num 0-    , _ellipseYRadius = Num 0-    }---- | Define a color stop for the gradients. Represent--- the `<stop>` SVG tag.-data GradientStop = GradientStop-    { -- | Gradient offset between 0 and 1, correspond-      -- to the `offset` attribute.-      _gradientOffset  :: !Float-      -- | Color of the gradient stop. Correspond-      -- to the `stop-color` attribute.-    , _gradientColor   :: !PixelRGBA8-      -- | Path command used in mesh patch-    , _gradientPath    :: !(Maybe GradientPathCommand)-      -- | Stop color opacity-    , _gradientOpacity :: !(Maybe Float)-    }-    deriving (Eq, Show, Generic, Hashable)---- makeClassy ''GradientStop--- | Lenses for the GradientStop type.-class HasGradientStop c_anhM where-  gradientStop :: Lens' c_anhM GradientStop-  gradientColor :: Lens' c_anhM PixelRGBA8-  {-# INLINE gradientColor #-}-  gradientOffset :: Lens' c_anhM Float-  {-# INLINE gradientOffset #-}-  gradientOpacity :: Lens' c_anhM (Maybe Float)-  {-# INLINE gradientOpacity #-}-  gradientPath :: Lens' c_anhM (Maybe GradientPathCommand)-  {-# INLINE gradientPath #-}-  gradientColor = ((.) gradientStop) gradientColor-  gradientOffset = ((.) gradientStop) gradientOffset-  gradientOpacity = ((.) gradientStop) gradientOpacity-  gradientPath = ((.) gradientStop) gradientPath--instance HasGradientStop GradientStop where-  {-# INLINE gradientColor #-}-  {-# INLINE gradientOffset #-}-  {-# INLINE gradientOpacity #-}-  {-# INLINE gradientPath #-}-  gradientStop = id-  gradientColor f attr =-    fmap (\y -> attr { _gradientColor = y }) (f $ _gradientColor attr)-  gradientOffset f attr =-    fmap (\y -> attr { _gradientOffset = y }) (f $ _gradientOffset attr)-  gradientOpacity f attr =-    fmap (\y -> attr { _gradientOpacity = y }) (f $ _gradientOpacity attr)-  gradientPath f attr =-    fmap (\y -> attr { _gradientPath = y }) (f $ _gradientPath attr)--instance WithDefaultSvg GradientStop where-  defaultSvg = GradientStop-    { _gradientOffset = 0.0-    , _gradientColor  = PixelRGBA8 0 0 0 255-    , _gradientPath   = Nothing-    , _gradientOpacity = Nothing-    }----- | Define `<meshpatch>` SVG tag-data MeshGradientPatch = MeshGradientPatch-  { -- | List of stop, from 2 to 4 in a patch-    _meshGradientPatchStops :: ![GradientStop]-  }-  deriving (Eq, Show, Generic, Hashable)---- makeClassy ''MeshGradientPatch-class HasMeshGradientPatch c_annx where-  meshGradientPatch :: Lens' c_annx MeshGradientPatch-  meshGradientPatchStops :: Lens' c_annx [GradientStop]-  {-# INLINE meshGradientPatchStops #-}-  meshGradientPatchStops =  meshGradientPatch . meshGradientPatchStops--instance HasMeshGradientPatch MeshGradientPatch where-  {-# INLINE meshGradientPatchStops #-}-  meshGradientPatch = id-  meshGradientPatchStops f m =-    fmap (\y -> m { _meshGradientPatchStops = y }) . f $ _meshGradientPatchStops m--instance WithDefaultSvg MeshGradientPatch where-  defaultSvg = MeshGradientPatch []---- | Define a `<meshrow>` tag.-data MeshGradientRow = MeshGradientRow-  { -- | List of patch in a row-    _meshGradientRowPatches :: ![MeshGradientPatch]-  }-  deriving (Eq, Show, Generic, Hashable)---- makeClassy ''MeshGradientRow-class HasMeshGradientRow c_antr where-  meshGradientRow :: Lens' c_antr MeshGradientRow-  meshGradientRowPatches :: Lens' c_antr [MeshGradientPatch]-  {-# INLINE meshGradientRowPatches #-}-  meshGradientRowPatches = meshGradientRow . meshGradientRowPatches--instance HasMeshGradientRow MeshGradientRow where-  {-# INLINE meshGradientRowPatches #-}-  meshGradientRow = id-  meshGradientRowPatches f m =-      fmap (\y -> m { _meshGradientRowPatches = y }) . f $ _meshGradientRowPatches m--instance WithDefaultSvg MeshGradientRow where-  defaultSvg = MeshGradientRow []----- | Define a `<meshgradient>` tag.-data MeshGradient = MeshGradient-  { _meshGradientDrawAttributes :: !DrawAttributes-    -- | Original x coordinate of the mesh gradient-  , _meshGradientX              :: !Number-    -- | Original y coordinate of the mesh gradient-  , _meshGradientY              :: !Number-    -- | Type of color interpolation to use-  , _meshGradientType           :: !MeshGradientType-    -- | Coordiante system to use-  , _meshGradientUnits          :: !CoordinateUnits-    -- | Optional transform-  , _meshGradientTransform      :: ![Transformation]-    -- | List of patch rows in the the mesh.-  , _meshGradientRows           :: ![MeshGradientRow]-  }-  deriving (Eq, Show, Generic, Hashable)---- makeClassy ''MeshGradient-class HasMeshGradient c_anxG where-  meshGradient :: Lens' c_anxG MeshGradient-  meshGradientDrawAttributes :: Lens' c_anxG DrawAttributes-  {-# INLINE meshGradientDrawAttributes #-}-  meshGradientRows :: Lens' c_anxG [MeshGradientRow]-  {-# INLINE meshGradientRows #-}-  meshGradientTransform :: Lens' c_anxG [Transformation]-  {-# INLINE meshGradientTransform #-}-  meshGradientType :: Lens' c_anxG MeshGradientType-  {-# INLINE meshGradientType #-}-  meshGradientUnits :: Lens' c_anxG CoordinateUnits-  {-# INLINE meshGradientUnits #-}-  meshGradientX :: Lens' c_anxG Number-  {-# INLINE meshGradientX #-}-  meshGradientY :: Lens' c_anxG Number-  {-# INLINE meshGradientY #-}-  meshGradientDrawAttributes-    = ((.) meshGradient) meshGradientDrawAttributes-  meshGradientRows = ((.) meshGradient) meshGradientRows-  meshGradientTransform = ((.) meshGradient) meshGradientTransform-  meshGradientType = ((.) meshGradient) meshGradientType-  meshGradientUnits = ((.) meshGradient) meshGradientUnits-  meshGradientX = ((.) meshGradient) meshGradientX-  meshGradientY = ((.) meshGradient) meshGradientY-instance HasMeshGradient MeshGradient where-  {-# INLINE meshGradientDrawAttributes #-}-  {-# INLINE meshGradientRows #-}-  {-# INLINE meshGradientTransform #-}-  {-# INLINE meshGradientType #-}-  {-# INLINE meshGradientUnits #-}-  {-# INLINE meshGradientX #-}-  {-# INLINE meshGradientY #-}-  meshGradient = id-  meshGradientDrawAttributes f attr =-    fmap (\y -> attr { _meshGradientDrawAttributes = y }) (f $ _meshGradientDrawAttributes attr)-  meshGradientRows f attr =-    fmap (\y -> attr { _meshGradientRows = y }) (f $ _meshGradientRows attr)-  meshGradientTransform f attr =-    fmap (\y -> attr { _meshGradientTransform = y }) (f $ _meshGradientTransform attr)-  meshGradientType f attr =-    fmap (\y -> attr { _meshGradientType = y }) (f $ _meshGradientType attr)-  meshGradientUnits f attr =-    fmap (\y -> attr { _meshGradientUnits = y }) (f $ _meshGradientUnits attr)-  meshGradientX f attr =-    fmap (\y -> attr { _meshGradientX = y }) (f $ _meshGradientX attr)-  meshGradientY f attr =-    fmap (\y -> attr { _meshGradientY = y }) (f $ _meshGradientY attr)---instance HasDrawAttributes MeshGradient where-  drawAttributes = meshGradientDrawAttributes--instance WithDefaultSvg MeshGradient where-  defaultSvg = MeshGradient-    { _meshGradientDrawAttributes = mempty-    , _meshGradientX              = Percent 0-    , _meshGradientY              = Percent 0-    , _meshGradientType           = GradientBilinear-    , _meshGradientUnits          = CoordBoundingBox-    , _meshGradientTransform      = mempty-    , _meshGradientRows           = mempty-    }----- | Define an `<image>` tag.-data Image = Image-  { -- | Drawing attributes of the image-    _imageDrawAttributes  :: !DrawAttributes-    -- | Position of the image referenced by its-    -- upper left corner.-  , _imageCornerUpperLeft :: !Point-    -- | Image width-  , _imageWidth           :: !Number-    -- | Image Height-  , _imageHeight          :: !Number-    -- | Image href, pointing to the real image.-  , _imageHref            :: !String-    -- | preserveAspectRatio attribute-  , _imageAspectRatio     :: !PreserveAspectRatio-  }-  deriving (Eq, Show, Generic, Hashable)---- makeClassy ''Image--- | Lenses for the Image type.-class HasImage c_anI7 where-  image :: Lens' c_anI7 Image-  imageAspectRatio :: Lens' c_anI7 PreserveAspectRatio-  {-# INLINE imageAspectRatio #-}-  imageCornerUpperLeft :: Lens' c_anI7 Point-  {-# INLINE imageCornerUpperLeft #-}-  imageDrawAttributes :: Lens' c_anI7 DrawAttributes-  {-# INLINE imageDrawAttributes #-}-  imageHeight :: Lens' c_anI7 Number-  {-# INLINE imageHeight #-}-  imageHref :: Lens' c_anI7 String-  {-# INLINE imageHref #-}-  imageWidth :: Lens' c_anI7 Number-  {-# INLINE imageWidth #-}-  imageAspectRatio = ((.) image) imageAspectRatio-  imageCornerUpperLeft = ((.) image) imageCornerUpperLeft-  imageDrawAttributes = ((.) image) imageDrawAttributes-  imageHeight = ((.) image) imageHeight-  imageHref = ((.) image) imageHref-  imageWidth = ((.) image) imageWidth-instance HasImage Image where-  {-# INLINE imageAspectRatio #-}-  {-# INLINE imageCornerUpperLeft #-}-  {-# INLINE imageDrawAttributes #-}-  {-# INLINE imageHeight #-}-  {-# INLINE imageHref #-}-  {-# INLINE imageWidth #-}-  image = id-  imageAspectRatio f attr =-    fmap (\y -> attr { _imageAspectRatio = y }) (f $ _imageAspectRatio attr)-  imageCornerUpperLeft f attr =-    fmap (\y -> attr { _imageCornerUpperLeft = y }) (f $ _imageCornerUpperLeft attr)-  imageDrawAttributes f attr =-    fmap (\y -> attr { _imageDrawAttributes = y }) (f $ _imageDrawAttributes attr)-  imageHeight f attr =-    fmap (\y -> attr { _imageHeight = y }) (f $ _imageHeight attr)-  imageHref f attr =-    fmap (\y -> attr { _imageHref = y }) (f $ _imageHref attr)-  imageWidth f attr =-    fmap (\y -> attr { _imageWidth = y }) (f $ _imageWidth attr)---instance HasDrawAttributes Image where-  drawAttributes = imageDrawAttributes--instance WithDefaultSvg Image where-  defaultSvg = Image-    { _imageDrawAttributes = mempty-    , _imageCornerUpperLeft = (Num 0, Num 0)-    , _imageWidth = Num 0-    , _imageHeight = Num 0-    , _imageHref = ""-    , _imageAspectRatio = defaultSvg-    }---- | Define an `<use>` for a named content.--- Every named content can be reused in the--- document using this element.-data Use = Use-  { -- | Position where to draw the "used" element.-    -- Correspond to the `x` and `y` attributes.-    _useBase           :: Point-    -- | Referenced name, correspond to `xlink:href`-    -- attribute.-  , _useName           :: String-    -- | Define the width of the region where-    -- to place the element. Map to the `width`-    -- attribute.-  , _useWidth          :: Maybe Number-    -- | Define the height of the region where-    -- to place the element. Map to the `height`-    -- attribute.-  , _useHeight         :: Maybe Number-    -- | Use draw attributes.-  , _useDrawAttributes :: DrawAttributes-  }-  deriving (Eq, Show, Generic, Hashable)---- makeClassy ''Use--- | Lenses for the Use type.-class HasUse c_anR3 where-  use :: Lens' c_anR3 Use-  useBase :: Lens' c_anR3 Point-  {-# INLINE useBase #-}-  useDrawAttributes :: Lens' c_anR3 DrawAttributes-  {-# INLINE useDrawAttributes #-}-  useHeight :: Lens' c_anR3 (Maybe Number)-  {-# INLINE useHeight #-}-  useName :: Lens' c_anR3 String-  {-# INLINE useName #-}-  useWidth :: Lens' c_anR3 (Maybe Number)-  {-# INLINE useWidth #-}-  useBase = ((.) use) useBase-  useDrawAttributes = ((.) use) useDrawAttributes-  useHeight = ((.) use) useHeight-  useName = ((.) use) useName-  useWidth = ((.) use) useWidth-instance HasUse Use where-  {-# INLINE useBase #-}-  {-# INLINE useDrawAttributes #-}-  {-# INLINE useHeight #-}-  {-# INLINE useName #-}-  {-# INLINE useWidth #-}-  use = id-  useBase f attr =-    fmap (\y -> attr { _useBase = y }) (f $ _useBase attr)-  useDrawAttributes f attr =-    fmap (\y -> attr { _useDrawAttributes = y }) (f $ _useDrawAttributes attr)-  useHeight f attr =-    fmap (\y -> attr { _useHeight = y }) (f $ _useHeight attr)-  useName f attr =-    fmap (\y -> attr { _useName = y }) (f $ _useName attr)-  useWidth f attr =-    fmap (\y -> attr { _useWidth = y }) (f $ _useWidth attr)--instance HasDrawAttributes Use where-  drawAttributes = useDrawAttributes--instance WithDefaultSvg Use where-  defaultSvg = Use-    { _useBase   = (Num 0, Num 0)-    , _useName   = ""-    , _useWidth  = Nothing-    , _useHeight = Nothing-    , _useDrawAttributes = mempty-    }---- | Define position information associated to--- `<text>` or `<tspan>` svg tag.-data TextInfo = TextInfo-  { _textInfoX      :: ![Number] -- ^ `x` attribute.-  , _textInfoY      :: ![Number] -- ^ `y` attribute.-  , _textInfoDX     :: ![Number] -- ^ `dx` attribute.-  , _textInfoDY     :: ![Number] -- ^ `dy` attribute.-  , _textInfoRotate :: ![Double] -- ^ `rotate` attribute.-  , _textInfoLength :: !(Maybe Number) -- ^ `textLength` attribute.-  }-  deriving (Eq, Show, Generic, Hashable)--instance Semigroup TextInfo where-  (<>) (TextInfo x1 y1 dx1 dy1 r1 l1)-       (TextInfo x2 y2 dx2 dy2 r2 l2) =-    TextInfo (x1 <> x2)   (y1 <> y2)-                (dx1 <> dx2) (dy1 <> dy2)-                (r1 <> r2)-                (getLast $ Last l1 <> Last l2)--instance Monoid TextInfo where-  mempty = TextInfo [] [] [] [] [] Nothing-  mappend = (<>)---- makeClassy ''TextInfo--- | Lenses for the TextInfo type.-class HasTextInfo c_ao0m where-  textInfo :: Lens' c_ao0m TextInfo-  textInfoDX :: Lens' c_ao0m [Number]-  {-# INLINE textInfoDX #-}-  textInfoDY :: Lens' c_ao0m [Number]-  {-# INLINE textInfoDY #-}-  textInfoLength :: Lens' c_ao0m (Maybe Number)-  {-# INLINE textInfoLength #-}-  textInfoRotate :: Lens' c_ao0m [Double]-  {-# INLINE textInfoRotate #-}-  textInfoX :: Lens' c_ao0m [Number]-  {-# INLINE textInfoX #-}-  textInfoY :: Lens' c_ao0m [Number]-  {-# INLINE textInfoY #-}-  textInfoDX = ((.) textInfo) textInfoDX-  textInfoDY = ((.) textInfo) textInfoDY-  textInfoLength = ((.) textInfo) textInfoLength-  textInfoRotate = ((.) textInfo) textInfoRotate-  textInfoX = ((.) textInfo) textInfoX-  textInfoY = ((.) textInfo) textInfoY-instance HasTextInfo TextInfo where-  {-# INLINE textInfoDX #-}-  {-# INLINE textInfoDY #-}-  {-# INLINE textInfoLength #-}-  {-# INLINE textInfoRotate #-}-  {-# INLINE textInfoX #-}-  {-# INLINE textInfoY #-}-  textInfo = id-  textInfoDX f attr =-    fmap (\y -> attr { _textInfoDX = y }) (f $ _textInfoDX attr)-  textInfoDY f attr =-    fmap (\y -> attr { _textInfoDY = y }) (f $ _textInfoDY attr)-  textInfoLength f attr =-    fmap (\y -> attr { _textInfoLength = y }) (f $ _textInfoLength attr)-  textInfoRotate f attr =-    fmap (\y -> attr { _textInfoRotate = y }) (f $ _textInfoRotate attr)-  textInfoX f attr =-    fmap (\y -> attr { _textInfoX = y }) (f $ _textInfoX attr)-  textInfoY f attr =-    fmap (\y -> attr { _textInfoY = y }) (f $ _textInfoY attr)--instance WithDefaultSvg TextInfo where-  defaultSvg = mempty---- | Define the content of a `<tspan>` tag.-data TextSpanContent-    = SpanText    !T.Text -- ^ Raw text-    | SpanTextRef !String -- ^ Equivalent to a `<tref>`-    | SpanSub     !TextSpan -- ^ Define a `<tspan>`-    deriving (Eq, Show, Generic, Hashable)---- | Define a `<tspan>` tag.-data TextSpan = TextSpan-  { -- | Placing information for the text.-    _spanInfo           :: !TextInfo-    -- | Drawing attributes for the text span.-  , _spanDrawAttributes :: !DrawAttributes-    -- | Content of the span.-  , _spanContent        :: ![TextSpanContent]-  }-  deriving (Eq, Show, Generic, Hashable)---- makeClassy ''TextSpan--- | Lenses for the TextSpan type.-class HasTextSpan c_aobD where-  textSpan :: Lens' c_aobD TextSpan-  spanContent :: Lens' c_aobD [TextSpanContent]-  {-# INLINE spanContent #-}-  spanDrawAttributes :: Lens' c_aobD DrawAttributes-  {-# INLINE spanDrawAttributes #-}-  spanInfo :: Lens' c_aobD TextInfo-  {-# INLINE spanInfo #-}-  spanContent = ((.) textSpan) spanContent-  spanDrawAttributes = ((.) textSpan) spanDrawAttributes-  spanInfo = ((.) textSpan) spanInfo-instance HasTextSpan TextSpan where-  {-# INLINE spanContent #-}-  {-# INLINE spanDrawAttributes #-}-  {-# INLINE spanInfo #-}-  textSpan = id-  spanContent f attr =-    fmap (\y -> attr { _spanContent = y }) (f $ _spanContent attr)-  spanDrawAttributes f attr =-    fmap (\y -> attr { _spanDrawAttributes = y }) (f $ _spanDrawAttributes attr)-  spanInfo f attr =-    fmap (\y -> attr { _spanInfo = y }) (f $ _spanInfo attr)--instance WithDefaultSvg TextSpan where-  defaultSvg = TextSpan-    { _spanInfo = defaultSvg-    , _spanDrawAttributes = mempty-    , _spanContent        = mempty-    }---- | Describe the content of the `method` attribute on--- text path.-data TextPathMethod-  = TextPathAlign   -- ^ Map to the `align` value.-  | TextPathStretch -- ^ Map to the `stretch` value.-  deriving (Eq, Show, Generic, Hashable)---- | Describe the content of the `spacing` text path--- attribute.-data TextPathSpacing-  = TextPathSpacingExact -- ^ Map to the `exact` value.-  | TextPathSpacingAuto  -- ^ Map to the `auto` value.-  deriving (Eq, Show, Generic, Hashable)---- | Describe the `<textpath>` SVG tag.-data TextPath = TextPath-  { -- | Define the beginning offset on the path,-    -- the `startOffset` attribute.-    _textPathStartOffset :: !Number-    -- | Define the `xlink:href` attribute.-  , _textPathName        :: !String-    -- | Correspond to the `method` attribute.-  , _textPathMethod      :: !TextPathMethod-    -- | Correspond to the `spacing` attribute.-  , _textPathSpacing     :: !TextPathSpacing-  }-  deriving (Eq, Show, Generic, Hashable)---- -- | Lenses for the TextPath type.--instance WithDefaultSvg TextPath where-  defaultSvg = TextPath-    { _textPathStartOffset = Num 0-    , _textPathName        = mempty-    , _textPathMethod      = TextPathAlign-    , _textPathSpacing     = TextPathSpacingExact-    }---- | Define the possible values of the `lengthAdjust`--- attribute.-data TextAdjust-  = TextAdjustSpacing -- ^ Value `spacing`-  | TextAdjustSpacingAndGlyphs -- ^ Value `spacingAndGlyphs`-  deriving (Eq, Show, Generic, Hashable)---- | Define the global `<tag>` SVG tag.-data Text = Text-  { -- | Define the `lengthAdjust` attribute.-    _textAdjust :: !TextAdjust-    -- | Root of the text content.-  , _textRoot   :: !TextSpan-  }-  deriving (Eq, Show, Generic, Hashable)---- makeClassy ''Text--- | Lenses for the Text type.-class HasText c_aorD where-  text :: Lens' c_aorD Text-  textAdjust :: Lens' c_aorD TextAdjust-  {-# INLINE textAdjust #-}-  textRoot :: Lens' c_aorD TextSpan-  {-# INLINE textRoot #-}-  textAdjust = ((.) text) textAdjust-  textRoot = ((.) text) textRoot-instance HasText Text where-  {-# INLINE textAdjust #-}-  {-# INLINE textRoot #-}-  text = id-  textAdjust f attr =-    fmap (\y -> attr { _textAdjust = y }) (f $ _textAdjust attr)-  textRoot f attr =-    fmap (\y -> attr { _textRoot = y }) (f $ _textRoot attr)---- | Little helper to create a SVG text at a given--- baseline position.-textAt :: Point -> T.Text -> Text-textAt (x, y) txt = Text TextAdjustSpacing tspan where-  tspan = defaultSvg-        { _spanContent = [SpanText txt]-        , _spanInfo = defaultSvg-                    { _textInfoX = [x]-                    , _textInfoY = [y]-                    }-        }--instance HasDrawAttributes Text where-  drawAttributes = textRoot . spanDrawAttributes--instance WithDefaultSvg Text where-  defaultSvg = Text-    { _textRoot = defaultSvg-    , _textAdjust = TextAdjustSpacing-    }---- | Main type for the scene description, reorient to--- specific type describing each tag.-data Tree-    = None-    | UseTree { useInformation :: !Use-              , useSubTree     :: !(Maybe Tree) }-    | GroupTree     !(Group Tree)-    | SymbolTree    !(Symbol Tree)-    | DefinitionTree !(Definitions Tree)-    | FilterTree    !Filter-    | PathTree      !Path-    | CircleTree    !Circle-    | PolyLineTree  !PolyLine-    | PolygonTree   !Polygon-    | EllipseTree   !Ellipse-    | LineTree      !Line-    | RectangleTree !Rectangle-    | TextTree      !(Maybe TextPath) !Text-    | ImageTree     !Image-    | LinearGradientTree !LinearGradient-    | RadialGradientTree !RadialGradient-    | MeshGradientTree !MeshGradient-    | PatternTree   !Pattern-    | MarkerTree    !Marker-    | MaskTree      !Mask-    | ClipPathTree  !ClipPath-    | SvgTree       !Document-    deriving (Eq, Show, Generic, Hashable)--data FilterElement-  = FEBlend-  | FEColorMatrix ColorMatrix-  | FEComponentTransfer -- Need-  | FEComposite Composite-  | FEConvolveMatrix-  | FEDiffuseLighting-  | FEDisplacementMap DisplacementMap-  | FEDropShadow-  | FEFlood-  | FEFuncA -- Need-  | FEFuncB-  | FEFuncG-  | FEFuncR-  | FEGaussianBlur GaussianBlur-  | FEImage-  | FEMerge-  | FEMergeNode-  | FEMorphology-  | FEOffset-  | FESpecularLighting-  | FETile-  | FETurbulence Turbulence-  | FENone-  deriving (Eq,Show, Generic, Hashable)--instance WithDefaultSvg FilterElement where-  defaultSvg = FENone--data TransferFunctionType-  = TFIdentity-  | TFTable-  | TFDiscrete-  | TFLinear-  | TFGamma-  deriving (Eq, Show, Generic, Hashable)--data TransferFunction = TransferFunction-  { _transferFunctionDrawAttributes   :: !DrawAttributes-  , _transferFunctionFilterAttr       :: !FilterAttributes-  , _transferFunctionType             :: TransferFunctionType-  , _transferFunctionTableValues      :: [Double]-  , _transferFunctionSlope            :: Double-  , _transferFunctionIntercept        :: Double-  , _transferFunctionAmplitude        :: Double-  , _transferFunctionExponent         :: Double-  , _transferFunctionOffset           :: Double-  } deriving (Eq, Show, Generic, Hashable)--data ChannelSelector-  = ChannelR-  | ChannelG-  | ChannelB-  | ChannelA-  deriving (Eq, Show, Generic, Hashable)--data DisplacementMap = DisplacementMap-  { _displacementMapDrawAttributes   :: !DrawAttributes-  , _displacementMapFilterAttr       :: !FilterAttributes-  , _displacementMapIn               :: !(Last FilterSource)-  , _displacementMapIn2              :: !(Last FilterSource)-  , _displacementMapScale            :: !(Last Double)-  , _displacementMapXChannelSelector :: ChannelSelector-  , _displacementMapYChannelSelector :: ChannelSelector-  } deriving (Eq, Show, Generic, Hashable)--instance WithDefaultSvg DisplacementMap where-  defaultSvg = DisplacementMap-    { _displacementMapDrawAttributes   = defaultSvg-    , _displacementMapFilterAttr       = defaultSvg-    , _displacementMapIn               = Last Nothing-    , _displacementMapIn2              = Last Nothing-    , _displacementMapScale            = Last Nothing-    , _displacementMapXChannelSelector = ChannelA-    , _displacementMapYChannelSelector = ChannelA-    }--data ColorMatrixType-  = Matrix-  | Saturate-  | HueRotate-  | LuminanceToAlpha-  deriving (Eq,Show, Generic, Hashable)--data ColorMatrix = ColorMatrix-  { _colorMatrixDrawAttributes :: !DrawAttributes-  , _colorMatrixFilterAttr     :: !FilterAttributes-  , _colorMatrixIn             :: !(Last FilterSource)-  , _colorMatrixType           :: !ColorMatrixType-  , _colorMatrixValues         :: !String-  } deriving (Eq,Show, Generic, Hashable)--instance WithDefaultSvg ColorMatrix where-  defaultSvg = ColorMatrix-    { _colorMatrixDrawAttributes = defaultSvg-    , _colorMatrixFilterAttr     = defaultSvg-    , _colorMatrixIn             = Last Nothing-    , _colorMatrixType           = Matrix-    , _colorMatrixValues         = ""-    }--data CompositeOperator-  = CompositeOver -- this is default-  | CompositeIn-  | CompositeOut-  | CompositeAtop-  | CompositeXor-  | CompositeArithmetic-  deriving (Eq, Show, Generic, Hashable)--data Composite = Composite-  { _compositeDrawAttributes :: DrawAttributes-  , _compositeFilterAttr     :: !FilterAttributes-  , _compositeIn             :: Last FilterSource-  , _compositeIn2            :: Last FilterSource-  , _compositeOperator       :: CompositeOperator-  , _compositeK1             :: Number-  , _compositeK2             :: Number-  , _compositeK3             :: Number-  , _compositeK4             :: Number-  } deriving (Eq, Show, Generic, Hashable)--instance WithDefaultSvg Composite where-  defaultSvg = Composite-    { _compositeDrawAttributes = defaultSvg-    , _compositeFilterAttr     = defaultSvg-    , _compositeIn             = Last Nothing-    , _compositeIn2            = Last Nothing-    , _compositeOperator       = CompositeOver-    , _compositeK1             = Num 0-    , _compositeK2             = Num 0-    , _compositeK3             = Num 0-    , _compositeK4             = Num 0-    }--data Turbulence = Turbulence-  { _turbulenceDrawAttributes :: !DrawAttributes-  , _turbulenceFilterAttr     :: !FilterAttributes-  , _turbulenceBaseFrequency  :: !(Double, Last Double) -- Not negative-  , _turbulenceNumOctaves     :: Int -- Not negative-  , _turbulenceSeed           :: Double-  , _turbulenceStitchTiles    :: StitchTiles-  , _turbulenceType           :: TurbulenceType-  } deriving (Eq, Show, Generic, Hashable)--data StitchTiles-  = NoStitch-  | Stitch-  deriving (Eq, Show, Generic, Hashable)--data TurbulenceType-  = FractalNoiseType-  | TurbulenceType-  deriving (Eq, Show, Generic, Hashable)--instance WithDefaultSvg Turbulence where-  defaultSvg = Turbulence-    { _turbulenceDrawAttributes = defaultSvg-    , _turbulenceFilterAttr     = defaultSvg-    , _turbulenceBaseFrequency  = (0, Last Nothing)-    , _turbulenceNumOctaves     = 1-    , _turbulenceSeed           = 0-    , _turbulenceStitchTiles    = NoStitch-    , _turbulenceType           = TurbulenceType-    }--data EdgeMode-  = EdgeDuplicate-  | EdgeWrap-  | EdgeNone-  deriving (Eq,Show, Generic, Hashable)--data GaussianBlur = GaussianBlur-  { _gaussianBlurDrawAttributes :: DrawAttributes-  , _gaussianBlurFilterAttr     :: !FilterAttributes-  , _gaussianBlurIn             :: Last FilterSource-  , _gaussianBlurStdDeviationX  :: Number-  , _gaussianBlurStdDeviationY  :: Last Number-  , _gaussianBlurEdgeMode       :: EdgeMode-  } deriving (Eq,Show, Generic, Hashable)--instance WithDefaultSvg GaussianBlur where-  defaultSvg = GaussianBlur-    { _gaussianBlurDrawAttributes = defaultSvg-    , _gaussianBlurFilterAttr     = defaultSvg-    , _gaussianBlurIn             = Last Nothing-    , _gaussianBlurStdDeviationX      = Num 0-    , _gaussianBlurStdDeviationY      = Last Nothing-    , _gaussianBlurEdgeMode           = EdgeDuplicate-    }---- | Define the orientation, associated to the--- `orient` attribute on the Marker-data MarkerOrientation-  = OrientationAuto        -- ^ Auto value-  | OrientationAngle Coord -- ^ Specific angle.-  deriving (Eq, Show, Generic, Hashable)---- | Define the content of the `markerUnits` attribute--- on the Marker.-data MarkerUnit-  = MarkerUnitStrokeWidth    -- ^ Value `strokeWidth`-  | MarkerUnitUserSpaceOnUse -- ^ Value `userSpaceOnUse`-  deriving (Eq, Show, Generic, Hashable)---- | Define the content of the `markerUnits` attribute--- on the Marker.-data Overflow-  = OverflowVisible    -- ^ Value `visible`-  | OverflowHidden     -- ^ Value `hidden`-  deriving (Eq, Show, Generic, Hashable)---- | Define the `<marker>` tag.-data Marker = Marker-  { -- | Draw attributes of the marker.-    _markerDrawAttributes :: DrawAttributes-    -- | Define the reference point of the marker.-    -- correspond to the `refX` and `refY` attributes.-  , _markerRefPoint       :: !(Number, Number)-    -- | Define the width of the marker. Correspond to-    -- the `markerWidth` attribute.-  , _markerWidth          :: !(Maybe Number)-    -- | Define the height of the marker. Correspond to-    -- the `markerHeight` attribute.-  , _markerHeight         :: !(Maybe Number)-    -- | Correspond to the `orient` attribute.-  , _markerOrient         :: !(Maybe MarkerOrientation)-    -- | Map the `markerUnits` attribute.-  , _markerUnits          :: !(Maybe MarkerUnit)-    -- | Optional viewbox-  , _markerViewBox        :: !(Maybe (Double, Double, Double, Double))-    -- | Elements defining the marker.-  , _markerOverflow       :: !(Maybe Overflow)-    -- | preserveAspectRatio attribute-  , _markerAspectRatio    :: !PreserveAspectRatio-    -- | Elements defining the marker.-  , _markerElements       :: [Tree]-  }-  deriving (Eq, Show, Generic, Hashable)---- makeClassy ''Marker--- | Lenses for the Marker type.-class HasMarker c_aoKc where-  marker :: Lens' c_aoKc Marker-  markerAspectRatio :: Lens' c_aoKc PreserveAspectRatio-  {-# INLINE markerAspectRatio #-}-  markerDrawAttributes :: Lens' c_aoKc DrawAttributes-  {-# INLINE markerDrawAttributes #-}-  markerElements :: Lens' c_aoKc [Tree]-  {-# INLINE markerElements #-}-  markerHeight :: Lens' c_aoKc (Maybe Number)-  {-# INLINE markerHeight #-}-  markerOrient :: Lens' c_aoKc (Maybe MarkerOrientation)-  {-# INLINE markerOrient #-}-  markerOverflow :: Lens' c_aoKc (Maybe Overflow)-  {-# INLINE markerOverflow #-}-  markerRefPoint :: Lens' c_aoKc (Number, Number)-  {-# INLINE markerRefPoint #-}-  markerUnits :: Lens' c_aoKc (Maybe MarkerUnit)-  {-# INLINE markerUnits #-}-  markerViewBox ::-    Lens' c_aoKc (Maybe (Double, Double, Double, Double))-  {-# INLINE markerViewBox #-}-  markerWidth :: Lens' c_aoKc (Maybe Number)-  {-# INLINE markerWidth #-}-  markerAspectRatio = ((.) marker) markerAspectRatio-  markerDrawAttributes = ((.) marker) markerDrawAttributes-  markerElements = ((.) marker) markerElements-  markerHeight = ((.) marker) markerHeight-  markerOrient = ((.) marker) markerOrient-  markerOverflow = ((.) marker) markerOverflow-  markerRefPoint = ((.) marker) markerRefPoint-  markerUnits = ((.) marker) markerUnits-  markerViewBox = ((.) marker) markerViewBox-  markerWidth = ((.) marker) markerWidth-instance HasMarker Marker where-  {-# INLINE markerAspectRatio #-}-  {-# INLINE markerDrawAttributes #-}-  {-# INLINE markerElements #-}-  {-# INLINE markerHeight #-}-  {-# INLINE markerOrient #-}-  {-# INLINE markerOverflow #-}-  {-# INLINE markerRefPoint #-}-  {-# INLINE markerUnits #-}-  {-# INLINE markerViewBox #-}-  {-# INLINE markerWidth #-}-  marker = id-  markerAspectRatio f attr =-    fmap (\y -> attr { _markerAspectRatio = y }) (f $ _markerAspectRatio attr)-  markerDrawAttributes f attr =-    fmap (\y -> attr { _markerDrawAttributes = y }) (f $ _markerDrawAttributes attr)-  markerElements f attr =-    fmap (\y -> attr { _markerElements = y }) (f $ _markerElements attr)-  markerHeight f attr =-    fmap (\y -> attr { _markerHeight = y }) (f $ _markerHeight attr)-  markerOrient f attr =-    fmap (\y -> attr { _markerOrient = y }) (f $ _markerOrient attr)-  markerOverflow f attr =-    fmap (\y -> attr { _markerOverflow = y }) (f $ _markerOverflow attr)-  markerRefPoint f attr =-    fmap (\y -> attr { _markerRefPoint = y }) (f $ _markerRefPoint attr)-  markerUnits f attr =-    fmap (\y -> attr { _markerUnits = y }) (f $ _markerUnits attr)-  markerViewBox f attr =-    fmap (\y -> attr { _markerViewBox = y }) (f $ _markerViewBox attr)-  markerWidth f attr =-    fmap (\y -> attr { _markerWidth = y }) (f $ _markerWidth attr)--instance HasDrawAttributes Marker where-  drawAttributes = markerDrawAttributes--instance WithDefaultSvg Marker where-  defaultSvg = Marker-    { _markerDrawAttributes = mempty-    , _markerRefPoint = (Num 0, Num 0)-    , _markerWidth = Just (Num 3)-    , _markerHeight = Just (Num 3)-    , _markerOrient = Nothing -- MarkerOrientation-    , _markerUnits = Nothing -- MarkerUnitStrokeWidth-    , _markerViewBox = Nothing-    , _markerOverflow = Nothing-    , _markerElements = mempty-    , _markerAspectRatio = defaultSvg-    }---- | Insert element in the first sublist in the list of list.-appNode :: [[a]] -> a -> [[a]]-appNode [] e           = [[e]]-appNode (curr:above) e = (e:curr) : above---- | Map a tree while propagating context information.--- The function passed in parameter receive a list--- representing the the path used to go arrive to the--- current node.-zipTree :: ([[Tree]] -> Tree) -> Tree -> Tree-zipTree f = dig [] where-  dig prev e@None = f $ appNode prev e-  dig prev e@(UseTree _ Nothing) = f $ appNode prev e-  dig prev e@(UseTree nfo (Just u)) =-      f . appNode prev . UseTree nfo . Just $ dig ([] : appNode prev e) u-  dig prev e@(GroupTree g) =-      f . appNode prev . GroupTree $ zipGroup (appNode prev e) g-  dig prev e@(SymbolTree g) =-      f . appNode prev . SymbolTree . Symbol .-            zipGroup (appNode prev e) $ _groupOfSymbol g-  dig prev e@(DefinitionTree g) =-      f . appNode prev . DefinitionTree . Definitions .-            zipGroup (appNode prev e) $ _groupOfDefinitions g-  dig prev e@(FilterTree _) = f $ appNode prev e-  dig prev e@(PathTree _) = f $ appNode prev e-  dig prev e@(CircleTree _) = f $ appNode prev e-  dig prev e@(PolyLineTree _) = f $ appNode prev e-  dig prev e@(PolygonTree _) = f $ appNode prev e-  dig prev e@(EllipseTree _) = f $ appNode prev e-  dig prev e@(LineTree _) = f $ appNode prev e-  dig prev e@(RectangleTree _) = f $ appNode prev e-  dig prev e@(TextTree _ _) = f $ appNode prev e-  dig prev e@(ImageTree _) = f $ appNode prev e-  dig prev e@(MeshGradientTree _) = f $ appNode prev e-  dig prev e@(LinearGradientTree _) = f $ appNode prev e-  dig prev e@(RadialGradientTree _) = f $ appNode prev e-  dig prev e@(PatternTree _) = f $ appNode prev e-  dig prev e@(MarkerTree _) = f $ appNode prev e-  dig prev e@(MaskTree _) = f $ appNode prev e-  dig prev e@(ClipPathTree _) = f $ appNode prev e-  dig prev e@(SvgTree _) = f $ appNode prev e---  zipGroup prev g = g { _groupChildren = updatedChildren }-    where-      groupChild = _groupChildren g-      updatedChildren =-        [dig (c:prev) child-            | (child, c) <- zip groupChild $ inits groupChild]---- | Fold all nodes of a SVG tree.-foldTree :: (a -> Tree -> a) -> a -> Tree -> a-foldTree f = go where-  go acc e = case e of-    None                 -> f acc e-    UseTree _ _          -> f acc e-    PathTree _           -> f acc e-    CircleTree _         -> f acc e-    PolyLineTree _       -> f acc e-    PolygonTree _        -> f acc e-    EllipseTree _        -> f acc e-    LineTree _           -> f acc e-    RectangleTree _      -> f acc e-    TextTree    _ _      -> f acc e-    ImageTree _          -> f acc e-    LinearGradientTree _ -> f acc e-    RadialGradientTree _ -> f acc e-    MeshGradientTree _   -> f acc e-    PatternTree _        -> f acc e-    MarkerTree _         -> f acc e-    MaskTree _           -> f acc e-    ClipPathTree _       -> f acc e-    DefinitionTree g     -> foldGroup (_groupOfDefinitions g)-    FilterTree _         -> f acc e-    GroupTree g          -> foldGroup g-    SymbolTree s         -> foldGroup (_groupOfSymbol s)-    SvgTree{}            -> f acc e-    where-      foldGroup g =-        let subAcc = F.foldl' go acc $ _groupChildren g in-        f subAcc e---- | Helper function mapping every tree element.-mapTree :: (Tree -> Tree) -> Tree -> Tree-mapTree f = go where-  go e@None = f e-  go e@(UseTree _ _) = f e-  go (GroupTree g) = f . GroupTree $ mapGroup g-  go (SymbolTree g) =-      f . SymbolTree . Symbol . mapGroup $ _groupOfSymbol g-  go (DefinitionTree defs) =-    f . DefinitionTree . Definitions . mapGroup $ _groupOfDefinitions defs-  go e@(FilterTree _) = f e-  go e@(PathTree _) = f e-  go e@(CircleTree _) = f e-  go e@(PolyLineTree _) = f e-  go e@(PolygonTree _) = f e-  go e@(EllipseTree _) = f e-  go e@(LineTree _) = f e-  go e@(RectangleTree _) = f e-  go e@(TextTree _ _) = f e-  go e@(ImageTree _) = f e-  go e@(LinearGradientTree _) = f e-  go e@(RadialGradientTree _) = f e-  go e@(MeshGradientTree _) = f e-  go e@(PatternTree _) = f e-  go e@(MarkerTree _) = f e-  go e@(MaskTree _) = f e-  go e@(ClipPathTree _) = f e-  go e@SvgTree{} = f e--  mapGroup g =-      g { _groupChildren = map go $ _groupChildren g }---- | For every element of a svg tree, associate--- it's SVG tag name.-nameOfTree :: Tree -> T.Text-nameOfTree v =-  case v of-   None                 -> ""-   UseTree _ _          -> "use"-   GroupTree _          -> "g"-   SymbolTree _         -> "symbol"-   DefinitionTree _     -> "defs"-   FilterTree _         -> "filter"-   PathTree _           -> "path"-   CircleTree _         -> "circle"-   PolyLineTree _       -> "polyline"-   PolygonTree _        -> "polygon"-   EllipseTree _        -> "ellipse"-   LineTree _           -> "line"-   RectangleTree _      -> "rectangle"-   TextTree    _ _      -> "text"-   ImageTree _          -> "image"-   LinearGradientTree _ -> "lineargradient"-   RadialGradientTree _ -> "radialgradient"-   MeshGradientTree _   -> "meshgradient"-   PatternTree _        -> "pattern"-   MarkerTree _         -> "marker"-   MaskTree _           -> "mask"-   ClipPathTree _       -> "clipPath"-   SvgTree{}            -> "svg"--drawAttrOfTree :: Tree -> DrawAttributes-drawAttrOfTree v = case v of-  None                 -> mempty-  UseTree e _          -> e ^. drawAttributes-  GroupTree e          -> e ^. drawAttributes-  SymbolTree e         -> e ^. drawAttributes-  DefinitionTree e     -> e ^. drawAttributes-  FilterTree e         -> e ^. drawAttributes-  PathTree e           -> e ^. drawAttributes-  CircleTree e         -> e ^. drawAttributes-  PolyLineTree e       -> e ^. drawAttributes-  PolygonTree e        -> e ^. drawAttributes-  EllipseTree e        -> e ^. drawAttributes-  LineTree e           -> e ^. drawAttributes-  RectangleTree e      -> e ^. drawAttributes-  TextTree _ e         -> e ^. drawAttributes-  ImageTree e          -> e ^. drawAttributes-  LinearGradientTree e -> e ^. drawAttributes-  RadialGradientTree e -> e ^. drawAttributes-  MeshGradientTree e   -> e ^. drawAttributes-  PatternTree e        -> e ^. drawAttributes-  MarkerTree e         -> e ^. drawAttributes-  MaskTree e           -> e ^. drawAttributes-  ClipPathTree e       -> e ^. drawAttributes-  SvgTree _            -> mempty -- FIXME--setDrawAttrOfTree :: Tree -> DrawAttributes -> Tree-setDrawAttrOfTree v attr' = case v of-  None                 -> None-  UseTree e m          -> UseTree (e & drawAttributes .~ attr) m-  GroupTree e          -> GroupTree $ e & drawAttributes .~ attr-  SymbolTree e         -> SymbolTree $ e & drawAttributes .~ attr-  DefinitionTree e     -> DefinitionTree $ e & drawAttributes .~ attr-  FilterTree e         -> FilterTree $ e & drawAttributes .~ attr-  PathTree e           -> PathTree $ e & drawAttributes .~ attr-  CircleTree e         -> CircleTree $ e & drawAttributes .~ attr-  PolyLineTree e       -> PolyLineTree $ e & drawAttributes .~ attr-  PolygonTree e        -> PolygonTree $ e & drawAttributes .~ attr-  EllipseTree e        -> EllipseTree $ e & drawAttributes .~ attr-  LineTree e           -> LineTree $ e & drawAttributes .~ attr-  RectangleTree e      -> RectangleTree $ e & drawAttributes .~ attr-  TextTree a e         -> TextTree a $ e & drawAttributes .~ attr-  ImageTree e          -> ImageTree $ e & drawAttributes .~ attr-  LinearGradientTree e -> LinearGradientTree $ e & drawAttributes .~ attr-  RadialGradientTree e -> RadialGradientTree $ e & drawAttributes .~ attr-  MeshGradientTree e   -> MeshGradientTree $ e & drawAttributes .~ attr-  PatternTree e        -> PatternTree $ e & drawAttributes .~ attr-  MarkerTree e         -> MarkerTree $ e & drawAttributes .~ attr-  MaskTree e           -> MaskTree $ e & drawAttributes .~ attr-  ClipPathTree e       -> ClipPathTree $ e & drawAttributes .~ attr-  SvgTree e            -> SvgTree e-  where-    attr = attr'{_preRendered = Nothing}--instance HasDrawAttributes Tree where-  drawAttributes = lens drawAttrOfTree setDrawAttrOfTree--instance WithDefaultSvg Tree where-    defaultSvg = None---- | Define the possible values for the `spreadMethod`--- values used for the gradient definitions.-data Spread-    = SpreadRepeat  -- ^ `reapeat` value-    | SpreadPad     -- ^ `pad` value-    | SpreadReflect -- ^ `reflect value`-    deriving (Eq, Show, Generic, Hashable)---- | Define a `<linearGradient>` tag.-data LinearGradient = LinearGradient-    { -- | Drawing attributes of the RadialGradient-      _linearGradientDrawAttributes :: DrawAttributes-      -- | Define coordinate system of the gradient,-      -- associated to the `gradientUnits` attribute.-    , _linearGradientUnits          :: CoordinateUnits-      -- | Point defining the beginning of the line gradient.-      -- Associated to the `x1` and `y1` attribute.-    , _linearGradientStart          :: Point-      -- | Point defining the end of the line gradient.-      -- Associated to the `x2` and `y2` attribute.-    , _linearGradientStop           :: Point-      -- | Define how to handle the values outside-      -- the gradient start and stop. Associated to the-      -- `spreadMethod` attribute.-    , _linearGradientSpread         :: Spread-      -- | Define the transformation to apply to the-      -- gradient points. Associated to the `gradientTransform`-      -- attribute.-    , _linearGradientTransform      :: [Transformation]-      -- | List of color stops of the linear gradient.-    , _linearGradientStops          :: [GradientStop]-    }-    deriving (Eq, Show, Generic, Hashable)---- makeClassy ''LinearGradient--- | Lenses for the LinearGradient type.-class HasLinearGradient c_apmJ where-  linearGradient :: Lens' c_apmJ LinearGradient-  linearGradientDrawAttributes :: Lens' c_apmJ DrawAttributes-  linearGradientSpread :: Lens' c_apmJ Spread-  {-# INLINE linearGradientSpread #-}-  linearGradientStart :: Lens' c_apmJ Point-  {-# INLINE linearGradientStart #-}-  linearGradientStop :: Lens' c_apmJ Point-  {-# INLINE linearGradientStop #-}-  linearGradientStops :: Lens' c_apmJ [GradientStop]-  {-# INLINE linearGradientStops #-}-  linearGradientTransform :: Lens' c_apmJ [Transformation]-  {-# INLINE linearGradientTransform #-}-  linearGradientUnits :: Lens' c_apmJ CoordinateUnits-  {-# INLINE linearGradientUnits #-}-  linearGradientDrawAttributes = ((.) linearGradient) linearGradientDrawAttributes-  linearGradientSpread = ((.) linearGradient) linearGradientSpread-  linearGradientStart = ((.) linearGradient) linearGradientStart-  linearGradientStop = ((.) linearGradient) linearGradientStop-  linearGradientStops = ((.) linearGradient) linearGradientStops-  linearGradientTransform-    = ((.) linearGradient) linearGradientTransform-  linearGradientUnits = ((.) linearGradient) linearGradientUnits--instance HasLinearGradient LinearGradient where-  {-# INLINE linearGradientSpread #-}-  {-# INLINE linearGradientStart #-}-  {-# INLINE linearGradientStop #-}-  {-# INLINE linearGradientStops #-}-  {-# INLINE linearGradientTransform #-}-  {-# INLINE linearGradientUnits #-}-  linearGradient = id-  linearGradientSpread f attr =-    fmap (\y -> attr { _linearGradientSpread = y }) (f $ _linearGradientSpread attr)-  linearGradientStart f attr =-    fmap (\y -> attr { _linearGradientStart = y }) (f $ _linearGradientStart attr)-  linearGradientStop f attr =-    fmap (\y -> attr { _linearGradientStop = y }) (f $ _linearGradientStop attr)-  linearGradientStops f attr =-    fmap (\y -> attr { _linearGradientStops = y }) (f $ _linearGradientStops attr)-  linearGradientTransform f attr =-    fmap (\y -> attr { _linearGradientTransform = y }) (f $ _linearGradientTransform attr)-  linearGradientUnits f attr =-    fmap (\y -> attr { _linearGradientUnits = y }) (f $ _linearGradientUnits attr)---instance HasDrawAttributes LinearGradient where-  drawAttributes = linearGradientDrawAttributes--instance WithDefaultSvg LinearGradient where-  defaultSvg = LinearGradient-    { _linearGradientDrawAttributes = mempty-    , _linearGradientUnits     = CoordBoundingBox-    , _linearGradientStart     = (Percent 0, Percent 0)-    , _linearGradientStop      = (Percent 1, Percent 0)-    , _linearGradientSpread    = SpreadPad-    , _linearGradientTransform = []-    , _linearGradientStops     = []-    }---- | Define a `<radialGradient>` tag.-data RadialGradient = RadialGradient-  { -- | Drawing attributes of the RadialGradient-    _radialGradientDrawAttributes :: DrawAttributes-    -- | Define coordinate system of the gradient,-    -- associated to the `gradientUnits` attribute.-  , _radialGradientUnits          :: CoordinateUnits-    -- | Center of the radial gradient. Associated to-    -- the `cx` and `cy` attributes.-  , _radialGradientCenter         :: Point-    -- | Radius of the radial gradient. Associated to-    -- the `r` attribute.-  , _radialGradientRadius         :: Number-    -- | X coordinate of the focus point of the radial-    -- gradient. Associated to the `fx` attribute.-  , _radialGradientFocusX         :: Maybe Number-    -- | Y coordinate of the focus point of the radial-    -- gradient. Associated to the `fy` attribute.-  , _radialGradientFocusY         :: Maybe Number-    -- | Define how to handle the values outside-    -- the gradient start and stop. Associated to the-    -- `spreadMethod` attribute.-  , _radialGradientSpread         :: Spread-    -- | Define the transformation to apply to the-    -- gradient points. Associated to the `gradientTransform`-    -- attribute.-  , _radialGradientTransform      :: [Transformation]-    -- | List of color stops of the radial gradient.-  , _radialGradientStops          :: [GradientStop]-  }-  deriving (Eq, Show, Generic, Hashable)---- makeClassy ''RadialGradient--- | Lenses for the RadialGradient type.--class HasRadialGradient c_apwt where-  radialGradient :: Lens' c_apwt RadialGradient-  radialGradientDrawAttributes :: Lens' c_apwt DrawAttributes-  radialGradientCenter :: Lens' c_apwt Point-  {-# INLINE radialGradientCenter #-}-  radialGradientFocusX :: Lens' c_apwt (Maybe Number)-  {-# INLINE radialGradientFocusX #-}-  radialGradientFocusY :: Lens' c_apwt (Maybe Number)-  {-# INLINE radialGradientFocusY #-}-  radialGradientRadius :: Lens' c_apwt Number-  {-# INLINE radialGradientRadius #-}-  radialGradientSpread :: Lens' c_apwt Spread-  {-# INLINE radialGradientSpread #-}-  radialGradientStops :: Lens' c_apwt [GradientStop]-  {-# INLINE radialGradientStops #-}-  radialGradientTransform :: Lens' c_apwt [Transformation]-  {-# INLINE radialGradientTransform #-}-  radialGradientUnits :: Lens' c_apwt CoordinateUnits-  {-# INLINE radialGradientUnits #-}-  radialGradientDrawAttributes = ((.) radialGradient) radialGradientDrawAttributes-  radialGradientCenter = ((.) radialGradient) radialGradientCenter-  radialGradientFocusX = ((.) radialGradient) radialGradientFocusX-  radialGradientFocusY = ((.) radialGradient) radialGradientFocusY-  radialGradientRadius = ((.) radialGradient) radialGradientRadius-  radialGradientSpread = ((.) radialGradient) radialGradientSpread-  radialGradientStops = ((.) radialGradient) radialGradientStops-  radialGradientTransform-    = ((.) radialGradient) radialGradientTransform-  radialGradientUnits = ((.) radialGradient) radialGradientUnits--instance HasRadialGradient RadialGradient where-  {-# INLINE radialGradientCenter #-}-  {-# INLINE radialGradientFocusX #-}-  {-# INLINE radialGradientFocusY #-}-  {-# INLINE radialGradientRadius #-}-  {-# INLINE radialGradientSpread #-}-  {-# INLINE radialGradientStops #-}-  {-# INLINE radialGradientTransform #-}-  {-# INLINE radialGradientUnits #-}-  radialGradient = id-  radialGradientCenter f attr =-    fmap (\y -> attr { _radialGradientCenter = y }) (f $ _radialGradientCenter attr)-  radialGradientFocusX f attr =-    fmap (\y -> attr { _radialGradientFocusX = y }) (f $ _radialGradientFocusX attr)-  radialGradientFocusY f attr =-    fmap (\y -> attr { _radialGradientFocusY = y }) (f $ _radialGradientFocusY attr)-  radialGradientRadius f attr =-    fmap (\y -> attr { _radialGradientRadius = y }) (f $ _radialGradientRadius attr)-  radialGradientSpread f attr =-    fmap (\y -> attr { _radialGradientSpread = y }) (f $ _radialGradientSpread attr)-  radialGradientStops f attr =-    fmap (\y -> attr { _radialGradientStops = y }) (f $ _radialGradientStops attr)-  radialGradientTransform f attr =-    fmap (\y -> attr { _radialGradientTransform = y }) (f $ _radialGradientTransform attr)-  radialGradientUnits f attr =-    fmap (\y -> attr { _radialGradientUnits = y }) (f $ _radialGradientUnits attr)---instance HasDrawAttributes RadialGradient where-  drawAttributes = radialGradientDrawAttributes--instance WithDefaultSvg RadialGradient where-  defaultSvg = RadialGradient-    { _radialGradientDrawAttributes = mempty-    , _radialGradientUnits   = CoordBoundingBox-    , _radialGradientCenter  = (Percent 0.5, Percent 0.5)-    , _radialGradientRadius  = Percent 0.5-    , _radialGradientFocusX  = Nothing-    , _radialGradientFocusY  = Nothing-    , _radialGradientSpread  = SpreadPad-    , _radialGradientTransform = []-    , _radialGradientStops   = []-    }---- | Define a SVG `<mask>` tag.-data Mask = Mask-  { -- | Drawing attributes of the Mask-    _maskDrawAttributes :: DrawAttributes-    -- | Correspond to the `maskContentUnits` attributes.-  , _maskContentUnits   :: CoordinateUnits-    -- | Mapping to the `maskUnits` attribute.-  , _maskUnits          :: CoordinateUnits-    -- | Map to the `x` and `y` attributes.-  , _maskPosition       :: Point-    -- | Map to the `width` attribute-  , _maskWidth          :: Number-    -- | Map to the `height` attribute.-  , _maskHeight         :: Number-    -- | Children of the `<mask>` tag.-  , _maskContent        :: [Tree]-  }-  deriving (Eq, Show, Generic, Hashable)---- makeClassy ''Mask--- | Lenses for the Mask type.-class HasMask c_apHI where-  mask :: Lens' c_apHI Mask-  maskContent :: Lens' c_apHI [Tree]-  {-# INLINE maskContent #-}-  maskContentUnits :: Lens' c_apHI CoordinateUnits-  {-# INLINE maskContentUnits #-}-  maskDrawAttributes :: Lens' c_apHI DrawAttributes-  {-# INLINE maskDrawAttributes #-}-  maskHeight :: Lens' c_apHI Number-  {-# INLINE maskHeight #-}-  maskPosition :: Lens' c_apHI Point-  {-# INLINE maskPosition #-}-  maskUnits :: Lens' c_apHI CoordinateUnits-  {-# INLINE maskUnits #-}-  maskWidth :: Lens' c_apHI Number-  {-# INLINE maskWidth #-}-  maskContent = ((.) mask) maskContent-  maskContentUnits = ((.) mask) maskContentUnits-  maskDrawAttributes = ((.) mask) maskDrawAttributes-  maskHeight = ((.) mask) maskHeight-  maskPosition = ((.) mask) maskPosition-  maskUnits = ((.) mask) maskUnits-  maskWidth = ((.) mask) maskWidth--instance HasMask Mask where-  {-# INLINE maskContent #-}-  {-# INLINE maskContentUnits #-}-  {-# INLINE maskDrawAttributes #-}-  {-# INLINE maskHeight #-}-  {-# INLINE maskPosition #-}-  {-# INLINE maskUnits #-}-  {-# INLINE maskWidth #-}-  mask = id-  maskContent f attr =-    fmap (\y -> attr { _maskContent = y }) (f $ _maskContent attr)-  maskContentUnits f attr =-    fmap (\y -> attr { _maskContentUnits = y }) (f $ _maskContentUnits attr)-  maskDrawAttributes f attr =-    fmap (\y -> attr { _maskDrawAttributes = y }) (f $ _maskDrawAttributes attr)-  maskHeight f attr =-    fmap (\y -> attr { _maskHeight = y }) (f $ _maskHeight attr)-  maskPosition f attr =-    fmap (\y -> attr { _maskPosition = y }) (f $ _maskPosition attr)-  maskUnits f attr =-    fmap (\y -> attr { _maskUnits = y }) (f $ _maskUnits attr)-  maskWidth f attr =-    fmap (\y -> attr { _maskWidth = y }) (f $ _maskWidth attr)---instance HasDrawAttributes Mask where-  drawAttributes = maskDrawAttributes--instance WithDefaultSvg Mask where-  defaultSvg = Mask-    { _maskDrawAttributes = mempty-    , _maskContentUnits = CoordUserSpace-    , _maskUnits        = CoordBoundingBox-    , _maskPosition     = (Percent (-0.1), Percent (-0.1))-    , _maskWidth        = Percent 1.2-    , _maskHeight       = Percent 1.2-    , _maskContent      = []-    }---- | Define a `<clipPath>` tag.-data ClipPath = ClipPath-  { _clipPathDrawAttributes :: DrawAttributes-    -- | Maps to the `clipPathUnits` attribute-  , _clipPathUnits          :: CoordinateUnits-    -- | Maps to the content of the tree-  , _clipPathContent        :: [Tree]-  }-  deriving (Eq, Show, Generic, Hashable)---- makeClassy ''ClipPath--- | Lenses for the ClipPath type.-class HasClipPath c_apZq where-  clipPath :: Lens' c_apZq ClipPath-  clipPathContent :: Lens' c_apZq [Tree]-  {-# INLINE clipPathContent #-}-  clipPathDrawAttributes :: Lens' c_apZq DrawAttributes-  {-# INLINE clipPathDrawAttributes #-}-  clipPathUnits :: Lens' c_apZq CoordinateUnits-  {-# INLINE clipPathUnits #-}-  clipPathContent = ((.) clipPath) clipPathContent-  clipPathDrawAttributes = ((.) clipPath) clipPathDrawAttributes-  clipPathUnits = ((.) clipPath) clipPathUnits-instance HasClipPath ClipPath where-  {-# INLINE clipPathContent #-}-  {-# INLINE clipPathDrawAttributes #-}-  {-# INLINE clipPathUnits #-}-  clipPath = id-  clipPathContent f attr =-    fmap (\y -> attr { _clipPathContent = y }) (f $ _clipPathContent attr)-  clipPathDrawAttributes f attr =-    fmap (\y -> attr { _clipPathDrawAttributes = y }) (f $ _clipPathDrawAttributes attr)-  clipPathUnits f attr =-    fmap (\y -> attr { _clipPathUnits = y }) (f $ _clipPathUnits attr)---instance HasDrawAttributes ClipPath where-  drawAttributes = clipPathDrawAttributes--instance WithDefaultSvg ClipPath where-  defaultSvg = ClipPath-    { _clipPathDrawAttributes = mempty-    , _clipPathUnits = CoordUserSpace-    , _clipPathContent = mempty-    }---- | Define a `<pattern>` tag.-data Pattern = Pattern-    { -- | Pattern drawing attributes.-      _patternDrawAttributes :: !DrawAttributes-      -- | Possible `viewBox`.-    , _patternViewBox        :: !(Maybe (Double, Double, Double, Double))-      -- | Width of the pattern tile, mapped to the-      -- `width` attribute-    , _patternWidth          :: !Number-      -- | Height of the pattern tile, mapped to the-      -- `height` attribute-    , _patternHeight         :: !Number-      -- | Pattern tile base, mapped to the `x` and-      -- `y` attributes.-    , _patternPos            :: !Point-      -- | Patterns can be chained, so this is a potential-      -- reference to another pattern-    , _patternHref           :: !String-      -- | Elements used in the pattern.-    , _patternElements       :: ![Tree]-      -- | Define the cordinate system to use for-      -- the pattern. Mapped to the `patternUnits`-      -- attribute.-    , _patternUnit           :: !CoordinateUnits-      -- | Value of the "preserveAspectRatio" attribute-    , _patternAspectRatio    :: !PreserveAspectRatio-      -- | Value of "patternTransform" attribute-    , _patternTransform      :: !(Maybe [Transformation])-    }-    deriving (Eq, Show, Generic, Hashable)---- makeClassy ''Pattern--- | Lenses for the Patter type.-class HasPattern c_aq6G where-  pattern :: Lens' c_aq6G Pattern-  patternAspectRatio :: Lens' c_aq6G PreserveAspectRatio-  {-# INLINE patternAspectRatio #-}-  patternDrawAttributes :: Lens' c_aq6G DrawAttributes-  {-# INLINE patternDrawAttributes #-}-  patternElements :: Lens' c_aq6G [Tree]-  {-# INLINE patternElements #-}-  patternHeight :: Lens' c_aq6G Number-  {-# INLINE patternHeight #-}-  patternHref :: Lens' c_aq6G String-  {-# INLINE patternHref #-}-  patternPos :: Lens' c_aq6G Point-  {-# INLINE patternPos #-}-  patternTransform :: Lens' c_aq6G (Maybe [Transformation])-  {-# INLINE patternTransform #-}-  patternUnit :: Lens' c_aq6G CoordinateUnits-  {-# INLINE patternUnit #-}-  patternViewBox ::-    Lens' c_aq6G (Maybe (Double, Double, Double, Double))-  {-# INLINE patternViewBox #-}-  patternWidth :: Lens' c_aq6G Number-  {-# INLINE patternWidth #-}-  patternAspectRatio = ((.) pattern) patternAspectRatio-  patternDrawAttributes = ((.) pattern) patternDrawAttributes-  patternElements = ((.) pattern) patternElements-  patternHeight = ((.) pattern) patternHeight-  patternHref = ((.) pattern) patternHref-  patternPos = ((.) pattern) patternPos-  patternTransform = ((.) pattern) patternTransform-  patternUnit = ((.) pattern) patternUnit-  patternViewBox = ((.) pattern) patternViewBox-  patternWidth = ((.) pattern) patternWidth--instance HasPattern Pattern where-  {-# INLINE patternAspectRatio #-}-  {-# INLINE patternDrawAttributes #-}-  {-# INLINE patternElements #-}-  {-# INLINE patternHeight #-}-  {-# INLINE patternHref #-}-  {-# INLINE patternPos #-}-  {-# INLINE patternTransform #-}-  {-# INLINE patternUnit #-}-  {-# INLINE patternViewBox #-}-  {-# INLINE patternWidth #-}-  pattern = id-  patternAspectRatio f attr =-    fmap (\y -> attr { _patternAspectRatio = y }) (f $ _patternAspectRatio attr)-  patternDrawAttributes f attr =-    fmap (\y -> attr { _patternDrawAttributes = y }) (f $ _patternDrawAttributes attr)-  patternElements f attr =-    fmap (\y -> attr { _patternElements = y }) (f $ _patternElements attr)-  patternHeight f attr =-    fmap (\y -> attr { _patternHeight = y }) (f $ _patternHeight attr)-  patternHref f attr =-    fmap (\y -> attr { _patternHref = y }) (f $ _patternHref attr)-  patternPos f attr =-    fmap (\y -> attr { _patternPos = y }) (f $ _patternPos attr)-  patternTransform f attr =-    fmap (\y -> attr { _patternTransform = y }) (f $ _patternTransform attr)-  patternUnit f attr =-    fmap (\y -> attr { _patternUnit = y }) (f $ _patternUnit attr)-  patternViewBox f attr =-    fmap (\y -> attr { _patternViewBox = y }) (f $ _patternViewBox attr)-  patternWidth f attr =-    fmap (\y -> attr { _patternWidth = y }) (f $ _patternWidth attr)--instance HasDrawAttributes Pattern where-  drawAttributes = patternDrawAttributes--instance WithDefaultSvg Pattern where-  defaultSvg = Pattern-    { _patternViewBox  = Nothing-    , _patternWidth    = Num 0-    , _patternHeight   = Num 0-    , _patternPos      = (Num 0, Num 0)-    , _patternElements = []-    , _patternUnit = CoordBoundingBox-    , _patternDrawAttributes = mempty-    , _patternAspectRatio = defaultSvg-    , _patternHref = ""-    , _patternTransform = mempty-    }---- | Sum types helping keeping track of all the namable--- elemens in a SVG document.-data Element-    = ElementLinearGradient LinearGradient-    | ElementRadialGradient RadialGradient-    | ElementMeshGradient   MeshGradient-    | ElementGeometry Tree-    | ElementPattern  Pattern-    | ElementMarker Marker-    | ElementMask Mask-    | ElementClipPath ClipPath-    deriving (Eq, Show, Generic, Hashable)---- | Represent a full svg document with style,--- geometry and named elements.-data Document = Document-    { _viewBox          :: Maybe (Double, Double, Double, Double)-    , _width            :: Maybe Number-    , _height           :: Maybe Number-    , _elements         :: [Tree]-    , _description      :: String-    , _documentLocation :: FilePath-    , _documentAspectRatio :: PreserveAspectRatio-    }-    deriving (Show, Eq, Generic, Hashable)----- | Lenses associated to a SVG document.-makeClassy ''Document---- | Calculate the document size in function of the--- different available attributes in the document.-documentSize :: Dpi -> Document -> (Int, Int)-documentSize _ Document { _viewBox = Just (x1, y1, x2, y2)-                        , _width = Just (Percent pw)-                        , _height = Just (Percent ph)-                        } =-    (floor $ dx * pw, floor $ dy * ph)-      where-        dx = abs $ x2 - x1-        dy = abs $ y2 - y1-documentSize _ Document { _width = Just (Num w)-                        , _height = Just (Num h) } = (floor w, floor h)-documentSize dpi doc@(Document { _width = Just w-                               , _height = Just h }) =-  documentSize dpi $ doc-    { _width = Just $ toUserUnit dpi w-    , _height = Just $ toUserUnit dpi h }-documentSize _ Document { _viewBox = Just (x1, y1, x2, y2) } =-    (floor . abs $ x2 - x1, floor . abs $ y2 - y1)-documentSize _ _ = (1, 1)--mayMerge :: Monoid a => Maybe a -> Maybe a -> Maybe a-mayMerge (Just a) (Just b) = Just $ mappend a b-mayMerge _ b@(Just _)      = b-mayMerge a Nothing         = a--instance Semigroup DrawAttributes where-  (<>) a b = DrawAttributes-        { _strokeWidth = (mappend `on` _strokeWidth) a b-        , _strokeColor =  (mappend `on` _strokeColor) a b-        , _strokeLineCap = (mappend `on` _strokeLineCap) a b-        , _strokeOpacity = (opacityMappend `on` _strokeOpacity) a b-        , _strokeLineJoin = (mappend `on` _strokeLineJoin) a b-        , _strokeMiterLimit = (mappend `on` _strokeMiterLimit) a b-        , _fillColor =  (mappend `on` _fillColor) a b-        , _fillOpacity = (opacityMappend `on` _fillOpacity) a b-        , _fontSize = (mappend `on` _fontSize) a b-        , _transform = (mayMerge `on` _transform) a b-        , _fillRule = (mappend `on` _fillRule) a b-        , _attrClass = _attrClass b-        , _attrId = _attrId b-        , _groupOpacity = _groupOpacity b-        , _strokeOffset = (mappend `on` _strokeOffset) a b-        , _strokeDashArray = (mappend `on` _strokeDashArray) a b-        , _fontFamily = (mappend `on` _fontFamily) a b-        , _fontStyle = (mappend `on` _fontStyle) a b-        , _textAnchor = (mappend `on` _textAnchor) a b-        , _maskRef = (mappend `on` _maskRef) a b-        , _clipPathRef = (mappend `on` _clipPathRef) a b-        , _clipRule = (mappend `on` _clipRule) a b-        , _markerStart = (mappend `on` _markerStart) a b-        , _markerMid = (mappend `on` _markerMid) a b-        , _markerEnd = (mappend `on` _markerEnd) a b-        , _filterRef = (mappend `on` _filterRef) a b-        , _preRendered = Nothing-        }-      where-        opacityMappend Nothing Nothing    = Nothing-        opacityMappend (Just v) Nothing   = Just v-        opacityMappend Nothing (Just v)   = Just v-        opacityMappend (Just v) (Just v2) = Just $ v * v2--instance Monoid DrawAttributes where-    mappend = (<>)-    mempty = DrawAttributes-        { _strokeWidth      = Last Nothing-        , _strokeColor      = Last Nothing-        , _strokeOpacity    = Nothing-        , _strokeLineCap    = Last Nothing-        , _strokeLineJoin   = Last Nothing-        , _strokeMiterLimit = Last Nothing-        , _fillColor        = Last Nothing-        , _groupOpacity     = Nothing-        , _fillOpacity      = Nothing-        , _fontSize         = Last Nothing-        , _fontFamily       = Last Nothing-        , _fontStyle        = Last Nothing-        , _transform        = Nothing-        , _fillRule         = Last Nothing-        , _attrClass        = mempty-        , _attrId           = Nothing-        , _strokeOffset     = Last Nothing-        , _strokeDashArray  = Last Nothing-        , _textAnchor       = Last Nothing-        , _maskRef          = Last Nothing-        , _clipPathRef      = Last Nothing-        , _clipRule         = Last Nothing--        , _markerStart      = Last Nothing-        , _markerMid        = Last Nothing-        , _markerEnd        = Last Nothing-        , _filterRef        = Last Nothing-        , _preRendered      = Nothing-        }--instance WithDefaultSvg DrawAttributes where-  defaultSvg = mempty--instance CssMatcheable Tree where-  cssAttribOf _ _ = Nothing-  cssClassOf = view (drawAttributes . attrClass)-  cssIdOf = fmap T.pack . view (drawAttributes . attrId)-  cssNameOf = nameOfTree-------------------------------------------------------------------------------- Dumped------------------------------------------------------------------------------ makeClassy ''PreserveAspectRatio------ | Lenses for the PreserveAspectRatio type-class HasPreserveAspectRatio a where-  preserveAspectRatio :: Lens' a PreserveAspectRatio-  aspectRatioAlign :: Lens' a Alignment-  {-# INLINE aspectRatioAlign #-}-  aspectRatioAlign = preserveAspectRatio . aspectRatioAlign--  aspectRatioDefer :: Lens' a Bool-  {-# INLINE aspectRatioDefer #-}-  aspectRatioDefer = preserveAspectRatio . aspectRatioDefer--  aspectRatioMeetSlice :: Lens' a (Maybe MeetSlice)-  {-# INLINE aspectRatioMeetSlice #-}-  aspectRatioMeetSlice = preserveAspectRatio . aspectRatioMeetSlice--instance HasPreserveAspectRatio PreserveAspectRatio where-  preserveAspectRatio = id-  {-# INLINE aspectRatioAlign #-}-  aspectRatioAlign f attr =-    fmap (\y -> attr { _aspectRatioAlign = y }) (f $ _aspectRatioAlign attr)--  {-# INLINE aspectRatioDefer #-}-  aspectRatioDefer f attr =-    fmap (\y -> attr { _aspectRatioDefer = y }) (f $ _aspectRatioDefer attr)--  {-# INLINE aspectRatioMeetSlice #-}-  aspectRatioMeetSlice f attr =-    fmap (\y -> attr { _aspectRatioMeetSlice = y }) (f $ _aspectRatioMeetSlice attr)---- makeClassy ''FilterAttributes--- | Lenses for the FilterAttributes type.-class HasFilterAttributes c_asYk where-  filterAttributes :: Lens' c_asYk FilterAttributes-  filterHeight :: Lens' c_asYk (Last Number)-  {-# INLINE filterHeight #-}-  filterResult :: Lens' c_asYk (Maybe String)-  {-# INLINE filterResult #-}-  filterWidth :: Lens' c_asYk (Last Number)-  {-# INLINE filterWidth #-}-  filterX :: Lens' c_asYk (Last Number)-  {-# INLINE filterX #-}-  filterY :: Lens' c_asYk (Last Number)-  {-# INLINE filterY #-}-  filterHeight = ((.) filterAttributes) filterHeight-  filterResult = ((.) filterAttributes) filterResult-  filterWidth = ((.) filterAttributes) filterWidth-  filterX = ((.) filterAttributes) filterX-  filterY = ((.) filterAttributes) filterY-instance HasFilterAttributes FilterAttributes where-  {-# INLINE filterHeight #-}-  {-# INLINE filterResult #-}-  {-# INLINE filterWidth #-}-  {-# INLINE filterX #-}-  {-# INLINE filterY #-}-  filterAttributes = id-  filterHeight-    f_asYl-    (FilterAttributes x1_asYm x2_asYn x3_asYo x4_asYp x5_asYq)-    = (fmap-         (\ y1_asYr-            -> ((((FilterAttributes y1_asYr) x2_asYn) x3_asYo) x4_asYp)-                 x5_asYq))-        (f_asYl x1_asYm)-  filterResult-    f_asYs-    (FilterAttributes x1_asYt x2_asYu x3_asYv x4_asYw x5_asYx)-    = (fmap-         (\ y1_asYy-            -> ((((FilterAttributes x1_asYt) y1_asYy) x3_asYv) x4_asYw)-                 x5_asYx))-        (f_asYs x2_asYu)-  filterWidth-    f_asYz-    (FilterAttributes x1_asYA x2_asYB x3_asYC x4_asYD x5_asYE)-    = (fmap-         (\ y1_asYF-            -> ((((FilterAttributes x1_asYA) x2_asYB) y1_asYF) x4_asYD)-                 x5_asYE))-        (f_asYz x3_asYC)-  filterX-    f_asYG-    (FilterAttributes x1_asYH x2_asYI x3_asYJ x4_asYK x5_asYL)-    = (fmap-         (\ y1_asYM-            -> ((((FilterAttributes x1_asYH) x2_asYI) x3_asYJ) y1_asYM)-                 x5_asYL))-        (f_asYG x4_asYK)-  filterY-    f_asYN-    (FilterAttributes x1_asYO x2_asYP x3_asYQ x4_asYR x5_asYS)-    = (fmap-         (\ y1_asYT-            -> ((((FilterAttributes x1_asYO) x2_asYP) x3_asYQ) x4_asYR)-                 y1_asYT))-        (f_asYN x5_asYS)---makeClassy ''TextPath---- | Lenses for the DrawAttributes type.--- makeClassy ''DrawAttributes--makeLenses ''Filter--instance HasDrawAttributes Filter where-  drawAttributes = filterDrawAttributes--instance HasFilterAttributes Filter where-  filterAttributes = filterSelfAttributes--makeClassy ''Composite-makeClassy ''ColorMatrix-makeClassy ''GaussianBlur-makeClassy ''Turbulence-makeClassy ''DisplacementMap--instance HasDrawAttributes Composite where-    drawAttributes = compositeDrawAttributes---instance HasDrawAttributes ColorMatrix where-    drawAttributes = colorMatrixDrawAttributes--instance HasDrawAttributes GaussianBlur where-    drawAttributes = gaussianBlurDrawAttributes--instance HasDrawAttributes Turbulence where-    drawAttributes = turbulenceDrawAttributes--instance HasDrawAttributes DisplacementMap where-    drawAttributes = displacementMapDrawAttributes--instance HasFilterAttributes Composite where-  filterAttributes = compositeFilterAttr--instance HasFilterAttributes ColorMatrix where-  filterAttributes = colorMatrixFilterAttr--instance HasFilterAttributes GaussianBlur where-  filterAttributes = gaussianBlurFilterAttr--instance HasFilterAttributes Turbulence where-  filterAttributes = turbulenceFilterAttr--instance HasFilterAttributes DisplacementMap where-  filterAttributes = displacementMapFilterAttr--instance HasFilterAttributes FilterElement where-  filterAttributes = lens getter setter-    where-      getter fe = case fe of-          FEBlend             -> defaultSvg-          FEColorMatrix m     -> m ^. filterAttributes-          FEComponentTransfer -> defaultSvg-          FEComposite c       -> c ^. filterAttributes-          FEConvolveMatrix    -> defaultSvg-          FEDiffuseLighting   -> defaultSvg-          FEDisplacementMap d -> d ^. filterAttributes-          FEDropShadow        -> defaultSvg-          FEFlood             -> defaultSvg-          FEFuncA             -> defaultSvg-          FEFuncB             -> defaultSvg-          FEFuncG             -> defaultSvg-          FEFuncR             -> defaultSvg-          FEGaussianBlur g    -> g ^. filterAttributes-          FEImage             -> defaultSvg-          FEMerge             -> defaultSvg-          FEMergeNode         -> defaultSvg-          FEMorphology        -> defaultSvg-          FEOffset            -> defaultSvg-          FESpecularLighting  -> defaultSvg-          FETile              -> defaultSvg-          FETurbulence t      -> t ^. filterAttributes-          FENone              -> defaultSvg-      setter fe attr = case fe of-        FEBlend             -> fe-        FEColorMatrix m     -> FEColorMatrix $ m & filterAttributes .~ attr-        FEComponentTransfer -> fe-        FEComposite c       -> FEComposite $ c & filterAttributes .~ attr-        FEConvolveMatrix    -> fe-        FEDiffuseLighting   -> fe-        FEDisplacementMap d -> FEDisplacementMap $ d & filterAttributes .~ attr-        FEDropShadow        -> fe-        FEFlood             -> fe-        FEFuncA             -> fe-        FEFuncB             -> fe-        FEFuncG             -> fe-        FEFuncR             -> fe-        FEGaussianBlur g    -> FEGaussianBlur $ g & filterAttributes .~ attr-        FEImage             -> fe-        FEMerge             -> fe-        FEMergeNode         -> fe-        FEMorphology        -> fe-        FEOffset            -> fe-        FESpecularLighting  -> fe-        FETile              -> fe-        FETurbulence t      -> FETurbulence $ t & filterAttributes .~ attr-        FENone              -> fe+{-# LANGUAGE PatternSynonyms    #-}+-- | This module define all the types used in the definition+-- of a svg scene.+--+-- Most of the types are lensified.+module Graphics.SvgTree.Types+    ( -- * Basic building types+      Coord+    , Origin( .. )+    , Point+    , RPoint+    , PathCommand( .. )+    , Transformation( .. )+    , ElementRef( .. )+    , CoordinateUnits( .. )++      -- ** Building helpers+    , serializeNumber+    , serializeTransformation+    , serializeTransformations++      -- * Drawing control types+    , Cap( .. )+    , LineJoin( .. )+    , Tree+    , pattern Tree+    , pattern None+    , treeBranch+    , TreeBranch(..)+    , Number( .. )+    , Spread( .. )+    , Texture( .. )+    , Element( .. )+    , FillRule( .. )+    , FontStyle( .. )+    , Dpi++    , WithDefaultSvg( .. )++      -- * Main type+    , Document( .. )+    , pattern SvgTree+    , svgTree+    ,documentViewBox,+    documentWidth,+    documentHeight,+    documentElements,+    documentDescription,+    documentLocation,+    documentAspectRatio,+    documentSize++      -- * Drawing attributes+    , DrawAttributes( .. )+    , HasDrawAttributes( .. )++      -- * Filters+    , FilterElement(..)+    , FilterAttributes(..)+    , HasFilterAttributes(..)+    , FilterSource(..)+    , ColorMatrixType(..)+    , colorMatrixDrawAttributes+    , colorMatrixFilterAttr+    , colorMatrixIn+    , colorMatrixType+    , colorMatrixValues+    , ColorMatrix(..)+    , compositeDrawAttributes+    , compositeFilterAttr+    , compositeIn+    , compositeIn2+    , compositeOperator+    , compositeK1+    , compositeK2+    , compositeK3+    , compositeK4+    , Composite(..)+    , CompositeOperator(..)+    , EdgeMode(..)+    , gaussianBlurDrawAttributes+    , gaussianBlurFilterAttr+    , gaussianBlurIn+    , gaussianBlurStdDeviationX+    , gaussianBlurStdDeviationY+    , gaussianBlurEdgeMode+    , GaussianBlur(..)+    , turbulenceDrawAttributes+    , turbulenceFilterAttr+    , turbulenceBaseFrequency+    , turbulenceNumOctaves+    , turbulenceSeed+    , turbulenceStitchTiles+    , turbulenceType+    , Turbulence(..)+    , TurbulenceType(..)+    , StitchTiles(..)+    , DisplacementMap(..)+    , displacementMapDrawAttributes+    , displacementMapFilterAttr+    , displacementMapIn+    , displacementMapIn2+    , displacementMapScale+    , displacementMapXChannelSelector+    , displacementMapYChannelSelector+    , ChannelSelector(..)++      -- * SVG drawing primitives+      -- ** Rectangle+    , Rectangle( .. )+    , pattern RectangleTree+    , rectangleTree+    , rectUpperLeftCorner+    , rectWidth+    , rectHeight+    , rectCornerRadius++      -- ** Line+    , Line( .. )+    , pattern LineTree+    , lineTree+    , linePoint1+    , linePoint2++      -- ** Polygon+    , Polygon( .. )+    , pattern PolygonTree+    , polygonTree+    , polygonPoints++      -- ** Polyline+    , PolyLine( .. )+    , pattern PolyLineTree+    , polyLineTree+    , polyLinePoints++      -- ** Path+    , Path( .. )+    , pattern PathTree+    , pathTree+    , pathDefinition++      -- ** Circle+    , Circle( .. )+    , pattern CircleTree+    , circleTree+    , circleCenter+    , circleRadius+++      -- ** Ellipse+    , Ellipse( .. )+    , pattern EllipseTree+    , ellipseTree+    , ellipseCenter+    , ellipseXRadius+    , ellipseYRadius++      -- ** Mesh (gradient mesh)+    , GradientPathCommand( .. )+    , MeshGradientType( .. )++    , MeshGradient( .. )+    , pattern MeshGradientTree+    , meshGradientTree+    , meshGradientX+    , meshGradientY+    , meshGradientType+    , meshGradientUnits+    , meshGradientTransform+    , meshGradientRows++    , MeshGradientRow( .. )+    , meshGradientRowPatches++    , MeshGradientPatch( .. )+    , meshGradientPatchStops++      -- ** Image+    , Image( .. )+    , pattern ImageTree+    , imageTree+    , imageCornerUpperLeft+    , imageWidth+    , imageHeight+    , imageHref+    , imageAspectRatio++      -- ** Use+    , Use( .. )+    , pattern UseTree+    , useTree+    , useBase+    , useName+    , useWidth+    , useHeight++      -- * Grouping primitives+      -- ** Group+    , Group( .. )+    , pattern GroupTree+    , groupTree+    , groupDrawAttributes+    , groupChildren+    , groupViewBox+    , groupAspectRatio++      -- ** Symbol+    , pattern SymbolTree+    , symbolTree++      -- ** Definitions+    , pattern DefinitionTree+    , definitionTree++    -- ** Filter+    , Filter( .. )+    , pattern FilterTree+    , filterTree+    , filterChildren++      -- * Text related types+      -- ** Text+    , Text( .. )+    , pattern TextTree+    , textTree+    , textAdjust+    , textRoot+    , TextAnchor( .. )+    , textAt++      -- ** Text path+    , TextPath( .. )+    , textPathStartOffset+    , textPathName+    , textPathMethod+    , textPathSpacing++    , TextPathSpacing( .. )+    , TextPathMethod( .. )++      -- ** Text span.+    , TextSpanContent( .. )++    , TextSpan( .. )+    , spanInfo+    , spanDrawAttributes+    , spanContent++    , TextInfo( .. )+    , textInfoX+    , textInfoY+    , textInfoDX+    , textInfoDY+    , textInfoRotate+    , textInfoLength++    , TextAdjust( .. )++      -- * Marker definition+    , Marker( .. )+    , pattern MarkerTree+    , markerTree+    , Overflow( .. )+    , MarkerOrientation( .. )+    , MarkerUnit( .. )+    , markerRefPoint+    , markerWidth+    , markerHeight+    , markerOrient+    , markerUnits+    , markerViewBox+    , markerOverflow+    , markerAspectRatio+    , markerElements++      -- * Gradient definition+    , GradientStop( .. )+    , gradientOffset+    , gradientColor+    , gradientPath+    , gradientOpacity++      -- ** Linear Gradient+    , LinearGradient( .. )+    , pattern LinearGradientTree+    , linearGradientTree+    , linearGradientUnits+    , linearGradientStart+    , linearGradientStop+    , linearGradientSpread+    , linearGradientTransform+    , linearGradientStops++      -- ** Radial Gradient+    , RadialGradient( .. )+    , pattern RadialGradientTree+    , radialGradientTree+    , radialGradientUnits+    , radialGradientCenter+    , radialGradientRadius+    , radialGradientFocusX+    , radialGradientFocusY+    , radialGradientSpread+    , radialGradientTransform+    , radialGradientStops++      -- * Pattern definition+    , Pattern( .. )+    , pattern PatternTree+    , patternTree+    , patternViewBox+    , patternWidth+    , patternHeight+    , patternPos+    , patternHref+    , patternElements+    , patternUnit+    , patternAspectRatio+    , patternTransform++      -- * Mask definition+    , Mask( .. )+    , pattern MaskTree+    , maskTree+    , maskContentUnits+    , maskUnits+    , maskPosition+    , maskWidth+    , maskHeight+    , maskContent++      -- * Clip path definition+    , ClipPath( .. )+    , pattern ClipPathTree+    , clipPathTree+    , clipPathUnits+    , clipPathContent++      -- * Aspect Ratio description+    , PreserveAspectRatio( .. )+    , Alignment( .. )+    , MeetSlice( .. )+    , aspectRatioDefer+    , aspectRatioAlign+    , aspectRatioMeetSlice++      -- * MISC functions+    , zipTree+    , foldTree+    , mapTree+    , mapBranch+    , nameOfTree+    , toUserUnit+    , mapNumber+    ) where++import Graphics.SvgTree.Types.Internal+import Graphics.SvgTree.Types.Hashable+import Graphics.SvgTree.Types.Fold+import Graphics.SvgTree.Types.Constructors+import Graphics.SvgTree.Types.Instances ()

@@ -0,0 +1,95 @@+{-# LANGUAGE DeriveGeneric #-}+{-+  Home of basic types without fields.+-}+module Graphics.SvgTree.Types.Basic where++import           Codec.Picture             (PixelRGBA8 (..))+import           GHC.Generics              (Generic)+import           Graphics.SvgTree.CssTypes (Number)+import           Linear                    (V2)++-- | Basic coordinate type.+type Coord = Double++-- | Real Point, fully determined and not+-- dependant of the rendering context.+type RPoint = V2 Coord++-- FIXME: Use 'V2 Number' instead of tuple+-- | Possibly context dependant point.+type Point = (Number, Number)++-- | Tell if a path command is absolute (in the current+-- user coordiante) or relative to the previous poitn.+data Origin+  = OriginAbsolute -- ^ Next point in absolute coordinate+  | OriginRelative -- ^ Next point relative to the previous+  deriving (Eq, Show, Generic)+++data MeshGradientType+  = GradientBilinear+  | GradientBicubic+  deriving (Eq, Show, Generic)++-- | Define the possible values of various *units attributes+-- used in the definition of the gradients and masks.+data CoordinateUnits+    = CoordUserSpace   -- ^ `userSpaceOnUse` value+    | CoordBoundingBox -- ^ `objectBoundingBox` value+    deriving (Eq, Show, Generic)++-- | This type represent the align information of the+-- preserveAspectRatio SVGattribute+data Alignment+  = AlignNone -- ^ "none" value+  | AlignxMinYMin -- "xMinYMin" value+  | AlignxMidYMin -- ^ "xMidYMin" value+  | AlignxMaxYMin -- ^ "xMaxYMin" value+  | AlignxMinYMid -- ^ "xMinYMid" value+  | AlignxMidYMid -- ^ "xMidYMid" value+  | AlignxMaxYMid -- ^ "xMaxYMid" value+  | AlignxMinYMax -- ^ "xMinYMax" value+  | AlignxMidYMax -- ^ "xMidYMax" value+  | AlignxMaxYMax -- ^ "xMaxYMax" value+  deriving (Eq, Show, Generic)++-- | This type represent the "meet or slice" information+-- of the preserveAspectRatio SVGattribute+data MeetSlice = Meet | Slice+    deriving (Eq, Show, Generic)++-- | Describe how the line should be terminated+-- when stroking them. Describe the values of the+-- `stroke-linecap` attribute.+-- See `_strokeLineCap`+data Cap+  = CapRound -- ^ End with a round (`round` value)+  | CapButt  -- ^ Define straight just at the end (`butt` value)+  | CapSquare -- ^ Straight further of the ends (`square` value)+  deriving (Eq, Show, Generic)++-- | Define the possible values of the `stroke-linejoin`+-- attribute.+-- see `_strokeLineJoin`+data LineJoin+    = JoinMiter -- ^ `miter` value+    | JoinBevel -- ^ `bevel` value+    | JoinRound -- ^ `round` value+    deriving (Eq, Show, Generic)++-- | Describe the different value which can be used+-- in the `fill` or `stroke` attributes.+data Texture+  = ColorRef   PixelRGBA8 -- ^ Direct solid color (#rrggbb, #rgb)+  | TextureRef String     -- ^ Link to a complex texture (url(#name))+  | FillNone              -- ^ Equivalent to the `none` value.+  deriving (Eq, Show, Generic)++-- | Describe the possile filling algorithms.+-- Map the values of the `fill-rule` attributes.+data FillRule+    = FillEvenOdd -- ^ Correspond to the `evenodd` value.+    | FillNonZero -- ^ Correspond to the `nonzero` value.+    deriving (Eq, Show, Generic)

@@ -0,0 +1,70 @@+module Graphics.SvgTree.Types.Constructors where++import Graphics.SvgTree.Types.Internal+import Graphics.SvgTree.Types.Hashable++useTree :: Use -> Tree+useTree u = UseTree u Nothing++groupTree :: Group -> Tree+groupTree = GroupTree++symbolTree :: Group -> Tree+symbolTree = SymbolTree++definitionTree :: Group -> Tree+definitionTree = DefinitionTree++filterTree :: Filter -> Tree+filterTree = FilterTree++pathTree :: Path -> Tree+pathTree = PathTree++circleTree :: Circle -> Tree+circleTree = CircleTree++polyLineTree :: PolyLine -> Tree+polyLineTree = PolyLineTree++polygonTree :: Polygon -> Tree+polygonTree = PolygonTree++ellipseTree :: Ellipse -> Tree+ellipseTree = EllipseTree++lineTree :: Line -> Tree+lineTree = LineTree++rectangleTree :: Rectangle -> Tree+rectangleTree = RectangleTree++textTree :: Maybe TextPath -> Text -> Tree+textTree = TextTree++imageTree :: Image -> Tree+imageTree = ImageTree++linearGradientTree :: LinearGradient -> Tree+linearGradientTree = LinearGradientTree++radialGradientTree :: RadialGradient -> Tree+radialGradientTree = RadialGradientTree++meshGradientTree :: MeshGradient -> Tree+meshGradientTree = MeshGradientTree++patternTree :: Pattern -> Tree+patternTree = PatternTree++markerTree :: Marker -> Tree+markerTree = MarkerTree++maskTree :: Mask -> Tree+maskTree = MaskTree++clipPathTree :: ClipPath -> Tree+clipPathTree = ClipPathTree++svgTree :: Document -> Tree+svgTree = SvgTree

@@ -0,0 +1,105 @@+module Graphics.SvgTree.Types.Fold where++import           Control.Lens           ((%~), (&), (^.))+import qualified Data.Foldable          as F+import           Data.List              (inits)+import           Graphics.SvgTree.Types.Internal+import           Graphics.SvgTree.Types.Hashable++-- | Insert element in the first sublist in the list of list.+appNode :: [[a]] -> a -> [[a]]+appNode [] e           = [[e]]+appNode (curr:above) e = (e:curr) : above++-- | Map a tree while propagating context information.+-- The function passed in parameter receive a list+-- representing the the path used to go arrive to the+-- current node.+zipTree :: ([[Tree]] -> Tree) -> Tree -> Tree+zipTree f = dig [] where+  dig prev e = case e ^. treeBranch of+    NoNode -> f $ appNode prev e+    UseNode _ Nothing -> f $ appNode prev e+    UseNode nfo (Just u) ->+      f $ appNode prev $ UseTree nfo (Just $ dig ([] : appNode prev e) u)+    GroupNode g ->+      f $ appNode prev $ GroupTree $ zipGroup (appNode prev e) g+    SymbolNode g ->+      f $ appNode prev $ SymbolTree $ zipGroup (appNode prev e) g+    DefinitionNode g ->+      f $ appNode prev $ DefinitionTree $ zipGroup (appNode prev e) g+    FilterNode{} -> f $ appNode prev e+    PathNode{} -> f $ appNode prev e+    CircleNode{} -> f $ appNode prev e+    PolyLineNode{} -> f $ appNode prev e+    PolygonNode{} -> f $ appNode prev e+    EllipseNode{} -> f $ appNode prev e+    LineNode{} -> f $ appNode prev e+    RectangleNode{} -> f $ appNode prev e+    TextNode{} -> f $ appNode prev e+    ImageNode{} -> f $ appNode prev e+    MeshGradientNode{} -> f $ appNode prev e+    LinearGradientNode{} -> f $ appNode prev e+    RadialGradientNode{} -> f $ appNode prev e+    PatternNode{} -> f $ appNode prev e+    MarkerNode{} -> f $ appNode prev e+    MaskNode{} -> f $ appNode prev e+    ClipPathNode{} -> f $ appNode prev e+    SvgNode{} -> f $ appNode prev e++  zipGroup prev g = g { _groupChildren = updatedChildren }+    where+      groupChild = _groupChildren g+      updatedChildren =+        [dig (c:prev) child+            | (child, c) <- zip groupChild $ inits groupChild]++-- | Fold all nodes of a SVG tree.+foldTree :: (a -> Tree -> a) -> a -> Tree -> a+foldTree f = go where+  go acc e = case e of+    DefinitionTree g   -> foldGroup g+    GroupTree g        -> foldGroup g+    SymbolTree g       -> foldGroup g+    _                  -> f acc e+    where+      foldGroup g =+        let subAcc = F.foldl' go acc $ _groupChildren g in+        f subAcc e++-- | Helper function mapping every tree element.+mapTree :: (Tree -> Tree) -> Tree -> Tree+mapTree f = worker where+  worker t = f $ t & treeBranch %~ go+  go e = case e of+    NoNode -> e+    UseNode{}    -> e+    GroupNode g  -> GroupNode $ mapGroup g+    SymbolNode g ->+      SymbolNode $ mapGroup g+    DefinitionNode g ->+      DefinitionNode $ mapGroup g+    FilterNode{} -> e+    PathNode{} -> e+    CircleNode{} -> e+    PolyLineNode{} -> e+    PolygonNode{} -> e+    EllipseNode{} -> e+    LineNode{} -> e+    RectangleNode{} -> e+    TextNode{} -> e+    ImageNode{} -> e+    LinearGradientNode{} -> e+    RadialGradientNode{} -> e+    MeshGradientNode{} -> e+    PatternNode{} -> e+    MarkerNode{} -> e+    MaskNode{} -> e+    ClipPathNode{} -> e+    SvgNode{} -> e++  mapGroup g =+      g { _groupChildren = map worker $ _groupChildren g }++mapBranch :: (TreeBranch -> TreeBranch) -> Tree -> Tree+mapBranch f = mapTree (treeBranch %~ f)

@@ -0,0 +1,247 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE ViewPatterns #-}+{-# OPTIONS_GHC -Wno-orphans -O0 #-}++module Graphics.SvgTree.Types.Hashable where++import Codec.Picture (PixelRGBA8 (..))+import Control.Lens+import Data.Hashable+import Data.Monoid+import GHC.Generics (Generic)+import Graphics.SvgTree.Types.Internal++-- Orphan instances :(+instance Hashable a => Hashable (Last a)++deriving instance Generic PixelRGBA8++instance Hashable PixelRGBA8++deriving instance Hashable DrawAttributes++deriving instance Hashable Pattern++deriving instance Hashable Element++deriving instance Hashable ClipPath++deriving instance Hashable Mask++deriving instance Hashable CoordinateUnits++deriving instance Hashable TreeBranch++deriving instance Hashable Group++deriving instance Hashable PreserveAspectRatio++deriving instance Hashable Alignment++deriving instance Hashable MeetSlice++deriving instance Hashable LinearGradient++deriving instance Hashable Spread++deriving instance Hashable Transformation++deriving instance Hashable GradientStop++deriving instance Hashable GradientPathCommand++deriving instance Hashable Origin++deriving instance Hashable Use++deriving instance Hashable Filter++deriving instance Hashable FilterAttributes++deriving instance Hashable FilterElement++deriving instance Hashable ColorMatrix++deriving instance Hashable FilterSource++deriving instance Hashable ColorMatrixType++deriving instance Hashable Composite++deriving instance Hashable CompositeOperator++deriving instance Hashable DisplacementMap++deriving instance Hashable ChannelSelector++deriving instance Hashable GaussianBlur++deriving instance Hashable EdgeMode++deriving instance Hashable Turbulence++deriving instance Hashable StitchTiles++deriving instance Hashable TurbulenceType++deriving instance Hashable Path++deriving instance Hashable PathCommand++deriving instance Hashable Circle++deriving instance Hashable PolyLine++deriving instance Hashable Polygon++deriving instance Hashable Ellipse++deriving instance Hashable Line++deriving instance Hashable Rectangle++deriving instance Hashable TextPath++deriving instance Hashable TextPathMethod++deriving instance Hashable TextPathSpacing++deriving instance Hashable Text++deriving instance Hashable TextAdjust++deriving instance Hashable TextSpan++deriving instance Hashable TextInfo++deriving instance Hashable TextSpanContent++deriving instance Hashable Image++deriving instance Hashable RadialGradient++deriving instance Hashable MeshGradient++deriving instance Hashable MeshGradientType++deriving instance Hashable MeshGradientRow++deriving instance Hashable MeshGradientPatch++deriving instance Hashable Marker++deriving instance Hashable MarkerOrientation++deriving instance Hashable MarkerUnit++deriving instance Hashable Overflow++deriving instance Hashable Document++deriving instance Hashable Texture++deriving instance Hashable Cap++deriving instance Hashable LineJoin++deriving instance Hashable FillRule++deriving instance Hashable ElementRef++deriving instance Hashable FontStyle++deriving instance Hashable TextAnchor++instance Hashable Tree where+  hashWithSalt s = hashWithSalt s . _treeHash++treeBranch :: Lens' Tree TreeBranch+treeBranch = lens _treeBranch $ const Tree++instance WithDefaultSvg Tree where+  defaultSvg = Tree NoNode++unpack :: Tree -> TreeBranch+unpack t = (_treeBranch t)++pattern Tree :: TreeBranch -> Tree+pattern Tree branch <-+  CachedTree {_treeBranch = branch}+  where+    Tree branch =+      CachedTree+        { _treeBranch = branch,+          _treeHash = hash branch+        }++pattern GroupTree :: Group -> Tree+pattern GroupTree g = Tree (GroupNode g)++pattern SymbolTree :: Group -> Tree+pattern SymbolTree g = Tree (SymbolNode g)++pattern DefinitionTree :: Group -> Tree+pattern DefinitionTree g = Tree (DefinitionNode g)++pattern None :: Tree+pattern None = Tree NoNode++pattern UseTree :: Use -> Maybe Tree -> Tree+pattern UseTree info sub = Tree (UseNode info sub)++pattern FilterTree :: Filter -> Tree+pattern FilterTree f = Tree (FilterNode f)++pattern PathTree :: Path -> Tree+pattern PathTree f = Tree (PathNode f)++pattern CircleTree :: Circle -> Tree+pattern CircleTree f = Tree (CircleNode f)++pattern PolyLineTree :: PolyLine -> Tree+pattern PolyLineTree f = Tree (PolyLineNode f)++pattern PolygonTree :: Polygon -> Tree+pattern PolygonTree f = Tree (PolygonNode f)++pattern EllipseTree :: Ellipse -> Tree+pattern EllipseTree f = Tree (EllipseNode f)++pattern LineTree :: Line -> Tree+pattern LineTree f = Tree (LineNode f)++pattern RectangleTree :: Rectangle -> Tree+pattern RectangleTree f = Tree (RectangleNode f)++pattern TextTree :: Maybe TextPath -> Text -> Tree+pattern TextTree p t = Tree (TextNode p t)++pattern ImageTree :: Image -> Tree+pattern ImageTree n = Tree (ImageNode n)++pattern LinearGradientTree :: LinearGradient -> Tree+pattern LinearGradientTree n = Tree (LinearGradientNode n)++pattern RadialGradientTree :: RadialGradient -> Tree+pattern RadialGradientTree n = Tree (RadialGradientNode n)++pattern MeshGradientTree :: MeshGradient -> Tree+pattern MeshGradientTree n = Tree (MeshGradientNode n)++pattern PatternTree :: Pattern -> Tree+pattern PatternTree n = Tree (PatternNode n)++pattern MarkerTree :: Marker -> Tree+pattern MarkerTree n = Tree (MarkerNode n)++pattern MaskTree :: Mask -> Tree+pattern MaskTree n = Tree (MaskNode n)++pattern ClipPathTree :: ClipPath -> Tree+pattern ClipPathTree n = Tree (ClipPathNode n)++pattern SvgTree :: Document -> Tree+pattern SvgTree n = Tree (SvgNode n)

@@ -0,0 +1,211 @@+{-# OPTIONS_GHC -Wno-orphans #-}+module Graphics.SvgTree.Types.Instances where++import Control.Lens ((&), (.~), (^.), lens, view)+import qualified Data.Text as T+import Graphics.SvgTree.CssTypes (CssMatcheable (..))+import Graphics.SvgTree.Types.Hashable+import Graphics.SvgTree.Types.Internal++instance CssMatcheable Tree where+  cssAttribOf _ _ = Nothing+  cssClassOf = view (drawAttributes . attrClass)+  cssIdOf = fmap T.pack . view (drawAttributes . attrId)+  cssNameOf = nameOfTree++instance HasDrawAttributes Tree where+  drawAttributes = treeBranch . drawAttributes++instance HasDrawAttributes Filter where+  drawAttributes = filterDrawAttributes++instance HasDrawAttributes Use where+  drawAttributes = useDrawAttributes++instance HasDrawAttributes Group where+  drawAttributes = groupDrawAttributes++instance HasDrawAttributes Rectangle where+  drawAttributes = rectangleDrawAttributes++instance HasDrawAttributes Line where+  drawAttributes = lineDrawAttributes++instance HasDrawAttributes Ellipse where+  drawAttributes = ellipseDrawAttributes++instance HasDrawAttributes Polygon where+  drawAttributes = polygonDrawAttributes++instance HasDrawAttributes PolyLine where+  drawAttributes = polyLineDrawAttributes++instance HasDrawAttributes Circle where+  drawAttributes = circleDrawAttributes++instance HasDrawAttributes Path where+  drawAttributes = pathDrawAttributes++instance HasDrawAttributes ClipPath where+  drawAttributes = clipPathDrawAttributes++instance HasDrawAttributes Mask where+  drawAttributes = maskDrawAttributes++instance HasDrawAttributes Marker where+  drawAttributes = markerDrawAttributes++instance HasDrawAttributes Image where+  drawAttributes = imageDrawAttributes++instance HasDrawAttributes Pattern where+  drawAttributes = patternDrawAttributes++instance HasDrawAttributes MeshGradient where+  drawAttributes = meshGradientDrawAttributes++instance HasDrawAttributes RadialGradient where+  drawAttributes = radialGradientDrawAttributes++instance HasDrawAttributes LinearGradient where+  drawAttributes = linearGradientDrawAttributes++instance HasDrawAttributes Composite where+  drawAttributes = compositeDrawAttributes++instance HasDrawAttributes ColorMatrix where+  drawAttributes = colorMatrixDrawAttributes++instance HasDrawAttributes GaussianBlur where+  drawAttributes = gaussianBlurDrawAttributes++instance HasDrawAttributes Turbulence where+  drawAttributes = turbulenceDrawAttributes++instance HasDrawAttributes DisplacementMap where+  drawAttributes = displacementMapDrawAttributes++instance HasDrawAttributes Text where+  drawAttributes = textRoot . spanDrawAttributes++instance HasFilterAttributes Filter where+  filterAttributes = filterSelfAttributes++instance HasFilterAttributes Composite where+  filterAttributes = compositeFilterAttr++instance HasFilterAttributes ColorMatrix where+  filterAttributes = colorMatrixFilterAttr++instance HasFilterAttributes GaussianBlur where+  filterAttributes = gaussianBlurFilterAttr++instance HasFilterAttributes Turbulence where+  filterAttributes = turbulenceFilterAttr++instance HasFilterAttributes DisplacementMap where+  filterAttributes = displacementMapFilterAttr++instance HasFilterAttributes FilterElement where+  filterAttributes = lens getter setter+    where+      getter fe = case fe of+        FEBlend -> defaultSvg+        FEColorMatrix m -> m ^. filterAttributes+        FEComponentTransfer -> defaultSvg+        FEComposite c -> c ^. filterAttributes+        FEConvolveMatrix -> defaultSvg+        FEDiffuseLighting -> defaultSvg+        FEDisplacementMap d -> d ^. filterAttributes+        FEDropShadow -> defaultSvg+        FEFlood -> defaultSvg+        FEFuncA -> defaultSvg+        FEFuncB -> defaultSvg+        FEFuncG -> defaultSvg+        FEFuncR -> defaultSvg+        FEGaussianBlur g -> g ^. filterAttributes+        FEImage -> defaultSvg+        FEMerge -> defaultSvg+        FEMergeNode -> defaultSvg+        FEMorphology -> defaultSvg+        FEOffset -> defaultSvg+        FESpecularLighting -> defaultSvg+        FETile -> defaultSvg+        FETurbulence t -> t ^. filterAttributes+        FENone -> defaultSvg+      setter fe attr = case fe of+        FEBlend -> fe+        FEColorMatrix m -> FEColorMatrix $ m & filterAttributes .~ attr+        FEComponentTransfer -> fe+        FEComposite c -> FEComposite $ c & filterAttributes .~ attr+        FEConvolveMatrix -> fe+        FEDiffuseLighting -> fe+        FEDisplacementMap d -> FEDisplacementMap $ d & filterAttributes .~ attr+        FEDropShadow -> fe+        FEFlood -> fe+        FEFuncA -> fe+        FEFuncB -> fe+        FEFuncG -> fe+        FEFuncR -> fe+        FEGaussianBlur g -> FEGaussianBlur $ g & filterAttributes .~ attr+        FEImage -> fe+        FEMerge -> fe+        FEMergeNode -> fe+        FEMorphology -> fe+        FEOffset -> fe+        FESpecularLighting -> fe+        FETile -> fe+        FETurbulence t -> FETurbulence $ t & filterAttributes .~ attr+        FENone -> fe++instance HasDrawAttributes TreeBranch where+  drawAttributes = lens getter setter+    where+      getter b = case b of+        NoNode -> defaultSvg+        UseNode use _subNode -> use ^. drawAttributes+        GroupNode t -> t ^. drawAttributes+        SymbolNode t -> t ^. drawAttributes+        DefinitionNode t -> t ^. drawAttributes+        FilterNode t -> t ^. drawAttributes+        PathNode t -> t ^. drawAttributes+        CircleNode t -> t ^. drawAttributes+        PolyLineNode t -> t ^. drawAttributes+        PolygonNode t -> t ^. drawAttributes+        EllipseNode t -> t ^. drawAttributes+        LineNode t -> t ^. drawAttributes+        RectangleNode t -> t ^. drawAttributes+        TextNode _ t -> t ^. drawAttributes+        ImageNode t -> t ^. drawAttributes+        LinearGradientNode t -> t ^. drawAttributes+        RadialGradientNode t -> t ^. drawAttributes+        MeshGradientNode t -> t ^. drawAttributes+        PatternNode t -> t ^. drawAttributes+        MarkerNode t -> t ^. drawAttributes+        MaskNode t -> t ^. drawAttributes+        ClipPathNode t -> t ^. drawAttributes+        SvgNode{} -> defaultSvg+      setter b attr = case b of+        NoNode -> b+        UseNode use subNode -> UseNode (use & drawAttributes .~ attr) subNode+        GroupNode t -> GroupNode $ t & drawAttributes .~ attr+        SymbolNode t -> SymbolNode $ t & drawAttributes .~ attr+        DefinitionNode t -> DefinitionNode $ t & drawAttributes .~ attr+        FilterNode t -> FilterNode $ t & drawAttributes .~ attr+        PathNode t -> PathNode $ t & drawAttributes .~ attr+        CircleNode t -> CircleNode $ t & drawAttributes .~ attr+        PolyLineNode t -> PolyLineNode $ t & drawAttributes .~ attr+        PolygonNode t -> PolygonNode $ t & drawAttributes .~ attr+        EllipseNode t -> EllipseNode $ t & drawAttributes .~ attr+        LineNode t -> LineNode $ t & drawAttributes .~ attr+        RectangleNode t -> RectangleNode $ t & drawAttributes .~ attr+        TextNode path t -> TextNode path $ t & drawAttributes .~ attr+        ImageNode t -> ImageNode $ t & drawAttributes .~ attr+        LinearGradientNode t -> LinearGradientNode $ t & drawAttributes .~ attr+        RadialGradientNode t -> RadialGradientNode $ t & drawAttributes .~ attr+        MeshGradientNode t -> MeshGradientNode $ t & drawAttributes .~ attr+        PatternNode t -> PatternNode $ t & drawAttributes .~ attr+        MarkerNode t -> MarkerNode $ t & drawAttributes .~ attr+        MaskNode t -> MaskNode $ t & drawAttributes .~ attr+        ClipPathNode t -> ClipPathNode $ t & drawAttributes .~ attr+        SvgNode {} -> GroupNode $ defaultSvg & groupChildren .~ [Tree b] & drawAttributes .~ attr

@@ -0,0 +1,1767 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TemplateHaskell #-}++-- | This module define all the types used in the definition+-- of a svg scene.+--+-- Most of the types are lensified.+module Graphics.SvgTree.Types.Internal+  ( -- * Basic building types+    Coord,+    Origin (..),+    Point,+    RPoint,+    PathCommand (..),+    Transformation (..),+    ElementRef (..),+    CoordinateUnits (..),++    -- ** Building helpers+    serializeNumber,+    serializeTransformation,+    serializeTransformations,++    -- * Drawing control types+    Cap (..),+    LineJoin (..),+    Tree (..),+    TreeBranch (..),+    Number (..),+    Spread (..),+    Texture (..),+    Element (..),+    FillRule (..),+    FontStyle (..),+    Dpi,+    WithDefaultSvg (..),++    -- * Main type+    Document (..),+    documentViewBox,+    documentWidth,+    documentHeight,+    documentElements,+    documentDescription,+    documentLocation,+    documentAspectRatio,+    documentSize,++    -- * Drawing attributes+    DrawAttributes (..),+    HasDrawAttributes (..),++    -- * Filters+    FilterElement (..),+    FilterAttributes (..),+    HasFilterAttributes (..),+    FilterSource (..),+    ColorMatrixType (..),+    colorMatrixDrawAttributes,+    colorMatrixFilterAttr,+    colorMatrixIn,+    colorMatrixType,+    colorMatrixValues,+    ColorMatrix (..),+    compositeDrawAttributes,+    compositeFilterAttr,+    compositeIn,+    compositeIn2,+    compositeOperator,+    compositeK1,+    compositeK2,+    compositeK3,+    compositeK4,+    Composite (..),+    CompositeOperator (..),+    EdgeMode (..),+    gaussianBlurDrawAttributes,+    gaussianBlurFilterAttr,+    gaussianBlurIn,+    gaussianBlurStdDeviationX,+    gaussianBlurStdDeviationY,+    gaussianBlurEdgeMode,+    GaussianBlur (..),+    turbulenceDrawAttributes,+    turbulenceFilterAttr,+    turbulenceBaseFrequency,+    turbulenceNumOctaves,+    turbulenceSeed,+    turbulenceStitchTiles,+    turbulenceType,+    Turbulence (..),+    TurbulenceType (..),+    StitchTiles (..),+    DisplacementMap (..),+    displacementMapDrawAttributes,+    displacementMapFilterAttr,+    displacementMapIn,+    displacementMapIn2,+    displacementMapScale,+    displacementMapXChannelSelector,+    displacementMapYChannelSelector,+    ChannelSelector (..),++    -- * SVG drawing primitives++    -- ** Rectangle+    Rectangle (..),+    rectangleDrawAttributes,+    rectUpperLeftCorner,+    rectWidth,+    rectHeight,+    rectCornerRadius,++    -- ** Line+    Line (..),+    lineDrawAttributes,+    linePoint1,+    linePoint2,++    -- ** Polygon+    Polygon (..),+    polygonDrawAttributes,+    polygonPoints,++    -- ** Polyline+    PolyLine (..),+    polyLineDrawAttributes,+    polyLinePoints,++    -- ** Path+    Path (..),+    pathDrawAttributes,+    pathDefinition,++    -- ** Circle+    Circle (..),+    circleDrawAttributes,+    circleCenter,+    circleRadius,++    -- ** Ellipse+    Ellipse (..),+    ellipseDrawAttributes,+    ellipseCenter,+    ellipseXRadius,+    ellipseYRadius,++    -- ** Mesh (gradient mesh)+    GradientPathCommand (..),+    MeshGradientType (..),+    MeshGradient (..),+    meshGradientDrawAttributes,+    meshGradientX,+    meshGradientY,+    meshGradientType,+    meshGradientUnits,+    meshGradientTransform,+    meshGradientRows,+    MeshGradientRow (..),+    meshGradientRowPatches,+    MeshGradientPatch (..),+    meshGradientPatchStops,++    -- ** Image+    Image (..),+    imageDrawAttributes,+    imageCornerUpperLeft,+    imageWidth,+    imageHeight,+    imageHref,+    imageAspectRatio,++    -- ** Use+    Use (..),+    useDrawAttributes,+    useBase,+    useName,+    useWidth,+    useHeight,++    -- * Grouping primitives++    -- ** Group+    Group (..),+    groupDrawAttributes,+    groupChildren,+    groupViewBox,+    groupAspectRatio,++    -- ** Filter+    Filter (..),+    filterDrawAttributes,+    filterSelfAttributes,+    filterChildren,++    -- * Text related types++    -- ** Text+    Text (..),+    textAdjust,+    textRoot,+    TextAnchor (..),+    textAt,++    -- ** Text path+    TextPath (..),+    textPathStartOffset,+    textPathName,+    textPathMethod,+    textPathSpacing,+    TextPathSpacing (..),+    TextPathMethod (..),++    -- ** Text span.+    TextSpanContent (..),+    TextSpan (..),+    spanInfo,+    spanDrawAttributes,+    spanContent,+    TextInfo (..),+    textInfoX,+    textInfoY,+    textInfoDX,+    textInfoDY,+    textInfoRotate,+    textInfoLength,+    TextAdjust (..),++    -- * Marker definition+    Marker (..),+    Overflow (..),+    MarkerOrientation (..),+    MarkerUnit (..),+    markerDrawAttributes,+    markerRefPoint,+    markerWidth,+    markerHeight,+    markerOrient,+    markerUnits,+    markerViewBox,+    markerOverflow,+    markerAspectRatio,+    markerElements,++    -- * Gradient definition+    GradientStop (..),+    gradientOffset,+    gradientColor,+    gradientPath,+    gradientOpacity,++    -- ** Linear Gradient+    LinearGradient (..),+    linearGradientDrawAttributes,+    linearGradientUnits,+    linearGradientStart,+    linearGradientStop,+    linearGradientSpread,+    linearGradientTransform,+    linearGradientStops,++    -- ** Radial Gradient+    RadialGradient (..),+    radialGradientDrawAttributes,+    radialGradientUnits,+    radialGradientCenter,+    radialGradientRadius,+    radialGradientFocusX,+    radialGradientFocusY,+    radialGradientSpread,+    radialGradientTransform,+    radialGradientStops,++    -- * Pattern definition+    Pattern (..),+    patternDrawAttributes,+    patternViewBox,+    patternWidth,+    patternHeight,+    patternPos,+    patternHref,+    patternElements,+    patternUnit,+    patternAspectRatio,+    patternTransform,++    -- * Mask definition+    Mask (..),+    maskDrawAttributes,+    maskContentUnits,+    maskUnits,+    maskPosition,+    maskWidth,+    maskHeight,+    maskContent,++    -- * Clip path definition+    ClipPath (..),+    clipPathDrawAttributes,+    clipPathUnits,+    clipPathContent,++    -- * Aspect Ratio description+    PreserveAspectRatio (..),+    Alignment (..),+    MeetSlice (..),+    aspectRatioDefer,+    aspectRatioAlign,+    aspectRatioMeetSlice,++    -- * MISC functions+    nameOfTree,+    toUserUnit,+    mapNumber,+  )+where++import Codec.Picture (PixelRGBA8 (..))+import Control.Lens.TH (makeClassy, makeLenses)+import Data.Function (on)+import Data.Monoid (Last (..))+import qualified Data.Text as T+import GHC.Generics (Generic)+import Graphics.SvgTree.CssTypes+  ( Dpi,+    Number (..),+    mapNumber,+    serializeNumber,+    toUserUnit,+  )+import Graphics.SvgTree.Misc (ppD)+import Graphics.SvgTree.Types.Basic+import Text.Printf (printf)++-- | Path command definition.+data PathCommand+  = -- | 'M' or 'm' command+    MoveTo !Origin ![RPoint]+  | -- | Line to, 'L' or 'l' Svg path command.+    LineTo !Origin ![RPoint]+  | -- | Equivalent to the 'H' or 'h' svg path command.+    HorizontalTo !Origin ![Coord]+  | -- | Equivalent to the 'V' or 'v' svg path command.+    VerticalTo !Origin ![Coord]+  | -- | Cubic bezier, 'C' or 'c' command+    CurveTo !Origin ![(RPoint, RPoint, RPoint)]+  | -- | Smooth cubic bezier, equivalent to 'S' or 's' command+    SmoothCurveTo !Origin ![(RPoint, RPoint)]+  | -- | Quadratic bezier, 'Q' or 'q' command+    QuadraticBezier !Origin ![(RPoint, RPoint)]+  | -- | Quadratic bezier, 'T' or 't' command+    SmoothQuadraticBezierCurveTo !Origin ![RPoint]+  | -- | Eliptical arc, 'A' or 'a' command.+    EllipticalArc !Origin ![(Coord, Coord, Coord, Bool, Bool, RPoint)]+  | -- | Close the path, 'Z' or 'z' svg path command.+    EndPath+  deriving (Eq, Show, Generic)++-- | Description of path used in meshgradient tag+data GradientPathCommand+  = -- | Line to, 'L' or 'l' Svg path command.+    GLine !Origin !(Maybe RPoint)+  | -- | Cubic bezier, 'C' or 'c' command+    GCurve !Origin !RPoint !RPoint !(Maybe RPoint)+  | -- | 'Z' command+    GClose+  deriving (Eq, Show, Generic)++-- | Describe the content of the preserveAspectRatio attribute.+data PreserveAspectRatio = PreserveAspectRatio+  { _aspectRatioDefer :: !Bool,+    _aspectRatioAlign :: !Alignment,+    _aspectRatioMeetSlice :: !(Maybe MeetSlice)+  }+  deriving (Eq, Show, Generic)++instance WithDefaultSvg PreserveAspectRatio where+  defaultSvg =+    PreserveAspectRatio+      { _aspectRatioDefer = False,+        _aspectRatioAlign = AlignxMidYMid,+        _aspectRatioMeetSlice = Nothing+      }++-- | Describe the content of the `transformation` attribute.+-- see `_transform` and `transform`.+data Transformation+  = -- | Directly encode the translation matrix.+    TransformMatrix+      !Coord+      !Coord+      !Coord+      !Coord+      !Coord+      !Coord+  | -- | Translation along a vector+    Translate !Double !Double+  | -- | Scaling on both axis or on X axis and Y axis.+    Scale !Double !(Maybe Double)+  | -- | Rotation around `(0, 0)` or around an optional+    -- point.+    Rotate !Double !(Maybe (Double, Double))+  | -- | Skew transformation along the X axis.+    SkewX !Double+  | -- | Skew transformation along the Y axis.+    SkewY !Double+  | -- | Unkown transformation, like identity.+    TransformUnknown+  deriving (Eq, Show, Generic)++-- | Convert the Transformation to a string which can be+-- directly used in a svg attributes.+serializeTransformation :: Transformation -> String+serializeTransformation t = case t of+  TransformUnknown -> ""+  TransformMatrix a b c d e f ->+    printf+      "matrix(%s, %s, %s, %s, %s, %s)"+      (ppD a)+      (ppD b)+      (ppD c)+      (ppD d)+      (ppD e)+      (ppD f)+  Translate x y -> printf "translate(%s, %s)" (ppD x) (ppD y)+  Scale x Nothing -> printf "scale(%s)" (ppD x)+  Scale x (Just y) -> printf "scale(%s, %s)" (ppD x) (ppD y)+  Rotate angle Nothing -> printf "rotate(%s)" (ppD angle)+  Rotate angle (Just (x, y)) ->+    printf+      "rotate(%s, %s, %s)"+      (ppD angle)+      (ppD x)+      (ppD y)+  SkewX x -> printf "skewX(%s)" (ppD x)+  SkewY y -> printf "skewY(%s)" (ppD y)++-- | Transform a list of transformations to a string for svg+-- `transform` attributes.+serializeTransformations :: [Transformation] -> String+serializeTransformations =+  unwords . fmap serializeTransformation++-- | Define an empty 'default' element for the SVG tree.+-- It is used as base when parsing the element from XML.+class WithDefaultSvg a where+  -- | The default element.+  defaultSvg :: a++-- | Classify the font style, used to search a matching+-- font in the FontCache.+data FontStyle+  = FontStyleNormal+  | FontStyleItalic+  | FontStyleOblique+  deriving (Eq, Show, Generic)++-- | Tell where to anchor the text, where the position+-- given is realative to the text.+data TextAnchor+  = -- | The text with left aligned, or start at the postion+    -- If the point is the '*' then the text will be printed+    -- this way:+    --+    -- >  *THE_TEXT_TO_PRINT+    --+    -- Equivalent to the `start` value.+    TextAnchorStart+  | -- | The text is middle aligned, so the text will be at+    -- the left and right of the position:+    --+    -- >   THE_TEXT*TO_PRINT+    --+    -- Equivalent to the `middle` value.+    TextAnchorMiddle+  | -- | The text is right aligned.+    --+    -- >   THE_TEXT_TO_PRINT*+    --+    -- Equivalent to the `end` value.+    TextAnchorEnd+  deriving (Eq, Show, Generic)++-- | Correspond to the possible values of the+-- the attributes which are either `none` or+-- `url(#elem)`+data ElementRef+  = -- | Value for `none`+    RefNone+  | -- | Equivalent to `url()` attribute.+    Ref String+  deriving (Eq, Show, Generic)++data FilterSource+  = SourceGraphic+  | SourceAlpha+  | BackgroundImage+  | BackgroundAlpha+  | FillPaint+  | StrokePaint+  | SourceRef String+  deriving (Eq, Show, Generic)++data FilterAttributes = FilterAttributes+  { _filterHeight :: !(Last Number),+    _filterResult :: !(Maybe String),+    _filterWidth :: !(Last Number),+    _filterX :: !(Last Number),+    _filterY :: !(Last Number)+  }+  deriving (Eq, Show, Generic)++instance WithDefaultSvg FilterAttributes where+  defaultSvg =+    FilterAttributes+      { _filterHeight = Last Nothing,+        _filterResult = Nothing,+        _filterWidth = Last Nothing,+        _filterX = Last Nothing,+        _filterY = Last Nothing+      }++-- | This type define how to draw any primitives,+-- which color to use, how to stroke the primitives+-- and the potential transformations to use.+--+-- All these attributes are propagated to the children.+data DrawAttributes = DrawAttributes+  { -- | Attribute corresponding to the `stroke-width`+    -- SVG attribute.+    _strokeWidth :: !(Last Number),+    -- | Correspond to the `stroke` attribute.+    _strokeColor :: !(Last Texture),+    -- | Define the `stroke-opacity` attribute, the transparency+    -- for the "border".+    _strokeOpacity :: !(Maybe Float),+    -- | Correspond to the `stroke-linecap` SVG+    -- attribute+    _strokeLineCap :: !(Last Cap),+    -- | Correspond to the `stroke-linejoin` SVG+    -- attribute+    _strokeLineJoin :: !(Last LineJoin),+    -- | Define the distance of the miter join, correspond+    -- to the `stroke-miterlimit` attritbue.+    _strokeMiterLimit :: !(Last Double),+    -- | Define the filling color of the elements. Corresponding+    -- to the `fill` attribute.+    _fillColor :: !(Last Texture),+    -- | Define the `fill-opacity` attribute, the transparency+    -- for the "content".+    _fillOpacity :: !(Maybe Float),+    -- | Define the global or group opacity attribute.+    _groupOpacity :: !(Maybe Float),+    -- | Content of the `transform` attribute+    _transform :: !(Maybe [Transformation]),+    -- | Define the `fill-rule` used during the rendering.+    _fillRule :: !(Last FillRule),+    -- | Define the `mask` attribute.+    _maskRef :: !(Last ElementRef),+    -- | Define the `clip-path` attribute.+    _clipPathRef :: !(Last ElementRef),+    -- | Define the `clip-rule` attribute.+    _clipRule :: !(Last FillRule),+    -- | Map to the `class` attribute. Used for the CSS+    -- rewriting.+    _attrClass :: ![T.Text],+    -- | Map to the `id` attribute. Used for the CSS+    -- rewriting.+    _attrId :: !(Maybe String),+    -- | Define the start distance of the dashing pattern.+    -- Correspond to the `stroke-dashoffset` attribute.+    _strokeOffset :: !(Last Number),+    -- | Define the dashing pattern for the lines. Correspond+    -- to the `stroke-dasharray` attribute.+    _strokeDashArray :: !(Last [Number]),+    -- | Current size of the text, correspond to the+    -- `font-size` SVG attribute.+    _fontSize :: !(Last Number),+    -- | Define the possible fonts to be used for text rendering.+    -- Map to the `font-family` attribute.+    _fontFamily :: !(Last [String]),+    -- | Map to the `font-style` attribute.+    _fontStyle :: !(Last FontStyle),+    -- | Define how to interpret the text position, correspond+    -- to the `text-anchor` attribute.+    _textAnchor :: !(Last TextAnchor),+    -- | Define the marker used for the start of the line.+    -- Correspond to the `marker-start` attribute.+    _markerStart :: !(Last ElementRef),+    -- | Define the marker used for every point of the+    -- polyline/path Correspond to the `marker-mid`+    -- attribute.+    _markerMid :: !(Last ElementRef),+    -- | Define the marker used for the end of the line.+    -- Correspond to the `marker-end` attribute.+    _markerEnd :: !(Last ElementRef),+    _filterRef :: !(Last ElementRef)+  }+  deriving (Eq, Show, Generic)++makeClassy ''DrawAttributes++-- | This primitive describe an unclosed suite of+-- segments. Correspond to the `<polyline>` tag.+data PolyLine = PolyLine+  { _polyLineDrawAttributes :: DrawAttributes,+    -- | Geometry definition of the polyline.+    -- correspond to the `points` attribute+    _polyLinePoints :: [RPoint]+  }+  deriving (Eq, Show, Generic)++instance WithDefaultSvg PolyLine where+  defaultSvg = PolyLine mempty mempty++-- | Primitive decriving polygon composed+-- of segements. Correspond to the `<polygon>`+-- tag+data Polygon = Polygon+  { _polygonDrawAttributes :: DrawAttributes,+    -- | Points of the polygon. Correspond to+    -- the `points` attributes.+    _polygonPoints :: [RPoint]+  }+  deriving (Eq, Show, Generic)++instance WithDefaultSvg Polygon where+  defaultSvg = Polygon mempty mempty++-- | Define a simple line. Correspond to the+-- `<line>` tag.+data Line = Line+  { _lineDrawAttributes :: DrawAttributes,+    -- | First point of the the line, correspond+    -- to the `x1` and `y1` attributes.+    _linePoint1 :: !Point,+    -- | Second point of the the line, correspond+    -- to the `x2` and `y2` attributes.+    _linePoint2 :: !Point+  }+  deriving (Eq, Show, Generic)++instance WithDefaultSvg Line where+  defaultSvg =+    Line+      { _lineDrawAttributes = mempty,+        _linePoint1 = zeroPoint,+        _linePoint2 = zeroPoint+      }+    where+      zeroPoint = (Num 0, Num 0)++-- | Define a rectangle. Correspond to+-- `<rectangle>` svg tag.+data Rectangle = Rectangle+  { _rectangleDrawAttributes :: DrawAttributes,+    -- | Upper left corner of the rectangle, correspond+    -- to the attributes `x` and `y`.+    _rectUpperLeftCorner :: !Point,+    -- | Rectangle width, correspond, strangely, to+    -- the `width` attribute.+    _rectWidth :: !(Maybe Number),+    -- | Rectangle height, correspond, amazingly, to+    -- the `height` attribute.+    _rectHeight :: !(Maybe Number),+    -- | Define the rounded corner radius radius+    -- of the rectangle. Correspond to the `rx` and+    -- `ry` attributes.+    _rectCornerRadius :: !(Maybe Number, Maybe Number)+  }+  deriving (Eq, Show, Generic)++instance WithDefaultSvg Rectangle where+  defaultSvg =+    Rectangle+      { _rectangleDrawAttributes = mempty,+        _rectUpperLeftCorner = (Num 0, Num 0),+        _rectWidth = Nothing,+        _rectHeight = Nothing,+        _rectCornerRadius = (Nothing, Nothing)+      }++-- | Type mapping the `<path>` svg tag.+data Path = Path+  { _pathDrawAttributes :: DrawAttributes,+    -- | Definition of the path, correspond to the+    -- `d` attributes.+    _pathDefinition :: [PathCommand]+  }+  deriving (Eq, Show, Generic)++instance WithDefaultSvg Path where+  defaultSvg = Path mempty mempty++-- | Define a SVG group, corresponding `<g>` tag.+data Group = Group+  { _groupDrawAttributes :: DrawAttributes,+    -- | Content of the group, corresponding to all the tags+    -- inside the `<g>` tag.+    _groupChildren :: ![Tree],+    -- | Mapped to the attribute `viewBox`+    _groupViewBox :: !(Maybe (Double, Double, Double, Double)),+    -- | used for symbols only+    _groupAspectRatio :: !PreserveAspectRatio+  }+  deriving (Eq, Show, Generic)++instance WithDefaultSvg Group where+  defaultSvg =+    Group+      { _groupDrawAttributes = mempty,+        _groupChildren = [],+        _groupViewBox = Nothing,+        _groupAspectRatio = defaultSvg+      }++-- | Define the `<filter>` tag.+data Filter = Filter+  { _filterDrawAttributes :: DrawAttributes,+    _filterSelfAttributes :: !FilterAttributes,+    _filterChildren :: ![FilterElement]+  }+  deriving (Eq, Show, Generic)++instance WithDefaultSvg Filter where+  defaultSvg =+    Filter+      { _filterDrawAttributes = mempty,+        _filterSelfAttributes = defaultSvg,+        _filterChildren = []+      }++-- | Define a `<circle>`.+data Circle = Circle+  { _circleDrawAttributes :: DrawAttributes,+    -- | Define the center of the circle, describe+    -- the `cx` and `cy` attributes.+    _circleCenter :: !Point,+    -- | Radius of the circle, equivalent to the `r`+    -- attribute.+    _circleRadius :: !Number+  }+  deriving (Eq, Show, Generic)++instance WithDefaultSvg Circle where+  defaultSvg =+    Circle+      { _circleDrawAttributes = mempty,+        _circleCenter = (Num 0, Num 0),+        _circleRadius = Num 0+      }++-- | Define an `<ellipse>`+data Ellipse = Ellipse+  { _ellipseDrawAttributes :: DrawAttributes,+    -- | Center of the ellipse, map to the `cx`+    -- and `cy` attributes.+    _ellipseCenter :: !Point,+    -- | Radius along the X axis, map the+    -- `rx` attribute.+    _ellipseXRadius :: !Number,+    -- | Radius along the Y axis, map the+    -- `ry` attribute.+    _ellipseYRadius :: !Number+  }+  deriving (Eq, Show, Generic)++instance WithDefaultSvg Ellipse where+  defaultSvg =+    Ellipse+      { _ellipseDrawAttributes = mempty,+        _ellipseCenter = (Num 0, Num 0),+        _ellipseXRadius = Num 0,+        _ellipseYRadius = Num 0+      }++-- | Define a color stop for the gradients. Represent+-- the `<stop>` SVG tag.+data GradientStop = GradientStop+  { -- | Gradient offset between 0 and 1, correspond+    -- to the `offset` attribute.+    _gradientOffset :: !Float,+    -- | Color of the gradient stop. Correspond+    -- to the `stop-color` attribute.+    _gradientColor :: !PixelRGBA8,+    -- | Path command used in mesh patch+    _gradientPath :: !(Maybe GradientPathCommand),+    -- | Stop color opacity+    _gradientOpacity :: !(Maybe Float)+  }+  deriving (Eq, Show, Generic)++instance WithDefaultSvg GradientStop where+  defaultSvg =+    GradientStop+      { _gradientOffset = 0.0,+        _gradientColor = PixelRGBA8 0 0 0 255,+        _gradientPath = Nothing,+        _gradientOpacity = Nothing+      }++-- | Define `<meshpatch>` SVG tag+data MeshGradientPatch = MeshGradientPatch+  { -- | List of stop, from 2 to 4 in a patch+    _meshGradientPatchStops :: ![GradientStop]+  }+  deriving (Eq, Show, Generic)++instance WithDefaultSvg MeshGradientPatch where+  defaultSvg = MeshGradientPatch []++-- | Define a `<meshrow>` tag.+data MeshGradientRow = MeshGradientRow+  { -- | List of patch in a row+    _meshGradientRowPatches :: ![MeshGradientPatch]+  }+  deriving (Eq, Show, Generic)++instance WithDefaultSvg MeshGradientRow where+  defaultSvg = MeshGradientRow []++-- | Define a `<meshgradient>` tag.+data MeshGradient = MeshGradient+  { _meshGradientDrawAttributes :: DrawAttributes,+    -- | Original x coordinate of the mesh gradient+    _meshGradientX :: !Number,+    -- | Original y coordinate of the mesh gradient+    _meshGradientY :: !Number,+    -- | Type of color interpolation to use+    _meshGradientType :: !MeshGradientType,+    -- | Coordiante system to use+    _meshGradientUnits :: !CoordinateUnits,+    -- | Optional transform+    _meshGradientTransform :: ![Transformation],+    -- | List of patch rows in the the mesh.+    _meshGradientRows :: ![MeshGradientRow]+  }+  deriving (Eq, Show, Generic)++instance WithDefaultSvg MeshGradient where+  defaultSvg =+    MeshGradient+      { _meshGradientDrawAttributes = mempty,+        _meshGradientX = Percent 0,+        _meshGradientY = Percent 0,+        _meshGradientType = GradientBilinear,+        _meshGradientUnits = CoordBoundingBox,+        _meshGradientTransform = mempty,+        _meshGradientRows = mempty+      }++-- | Define an `<image>` tag.+data Image = Image+  { _imageDrawAttributes :: DrawAttributes,+    -- | Position of the image referenced by its+    -- upper left corner.+    _imageCornerUpperLeft :: !Point,+    -- | Image width+    _imageWidth :: !Number,+    -- | Image Height+    _imageHeight :: !Number,+    -- | Image href, pointing to the real image.+    _imageHref :: !String,+    -- | preserveAspectRatio attribute+    _imageAspectRatio :: !PreserveAspectRatio+  }+  deriving (Eq, Show, Generic)++instance WithDefaultSvg Image where+  defaultSvg =+    Image+      { _imageDrawAttributes = mempty,+        _imageCornerUpperLeft = (Num 0, Num 0),+        _imageWidth = Num 0,+        _imageHeight = Num 0,+        _imageHref = "",+        _imageAspectRatio = defaultSvg+      }++-- | Define an `<use>` for a named content.+-- Every named content can be reused in the+-- document using this element.+data Use = Use+  { _useDrawAttributes :: DrawAttributes,+    -- | Position where to draw the "used" element.+    -- Correspond to the `x` and `y` attributes.+    _useBase :: Point,+    -- | Referenced name, correspond to `xlink:href`+    -- attribute.+    _useName :: String,+    -- | Define the width of the region where+    -- to place the element. Map to the `width`+    -- attribute.+    _useWidth :: Maybe Number,+    -- | Define the height of the region where+    -- to place the element. Map to the `height`+    -- attribute.+    _useHeight :: Maybe Number+  }+  deriving (Eq, Show, Generic)++instance WithDefaultSvg Use where+  defaultSvg =+    Use+      { _useDrawAttributes = mempty,+        _useBase = (Num 0, Num 0),+        _useName = "",+        _useWidth = Nothing,+        _useHeight = Nothing+      }++-- | Define position information associated to+-- `<text>` or `<tspan>` svg tag.+data TextInfo = TextInfo+  { -- | `x` attribute.+    _textInfoX :: ![Number],+    -- | `y` attribute.+    _textInfoY :: ![Number],+    -- | `dx` attribute.+    _textInfoDX :: ![Number],+    -- | `dy` attribute.+    _textInfoDY :: ![Number],+    -- | `rotate` attribute.+    _textInfoRotate :: ![Double],+    -- | `textLength` attribute.+    _textInfoLength :: !(Maybe Number)+  }+  deriving (Eq, Show, Generic)++instance Semigroup TextInfo where+  (<>)+    (TextInfo x1 y1 dx1 dy1 r1 l1)+    (TextInfo x2 y2 dx2 dy2 r2 l2) =+      TextInfo+        (x1 <> x2)+        (y1 <> y2)+        (dx1 <> dx2)+        (dy1 <> dy2)+        (r1 <> r2)+        (getLast $ Last l1 <> Last l2)++instance Monoid TextInfo where+  mempty = TextInfo [] [] [] [] [] Nothing+  mappend = (<>)++instance WithDefaultSvg TextInfo where+  defaultSvg = mempty++-- | Define the content of a `<tspan>` tag.+data TextSpanContent+  = -- | Raw text+    SpanText !T.Text+  | -- | Equivalent to a `<tref>`+    SpanTextRef !String+  | -- | Define a `<tspan>`+    SpanSub !TextSpan+  deriving (Eq, Show, Generic)++-- | Define a `<tspan>` tag.+data TextSpan = TextSpan+  { -- | Placing information for the text.+    _spanInfo :: !TextInfo,+    -- | Drawing attributes for the text span.+    _spanDrawAttributes :: !DrawAttributes,+    -- | Content of the span.+    _spanContent :: ![TextSpanContent]+  }+  deriving (Eq, Show, Generic)++instance WithDefaultSvg TextSpan where+  defaultSvg =+    TextSpan+      { _spanInfo = defaultSvg,+        _spanDrawAttributes = mempty,+        _spanContent = mempty+      }++-- | Describe the content of the `method` attribute on+-- text path.+data TextPathMethod+  = -- | Map to the `align` value.+    TextPathAlign+  | -- | Map to the `stretch` value.+    TextPathStretch+  deriving (Eq, Show, Generic)++-- | Describe the content of the `spacing` text path+-- attribute.+data TextPathSpacing+  = -- | Map to the `exact` value.+    TextPathSpacingExact+  | -- | Map to the `auto` value.+    TextPathSpacingAuto+  deriving (Eq, Show, Generic)++-- | Describe the `<textpath>` SVG tag.+data TextPath = TextPath+  { -- | Define the beginning offset on the path,+    -- the `startOffset` attribute.+    _textPathStartOffset :: !Number,+    -- | Define the `xlink:href` attribute.+    _textPathName :: !String,+    -- | Correspond to the `method` attribute.+    _textPathMethod :: !TextPathMethod,+    -- | Correspond to the `spacing` attribute.+    _textPathSpacing :: !TextPathSpacing+  }+  deriving (Eq, Show, Generic)++instance WithDefaultSvg TextPath where+  defaultSvg =+    TextPath+      { _textPathStartOffset = Num 0,+        _textPathName = mempty,+        _textPathMethod = TextPathAlign,+        _textPathSpacing = TextPathSpacingExact+      }++-- | Define the possible values of the `lengthAdjust`+-- attribute.+data TextAdjust+  = -- | Value `spacing`+    TextAdjustSpacing+  | -- | Value `spacingAndGlyphs`+    TextAdjustSpacingAndGlyphs+  deriving (Eq, Show, Generic)++-- | Define the global `<text>` SVG tag.+data Text = Text+  { -- | Define the `lengthAdjust` attribute.+    _textAdjust :: !TextAdjust,+    -- | Root of the text content.+    _textRoot :: !TextSpan+  }+  deriving (Eq, Show, Generic)++-- | Little helper to create a SVG text at a given+-- baseline position.+textAt :: Point -> T.Text -> Text+textAt (x, y) txt = Text TextAdjustSpacing tspan+  where+    tspan =+      defaultSvg+        { _spanContent = [SpanText txt],+          _spanInfo =+            defaultSvg+              { _textInfoX = [x],+                _textInfoY = [y]+              }+        }++instance WithDefaultSvg Text where+  defaultSvg =+    Text+      { _textRoot = defaultSvg,+        _textAdjust = TextAdjustSpacing+      }++-- | Main type for the scene description, reorient to+-- specific type describing each tag.+data Tree = CachedTree+  { _treeBranch :: TreeBranch,+    _treeHash :: Int+  }+  deriving (Eq, Show, Generic)++data TreeBranch+  = NoNode+  | UseNode+      { useInformation :: !Use,+        useSubTree :: !(Maybe Tree)+      }+  | GroupNode !Group+  | SymbolNode !Group+  | DefinitionNode !Group+  | FilterNode !Filter+  | PathNode !Path+  | CircleNode !Circle+  | PolyLineNode !PolyLine+  | PolygonNode !Polygon+  | EllipseNode !Ellipse+  | LineNode !Line+  | RectangleNode !Rectangle+  | TextNode !(Maybe TextPath) !Text+  | ImageNode !Image+  | LinearGradientNode !LinearGradient+  | RadialGradientNode !RadialGradient+  | MeshGradientNode !MeshGradient+  | PatternNode !Pattern+  | MarkerNode !Marker+  | MaskNode !Mask+  | ClipPathNode !ClipPath+  | SvgNode !Document+  deriving (Eq, Show, Generic)++instance WithDefaultSvg TreeBranch where+  defaultSvg = NoNode++data FilterElement+  = FEBlend+  | FEColorMatrix ColorMatrix+  | FEComponentTransfer -- Need+  | FEComposite Composite+  | FEConvolveMatrix+  | FEDiffuseLighting+  | FEDisplacementMap DisplacementMap+  | FEDropShadow+  | FEFlood+  | FEFuncA -- Need+  | FEFuncB+  | FEFuncG+  | FEFuncR+  | FEGaussianBlur GaussianBlur+  | FEImage+  | FEMerge+  | FEMergeNode+  | FEMorphology+  | FEOffset+  | FESpecularLighting+  | FETile+  | FETurbulence Turbulence+  | FENone+  deriving (Eq, Show, Generic)++instance WithDefaultSvg FilterElement where+  defaultSvg = FENone++data TransferFunctionType+  = TFIdentity+  | TFTable+  | TFDiscrete+  | TFLinear+  | TFGamma+  deriving (Eq, Show, Generic)++data TransferFunction = TransferFunction+  { _transferFunctionDrawAttributes :: !DrawAttributes,+    _transferFunctionFilterAttr :: !FilterAttributes,+    _transferFunctionType :: TransferFunctionType,+    _transferFunctionTableValues :: [Double],+    _transferFunctionSlope :: Double,+    _transferFunctionIntercept :: Double,+    _transferFunctionAmplitude :: Double,+    _transferFunctionExponent :: Double,+    _transferFunctionOffset :: Double+  }+  deriving (Eq, Show, Generic)++data ChannelSelector+  = ChannelR+  | ChannelG+  | ChannelB+  | ChannelA+  deriving (Eq, Show, Generic)++data DisplacementMap = DisplacementMap+  { _displacementMapDrawAttributes :: !DrawAttributes,+    _displacementMapFilterAttr :: !FilterAttributes,+    _displacementMapIn :: !(Last FilterSource),+    _displacementMapIn2 :: !(Last FilterSource),+    _displacementMapScale :: !(Last Double),+    _displacementMapXChannelSelector :: ChannelSelector,+    _displacementMapYChannelSelector :: ChannelSelector+  }+  deriving (Eq, Show, Generic)++instance WithDefaultSvg DisplacementMap where+  defaultSvg =+    DisplacementMap+      { _displacementMapDrawAttributes = defaultSvg,+        _displacementMapFilterAttr = defaultSvg,+        _displacementMapIn = Last Nothing,+        _displacementMapIn2 = Last Nothing,+        _displacementMapScale = Last Nothing,+        _displacementMapXChannelSelector = ChannelA,+        _displacementMapYChannelSelector = ChannelA+      }++data ColorMatrixType+  = Matrix+  | Saturate+  | HueRotate+  | LuminanceToAlpha+  deriving (Eq, Show, Generic)++data ColorMatrix = ColorMatrix+  { _colorMatrixDrawAttributes :: !DrawAttributes,+    _colorMatrixFilterAttr :: !FilterAttributes,+    _colorMatrixIn :: !(Last FilterSource),+    _colorMatrixType :: !ColorMatrixType,+    _colorMatrixValues :: !String+  }+  deriving (Eq, Show, Generic)++instance WithDefaultSvg ColorMatrix where+  defaultSvg =+    ColorMatrix+      { _colorMatrixDrawAttributes = defaultSvg,+        _colorMatrixFilterAttr = defaultSvg,+        _colorMatrixIn = Last Nothing,+        _colorMatrixType = Matrix,+        _colorMatrixValues = ""+      }++data CompositeOperator+  = CompositeOver -- this is default+  | CompositeIn+  | CompositeOut+  | CompositeAtop+  | CompositeXor+  | CompositeArithmetic+  deriving (Eq, Show, Generic)++data Composite = Composite+  { _compositeDrawAttributes :: DrawAttributes,+    _compositeFilterAttr :: !FilterAttributes,+    _compositeIn :: Last FilterSource,+    _compositeIn2 :: Last FilterSource,+    _compositeOperator :: CompositeOperator,+    _compositeK1 :: Number,+    _compositeK2 :: Number,+    _compositeK3 :: Number,+    _compositeK4 :: Number+  }+  deriving (Eq, Show, Generic)++instance WithDefaultSvg Composite where+  defaultSvg =+    Composite+      { _compositeDrawAttributes = defaultSvg,+        _compositeFilterAttr = defaultSvg,+        _compositeIn = Last Nothing,+        _compositeIn2 = Last Nothing,+        _compositeOperator = CompositeOver,+        _compositeK1 = Num 0,+        _compositeK2 = Num 0,+        _compositeK3 = Num 0,+        _compositeK4 = Num 0+      }++data Turbulence = Turbulence+  { _turbulenceDrawAttributes :: !DrawAttributes,+    _turbulenceFilterAttr :: !FilterAttributes,+    _turbulenceBaseFrequency :: !(Double, Last Double), -- Not negative+    _turbulenceNumOctaves :: Int, -- Not negative+    _turbulenceSeed :: Double,+    _turbulenceStitchTiles :: StitchTiles,+    _turbulenceType :: TurbulenceType+  }+  deriving (Eq, Show, Generic)++data StitchTiles+  = NoStitch+  | Stitch+  deriving (Eq, Show, Generic)++data TurbulenceType+  = FractalNoiseType+  | TurbulenceType+  deriving (Eq, Show, Generic)++instance WithDefaultSvg Turbulence where+  defaultSvg =+    Turbulence+      { _turbulenceDrawAttributes = defaultSvg,+        _turbulenceFilterAttr = defaultSvg,+        _turbulenceBaseFrequency = (0, Last Nothing),+        _turbulenceNumOctaves = 1,+        _turbulenceSeed = 0,+        _turbulenceStitchTiles = NoStitch,+        _turbulenceType = TurbulenceType+      }++data EdgeMode+  = EdgeDuplicate+  | EdgeWrap+  | EdgeNone+  deriving (Eq, Show, Generic)++data GaussianBlur = GaussianBlur+  { _gaussianBlurDrawAttributes :: DrawAttributes,+    _gaussianBlurFilterAttr :: !FilterAttributes,+    _gaussianBlurIn :: Last FilterSource,+    _gaussianBlurStdDeviationX :: Number,+    _gaussianBlurStdDeviationY :: Last Number,+    _gaussianBlurEdgeMode :: EdgeMode+  }+  deriving (Eq, Show, Generic)++instance WithDefaultSvg GaussianBlur where+  defaultSvg =+    GaussianBlur+      { _gaussianBlurDrawAttributes = defaultSvg,+        _gaussianBlurFilterAttr = defaultSvg,+        _gaussianBlurIn = Last Nothing,+        _gaussianBlurStdDeviationX = Num 0,+        _gaussianBlurStdDeviationY = Last Nothing,+        _gaussianBlurEdgeMode = EdgeDuplicate+      }++-- | Define the orientation, associated to the+-- `orient` attribute on the Marker+data MarkerOrientation+  = -- | Auto value+    OrientationAuto+  | -- | Specific angle.+    OrientationAngle Coord+  deriving (Eq, Show, Generic)++-- | Define the content of the `markerUnits` attribute+-- on the Marker.+data MarkerUnit+  = -- | Value `strokeWidth`+    MarkerUnitStrokeWidth+  | -- | Value `userSpaceOnUse`+    MarkerUnitUserSpaceOnUse+  deriving (Eq, Show, Generic)++-- | Define the content of the `markerUnits` attribute+-- on the Marker.+data Overflow+  = -- | Value `visible`+    OverflowVisible+  | -- | Value `hidden`+    OverflowHidden+  deriving (Eq, Show, Generic)++-- | Define the `<marker>` tag.+data Marker = Marker+  { _markerDrawAttributes :: DrawAttributes,+    -- | Define the reference point of the marker.+    -- correspond to the `refX` and `refY` attributes.+    _markerRefPoint :: !(Number, Number),+    -- | Define the width of the marker. Correspond to+    -- the `markerWidth` attribute.+    _markerWidth :: !(Maybe Number),+    -- | Define the height of the marker. Correspond to+    -- the `markerHeight` attribute.+    _markerHeight :: !(Maybe Number),+    -- | Correspond to the `orient` attribute.+    _markerOrient :: !(Maybe MarkerOrientation),+    -- | Map the `markerUnits` attribute.+    _markerUnits :: !(Maybe MarkerUnit),+    -- | Optional viewbox+    _markerViewBox :: !(Maybe (Double, Double, Double, Double)),+    -- | Elements defining the marker.+    _markerOverflow :: !(Maybe Overflow),+    -- | preserveAspectRatio attribute+    _markerAspectRatio :: !PreserveAspectRatio,+    -- | Elements defining the marker.+    _markerElements :: [Tree]+  }+  deriving (Eq, Show, Generic)++instance WithDefaultSvg Marker where+  defaultSvg =+    Marker+      { _markerDrawAttributes = mempty,+        _markerRefPoint = (Num 0, Num 0),+        _markerWidth = Just (Num 3),+        _markerHeight = Just (Num 3),+        _markerOrient = Nothing, -- MarkerOrientation+        _markerUnits = Nothing, -- MarkerUnitStrokeWidth+        _markerViewBox = Nothing,+        _markerOverflow = Nothing,+        _markerElements = mempty,+        _markerAspectRatio = defaultSvg+      }++-- | For every element of a svg tree, associate+-- it's SVG tag name.+nameOfTree :: Tree -> T.Text+nameOfTree v =+  case _treeBranch v of+    NoNode -> ""+    UseNode _ _ -> "use"+    GroupNode _ -> "g"+    SymbolNode _ -> "symbol"+    DefinitionNode _ -> "defs"+    FilterNode _ -> "filter"+    PathNode _ -> "path"+    CircleNode _ -> "circle"+    PolyLineNode _ -> "polyline"+    PolygonNode _ -> "polygon"+    EllipseNode _ -> "ellipse"+    LineNode _ -> "line"+    RectangleNode _ -> "rectangle"+    TextNode _ _ -> "text"+    ImageNode _ -> "image"+    LinearGradientNode _ -> "lineargradient"+    RadialGradientNode _ -> "radialgradient"+    MeshGradientNode _ -> "meshgradient"+    PatternNode _ -> "pattern"+    MarkerNode _ -> "marker"+    MaskNode _ -> "mask"+    ClipPathNode _ -> "clipPath"+    SvgNode {} -> "svg"++-- | Define the possible values for the `spreadMethod`+-- values used for the gradient definitions.+data Spread+  = -- | `reapeat` value+    SpreadRepeat+  | -- | `pad` value+    SpreadPad+  | -- | `reflect value`+    SpreadReflect+  deriving (Eq, Show, Generic)++-- | Define a `<linearGradient>` tag.+data LinearGradient = LinearGradient+  { _linearGradientDrawAttributes :: DrawAttributes,+    -- | Define coordinate system of the gradient,+    -- associated to the `gradientUnits` attribute.+    _linearGradientUnits :: CoordinateUnits,+    -- | Point defining the beginning of the line gradient.+    -- Associated to the `x1` and `y1` attribute.+    _linearGradientStart :: Point,+    -- | Point defining the end of the line gradient.+    -- Associated to the `x2` and `y2` attribute.+    _linearGradientStop :: Point,+    -- | Define how to handle the values outside+    -- the gradient start and stop. Associated to the+    -- `spreadMethod` attribute.+    _linearGradientSpread :: Spread,+    -- | Define the transformation to apply to the+    -- gradient points. Associated to the `gradientTransform`+    -- attribute.+    _linearGradientTransform :: [Transformation],+    -- | List of color stops of the linear gradient.+    _linearGradientStops :: [GradientStop]+  }+  deriving (Eq, Show, Generic)++instance WithDefaultSvg LinearGradient where+  defaultSvg =+    LinearGradient+      { _linearGradientDrawAttributes = mempty,+        _linearGradientUnits = CoordBoundingBox,+        _linearGradientStart = (Percent 0, Percent 0),+        _linearGradientStop = (Percent 1, Percent 0),+        _linearGradientSpread = SpreadPad,+        _linearGradientTransform = [],+        _linearGradientStops = []+      }++-- | Define a `<radialGradient>` tag.+data RadialGradient = RadialGradient+  { _radialGradientDrawAttributes :: DrawAttributes,+    -- | Define coordinate system of the gradient,+    -- associated to the `gradientUnits` attribute.+    _radialGradientUnits :: CoordinateUnits,+    -- | Center of the radial gradient. Associated to+    -- the `cx` and `cy` attributes.+    _radialGradientCenter :: Point,+    -- | Radius of the radial gradient. Associated to+    -- the `r` attribute.+    _radialGradientRadius :: Number,+    -- | X coordinate of the focus point of the radial+    -- gradient. Associated to the `fx` attribute.+    _radialGradientFocusX :: Maybe Number,+    -- | Y coordinate of the focus point of the radial+    -- gradient. Associated to the `fy` attribute.+    _radialGradientFocusY :: Maybe Number,+    -- | Define how to handle the values outside+    -- the gradient start and stop. Associated to the+    -- `spreadMethod` attribute.+    _radialGradientSpread :: Spread,+    -- | Define the transformation to apply to the+    -- gradient points. Associated to the `gradientTransform`+    -- attribute.+    _radialGradientTransform :: [Transformation],+    -- | List of color stops of the radial gradient.+    _radialGradientStops :: [GradientStop]+  }+  deriving (Eq, Show, Generic)++instance WithDefaultSvg RadialGradient where+  defaultSvg =+    RadialGradient+      { _radialGradientDrawAttributes = mempty,+        _radialGradientUnits = CoordBoundingBox,+        _radialGradientCenter = (Percent 0.5, Percent 0.5),+        _radialGradientRadius = Percent 0.5,+        _radialGradientFocusX = Nothing,+        _radialGradientFocusY = Nothing,+        _radialGradientSpread = SpreadPad,+        _radialGradientTransform = [],+        _radialGradientStops = []+      }++-- | Define a SVG `<mask>` tag.+data Mask = Mask+  { _maskDrawAttributes :: DrawAttributes,+    -- | Correspond to the `maskContentUnits` attributes.+    _maskContentUnits :: CoordinateUnits,+    -- | Mapping to the `maskUnits` attribute.+    _maskUnits :: CoordinateUnits,+    -- | Map to the `x` and `y` attributes.+    _maskPosition :: Point,+    -- | Map to the `width` attribute+    _maskWidth :: Number,+    -- | Map to the `height` attribute.+    _maskHeight :: Number,+    -- | Children of the `<mask>` tag.+    _maskContent :: [Tree]+  }+  deriving (Eq, Show, Generic)++instance WithDefaultSvg Mask where+  defaultSvg =+    Mask+      { _maskDrawAttributes = mempty,+        _maskContentUnits = CoordUserSpace,+        _maskUnits = CoordBoundingBox,+        _maskPosition = (Percent (-0.1), Percent (-0.1)),+        _maskWidth = Percent 1.2,+        _maskHeight = Percent 1.2,+        _maskContent = []+      }++-- | Define a `<clipPath>` tag.+data ClipPath = ClipPath+  { _clipPathDrawAttributes :: DrawAttributes,+    -- | Maps to the `clipPathUnits` attribute+    _clipPathUnits :: CoordinateUnits,+    -- | Maps to the content of the tree+    _clipPathContent :: [Tree]+  }+  deriving (Eq, Show, Generic)++instance WithDefaultSvg ClipPath where+  defaultSvg =+    ClipPath+      { _clipPathDrawAttributes = mempty,+        _clipPathUnits = CoordUserSpace,+        _clipPathContent = mempty+      }++-- | Define a `<pattern>` tag.+data Pattern = Pattern+  { _patternDrawAttributes :: DrawAttributes,+    -- | Possible `viewBox`.+    _patternViewBox :: !(Maybe (Double, Double, Double, Double)),+    -- | Width of the pattern tile, mapped to the+    -- `width` attribute+    _patternWidth :: !Number,+    -- | Height of the pattern tile, mapped to the+    -- `height` attribute+    _patternHeight :: !Number,+    -- | Pattern tile base, mapped to the `x` and+    -- `y` attributes.+    _patternPos :: !Point,+    -- | Patterns can be chained, so this is a potential+    -- reference to another pattern+    _patternHref :: !String,+    -- | Elements used in the pattern.+    _patternElements :: ![Tree],+    -- | Define the cordinate system to use for+    -- the pattern. Mapped to the `patternUnits`+    -- attribute.+    _patternUnit :: !CoordinateUnits,+    -- | Value of the "preserveAspectRatio" attribute+    _patternAspectRatio :: !PreserveAspectRatio,+    -- | Value of "patternTransform" attribute+    _patternTransform :: !(Maybe [Transformation])+  }+  deriving (Eq, Show, Generic)++instance WithDefaultSvg Pattern where+  defaultSvg =+    Pattern+      { _patternDrawAttributes = mempty,+        _patternViewBox = Nothing,+        _patternWidth = Num 0,+        _patternHeight = Num 0,+        _patternPos = (Num 0, Num 0),+        _patternElements = [],+        _patternUnit = CoordBoundingBox,+        _patternAspectRatio = defaultSvg,+        _patternHref = "",+        _patternTransform = mempty+      }++-- | Sum types helping keeping track of all the namable+-- elemens in a SVG document.+data Element+  = ElementLinearGradient LinearGradient+  | ElementRadialGradient RadialGradient+  | ElementMeshGradient MeshGradient+  | ElementGeometry Tree+  | ElementPattern Pattern+  | ElementMarker Marker+  | ElementMask Mask+  | ElementClipPath ClipPath+  deriving (Eq, Show, Generic)++-- | Represent a full svg document with style,+-- geometry and named elements.+data Document = Document+  { _documentViewBox :: Maybe (Double, Double, Double, Double),+    _documentWidth :: Maybe Number,+    _documentHeight :: Maybe Number,+    _documentElements :: [Tree],+    _documentDescription :: String,+    _documentLocation :: FilePath,+    _documentAspectRatio :: PreserveAspectRatio+  }+  deriving (Show, Eq, Generic)++-- | Calculate the document size in function of the+-- different available attributes in the document.+documentSize :: Dpi -> Document -> (Int, Int)+documentSize+  _+  Document+    { _documentViewBox = Just (x1, y1, x2, y2),+      _documentWidth = Just (Percent pw),+      _documentHeight = Just (Percent ph)+    } =+    (floor $ dx * pw, floor $ dy * ph)+    where+      dx = abs $ x2 - x1+      dy = abs $ y2 - y1+documentSize+  _+  Document+    { _documentWidth = Just (Num w),+      _documentHeight = Just (Num h)+    } = (floor w, floor h)+documentSize+  dpi+  doc@( Document+          { _documentWidth = Just w,+            _documentHeight = Just h+          }+        ) =+    documentSize dpi $+      doc+        { _documentWidth = Just $ toUserUnit dpi w,+          _documentHeight = Just $ toUserUnit dpi h+        }+documentSize _ Document {_documentViewBox = Just (x1, y1, x2, y2)} =+  (floor . abs $ x2 - x1, floor . abs $ y2 - y1)+documentSize _ _ = (1, 1)++mayMerge :: Monoid a => Maybe a -> Maybe a -> Maybe a+mayMerge (Just a) (Just b) = Just $ mappend a b+mayMerge _ b@(Just _) = b+mayMerge a Nothing = a++instance Semigroup DrawAttributes where+  (<>) a b =+    DrawAttributes+      { _strokeWidth = (mappend `on` _strokeWidth) a b,+        _strokeColor = (mappend `on` _strokeColor) a b,+        _strokeLineCap = (mappend `on` _strokeLineCap) a b,+        _strokeOpacity = (opacityMappend `on` _strokeOpacity) a b,+        _strokeLineJoin = (mappend `on` _strokeLineJoin) a b,+        _strokeMiterLimit = (mappend `on` _strokeMiterLimit) a b,+        _fillColor = (mappend `on` _fillColor) a b,+        _fillOpacity = (opacityMappend `on` _fillOpacity) a b,+        _fontSize = (mappend `on` _fontSize) a b,+        _transform = (mayMerge `on` _transform) a b,+        _fillRule = (mappend `on` _fillRule) a b,+        _attrClass = _attrClass b,+        _attrId = _attrId b,+        _groupOpacity = _groupOpacity b,+        _strokeOffset = (mappend `on` _strokeOffset) a b,+        _strokeDashArray = (mappend `on` _strokeDashArray) a b,+        _fontFamily = (mappend `on` _fontFamily) a b,+        _fontStyle = (mappend `on` _fontStyle) a b,+        _textAnchor = (mappend `on` _textAnchor) a b,+        _maskRef = (mappend `on` _maskRef) a b,+        _clipPathRef = (mappend `on` _clipPathRef) a b,+        _clipRule = (mappend `on` _clipRule) a b,+        _markerStart = (mappend `on` _markerStart) a b,+        _markerMid = (mappend `on` _markerMid) a b,+        _markerEnd = (mappend `on` _markerEnd) a b,+        _filterRef = (mappend `on` _filterRef) a b+      }+    where+      opacityMappend Nothing Nothing = Nothing+      opacityMappend (Just v) Nothing = Just v+      opacityMappend Nothing (Just v) = Just v+      opacityMappend (Just v) (Just v2) = Just $ v * v2++instance Monoid DrawAttributes where+  mappend = (<>)+  mempty =+    DrawAttributes+      { _strokeWidth = Last Nothing,+        _strokeColor = Last Nothing,+        _strokeOpacity = Nothing,+        _strokeLineCap = Last Nothing,+        _strokeLineJoin = Last Nothing,+        _strokeMiterLimit = Last Nothing,+        _fillColor = Last Nothing,+        _groupOpacity = Nothing,+        _fillOpacity = Nothing,+        _fontSize = Last Nothing,+        _fontFamily = Last Nothing,+        _fontStyle = Last Nothing,+        _transform = Nothing,+        _fillRule = Last Nothing,+        _attrClass = mempty,+        _attrId = Nothing,+        _strokeOffset = Last Nothing,+        _strokeDashArray = Last Nothing,+        _textAnchor = Last Nothing,+        _maskRef = Last Nothing,+        _clipPathRef = Last Nothing,+        _clipRule = Last Nothing,+        _markerStart = Last Nothing,+        _markerMid = Last Nothing,+        _markerEnd = Last Nothing,+        _filterRef = Last Nothing+      }++instance WithDefaultSvg DrawAttributes where+  defaultSvg = mempty++--------------------------------------------------------------------------+--- Template Haskell and HasDrawAttributes instances+--------------------------------------------------------------------------++makeLenses ''Rectangle+makeLenses ''Pattern+makeLenses ''Document+makeLenses ''Filter+makeLenses ''Line+makeLenses ''Polygon+makeLenses ''PolyLine+makeLenses ''PreserveAspectRatio+makeLenses ''Path+makeLenses ''Circle+makeLenses ''Text+makeLenses ''TextPath+makeLenses ''Ellipse+makeLenses ''MeshGradientPatch+makeLenses ''MeshGradientRow+makeLenses ''MeshGradient+makeLenses ''Image+makeLenses ''Use+makeLenses ''TextSpan+makeLenses ''TextInfo+makeLenses ''Marker+makeLenses ''GradientStop+makeLenses ''LinearGradient+makeLenses ''RadialGradient+makeLenses ''Mask+makeLenses ''ClipPath+makeLenses ''ColorMatrix+makeLenses ''Composite+makeLenses ''GaussianBlur+makeLenses ''Turbulence+makeLenses ''DisplacementMap+makeLenses ''Group++makeClassy ''FilterAttributes

@@ -1,4 +1,3 @@-{-# LANGUAGE CPP               #-} {-# LANGUAGE FlexibleContexts  #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-}@@ -15,18 +14,8 @@   ) where  -#if !MIN_VERSION_base(4,6,0)-import           Text.Read                    (reads)-#else import           Text.Read                    (readMaybe)-#endif -#if !MIN_VERSION_base(4,8,0)-import           Control.Applicative          (pure, (<$), (<$>), (<*>))-import           Data.Foldable                (foldMap)-import           Data.Monoid                  (mempty)-#endif- import           Control.Applicative          (many, (<|>))  import           Codec.Picture                (PixelRGBA8 (..))@@ -36,16 +25,16 @@ import           Data.Attoparsec.Text         (Parser, parseOnly, string) import           Data.List                    (foldl', intercalate) import           Data.Maybe                   (catMaybes, fromMaybe)-import           Data.Monoid                  (Last (Last), getLast, (<>))+import           Data.Monoid import qualified Data.Text                    as T import           Graphics.SvgTree.ColorParser import           Graphics.SvgTree.CssParser   (complexNumber, dashArray, num,                                                numberList, styleString) import           Graphics.SvgTree.CssTypes    (CssDeclaration (..),                                                CssElement (..))+import           Graphics.SvgTree.Misc import           Graphics.SvgTree.PathParser import           Graphics.SvgTree.Types-import           Graphics.SvgTree.Misc import qualified Text.XML.Light               as X import           Text.XML.Light.Proc          (elChildren, findAttrBy) @@ -53,16 +42,12 @@  {-import Debug.Trace-} -#if !MIN_VERSION_base(4,6,0)-readMaybe :: Read a => String -> Maybe a-readMaybe str = case reads str of-  []       -> Nothing-  (x, _):_ -> Just x-#endif- nodeName :: X.Element -> String nodeName = X.qName . X.elName +setName :: String -> X.Element -> X.Element+setName name elt = elt{ X.elName = X.unqual name }+ attributeFinder :: String -> X.Element -> Maybe String attributeFinder str =     findAttrBy (\a -> X.qName a == str)@@ -546,7 +531,7 @@     serializer a = printf "%s" . ppF <$> a ^. elLens     updater el str = case parseMayStartDot num str of         Nothing -> el-        Just v  -> el & elLens .~ Just (realToFrac v)+        Just v  -> el & elLens ?~ realToFrac v  type Serializer e = e -> Maybe String @@ -592,7 +577,7 @@ classSetter = SvgAttributeLens "class" updater serializer   where     updater el str =-      el & attrClass .~ (T.split (== ' ') $ T.pack str)+      el & attrClass .~ T.split (== ' ') (T.pack str)      serializer a = case a ^. attrClass of       []  -> Nothing@@ -609,7 +594,7 @@                => ASetter el el a (Maybe n)                -> CssUpdater el cssUniqueFloat setter attr ((CssNumber (Num n):_):_) =-    attr & setter .~ Just (realToFrac n)+    attr & setter ?~ realToFrac n cssUniqueFloat _ attr _ = attr  cssUniqueMayFloat :: ASetter el el a (Last Double)@@ -660,9 +645,9 @@  cssMayStringSetter :: ASetter el el a (Maybe String) -> CssUpdater el cssMayStringSetter setter attr ((CssIdent i:_):_) =-    attr & setter .~ Just (T.unpack i)+    attr & setter ?~ T.unpack i cssMayStringSetter setter attr ((CssString i:_):_) =-    attr & setter .~ Just (T.unpack i)+    attr & setter ?~ T.unpack i cssMayStringSetter _ attr _ = attr  cssNullSetter :: CssUpdater a@@ -874,66 +859,49 @@ instance XMLUpdatable Tree where   xmlTagName _ = "TREE"   attributes = []-  serializeTreeNode e = case e of-    None -> Nothing-    UseTree u _ -> serializeTreeNode u-    GroupTree g -> serializeTreeNode g-    SymbolTree s -> serializeTreeNode s-    DefinitionTree d -> serializeTreeNode d-    FilterTree g -> serializeTreeNode g-    PathTree p -> serializeTreeNode p-    CircleTree c -> serializeTreeNode c-    PolyLineTree p -> serializeTreeNode p-    PolygonTree p -> serializeTreeNode p-    EllipseTree el -> serializeTreeNode el-    LineTree l -> serializeTreeNode l-    RectangleTree r -> serializeTreeNode r-    TextTree Nothing t -> serializeTreeNode t-    ImageTree i -> serializeTreeNode i-    LinearGradientTree l -> serializeTreeNode l-    RadialGradientTree r -> serializeTreeNode r-    MeshGradientTree m -> serializeTreeNode m-    PatternTree p -> serializeTreeNode p-    MarkerTree m -> serializeTreeNode m-    MaskTree m -> serializeTreeNode m-    ClipPathTree c -> serializeTreeNode c-    TextTree (Just p) t -> do+  serializeTreeNode e = case e ^. treeBranch of+    NoNode -> Nothing+    UseNode u _ -> serializeTreeNode u+    GroupNode g -> serializeTreeNode g+    SymbolNode s -> setName "symbol" <$> serializeTreeNode s+    DefinitionNode d -> setName "defs" <$> serializeTreeNode d+    FilterNode g -> serializeTreeNode g+    PathNode p -> serializeTreeNode p+    CircleNode c -> serializeTreeNode c+    PolyLineNode p -> serializeTreeNode p+    PolygonNode p -> serializeTreeNode p+    EllipseNode el -> serializeTreeNode el+    LineNode l -> serializeTreeNode l+    RectangleNode r -> serializeTreeNode r+    TextNode Nothing t -> serializeTreeNode t+    ImageNode i -> serializeTreeNode i+    LinearGradientNode l -> serializeTreeNode l+    RadialGradientNode r -> serializeTreeNode r+    MeshGradientNode m -> serializeTreeNode m+    PatternNode p -> serializeTreeNode p+    MarkerNode m -> serializeTreeNode m+    MaskNode m -> serializeTreeNode m+    ClipPathNode c -> serializeTreeNode c+    TextNode (Just p) t -> do        textNode <- serializeTreeNode t        pathNode <- serializeTreeNode p        let sub = [X.Elem . setChildren pathNode $ X.elContent textNode]        return $ setChildren textNode sub-    SvgTree doc -> Just $ xmlOfDocument doc+    SvgNode doc -> Just $ xmlOfDocument doc   isNotNone :: Tree -> Bool isNotNone None = False-isNotNone _    = True+isNotNone _ = True -instance XMLUpdatable (Group Tree) where+instance XMLUpdatable Group where   xmlTagName _ = "g"   serializeTreeNode node =      updateWithAccessor (filter isNotNone . _groupChildren) node $         genericSerializeWithDrawAttr node-  attributes = []--instance XMLUpdatable (Symbol Tree) where-  xmlTagName _ = "symbol"-  serializeTreeNode node =-     updateWithAccessor (filter isNotNone . _groupChildren . _groupOfSymbol) node $-        genericSerializeWithDrawAttr node   attributes =-     ["viewBox" `parseIn` (groupOfSymbol . groupViewBox)-     ,"preserveAspectRatio" `parseIn` (groupOfSymbol . groupAspectRatio)-     ]--instance XMLUpdatable (Definitions Tree) where-  xmlTagName _ = "defs"-  serializeTreeNode node =-     updateWithAccessor (filter isNotNone . _groupChildren . _groupOfDefinitions) node $-        genericSerializeWithDrawAttr node-  attributes =-     ["viewBox" `parseIn` (groupOfDefinitions . groupViewBox)-     ,"preserveAspectRatio" `parseIn` (groupOfDefinitions . groupAspectRatio)+     ["viewBox" `parseIn` groupViewBox+     ,"preserveAspectRatio" `parseIn` groupAspectRatio      ]  instance XMLUpdatable Filter where@@ -949,7 +917,7 @@  instance XMLUpdatable FilterElement where   xmlTagName _ = "FilterElement"-  serializeTreeNode fe = flip mergeAttributes <$> (genericSerializeNode fe) <*>+  serializeTreeNode fe = flip mergeAttributes <$> genericSerializeNode fe <*>     case fe of       FEColorMatrix m     -> serializeTreeNode m       FEComposite c       -> serializeTreeNode c@@ -1211,7 +1179,7 @@     attributes = styleAttribute cssAvailable : fmap fst cssAvailable ++ lst where       cssAvailable :: [(SvgAttributeLens GradientStop, CssUpdater GradientStop)]       cssAvailable =-          [(opacitySetter "stop-opacity" gradientOpacity, (cssUniqueFloat gradientOpacity))+          [(opacitySetter "stop-opacity" gradientOpacity, cssUniqueFloat gradientOpacity)           ,("stop-color" `parseIn` gradientColor, cssUniqueColor gradientColor)           ] @@ -1251,23 +1219,15 @@   ClipPathTree $ xmlUnparseWithDrawAttr e & clipPathContent .~ map unparse (elChildren e) unparse (nodeName -> "style") = None -- XXX: Create a style node? unparse e@(nodeName -> "defs") =-  DefinitionTree . Definitions $ groupNode & groupChildren .~ map unparse (elChildren e)-  where-    groupNode :: Group Tree-    groupNode = _groupOfSymbol $ xmlUnparseWithDrawAttr e+  DefinitionTree $ xmlUnparseWithDrawAttr e & groupChildren .~ map unparse (elChildren e) unparse e@(nodeName -> "filter") =   FilterTree $ xmlUnparseWithDrawAttr e & filterChildren .~ map unparseFE (elChildren e) unparse e@(nodeName -> "symbol") =-  SymbolTree . Symbol $ groupNode & groupChildren .~ map unparse (elChildren e)-  where-    groupNode :: Group Tree-    groupNode = _groupOfSymbol $ xmlUnparseWithDrawAttr e+  SymbolTree $ xmlUnparseWithDrawAttr e & groupChildren .~ map unparse (elChildren e) unparse e@(nodeName -> "g") =   GroupTree $ xmlUnparseWithDrawAttr e & groupChildren .~ map unparse (elChildren e) unparse e@(nodeName -> "svg") =-  case unparseDocument "" e of-    Nothing -> None-    Just doc -> SvgTree doc+  maybe None SvgTree $ unparseDocument "" e unparse e@(nodeName -> "text") =   TextTree tPath $ xmlUnparse e & textRoot .~ root     where@@ -1302,12 +1262,12 @@  unparseDocument :: FilePath -> X.Element -> Maybe Document unparseDocument rootLocation e@(nodeName -> "svg") = Just Document-    { _viewBox =+    { _documentViewBox =         attributeFinder "viewBox" e >>= parse viewBoxParser-    , _elements = parsedElements-    , _width = lengthFind "width"-    , _height = lengthFind "height"-    , _description = ""+    , _documentElements = parsedElements+    , _documentWidth = lengthFind "width"+    , _documentHeight = lengthFind "height"+    , _documentDescription = ""     , _documentLocation = rootLocation     , _documentAspectRatio =         fromMaybe defaultSvg $@@ -1325,13 +1285,13 @@     X.node (X.unqual "svg") (attrs, descTag ++ children)   where     attr name = X.Attr (X.unqual name)-    children = catMaybes [serializeTreeNode el | el <- _elements doc]+    children = catMaybes [serializeTreeNode el | el <- _documentElements doc] -    docViewBox = case _viewBox doc of+    docViewBox = case _documentViewBox doc of         Nothing -> []         Just b  -> [attr "viewBox" $ serializeViewBox b] -    descTag = case _description doc of+    descTag = case _documentDescription doc of         ""  -> []         txt -> [X.node (X.unqual "desc") txt] @@ -1340,8 +1300,8 @@         [attr "xmlns" "http://www.w3.org/2000/svg"         ,attr "xmlns:xlink" "http://www.w3.org/1999/xlink"         ,attr "version" "1.1"] ++-        catMaybes [attr "width" . serializeNumber <$> _width doc-                  ,attr "height" . serializeNumber <$> _height doc+        catMaybes [attr "width" . serializeNumber <$> _documentWidth doc+                  ,attr "height" . serializeNumber <$> _documentHeight doc                   ] ++         catMaybes [attr "preserveAspectRatio" <$>  aserialize (_documentAspectRatio doc)                   | _documentAspectRatio doc /= defaultSvg ]