From 7c61ca57cdc215cf2e250b6481331df97795b932 Mon Sep 17 00:00:00 2001 From: David Date: Tue, 26 Feb 2019 14:15:37 +0100 Subject: [PATCH 1/3] Allow non-drawable objects to appear anywhere in SVG tree. --- src/Graphics/Svg.hs | 14 +--- src/Graphics/Svg/Types.hs | 116 +++++++++++++++++++++++++++---- src/Graphics/Svg/XmlParser.hs | 126 ++++++++++++---------------------- 3 files changed, 148 insertions(+), 108 deletions(-) diff --git a/src/Graphics/Svg.hs b/src/Graphics/Svg.hs index 3b44f16..c43641d 100644 --- a/src/Graphics/Svg.hs +++ b/src/Graphics/Svg.hs @@ -91,22 +91,10 @@ resolveUses doc = fetchUses (UseTree useInfo _) = UseTree useInfo $ search useInfo fetchUses a = a - search nfo = maybe Nothing geometryExtract found where - found = M.lookup (_useName nfo) $ _definitions doc - - geometryExtract c = case c of - ElementLinearGradient _ -> Nothing - ElementRadialGradient _ -> Nothing - ElementMeshGradient _ -> Nothing - ElementMask _ -> Nothing - ElementClipPath _ -> Nothing - ElementGeometry t -> Just t - ElementPattern _ -> Nothing - ElementMarker _ -> Nothing + search nfo = M.lookup (_useName nfo) $ _definitions doc -- | Rewrite the document by applying the CSS rules embedded -- inside it. applyCSSRules :: Document -> Document applyCSSRules doc = doc { _elements = cssApply (_styleRules doc) <$> _elements doc } - diff --git a/src/Graphics/Svg/Types.hs b/src/Graphics/Svg/Types.hs index 97fe797..1b4e2fd 100644 --- a/src/Graphics/Svg/Types.hs +++ b/src/Graphics/Svg/Types.hs @@ -108,6 +108,10 @@ module Graphics.Svg.Types , Symbol( .. ) , groupOfSymbol + -- ** Definitions + , Definitions( .. ) + , groupOfDefinitions + -- * Text related types -- ** Text , Text( .. ) @@ -844,7 +848,7 @@ instance WithDefaultSvg (Group a) where } -- | Define the `` tag, equivalent to --- a named group. +-- a hidden named group. newtype Symbol a = Symbol { _groupOfSymbol :: Group a } deriving (Eq, Show) @@ -861,6 +865,24 @@ instance WithDrawAttributes (Symbol a) where instance WithDefaultSvg (Symbol a) where defaultSvg = Symbol defaultSvg +-- | Define the `` tag, equivalent to +-- a named symbol. +newtype Definitions a = + Definitions { _groupOfDefinitions :: Group a } + deriving (Eq, Show) + +-- 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 WithDrawAttributes (Definitions a) where + drawAttr = groupOfDefinitions . drawAttr + +instance WithDefaultSvg (Definitions a) where + defaultSvg = Definitions defaultSvg + -- | Define a ``. data Circle = Circle { -- | Drawing attributes of the circle. @@ -1563,6 +1585,7 @@ data Tree , useSubTree :: !(Maybe Tree) } | GroupTree !(Group Tree) | SymbolTree !(Symbol Tree) + | DefinitionTree !(Definitions Tree) | PathTree !Path | CircleTree !Circle | PolyLineTree !PolyLine @@ -1572,7 +1595,13 @@ data Tree | RectangleTree !Rectangle | TextTree !(Maybe TextPath) !Text | ImageTree !Image + | LinearGradientTree !LinearGradient + | RadialGradientTree !RadialGradient | MeshGradientTree !MeshGradient + | PatternTree !Pattern + | MarkerTree !Marker + | MaskTree !Mask + | ClipPathTree !ClipPath deriving (Eq, Show) -- | Define the orientation, associated to the @@ -1739,6 +1768,14 @@ zipTree f = dig [] where 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@(DefinitionTree _) = 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 + zipGroup prev g = g { _groupChildren = updatedChildren } where @@ -1762,7 +1799,17 @@ foldTree f = go where 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 d -> + let subAcc = + F.foldl' go acc . _groupChildren $ _groupOfDefinitions d in + f subAcc e GroupTree g -> let subAcc = F.foldl' go acc $ _groupChildren g in f subAcc e @@ -1779,6 +1826,8 @@ mapTree f = go where 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@(PathTree _) = f e go e@(CircleTree _) = f e go e@(PolyLineTree _) = f e @@ -1788,7 +1837,13 @@ mapTree f = go where 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 mapGroup g = g { _groupChildren = map go $ _groupChildren g } @@ -1802,6 +1857,7 @@ nameOfTree v = UseTree _ _ -> "use" GroupTree _ -> "g" SymbolTree _ -> "symbol" + DefinitionTree _ -> "defs" PathTree _ -> "path" CircleTree _ -> "circle" PolyLineTree _ -> "polyline" @@ -1811,7 +1867,13 @@ nameOfTree v = RectangleTree _ -> "rectangle" TextTree _ _ -> "text" ImageTree _ -> "image" + LinearGradientTree _ -> "lineargradient" + RadialGradientTree _ -> "radialgradient" MeshGradientTree _ -> "meshgradient" + PatternTree _ -> "pattern" + MarkerTree _ -> "marker" + MaskTree _ -> "mask" + ClipPathTree _ -> "clipPath" drawAttrOfTree :: Tree -> DrawAttributes drawAttrOfTree v = case v of @@ -1819,6 +1881,7 @@ drawAttrOfTree v = case v of UseTree e _ -> e ^. drawAttr GroupTree e -> e ^. drawAttr SymbolTree e -> e ^. drawAttr + DefinitionTree e -> e ^. drawAttr PathTree e -> e ^. drawAttr CircleTree e -> e ^. drawAttr PolyLineTree e -> e ^. drawAttr @@ -1828,7 +1891,13 @@ drawAttrOfTree v = case v of RectangleTree e -> e ^. drawAttr TextTree _ e -> e ^. drawAttr ImageTree e -> e ^. drawAttr + LinearGradientTree e -> e ^. drawAttr + RadialGradientTree e -> e ^. drawAttr MeshGradientTree e -> e ^. drawAttr + PatternTree e -> e ^. drawAttr + MarkerTree e -> e ^. drawAttr + MaskTree e -> e ^. drawAttr + ClipPathTree e -> e ^. drawAttr setDrawAttrOfTree :: Tree -> DrawAttributes -> Tree setDrawAttrOfTree v attr = case v of @@ -1836,6 +1905,7 @@ setDrawAttrOfTree v attr = case v of UseTree e m -> UseTree (e & drawAttr .~ attr) m GroupTree e -> GroupTree $ e & drawAttr .~ attr SymbolTree e -> SymbolTree $ e & drawAttr .~ attr + DefinitionTree e -> DefinitionTree e PathTree e -> PathTree $ e & drawAttr .~ attr CircleTree e -> CircleTree $ e & drawAttr .~ attr PolyLineTree e -> PolyLineTree $ e & drawAttr .~ attr @@ -1845,7 +1915,13 @@ setDrawAttrOfTree v attr = case v of RectangleTree e -> RectangleTree $ e & drawAttr .~ attr TextTree a e -> TextTree a $ e & drawAttr .~ attr ImageTree e -> ImageTree $ e & drawAttr .~ attr + LinearGradientTree e -> LinearGradientTree $ e & drawAttr .~ attr + RadialGradientTree e -> RadialGradientTree $ e & drawAttr .~ attr MeshGradientTree e -> MeshGradientTree $ e & drawAttr .~ attr + PatternTree e -> PatternTree $ e & drawAttr .~ attr + MarkerTree e -> MarkerTree $ e & drawAttr .~ attr + MaskTree e -> MaskTree $ e & drawAttr .~ attr + ClipPathTree e -> ClipPathTree $ e & drawAttr .~ attr instance WithDrawAttributes Tree where drawAttr = lens drawAttrOfTree setDrawAttrOfTree @@ -1863,9 +1939,11 @@ data Spread -- | Define a `` tag. data LinearGradient = LinearGradient - { -- | Define coordinate system of the gradient, + { -- | Drawing attributes of the RadialGradient + _linearGradientDrawAttributes :: DrawAttributes + -- | Define coordinate system of the gradient, -- associated to the `gradientUnits` attribute. - _linearGradientUnits :: CoordinateUnits + , _linearGradientUnits :: CoordinateUnits -- | Point defining the beginning of the line gradient. -- Associated to the `x1` and `y1` attribute. , _linearGradientStart :: Point @@ -1889,6 +1967,7 @@ data LinearGradient = 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 @@ -1901,6 +1980,7 @@ class HasLinearGradient c_apmJ where {-# INLINE linearGradientTransform #-} linearGradientUnits :: Lens' c_apmJ CoordinateUnits {-# INLINE linearGradientUnits #-} + linearGradientDrawAttributes = ((.) linearGradient) linearGradientDrawAttributes linearGradientSpread = ((.) linearGradient) linearGradientSpread linearGradientStart = ((.) linearGradient) linearGradientStart linearGradientStop = ((.) linearGradient) linearGradientStop @@ -1930,9 +2010,13 @@ instance HasLinearGradient LinearGradient where linearGradientUnits f attr = fmap (\y -> attr { _linearGradientUnits = y }) (f $ _linearGradientUnits attr) +instance WithDrawAttributes LinearGradient where + drawAttr = linearGradientDrawAttributes + instance WithDefaultSvg LinearGradient where defaultSvg = LinearGradient - { _linearGradientUnits = CoordBoundingBox + { _linearGradientDrawAttributes = mempty + , _linearGradientUnits = CoordBoundingBox , _linearGradientStart = (Percent 0, Percent 0) , _linearGradientStop = (Percent 1, Percent 0) , _linearGradientSpread = SpreadPad @@ -1942,9 +2026,11 @@ instance WithDefaultSvg LinearGradient where -- | Define a `` tag. data RadialGradient = RadialGradient - { -- | Define coordinate system of the gradient, + { -- | Drawing attributes of the RadialGradient + _radialGradientDrawAttributes :: DrawAttributes + -- | Define coordinate system of the gradient, -- associated to the `gradientUnits` attribute. - _radialGradientUnits :: CoordinateUnits + , _radialGradientUnits :: CoordinateUnits -- | Center of the radial gradient. Associated to -- the `cx` and `cy` attributes. , _radialGradientCenter :: Point @@ -1975,6 +2061,7 @@ data RadialGradient = RadialGradient 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) @@ -1991,6 +2078,7 @@ class HasRadialGradient c_apwt where {-# INLINE radialGradientTransform #-} radialGradientUnits :: Lens' c_apwt CoordinateUnits {-# INLINE radialGradientUnits #-} + radialGradientDrawAttributes = ((.) radialGradient) radialGradientDrawAttributes radialGradientCenter = ((.) radialGradient) radialGradientCenter radialGradientFocusX = ((.) radialGradient) radialGradientFocusX radialGradientFocusY = ((.) radialGradient) radialGradientFocusY @@ -2028,9 +2116,13 @@ instance HasRadialGradient RadialGradient where radialGradientUnits f attr = fmap (\y -> attr { _radialGradientUnits = y }) (f $ _radialGradientUnits attr) +instance WithDrawAttributes RadialGradient where + drawAttr = radialGradientDrawAttributes + instance WithDefaultSvg RadialGradient where defaultSvg = RadialGradient - { _radialGradientUnits = CoordBoundingBox + { _radialGradientDrawAttributes = mempty + , _radialGradientUnits = CoordBoundingBox , _radialGradientCenter = (Percent 0.5, Percent 0.5) , _radialGradientRadius = Percent 0.5 , _radialGradientFocusX = Nothing @@ -2193,11 +2285,11 @@ data Pattern = Pattern -- attribute. , _patternUnit :: !CoordinateUnits -- | Value of the "preserveAspectRatio" attribute - , _patternAspectRatio :: !PreserveAspectRatio + , _patternAspectRatio :: !PreserveAspectRatio -- | Value of "patternTransform" attribute , _patternTransform :: !(Maybe [Transformation]) } - deriving Show + deriving (Eq, Show) -- makeClassy ''Pattern -- | Lenses for the Patter type. @@ -2296,7 +2388,7 @@ data Element | ElementMarker Marker | ElementMask Mask | ElementClipPath ClipPath - deriving Show + deriving (Eq, Show) -- | Represent a full svg document with style, -- geometry and named elements. @@ -2305,7 +2397,7 @@ data Document = Document , _width :: Maybe Number , _height :: Maybe Number , _elements :: [Tree] - , _definitions :: M.Map String Element + , _definitions :: M.Map String Tree , _description :: String , _styleRules :: [CssRule] , _documentLocation :: FilePath @@ -2316,7 +2408,7 @@ data Document = Document -- | Lenses associated to a SVG document. class HasDocument c_aqpq where document :: Lens' c_aqpq Document - definitions :: Lens' c_aqpq (M.Map String Element) + definitions :: Lens' c_aqpq (M.Map String Tree) {-# INLINE definitions #-} definitions = document . definitions diff --git a/src/Graphics/Svg/XmlParser.hs b/src/Graphics/Svg/XmlParser.hs index 1a7fd9f..340c437 100644 --- a/src/Graphics/Svg/XmlParser.hs +++ b/src/Graphics/Svg/XmlParser.hs @@ -760,6 +760,7 @@ instance XMLUpdatable Tree where UseTree u _ -> serializeTreeNode u GroupTree g -> serializeTreeNode g SymbolTree s -> serializeTreeNode s + DefinitionTree d -> serializeTreeNode d PathTree p -> serializeTreeNode p CircleTree c -> serializeTreeNode c PolyLineTree p -> serializeTreeNode p @@ -769,7 +770,13 @@ instance XMLUpdatable Tree where 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 textNode <- serializeTreeNode t pathNode <- serializeTreeNode p @@ -798,6 +805,16 @@ instance XMLUpdatable (Symbol Tree) where ,"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) + ] + instance XMLUpdatable RadialGradient where xmlTagName _ = "radialGradient" @@ -1035,71 +1052,27 @@ parseMeshGradientRows = foldMap unRows . elChildren where unRows e@(nodeName -> "meshrow") = [MeshGradientRow $ parseMeshGradientPatches e] unRows _ = [] -withId :: X.Element -> (X.Element -> Element) - -> State Symbols Tree -withId el f = case attributeFinder "id" el of - Nothing -> return None - Just elemId -> do - modify $ \s -> - s { symbols = M.insert elemId (f el) $ symbols s } - return None - -isDefTag :: String -> Bool -isDefTag n = n `elem` defList where - defList = - [ "pattern" - , "marker" - , "mask" - , "clipPath" - , "linearGradient" - , "meshgradient" - , "radialGradient"] - -unparseDefs :: X.Element -> State Symbols Tree -unparseDefs e@(nodeName -> "pattern") = do +unparse :: X.Element -> State Symbols Tree +unparse e@(nodeName -> "pattern") = do subElements <- mapM unparse $ elChildren e - withId e . const . ElementPattern $ pat { _patternElements = subElements} + pure $ PatternTree $ pat { _patternElements = subElements} where pat = xmlUnparse e -unparseDefs e@(nodeName -> "marker") = do +unparse e@(nodeName -> "marker") = do subElements <- mapM unparse $ elChildren e - withId e . const . ElementMarker $ mark {_markerElements = subElements } + pure $ MarkerTree $ mark {_markerElements = subElements } where mark = xmlUnparseWithDrawAttr e -unparseDefs e@(nodeName -> "mask") = do +unparse e@(nodeName -> "mask") = do children <- mapM unparse $ elChildren e let realChildren = filter isNotNone children parsedMask = xmlUnparseWithDrawAttr e - withId e . const . ElementMask $ parsedMask { _maskContent = realChildren } - -unparseDefs e@(nodeName -> "clipPath") = do + pure $ MaskTree $ parsedMask { _maskContent = realChildren } +unparse e@(nodeName -> "clipPath") = do children <- mapM unparse $ elChildren e let realChildren = filter isNotNone children parsedClip = xmlUnparseWithDrawAttr e - withId e . const . ElementClipPath $ parsedClip { _clipPathContent = realChildren } - -unparseDefs e@(nodeName -> "linearGradient") = - withId e $ ElementLinearGradient . unparser - where - unparser ee = - xmlUnparse ee & linearGradientStops .~ parseGradientStops ee - -unparseDefs e@(nodeName -> "meshgradient") = - withId e $ ElementMeshGradient . unparser - where - unparser ee = - xmlUnparseWithDrawAttr ee & meshGradientRows .~ parseMeshGradientRows ee - -unparseDefs e@(nodeName -> "radialGradient") = - withId e $ ElementRadialGradient . unparser - where - unparser ee = - xmlUnparse ee & radialGradientStops .~ parseGradientStops ee -unparseDefs e = do - el <- unparse e - withId e (const $ ElementGeometry el) - -unparse :: X.Element -> State Symbols Tree + pure $ ClipPathTree $ parsedClip { _clipPathContent = realChildren } unparse e@(nodeName -> "style") = do case parseOnly (many1 ruleSet) . T.pack $ strContent e of Left _ -> return () @@ -1107,8 +1080,12 @@ unparse e@(nodeName -> "style") = do modify $ \s -> s { cssStyle = cssStyle s ++ rules } return None unparse e@(nodeName -> "defs") = do - mapM_ unparseDefs $ elChildren e - return None + defsChildren <- mapM unparse $ elChildren e + let realChildren = filter isNotNone defsChildren + pure . DefinitionTree . Definitions $ groupNode & groupChildren .~ realChildren + where + groupNode :: Group Tree + groupNode = _groupOfSymbol $ xmlUnparseWithDrawAttr e unparse e@(nodeName -> "symbol") = do symbolChildren <- mapM unparse $ elChildren e let realChildren = filter isNotNone symbolChildren @@ -1116,7 +1093,6 @@ unparse e@(nodeName -> "symbol") = do where groupNode :: Group Tree groupNode = _groupOfSymbol $ xmlUnparseWithDrawAttr e - unparse e@(nodeName -> "g") = do children <- mapM unparse $ elChildren e let realChildren = filter isNotNone children @@ -1163,10 +1139,13 @@ unparse e = case nodeName e of "circle"-> pure $ CircleTree parsed "line" -> pure $ LineTree parsed "path" -> pure $ PathTree parsed + "linearGradient" -> + pure $ LinearGradientTree $ parsed & linearGradientStops .~ parseGradientStops e + "radialGradient" -> + pure $ RadialGradientTree $ parsed & radialGradientStops .~ parseGradientStops e "meshgradient" -> pure $ MeshGradientTree $ parsed & meshGradientRows .~ parseMeshGradientRows e "use" -> pure $ UseTree parsed Nothing - n | isDefTag n -> unparseDefs e _ -> pure None where parsed :: (XMLUpdatable a, WithDrawAttributes a) => a @@ -1179,7 +1158,7 @@ unparseDocument rootLocation e@(nodeName -> "svg") = Just Document , _elements = parsedElements , _width = lengthFind "width" , _height = lengthFind "height" - , _definitions = symbols named + , _definitions = defs , _description = "" , _styleRules = cssStyle named , _documentLocation = rootLocation @@ -1187,6 +1166,11 @@ unparseDocument rootLocation e@(nodeName -> "svg") = Just Document where (parsedElements, named) = runState (mapM unparse $ elChildren e) emptyState + defs = foldl' (foldTree worker) M.empty parsedElements + worker m t = + case t ^.drawAttr.attrId of + Nothing -> m + Just tid -> M.insert tid t m lengthFind n = attributeFinder n e >>= parse complexNumber unparseDocument _ _ = Nothing @@ -1194,35 +1178,11 @@ unparseDocument _ _ = Nothing -- | Transform a SVG document to a XML node. xmlOfDocument :: Document -> X.Element xmlOfDocument doc = - X.node (X.unqual "svg") (attrs, descTag ++ styleTag ++ defsTag ++ children) + X.node (X.unqual "svg") (attrs, descTag ++ styleTag ++ children) where attr name = X.Attr (X.unqual name) children = catMaybes [serializeTreeNode el | el <- _elements doc] - defsTag | null defs = [] - | otherwise = [X.node (X.unqual "defs") defs] - - defs = catMaybes [elementRender k e | (k, e) <- M.assocs $ _definitions doc] - - elementRender k e = case e of - ElementGeometry t -> serialize t - ElementMarker m -> serialize m - ElementMask m -> serialize m - ElementClipPath c -> serialize c - ElementPattern p -> serialize p - ElementLinearGradient lg -> addId $ serializeTreeNode lg - ElementRadialGradient rg -> addId $ serializeTreeNode rg - ElementMeshGradient mg -> addId $ serializeTreeNode mg - where - addId = fmap (X.add_attr $ attr "id" k) - - serialize :: (WithDrawAttributes e, XMLUpdatable e) => e -> Maybe X.Element - serialize el = case el^.drawAttr.attrId of - Nothing -> addId $ serializeTreeNode el - Just _id -> - let newNode = el & drawAttr.attrId .~ Just k in - serializeTreeNode newNode - docViewBox = case _viewBox doc of Nothing -> [] Just b -> [attr "viewBox" $ serializeViewBox b] From d2b3416eb47ee34c27479f6169ff059252c76e49 Mon Sep 17 00:00:00 2001 From: David Date: Tue, 26 Feb 2019 14:17:45 +0100 Subject: [PATCH 2/3] Improve alignment. --- src/Graphics/Svg/Types.hs | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/Graphics/Svg/Types.hs b/src/Graphics/Svg/Types.hs index 1b4e2fd..89634e4 100644 --- a/src/Graphics/Svg/Types.hs +++ b/src/Graphics/Svg/Types.hs @@ -1802,10 +1802,10 @@ foldTree f = go where 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 + PatternTree _ -> f acc e + MarkerTree _ -> f acc e + MaskTree _ -> f acc e + ClipPathTree _ -> f acc e DefinitionTree d -> let subAcc = F.foldl' go acc . _groupChildren $ _groupOfDefinitions d in @@ -1871,9 +1871,9 @@ nameOfTree v = RadialGradientTree _ -> "radialgradient" MeshGradientTree _ -> "meshgradient" PatternTree _ -> "pattern" - MarkerTree _ -> "marker" - MaskTree _ -> "mask" - ClipPathTree _ -> "clipPath" + MarkerTree _ -> "marker" + MaskTree _ -> "mask" + ClipPathTree _ -> "clipPath" drawAttrOfTree :: Tree -> DrawAttributes drawAttrOfTree v = case v of From 5664303a03cae432d26097126c9135a8f9324a9c Mon Sep 17 00:00:00 2001 From: David Date: Sun, 3 Mar 2019 12:58:43 +0100 Subject: [PATCH 3/3] Update changelog. --- changelog.md | 1 + 1 file changed, 1 insertion(+) diff --git a/changelog.md b/changelog.md index c405139..7d26b3f 100644 --- a/changelog.md +++ b/changelog.md @@ -3,6 +3,7 @@ v0.6.2.3 October 2018 * GHC 8.6 fixes + * Adding: Allow definitions to appear anywhere in an svg document. v0.6.2.2 December 2017