diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,5 +1,13 @@ -*-change-log-*- +v0.12.2.2 + + * Update dependencies. + +v0.12.0.0 + + * Improve filter-element support. + v0.11.0.0 * Drop support for GHC 7. diff --git a/reanimate-svg.cabal b/reanimate-svg.cabal --- a/reanimate-svg.cabal +++ b/reanimate-svg.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: reanimate-svg -version: 0.12.2.1 +version: 0.12.2.2 synopsis: SVG file loader and serializer description: reanimate-svg provides types representing a SVG document, @@ -15,6 +15,7 @@ license-file: LICENSE author: Vincent Berthoux, David Himmelstrup maintainer: David Himmelstrup +homepage: https://github.com/reanimate/reanimate-svg#readme -- copyright: category: Graphics, Svg build-type: Simple @@ -23,7 +24,7 @@ Source-Repository head Type: git - Location: git://github.com/lemmih/reanimate-svg.git + Location: git://github.com/reanimate/reanimate-svg.git library hs-source-dirs: src @@ -60,7 +61,7 @@ , text >= 1.1 , transformers >= 0.3 && < 0.6 , mtl >= 2.1 && < 2.3 - , lens >= 4.6 && < 5 + , lens >= 4.6 && < 6 , double-conversion >= 2.0.0.0 && < 3.0.0.0 , hashable >= 1.3.0.0 @@ -80,7 +81,7 @@ Diff, vector, linear, QuickCheck >= 2.1.0, text, - temporary, + temporary, typed-process, tasty, tasty-golden, tasty-hunit, tasty-quickcheck, tasty-rerun >= 1.1.17, tasty-expected-failure diff --git a/src/Graphics/SvgTree.hs b/src/Graphics/SvgTree.hs --- a/src/Graphics/SvgTree.hs +++ b/src/Graphics/SvgTree.hs @@ -22,9 +22,9 @@ where import Control.Lens -import qualified Data.ByteString as B import Data.List (foldl') import qualified Data.Text as T +import qualified Data.Text.IO as T import Graphics.SvgTree.CssParser (cssRulesOfText) import Graphics.SvgTree.CssTypes import Graphics.SvgTree.Types @@ -36,14 +36,14 @@ -- a SVG Document. loadSvgFile :: FilePath -> IO (Maybe Document) loadSvgFile filename = - parseSvgFile filename <$> B.readFile filename + parseSvgFile filename <$> T.readFile filename -- | Parse an in-memory SVG file parseSvgFile :: -- | Source path/URL of the document, used -- to resolve relative links. FilePath -> - B.ByteString -> + T.Text -> Maybe Document parseSvgFile filename fileContent = parseXMLDoc fileContent >>= unparseDocument filename @@ -54,7 +54,7 @@ Nothing -> error "Invalid XML" Just xml -> unparse xml --- | Save a svg Document on a file on disk. +-- | Save a svg Document to a file on disk. saveXmlFile :: FilePath -> Document -> IO () saveXmlFile filePath = writeFile filePath . ppcTopElement prettyConfigPP . xmlOfDocument diff --git a/src/Graphics/SvgTree/CssTypes.hs b/src/Graphics/SvgTree/CssTypes.hs --- a/src/Graphics/SvgTree/CssTypes.hs +++ b/src/Graphics/SvgTree/CssTypes.hs @@ -1,7 +1,7 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE OverloadedStrings #-} --- | Define the types used to describes CSS elements +-- | Defines the types used to describes CSS elements module Graphics.SvgTree.CssTypes ( CssSelector( .. ) , CssSelectorRule @@ -41,7 +41,7 @@ -- | Serialize an element to a text builder. tserialize :: a -> TB.Builder --- | Describe an element of a CSS selector. Multiple +-- | Describes an element of a CSS selector. Multiple -- elements can be combined in a CssSelector type. data CssDescriptor = OfClass T.Text -- ^ .IDENT @@ -64,10 +64,10 @@ ft = TB.fromText si = TB.singleton --- | Define complex selector. +-- | Defines complex selector. data CssSelector - = Nearby -- ^ Correspond to the `+` CSS selector. - | DirectChildren -- ^ Correspond to the `>` CSS selectro. + = Nearby -- ^ Corresponds to the `+` CSS selector. + | DirectChildren -- ^ Corresponds to the `>` CSS selectro. | AllOf [CssDescriptor] -- ^ Grouping construct, all the elements -- of the list must be matched. deriving (Eq, Show) @@ -81,13 +81,13 @@ si = TB.singleton -- | A CssSelectorRule is a list of all the elements --- that must be meet in a depth first search fashion. +-- that must be met in a depth first search fashion. type CssSelectorRule = [CssSelector] --- | Represent a CSS selector and the different declarations +-- | Represents a CSS selector and the different declarations -- to apply to the matched elemens. data CssRule = CssRule - { -- | At the first level represent a list of elements + { -- | At the first level represents a list of elements -- to be matched. If any match is made, you can apply -- the declarations. At the second level cssRuleSelector :: ![CssSelectorRule] @@ -122,7 +122,7 @@ -- | Return a value of a given attribute if present cssAttribOf :: a -> T.Text -> Maybe T.Text --- | Represent a zipper in depth at the first list +-- | Represents a zipper in depth at the first list -- level, and the previous nodes at in the second -- list level. type CssContext a = [[a]] @@ -152,7 +152,7 @@ | otherwise = go upper selectors go (_:upper) selector = go upper selector --- | Given CSS rules, find all the declaration to apply to the +-- | Given CSS rules, find all the declarations to apply to the -- element in a given context. findMatchingDeclarations :: CssMatcheable a => [CssRule] -> CssContext a -> [CssDeclaration] @@ -162,7 +162,7 @@ , selector <- cssRuleSelector rule , isMatching context $ reverse selector ] --- | Represent the content to apply to some +-- | Represents the content to apply to some -- CSS matched rules. data CssDeclaration = CssDeclaration { -- | Property name to change (like font-family or color). @@ -181,7 +181,7 @@ si = TB.singleton --- | Encode complex number possibly dependant to the current +-- | Encode complex number possibly depending on the current -- render size. data Number = Num Double -- ^ Simple coordinate in current user coordinate. @@ -253,9 +253,9 @@ ft = TB.fromText si = TB.singleton --- | This function replace all device dependant units to user --- units given it's DPI configuration. --- Preserve percentage and "em" notation. +-- | This function replaces all device dependant units with user +-- units given its DPI configuration. +-- Preserves percentage and "em" notation. toUserUnit :: Dpi -> Number -> Number toUserUnit dpi = go where go nu = case nu of diff --git a/src/Graphics/SvgTree/PathParser.hs b/src/Graphics/SvgTree/PathParser.hs --- a/src/Graphics/SvgTree/PathParser.hs +++ b/src/Graphics/SvgTree/PathParser.hs @@ -39,6 +39,9 @@ shorthand = process' <$> (string "." *> many1 digit) process' = either (const 0) id . parseOnly doubleNumber . T.pack . (++) "0." +flag :: Parser Bool +flag = fmap (/='0') digit + viewBoxParser :: Parser (Double, Double, Double, Double) viewBoxParser = (,,,) <$> iParse <*> iParse <*> iParse <*> iParse @@ -91,11 +94,12 @@ manyComma a = a `sepBy1` commaWsp numComma = num <* commaWsp + flagComma = flag <* commaWsp ellipticalArgs = (,,,,,) <$> numComma <*> numComma <*> numComma - <*> fmap (/= 0) numComma - <*> fmap (/= 0) numComma + <*> flagComma + <*> flagComma <*> point unwordsS :: [ShowS] -> ShowS diff --git a/src/Graphics/SvgTree/Types/Basic.hs b/src/Graphics/SvgTree/Types/Basic.hs --- a/src/Graphics/SvgTree/Types/Basic.hs +++ b/src/Graphics/SvgTree/Types/Basic.hs @@ -12,8 +12,8 @@ -- | Basic coordinate type. type Coord = Double --- | Real Point, fully determined and not --- dependant of the rendering context. +-- | Real Point, fully determined and +-- independent of the rendering context. type RPoint = V2 Coord -- FIXME: Use 'V2 Number' instead of tuple @@ -21,7 +21,7 @@ type Point = (Number, Number) -- | Tell if a path command is absolute (in the current --- user coordiante) or relative to the previous poitn. +-- user coordiante) or relative to the previous point. data Origin = OriginAbsolute -- ^ Next point in absolute coordinate | OriginRelative -- ^ Next point relative to the previous @@ -33,35 +33,35 @@ | GradientBicubic deriving (Eq, Show, Generic) --- | Define the possible values of various *units attributes +-- | Defines 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 +-- | This type represents 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 + = 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 +-- | This type represents the "meet or slice" information +-- of the `preserveAspectRatio` SVG attribute data MeetSlice = Meet | Slice deriving (Eq, Show, Generic) --- | Describe how the line should be terminated --- when stroking them. Describe the values of the +-- | Describes how the line should be terminated +-- when stroked. Describes the values of the -- `stroke-linecap` attribute. -- See `_strokeLineCap` data Cap @@ -70,7 +70,7 @@ | CapSquare -- ^ Straight further of the ends (`square` value) deriving (Eq, Show, Generic) --- | Define the possible values of the `stroke-linejoin` +-- | Defines the possible values of the `stroke-linejoin` -- attribute. -- see `_strokeLineJoin` data LineJoin @@ -79,7 +79,7 @@ | JoinRound -- ^ `round` value deriving (Eq, Show, Generic) --- | Describe the different value which can be used +-- | Describes the different values which can be used -- in the `fill` or `stroke` attributes. data Texture = ColorRef PixelRGBA8 -- ^ Direct solid color (#rrggbb, #rgb) @@ -87,9 +87,9 @@ | FillNone -- ^ Equivalent to the `none` value. deriving (Eq, Show, Generic) --- | Describe the possile filling algorithms. +-- | Describe the possible filling algorithms. -- Map the values of the `fill-rule` attributes. data FillRule - = FillEvenOdd -- ^ Correspond to the `evenodd` value. - | FillNonZero -- ^ Correspond to the `nonzero` value. + = FillEvenOdd -- ^ Corresponds to the `evenodd` value. + | FillNonZero -- ^ Corresponds to the `nonzero` value. deriving (Eq, Show, Generic) diff --git a/src/Graphics/SvgTree/Types/Fold.hs b/src/Graphics/SvgTree/Types/Fold.hs --- a/src/Graphics/SvgTree/Types/Fold.hs +++ b/src/Graphics/SvgTree/Types/Fold.hs @@ -12,8 +12,8 @@ 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 +-- The function passed in parameter receives a list +-- representing the path used to go arrive to the -- current node. zipTree :: ([[Tree]] -> Tree) -> Tree -> Tree zipTree f = dig [] where diff --git a/src/Graphics/SvgTree/Types/Hashable.hs b/src/Graphics/SvgTree/Types/Hashable.hs --- a/src/Graphics/SvgTree/Types/Hashable.hs +++ b/src/Graphics/SvgTree/Types/Hashable.hs @@ -2,7 +2,6 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -Wno-orphans -O0 #-} module Graphics.SvgTree.Types.Hashable where @@ -10,12 +9,10 @@ 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 @@ -198,7 +195,7 @@ defaultSvg = Tree NoNode unpack :: Tree -> TreeBranch -unpack t = (_treeBranch t) +unpack = _treeBranch pattern Tree :: TreeBranch -> Tree pattern Tree branch <- diff --git a/src/Graphics/SvgTree/Types/Internal.hs b/src/Graphics/SvgTree/Types/Internal.hs --- a/src/Graphics/SvgTree/Types/Internal.hs +++ b/src/Graphics/SvgTree/Types/Internal.hs @@ -2,13 +2,12 @@ {-# 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 +-- | This module defines all the types used in the definition -- of a svg scene. -- -- Most of the types are lensified. @@ -455,9 +454,9 @@ where import Codec.Picture (PixelRGBA8 (..)) +import Control.Applicative ((<|>)) 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 @@ -489,7 +488,7 @@ QuadraticBezier !Origin ![(RPoint, RPoint)] | -- | Quadratic bezier, 'T' or 't' command SmoothQuadraticBezierCurveTo !Origin ![RPoint] - | -- | Eliptical arc, 'A' or 'a' command. + | -- | Elliptical arc, 'A' or 'a' command. EllipticalArc !Origin ![(Coord, Coord, Coord, Bool, Bool, RPoint)] | -- | Close the path, 'Z' or 'z' svg path command. EndPath @@ -534,7 +533,7 @@ !Coord | -- | Translation along a vector Translate !Double !Double - | -- | Scaling on both axis or on X axis and Y axis. + | -- | Scaling on both axes or on X axis and Y axis. Scale !Double !(Maybe Double) | -- | Rotation around `(0, 0)` or around an optional -- point. @@ -543,7 +542,7 @@ SkewX !Double | -- | Skew transformation along the Y axis. SkewY !Double - | -- | Unkown transformation, like identity. + | -- | Unknown transformation, like identity. TransformUnknown deriving (Eq, Show, Generic) @@ -620,7 +619,7 @@ TextAnchorEnd deriving (Eq, Show, Generic) --- | Correspond to the possible values of the +-- | Corresponds to the possible values of -- the attributes which are either `none` or -- `url(#elem)` data ElementRef @@ -641,110 +640,107 @@ deriving (Eq, Show, Generic) data FilterAttributes = FilterAttributes - { _filterHeight :: !(Last Number), + { _filterHeight :: !(Maybe Number), _filterResult :: !(Maybe String), - _filterWidth :: !(Last Number), - _filterX :: !(Last Number), - _filterY :: !(Last Number) + _filterWidth :: !(Maybe Number), + _filterX :: !(Maybe Number), + _filterY :: !(Maybe Number) } deriving (Eq, Show, Generic) instance WithDefaultSvg FilterAttributes where defaultSvg = FilterAttributes - { _filterHeight = Last Nothing, + { _filterHeight = Nothing, _filterResult = Nothing, - _filterWidth = Last Nothing, - _filterX = Last Nothing, - _filterY = Last Nothing + _filterWidth = Nothing, + _filterX = Nothing, + _filterY = Nothing } --- | This type define how to draw any primitives, +-- | This type defines 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), + { -- | Corresponds to the `stroke-width` SVG attribute. + _strokeWidth :: !(Maybe Number), + -- | Corresponds to the `stroke` attribute. + _strokeColor :: !(Maybe 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 + -- | Corresponds to the `stroke-linecap` SVG attribute. + _strokeLineCap :: !(Maybe Cap), + -- | Corresponds to the `stroke-linejoin` attribute. + _strokeLineJoin :: !(Maybe LineJoin), + -- | Defines the distance of the miter join, corresponds -- to the `stroke-miterlimit` attritbue. - _strokeMiterLimit :: !(Last Double), - -- | Define the filling color of the elements. Corresponding + _strokeMiterLimit :: !(Maybe Double), + -- | Define the fill color of the elements. Corresponds -- to the `fill` attribute. - _fillColor :: !(Last Texture), + _fillColor :: !(Maybe Texture), -- | Define the `fill-opacity` attribute, the transparency -- for the "content". _fillOpacity :: !(Maybe Float), - -- | Define the global or group opacity attribute. + -- | Defines 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), + -- | Defines the `fill-rule` used during the rendering. + _fillRule :: !(Maybe FillRule), + -- | Defines the `mask` attribute. + _maskRef :: !(Maybe ElementRef), + -- | Defines the `clip-path` attribute. + _clipPathRef :: !(Maybe ElementRef), + -- | Defines the `clip-rule` attribute. + _clipRule :: !(Maybe 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 + -- | Defines the start distance of the dashing pattern. + -- Corresponds to the `stroke-dashoffset` attribute. + _strokeOffset :: !(Maybe Number), + -- | Defines the dashing pattern for the lines. Corresponds -- to the `stroke-dasharray` attribute. - _strokeDashArray :: !(Last [Number]), - -- | Current size of the text, correspond to the + _strokeDashArray :: !(Maybe [Number]), + -- | Current size of the text, corresponds 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 + _fontSize :: !(Maybe Number), + -- | Defines the possible fonts to be used for text rendering. + -- Maps to the `font-family` attribute. + _fontFamily :: !(Maybe [String]), + -- | Maps to the `font-style` attribute. + _fontStyle :: !(Maybe FontStyle), + -- | Defines how to interpret the text position, corresponds -- 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` + _textAnchor :: !(Maybe TextAnchor), + -- | Defines the marker used for the start of the line. + -- Corresponds to the `marker-start` attribute. + _markerStart :: !(Maybe ElementRef), + -- | Defines the marker used for every point of the + -- polyline/path. Corresponds 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) + _markerMid :: !(Maybe ElementRef), + -- | Defines the marker used for the end of the line. + -- Corresponds to the `marker-end` attribute. + _markerEnd :: !(Maybe ElementRef), + _filterRef :: !(Maybe ElementRef) } deriving (Eq, Show, Generic) makeClassy ''DrawAttributes --- | This primitive describe an unclosed suite of +-- | This primitive describes an unclosed suite of -- segments. Correspond to the `` tag. data PolyLine = PolyLine { _polyLineDrawAttributes :: DrawAttributes, -- | Geometry definition of the polyline. - -- correspond to the `points` attribute + -- Corresponds to the `points` attribute _polyLinePoints :: [RPoint] } deriving (Eq, Show, Generic) @@ -752,13 +748,13 @@ instance WithDefaultSvg PolyLine where defaultSvg = PolyLine mempty mempty --- | Primitive decriving polygon composed --- of segements. Correspond to the `` +-- | Primitive decribing polygon composed +-- of segements. Corresponds to the `` -- tag data Polygon = Polygon { _polygonDrawAttributes :: DrawAttributes, - -- | Points of the polygon. Correspond to - -- the `points` attributes. + -- | Points of the polygon. Corresponds to + -- the `points` attribute. _polygonPoints :: [RPoint] } deriving (Eq, Show, Generic) @@ -766,14 +762,14 @@ instance WithDefaultSvg Polygon where defaultSvg = Polygon mempty mempty --- | Define a simple line. Correspond to the +-- | Defines a simple line. Corresponds to the -- `` tag. data Line = Line { _lineDrawAttributes :: DrawAttributes, - -- | First point of the the line, correspond + -- | First point of the line, corresponds -- to the `x1` and `y1` attributes. _linePoint1 :: !Point, - -- | Second point of the the line, correspond + -- | Second point of the line, corresponds -- to the `x2` and `y2` attributes. _linePoint2 :: !Point } @@ -789,21 +785,21 @@ where zeroPoint = (Num 0, Num 0) --- | Define a rectangle. Correspond to +-- | Defines a rectangle. Corresponds to -- `` svg tag. data Rectangle = Rectangle { _rectangleDrawAttributes :: DrawAttributes, - -- | Upper left corner of the rectangle, correspond + -- | Upper left corner of the rectangle, corresponds -- to the attributes `x` and `y`. _rectUpperLeftCorner :: !Point, - -- | Rectangle width, correspond, strangely, to + -- | Rectangle width, corresponds to -- the `width` attribute. _rectWidth :: !(Maybe Number), - -- | Rectangle height, correspond, amazingly, to + -- | Rectangle height, corresponds to -- the `height` attribute. _rectHeight :: !(Maybe Number), - -- | Define the rounded corner radius radius - -- of the rectangle. Correspond to the `rx` and + -- | Defines the rounded corner radius + -- of the rectangle. Corresponds to the `rx` and -- `ry` attributes. _rectCornerRadius :: !(Maybe Number, Maybe Number) } @@ -822,8 +818,8 @@ -- | Type mapping the `` svg tag. data Path = Path { _pathDrawAttributes :: DrawAttributes, - -- | Definition of the path, correspond to the - -- `d` attributes. + -- | Definition of the path, corresponds to the + -- `d` attribute. _pathDefinition :: [PathCommand] } deriving (Eq, Show, Generic) @@ -831,7 +827,7 @@ instance WithDefaultSvg Path where defaultSvg = Path mempty mempty --- | Define a SVG group, corresponding `` tag. +-- | Defines a SVG group, corresponds to `` tag. data Group = Group { _groupDrawAttributes :: DrawAttributes, -- | Content of the group, corresponding to all the tags @@ -853,7 +849,7 @@ _groupAspectRatio = defaultSvg } --- | Define the `` tag. +-- | Defines the `` tag. data Filter = Filter { _filterDrawAttributes :: DrawAttributes, _filterSelfAttributes :: !FilterAttributes, @@ -869,13 +865,13 @@ _filterChildren = [] } --- | Define a ``. +-- | Defines a ``. data Circle = Circle { _circleDrawAttributes :: DrawAttributes, - -- | Define the center of the circle, describe - -- the `cx` and `cy` attributes. + -- | Defines the center of the circle. + -- Corresponds to the `cx` and `cy` attributes. _circleCenter :: !Point, - -- | Radius of the circle, equivalent to the `r` + -- | Radius of the circle, corresponds to the `r` -- attribute. _circleRadius :: !Number } @@ -889,16 +885,16 @@ _circleRadius = Num 0 } --- | Define an `` +-- | Defines an `` data Ellipse = Ellipse { _ellipseDrawAttributes :: DrawAttributes, - -- | Center of the ellipse, map to the `cx` + -- | Center of the ellipse, corresponds to the `cx` -- and `cy` attributes. _ellipseCenter :: !Point, - -- | Radius along the X axis, map the + -- | Radius along the X axis, corresponds to the -- `rx` attribute. _ellipseXRadius :: !Number, - -- | Radius along the Y axis, map the + -- | Radius along the Y axis, corresponds to the -- `ry` attribute. _ellipseYRadius :: !Number } @@ -913,13 +909,13 @@ _ellipseYRadius = Num 0 } --- | Define a color stop for the gradients. Represent +-- | Defines a color stop for the gradients. Represents -- the `` SVG tag. data GradientStop = GradientStop - { -- | Gradient offset between 0 and 1, correspond + { -- | Gradient offset between 0 and 1, corresponds -- to the `offset` attribute. _gradientOffset :: !Float, - -- | Color of the gradient stop. Correspond + -- | Color of the gradient stop. Corresponds -- to the `stop-color` attribute. _gradientColor :: !PixelRGBA8, -- | Path command used in mesh patch @@ -938,10 +934,10 @@ _gradientOpacity = Nothing } --- | Define `` SVG tag -data MeshGradientPatch = MeshGradientPatch +-- | Defines `` SVG tag +newtype MeshGradientPatch = MeshGradientPatch { -- | List of stop, from 2 to 4 in a patch - _meshGradientPatchStops :: ![GradientStop] + _meshGradientPatchStops :: [GradientStop] } deriving (Eq, Show, Generic) @@ -949,16 +945,16 @@ defaultSvg = MeshGradientPatch [] -- | Define a `` tag. -data MeshGradientRow = MeshGradientRow +newtype MeshGradientRow = MeshGradientRow { -- | List of patch in a row - _meshGradientRowPatches :: ![MeshGradientPatch] + _meshGradientRowPatches :: [MeshGradientPatch] } deriving (Eq, Show, Generic) instance WithDefaultSvg MeshGradientRow where defaultSvg = MeshGradientRow [] --- | Define a `` tag. +-- | Defines a `` tag. data MeshGradient = MeshGradient { _meshGradientDrawAttributes :: DrawAttributes, -- | Original x coordinate of the mesh gradient @@ -971,7 +967,7 @@ _meshGradientUnits :: !CoordinateUnits, -- | Optional transform _meshGradientTransform :: ![Transformation], - -- | List of patch rows in the the mesh. + -- | List of patch rows in the mesh. _meshGradientRows :: ![MeshGradientRow] } deriving (Eq, Show, Generic) @@ -988,7 +984,7 @@ _meshGradientRows = mempty } --- | Define an `` tag. +-- | Defines an `` tag. data Image = Image { _imageDrawAttributes :: DrawAttributes, -- | Position of the image referenced by its @@ -1016,23 +1012,23 @@ _imageAspectRatio = defaultSvg } --- | Define an `` for a named content. +-- | Defines an `` 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. + -- Corresponds to the `x` and `y` attributes. _useBase :: Point, - -- | Referenced name, correspond to `xlink:href` + -- | Referenced name, corresponds to `xlink:href` -- attribute. _useName :: String, - -- | Define the width of the region where - -- to place the element. Map to the `width` + -- | Defines the width of the region where + -- to place the element. Corresponds to the `width` -- attribute. _useWidth :: Maybe Number, - -- | Define the height of the region where - -- to place the element. Map to the `height` + -- | Defines the height of the region where + -- to place the element. Corresponds to the `height` -- attribute. _useHeight :: Maybe Number } @@ -1048,7 +1044,7 @@ _useHeight = Nothing } --- | Define position information associated to +-- | Defines position information associated to -- `` or `` svg tag. data TextInfo = TextInfo { -- | `x` attribute. @@ -1076,7 +1072,7 @@ (dx1 <> dx2) (dy1 <> dy2) (r1 <> r2) - (getLast $ Last l1 <> Last l2) + (l2 <|> l1) instance Monoid TextInfo where mempty = TextInfo [] [] [] [] [] Nothing @@ -1085,19 +1081,19 @@ instance WithDefaultSvg TextInfo where defaultSvg = mempty --- | Define the content of a `` tag. +-- | Defines the content of a `` tag. data TextSpanContent = -- | Raw text SpanText !T.Text | -- | Equivalent to a `` SpanTextRef !String - | -- | Define a `` + | -- | Defines a `` SpanSub !TextSpan deriving (Eq, Show, Generic) --- | Define a `` tag. +-- | Defines a `` tag. data TextSpan = TextSpan - { -- | Placing information for the text. + { -- | Placement information for the text. _spanInfo :: !TextInfo, -- | Drawing attributes for the text span. _spanDrawAttributes :: !DrawAttributes, @@ -1117,31 +1113,31 @@ -- | Describe the content of the `method` attribute on -- text path. data TextPathMethod - = -- | Map to the `align` value. + = -- | Corresponds to the `align` value. TextPathAlign - | -- | Map to the `stretch` value. + | -- | Corresponds to the `stretch` value. TextPathStretch deriving (Eq, Show, Generic) --- | Describe the content of the `spacing` text path +-- | Describes the content of the `spacing` text path -- attribute. data TextPathSpacing - = -- | Map to the `exact` value. + = -- | Corresponds to the `exact` value. TextPathSpacingExact - | -- | Map to the `auto` value. + | -- | Corresponds to the `auto` value. TextPathSpacingAuto deriving (Eq, Show, Generic) --- | Describe the `` SVG tag. +-- | Describes the `` SVG tag. data TextPath = TextPath - { -- | Define the beginning offset on the path, + { -- | Defines the beginning offset on the path, -- the `startOffset` attribute. _textPathStartOffset :: !Number, - -- | Define the `xlink:href` attribute. + -- | Defines the `xlink:href` attribute. _textPathName :: !String, - -- | Correspond to the `method` attribute. + -- | Corresponds to the `method` attribute. _textPathMethod :: !TextPathMethod, - -- | Correspond to the `spacing` attribute. + -- | Corresponds to the `spacing` attribute. _textPathSpacing :: !TextPathSpacing } deriving (Eq, Show, Generic) @@ -1155,7 +1151,7 @@ _textPathSpacing = TextPathSpacingExact } --- | Define the possible values of the `lengthAdjust` +-- | Defines the possible values of the `lengthAdjust` -- attribute. data TextAdjust = -- | Value `spacing` @@ -1164,9 +1160,9 @@ TextAdjustSpacingAndGlyphs deriving (Eq, Show, Generic) --- | Define the global `` SVG tag. +-- | Defines the global `` SVG tag. data Text = Text - { -- | Define the `lengthAdjust` attribute. + { -- | Defines the `lengthAdjust` attribute. _textAdjust :: !TextAdjust, -- | Root of the text content. _textRoot :: !TextSpan @@ -1267,7 +1263,7 @@ data SpecularLighting = SpecularLighting { _specLightingDrawAttributes :: DrawAttributes, _specLightingFilterAttr :: !FilterAttributes, - _specLightingIn :: !(Last FilterSource), + _specLightingIn :: !(Maybe FilterSource), _specLightingSurfaceScale :: Double, _specLightingSpecularConst :: Double, _specLightingSpecularExp :: Double, @@ -1280,7 +1276,7 @@ SpecularLighting { _specLightingDrawAttributes = defaultSvg, _specLightingFilterAttr = defaultSvg, - _specLightingIn = Last Nothing, + _specLightingIn = Nothing, _specLightingSurfaceScale = 1, _specLightingSpecularConst = 1, _specLightingSpecularExp = 1, @@ -1290,7 +1286,7 @@ data ConvolveMatrix = ConvolveMatrix { _convolveMatrixDrawAttributes :: DrawAttributes, _convolveMatrixFilterAttr :: !FilterAttributes, - _convolveMatrixIn :: !(Last FilterSource), + _convolveMatrixIn :: !(Maybe FilterSource), _convolveMatrixOrder :: NumberOptionalNumber, _convolveMatrixKernelMatrix :: [Double], _convolveMatrixDivisor :: Double, @@ -1308,7 +1304,7 @@ ConvolveMatrix { _convolveMatrixDrawAttributes = defaultSvg, _convolveMatrixFilterAttr = defaultSvg, - _convolveMatrixIn = Last Nothing, + _convolveMatrixIn = Nothing, _convolveMatrixOrder = Num1 3, _convolveMatrixKernelMatrix = [], _convolveMatrixDivisor = 1, @@ -1323,7 +1319,7 @@ data DiffuseLighting = DiffuseLighting { _diffuseLightingDrawAttributes :: DrawAttributes, _diffuseLightingFilterAttr :: !FilterAttributes, - _diffuseLightingIn :: !(Last FilterSource), + _diffuseLightingIn :: !(Maybe FilterSource), _diffuseLightingSurfaceScale :: Double, _diffuseLightingDiffuseConst :: Double, _diffuseLightingKernelUnitLength :: NumberOptionalNumber @@ -1335,7 +1331,7 @@ DiffuseLighting { _diffuseLightingDrawAttributes = defaultSvg, _diffuseLightingFilterAttr = defaultSvg, - _diffuseLightingIn = Last Nothing, + _diffuseLightingIn = Nothing, _diffuseLightingSurfaceScale = 1, _diffuseLightingDiffuseConst = 1, _diffuseLightingKernelUnitLength = Num1 0 @@ -1344,7 +1340,7 @@ data Morphology = Morphology { _morphologyDrawAttributes :: DrawAttributes, _morphologyFilterAttr :: !FilterAttributes, - _morphologyIn :: !(Last FilterSource), + _morphologyIn :: !(Maybe FilterSource), _morphologyOperator :: OperatorType, _morphologyRadius :: NumberOptionalNumber } @@ -1356,7 +1352,7 @@ Morphology { _morphologyDrawAttributes = defaultSvg, _morphologyFilterAttr = defaultSvg, - _morphologyIn = Last Nothing, + _morphologyIn = Nothing, _morphologyOperator = OperatorOver, _morphologyRadius = Num1 0 } @@ -1443,9 +1439,9 @@ data DisplacementMap = DisplacementMap { _displacementMapDrawAttributes :: !DrawAttributes, _displacementMapFilterAttr :: !FilterAttributes, - _displacementMapIn :: !(Last FilterSource), - _displacementMapIn2 :: !(Last FilterSource), - _displacementMapScale :: !(Last Double), + _displacementMapIn :: !(Maybe FilterSource), + _displacementMapIn2 :: !(Maybe FilterSource), + _displacementMapScale :: !(Maybe Double), _displacementMapXChannelSelector :: ChannelSelector, _displacementMapYChannelSelector :: ChannelSelector } @@ -1456,9 +1452,9 @@ DisplacementMap { _displacementMapDrawAttributes = defaultSvg, _displacementMapFilterAttr = defaultSvg, - _displacementMapIn = Last Nothing, - _displacementMapIn2 = Last Nothing, - _displacementMapScale = Last Nothing, + _displacementMapIn = Nothing, + _displacementMapIn2 = Nothing, + _displacementMapScale = Nothing, _displacementMapXChannelSelector = ChannelA, _displacementMapYChannelSelector = ChannelA } @@ -1485,8 +1481,8 @@ data Blend = Blend { _blendDrawAttributes :: !DrawAttributes, _blendFilterAttr :: !FilterAttributes, - _blendIn :: !(Last FilterSource), - _blendIn2 :: !(Last FilterSource), + _blendIn :: !(Maybe FilterSource), + _blendIn2 :: !(Maybe FilterSource), _blendMode :: !BlendMode } deriving (Eq, Show, Generic) @@ -1496,8 +1492,8 @@ Blend { _blendDrawAttributes = defaultSvg, _blendFilterAttr = defaultSvg, - _blendIn = Last Nothing, - _blendIn2 = Last Nothing, + _blendIn = Nothing, + _blendIn2 = Nothing, _blendMode = Normal } @@ -1521,7 +1517,7 @@ data Offset = Offset { _offsetDrawAttributes :: !DrawAttributes, _offsetFilterAttr :: !FilterAttributes, - _offsetIn :: !(Last FilterSource), + _offsetIn :: !(Maybe FilterSource), _offsetDX :: !Number, _offsetDY :: !Number } @@ -1532,7 +1528,7 @@ Offset { _offsetDrawAttributes = defaultSvg, _offsetFilterAttr = defaultSvg, - _offsetIn = Last Nothing, + _offsetIn = Nothing, _offsetDX = Num 0, _offsetDY = Num 0 } @@ -1540,7 +1536,7 @@ data Tile = Tile { _tileDrawAttributes :: !DrawAttributes, _tileFilterAttr :: !FilterAttributes, - _tileIn :: !(Last FilterSource) + _tileIn :: !(Maybe FilterSource) } deriving (Eq, Show, Generic) @@ -1549,7 +1545,7 @@ Tile { _tileDrawAttributes = defaultSvg, _tileFilterAttr = defaultSvg, - _tileIn = Last Nothing + _tileIn = Nothing } data Merge = Merge @@ -1570,7 +1566,7 @@ data MergeNode = MergeNode { _mergeNodeDrawAttributes :: !DrawAttributes, --Does not have filter attributes! - _mergeNodeIn :: !(Last FilterSource) + _mergeNodeIn :: !(Maybe FilterSource) } deriving (Eq, Show, Generic) @@ -1578,14 +1574,14 @@ defaultSvg = MergeNode { _mergeNodeDrawAttributes = defaultSvg, - _mergeNodeIn = Last Nothing + _mergeNodeIn = Nothing } data ComponentTransfer = ComponentTransfer { _compTransferDrawAttributes :: !DrawAttributes, _compTransferFilterAttr :: !FilterAttributes, _compTransferChildren :: ![FilterElement], - _compTransferIn :: !(Last FilterSource) + _compTransferIn :: !(Maybe FilterSource) } deriving (Eq, Show, Generic) @@ -1595,7 +1591,7 @@ { _compTransferDrawAttributes = defaultSvg, _compTransferFilterAttr = defaultSvg, _compTransferChildren = [], - _compTransferIn = Last Nothing + _compTransferIn = Nothing } data FuncType @@ -1717,7 +1713,7 @@ data ColorMatrix = ColorMatrix { _colorMatrixDrawAttributes :: !DrawAttributes, _colorMatrixFilterAttr :: !FilterAttributes, - _colorMatrixIn :: !(Last FilterSource), + _colorMatrixIn :: !(Maybe FilterSource), _colorMatrixType :: !ColorMatrixType, _colorMatrixValues :: !String } @@ -1728,7 +1724,7 @@ ColorMatrix { _colorMatrixDrawAttributes = defaultSvg, _colorMatrixFilterAttr = defaultSvg, - _colorMatrixIn = Last Nothing, + _colorMatrixIn = Nothing, _colorMatrixType = Matrix, _colorMatrixValues = "" } @@ -1745,8 +1741,8 @@ data Composite = Composite { _compositeDrawAttributes :: DrawAttributes, _compositeFilterAttr :: !FilterAttributes, - _compositeIn :: Last FilterSource, - _compositeIn2 :: Last FilterSource, + _compositeIn :: Maybe FilterSource, + _compositeIn2 :: Maybe FilterSource, _compositeOperator :: CompositeOperator, _compositeK1 :: Number, _compositeK2 :: Number, @@ -1760,8 +1756,8 @@ Composite { _compositeDrawAttributes = defaultSvg, _compositeFilterAttr = defaultSvg, - _compositeIn = Last Nothing, - _compositeIn2 = Last Nothing, + _compositeIn = Nothing, + _compositeIn2 = Nothing, _compositeOperator = CompositeOver, _compositeK1 = Num 0, _compositeK2 = Num 0, @@ -1772,7 +1768,7 @@ data Turbulence = Turbulence { _turbulenceDrawAttributes :: !DrawAttributes, _turbulenceFilterAttr :: !FilterAttributes, - _turbulenceBaseFrequency :: !(Double, Last Double), -- Not negative + _turbulenceBaseFrequency :: !(Double, Maybe Double), -- Not negative _turbulenceNumOctaves :: Int, -- Not negative _turbulenceSeed :: Double, _turbulenceStitchTiles :: StitchTiles, @@ -1795,7 +1791,7 @@ Turbulence { _turbulenceDrawAttributes = defaultSvg, _turbulenceFilterAttr = defaultSvg, - _turbulenceBaseFrequency = (0, Last Nothing), + _turbulenceBaseFrequency = (0, Nothing), _turbulenceNumOctaves = 1, _turbulenceSeed = 0, _turbulenceStitchTiles = NoStitch, @@ -1811,9 +1807,9 @@ data GaussianBlur = GaussianBlur { _gaussianBlurDrawAttributes :: DrawAttributes, _gaussianBlurFilterAttr :: !FilterAttributes, - _gaussianBlurIn :: Last FilterSource, + _gaussianBlurIn :: Maybe FilterSource, _gaussianBlurStdDeviationX :: Number, - _gaussianBlurStdDeviationY :: Last Number, + _gaussianBlurStdDeviationY :: Maybe Number, _gaussianBlurEdgeMode :: EdgeMode } deriving (Eq, Show, Generic) @@ -1823,13 +1819,13 @@ GaussianBlur { _gaussianBlurDrawAttributes = defaultSvg, _gaussianBlurFilterAttr = defaultSvg, - _gaussianBlurIn = Last Nothing, + _gaussianBlurIn = Nothing, _gaussianBlurStdDeviationX = Num 0, - _gaussianBlurStdDeviationY = Last Nothing, + _gaussianBlurStdDeviationY = Nothing, _gaussianBlurEdgeMode = EdgeDuplicate } --- | Define the orientation, associated to the +-- | Defines the orientation, associated to the -- `orient` attribute on the Marker data MarkerOrientation = -- | Auto value @@ -1847,7 +1843,7 @@ MarkerUnitUserSpaceOnUse deriving (Eq, Show, Generic) --- | Define the content of the `markerUnits` attribute +-- | Defines the content of the `markerUnits` attribute -- on the Marker. data Overflow = -- | Value `visible` @@ -1856,21 +1852,21 @@ OverflowHidden deriving (Eq, Show, Generic) --- | Define the `` tag. +-- | Defines the `` tag. data Marker = Marker { _markerDrawAttributes :: DrawAttributes, - -- | Define the reference point of the marker. - -- correspond to the `refX` and `refY` attributes. + -- | Defines the reference point of the marker. + -- corresponds to the `refX` and `refY` attributes. _markerRefPoint :: !(Number, Number), - -- | Define the width of the marker. Correspond to + -- | Defines the width of the marker. Corresponds to -- the `markerWidth` attribute. _markerWidth :: !(Maybe Number), - -- | Define the height of the marker. Correspond to + -- | Defines the height of the marker. Corresponds to -- the `markerHeight` attribute. _markerHeight :: !(Maybe Number), - -- | Correspond to the `orient` attribute. + -- | Corresponds to the `orient` attribute. _markerOrient :: !(Maybe MarkerOrientation), - -- | Map the `markerUnits` attribute. + -- | Corresponds to the `markerUnits` attribute. _markerUnits :: !(Maybe MarkerUnit), -- | Optional viewbox _markerViewBox :: !(Maybe (Double, Double, Double, Double)), @@ -1927,7 +1923,7 @@ ClipPathNode _ -> "clipPath" SvgNode {} -> "svg" --- | Define the possible values for the `spreadMethod` +-- | Defines the possible values for the `spreadMethod` -- values used for the gradient definitions. data Spread = -- | `reapeat` value @@ -1938,10 +1934,10 @@ SpreadReflect deriving (Eq, Show, Generic) --- | Define a `` tag. +-- | Defines a `` tag. data LinearGradient = LinearGradient { _linearGradientDrawAttributes :: DrawAttributes, - -- | Define coordinate system of the gradient, + -- | Defines coordinate system of the gradient, -- associated to the `gradientUnits` attribute. _linearGradientUnits :: CoordinateUnits, -- | Point defining the beginning of the line gradient. @@ -1975,10 +1971,10 @@ _linearGradientStops = [] } --- | Define a `` tag. +-- | Defines a `` tag. data RadialGradient = RadialGradient { _radialGradientDrawAttributes :: DrawAttributes, - -- | Define coordinate system of the gradient, + -- | Defines coordinate system of the gradient, -- associated to the `gradientUnits` attribute. _radialGradientUnits :: CoordinateUnits, -- | Center of the radial gradient. Associated to @@ -1993,7 +1989,7 @@ -- | 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 + -- | Defines how to handle the values outside -- the gradient start and stop. Associated to the -- `spreadMethod` attribute. _radialGradientSpread :: Spread, @@ -2020,18 +2016,18 @@ _radialGradientStops = [] } --- | Define a SVG `` tag. +-- | Defines a SVG `` tag. data Mask = Mask { _maskDrawAttributes :: DrawAttributes, - -- | Correspond to the `maskContentUnits` attributes. + -- | Corresponds to the `maskContentUnits` attributes. _maskContentUnits :: CoordinateUnits, - -- | Mapping to the `maskUnits` attribute. + -- | Corresponds to the `maskUnits` attribute. _maskUnits :: CoordinateUnits, - -- | Map to the `x` and `y` attributes. + -- | Corresponds to the `x` and `y` attributes. _maskPosition :: Point, - -- | Map to the `width` attribute + -- | Corresponds to the `width` attribute _maskWidth :: Number, - -- | Map to the `height` attribute. + -- | Corresponds to the `height` attribute. _maskHeight :: Number, -- | Children of the `` tag. _maskContent :: [Tree] @@ -2050,12 +2046,12 @@ _maskContent = [] } --- | Define a `` tag. +-- | Defines a `` tag. data ClipPath = ClipPath { _clipPathDrawAttributes :: DrawAttributes, - -- | Maps to the `clipPathUnits` attribute + -- | Corresponds to the `clipPathUnits` attribute _clipPathUnits :: CoordinateUnits, - -- | Maps to the content of the tree + -- | Corresponds to the content of the tree _clipPathContent :: [Tree] } deriving (Eq, Show, Generic) @@ -2068,7 +2064,7 @@ _clipPathContent = mempty } --- | Define a `` tag. +-- | Defines a `` tag. data Pattern = Pattern { _patternDrawAttributes :: DrawAttributes, -- | Possible `viewBox`. @@ -2087,13 +2083,13 @@ _patternHref :: !String, -- | Elements used in the pattern. _patternElements :: ![Tree], - -- | Define the cordinate system to use for - -- the pattern. Mapped to the `patternUnits` + -- | Defines the cordinate system to use for + -- the pattern. Corresponds to the `patternUnits` -- attribute. _patternUnit :: !CoordinateUnits, - -- | Value of the "preserveAspectRatio" attribute + -- | Value of the `preserveAspectRatio` attribute _patternAspectRatio :: !PreserveAspectRatio, - -- | Value of "patternTransform" attribute + -- | Value of `patternTransform` attribute _patternTransform :: !(Maybe [Transformation]) } deriving (Eq, Show, Generic) @@ -2126,7 +2122,7 @@ | ElementClipPath ClipPath deriving (Eq, Show, Generic) --- | Represent a full svg document with style, +-- | Represents a full svg document with style, -- geometry and named elements. data Document = Document { _documentViewBox :: Maybe (Double, Double, Double, Double), @@ -2161,11 +2157,10 @@ } = (floor w, floor h) documentSize dpi - doc@( Document - { _documentWidth = Just w, - _documentHeight = Just h - } - ) = + doc@Document + { _documentWidth = Just w, + _documentHeight = Just h + } = documentSize dpi $ doc { _documentWidth = Just $ toUserUnit dpi w, @@ -2183,69 +2178,70 @@ 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, + { _strokeWidth = chooseLast _strokeWidth, + _strokeColor = chooseLast _strokeColor, + _strokeLineCap = chooseLast _strokeLineCap, _strokeOpacity = (opacityMappend `on` _strokeOpacity) a b, - _strokeLineJoin = (mappend `on` _strokeLineJoin) a b, - _strokeMiterLimit = (mappend `on` _strokeMiterLimit) a b, - _fillColor = (mappend `on` _fillColor) a b, + _strokeLineJoin = chooseLast _strokeLineJoin, + _strokeMiterLimit = chooseLast _strokeMiterLimit, + _fillColor = chooseLast _fillColor, _fillOpacity = (opacityMappend `on` _fillOpacity) a b, - _fontSize = (mappend `on` _fontSize) a b, + _fontSize = chooseLast _fontSize, _transform = (mayMerge `on` _transform) a b, - _fillRule = (mappend `on` _fillRule) a b, + _fillRule = chooseLast _fillRule, _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 + _strokeOffset = chooseLast _strokeOffset, + _strokeDashArray = chooseLast _strokeDashArray, + _fontFamily = chooseLast _fontFamily, + _fontStyle = chooseLast _fontStyle, + _textAnchor = chooseLast _textAnchor, + _maskRef = chooseLast _maskRef, + _clipPathRef = chooseLast _clipPathRef, + _clipRule = chooseLast _clipRule, + _markerStart = chooseLast _markerStart, + _markerMid = chooseLast _markerMid, + _markerEnd = chooseLast _markerEnd, + _filterRef = chooseLast _filterRef } 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 + chooseLast f = f b <|> f a instance Monoid DrawAttributes where mappend = (<>) mempty = DrawAttributes - { _strokeWidth = Last Nothing, - _strokeColor = Last Nothing, + { _strokeWidth = Nothing, + _strokeColor = Nothing, _strokeOpacity = Nothing, - _strokeLineCap = Last Nothing, - _strokeLineJoin = Last Nothing, - _strokeMiterLimit = Last Nothing, - _fillColor = Last Nothing, + _strokeLineCap = Nothing, + _strokeLineJoin = Nothing, + _strokeMiterLimit = Nothing, + _fillColor = Nothing, _groupOpacity = Nothing, _fillOpacity = Nothing, - _fontSize = Last Nothing, - _fontFamily = Last Nothing, - _fontStyle = Last Nothing, + _fontSize = Nothing, + _fontFamily = Nothing, + _fontStyle = Nothing, _transform = Nothing, - _fillRule = Last Nothing, + _fillRule = 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 + _strokeOffset = Nothing, + _strokeDashArray = Nothing, + _textAnchor = Nothing, + _maskRef = Nothing, + _clipPathRef = Nothing, + _clipRule = Nothing, + _markerStart = Nothing, + _markerMid = Nothing, + _markerEnd = Nothing, + _filterRef = Nothing } instance WithDefaultSvg DrawAttributes where diff --git a/src/Graphics/SvgTree/XmlParser.hs b/src/Graphics/SvgTree/XmlParser.hs --- a/src/Graphics/SvgTree/XmlParser.hs +++ b/src/Graphics/SvgTree/XmlParser.hs @@ -25,7 +25,6 @@ import Data.Attoparsec.Text (Parser, parseOnly, string) import Data.List (foldl', intercalate) import Data.Maybe (catMaybes, fromMaybe) -import Data.Monoid import qualified Data.Text as T import Graphics.SvgTree.ColorParser import Graphics.SvgTree.CssParser (complexNumber, dashArray, num, @@ -62,10 +61,6 @@ aparse = fmap Just . aparse aserialize = (>>= aserialize) -instance ParseableAttribute v => ParseableAttribute (Last v) where - aparse = fmap Last . aparse - aserialize = aserialize . getLast - instance ParseableAttribute String where aparse = Just aserialize = Just @@ -522,23 +517,23 @@ EdgeWrap -> "wrap" EdgeNone -> "none" -instance ParseableAttribute (Number, Last Number) where +instance ParseableAttribute (Number, Maybe Number) where aparse s = case aparse s of - Just [x] -> Just (x, Last Nothing) - Just [x,y] -> Just (x, Last (Just y)) + Just [x] -> Just (x, Nothing) + Just [x,y] -> Just (x, Just y) _ -> Nothing - aserialize (x, Last Nothing) = aserialize [x] - aserialize (x, Last (Just y)) = aserialize [x, y] + aserialize (x, Nothing) = aserialize [x] + aserialize (x, Just y) = aserialize [x, y] -instance ParseableAttribute (Double, Last Double) where +instance ParseableAttribute (Double, Maybe Double) where aparse s = case aparse s of - Just [x] -> Just (x, Last Nothing) - Just [x,y] -> Just (x, Last (Just y)) + Just [x] -> Just (x, Nothing) + Just [x,y] -> Just (x, Just y) _ -> Nothing - aserialize (x, Last Nothing) = aserialize [x] - aserialize (x, Last (Just y)) = aserialize [x, y] + aserialize (x, Nothing) = aserialize [x] + aserialize (x, Just y) = aserialize [x, y] parse :: Parser a -> String -> Maybe a parse p str = case parseOnly p (T.pack str) of @@ -655,16 +650,16 @@ v = a ^. elLens defaultVal = defaultSvg ^. elLens -parserLastSetter :: String -> Lens' a (Last e) -> (String -> Maybe e) -> Serializer e +parserMaybeSetter :: String -> Lens' a (Maybe e) -> (String -> Maybe e) -> Serializer e -> SvgAttributeLens a -parserLastSetter attribute elLens parser serialize = +parserMaybeSetter attribute elLens parser serialize = SvgAttributeLens attribute updater serializer where updater el str = case parser str of Nothing -> el - Just v -> el & elLens .~ Last (Just v) + Just v -> el & elLens ?~ v - serializer a = getLast (a ^. elLens) >>= serialize + serializer a = (a ^. elLens) >>= serialize classSetter :: SvgAttributeLens DrawAttributes classSetter = SvgAttributeLens "class" updater serializer @@ -677,10 +672,10 @@ lst -> Just . T.unpack $ T.intercalate " " lst cssUniqueNumber :: ASetter el el - a (Last Number) + a (Maybe Number) -> CssUpdater el cssUniqueNumber setter attr ((CssNumber n:_):_) = - attr & setter .~ Last (Just n) + attr & setter ?~ n cssUniqueNumber _ attr _ = attr cssUniqueFloat :: (Fractional n) @@ -690,10 +685,10 @@ attr & setter ?~ realToFrac n cssUniqueFloat _ attr _ = attr -cssUniqueMayFloat :: ASetter el el a (Last Double) +cssUniqueMayFloat :: ASetter el el a (Maybe Double) -> CssUpdater el cssUniqueMayFloat setter attr ((CssNumber (Num n):_):_) = - attr & setter .~ Last (Just n) + attr & setter ?~ n cssUniqueMayFloat _ attr _ = attr cssIdentAttr :: ParseableAttribute a => Lens' el a -> CssUpdater el @@ -705,7 +700,7 @@ fontFamilyParser :: CssUpdater DrawAttributes fontFamilyParser attr (lst:_) = attr & fontFamily .~ fontNames where - fontNames = Last . Just $ T.unpack <$> extractString lst + fontNames = Just $ T.unpack <$> extractString lst extractString [] = [] extractString (CssIdent n:rest) = n : extractString rest @@ -715,13 +710,13 @@ cssUniqueTexture :: ASetter el el - a (Last Texture) + a (Maybe Texture) -> CssUpdater el cssUniqueTexture setter attr css = case css of - ((CssIdent "none":_):_) -> attr & setter .~ Last (Just FillNone) - ((CssColor c:_):_) -> attr & setter .~ Last (Just $ ColorRef c) + ((CssIdent "none":_):_) -> attr & setter ?~ FillNone + ((CssColor c:_):_) -> attr & setter ?~ ColorRef c ((CssFunction "url" [CssReference c]:_):_) -> - attr & setter .~ Last (Just . TextureRef $ T.unpack c) + attr & setter ?~ TextureRef (T.unpack c) _ -> attr cssUniqueColor :: ASetter el el a PixelRGBA8 -> CssUpdater el @@ -729,11 +724,11 @@ ((CssColor c:_):_) -> attr & setter .~ c _ -> attr -cssElementRefSetter :: Lens' el (Last ElementRef) -> CssUpdater el +cssElementRefSetter :: Lens' el (Maybe ElementRef) -> CssUpdater el cssElementRefSetter setter attr ((CssFunction "url" [CssReference c]:_):_) = - attr & setter .~ Last (Just . Ref $ T.unpack c) + attr & setter ?~ Ref (T.unpack c) cssElementRefSetter setter attr ((CssIdent "none":_):_) = - attr & setter .~ Last (Just RefNone) + attr & setter ?~ RefNone cssElementRefSetter _ attr _ = attr cssMayStringSetter :: ASetter el el a (Maybe String) -> CssUpdater el @@ -746,11 +741,11 @@ cssNullSetter :: CssUpdater a cssNullSetter attr _ = attr -cssDashArray :: ASetter el el a (Last [Number]) -> CssUpdater el +cssDashArray :: ASetter el el a (Maybe [Number]) -> CssUpdater el cssDashArray setter attr (lst:_) = case [n | CssNumber n <- lst ] of [] -> attr - v -> attr & setter .~ Last (Just v) + v -> attr & setter ?~ v cssDashArray _ attr _ = attr @@ -769,7 +764,7 @@ ,(opacitySetter "fill-opacity" fillOpacity, cssUniqueFloat fillOpacity) ,(opacitySetter "stroke-opacity" strokeOpacity, cssUniqueFloat strokeOpacity) ,("font-size" `parseIn` fontSize, cssUniqueNumber fontSize) - ,(parserLastSetter "font-family" fontFamily (Just . commaSeparate) + ,(parserMaybeSetter "font-family" fontFamily (Just . commaSeparate) (Just . intercalate ", "), fontFamilyParser) ,("fill-rule" `parseIn` fillRule, cssIdentAttr fillRule) diff --git a/test/W3C.hs b/test/W3C.hs --- a/test/W3C.hs +++ b/test/W3C.hs @@ -1,42 +1,45 @@ +{-# LANGUAGE DataKinds #-} module Main (main) where -import Test.Tasty -import Test.Tasty.Ingredients.Rerun (defaultMainWithRerun) -import Test.Tasty.ExpectedFailure -import Test.Tasty.HUnit -import qualified Data.ByteString.Char8 as BS +import Data.Algorithm.Diff +import Data.Algorithm.DiffOutput +import qualified Data.ByteString.Lazy as BS +import Data.Char +import Data.List +import Control.Monad +import Control.Exception (evaluate, handle, ErrorCall(..)) import Graphics.SvgTree import Graphics.SvgTree.Printer -import System.Process import System.Directory -import System.FilePath -import Data.List import System.Environment -import Data.Algorithm.Diff -import Data.Algorithm.DiffOutput -import Data.Char +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import System.FilePath +import System.Process.Typed +import Test.Tasty +import Test.Tasty.ExpectedFailure +import Test.Tasty.HUnit +import Test.Tasty.Ingredients.Rerun (defaultMainWithRerun) main :: IO () -main = return () --- main = do --- args <- getArgs --- case args of --- [path] -> do --- haveFile <- doesFileExist path --- if haveFile --- then do --- raw <- readFile path --- golden <- prettyPrintSvg =<< sanitizeSvg raw --- cycled <- prettyPrintSvg (cycleSvg golden) --- if golden == cycled --- then putStrLn "Good" --- else do --- putStrLn "Mismatch!" --- let d = getGroupedDiff (lines golden) (lines cycled) :: [Diff [String]] --- ranges = diffToLineRanges d --- print (prettyDiffs ranges) --- else runTestSuite --- _ -> runTestSuite +-- main = return () +main = do + args <- getArgs + case args of + ["sort"] -> sortTestCases + ["cycle", path] -> do + inp <- readFile path + putStrLn $ cycleSvg inp + [path] -> do + haveFile <- doesFileExist path + if haveFile + then do + passed <- checkCycled path + if passed + then putStrLn "Good" + else putStrLn "Mismatch!" + else runTestSuite + _ -> runTestSuite runTestSuite :: IO () runTestSuite = do @@ -48,39 +51,79 @@ unitTestFolder :: FilePath -> IO TestTree unitTestFolder path = do files <- sort <$> getDirectoryContents path - return $ testGroup "animate" - [ testSvg fullPath - | file <- files - , let fullPath = path file - , takeExtension fullPath == ".svg" - ] + return $ + testGroup + "animate" + [ testSvg fullPath + | file <- files, + let fullPath = path file, + takeExtension fullPath == ".svg" + ] +sortTestCases :: IO () +sortTestCases = do + goodFiles <- getDirectoryContents "test/good" + badFiles <- getDirectoryContents "test/bad" + forM_ goodFiles $ \file -> when (takeExtension file == ".svg") $ do + -- putStrLn $ "Processing: " ++ ("test/good" file) + passed <- checkCycled ("test/good" file) + unless passed $ do + putStrLn $ "Marking bad: " ++ file + renameFile ("test/good" file) ("test/bad" file) + forM_ badFiles $ \file -> when (takeExtension file == ".svg") $ do + -- putStrLn $ "Processing: " ++ ("test/bad" file) + passed <- checkCycled ("test/bad" file) + when passed $ do + putStrLn $ "Marking good: " ++ file + renameFile ("test/bad" file) ("test/good" file) + +checkCycled :: FilePath -> IO Bool +checkCycled path = + handle (\ExitCodeException{} -> return False) $ + handle (\ErrorCall{} -> return False) $ do + raw <- readFile path + golden <- sanitizeSvg raw + cycled <- sanitizeSvg (cycleSvg raw) + return (golden == cycled) + testSvg :: FilePath -> TestTree -testSvg path = testCase (takeBaseName path) $ do - raw <- readFile path - golden <- prettyPrintSvg =<< sanitizeSvg raw - cycled <- prettyPrintSvg (cycleSvg golden) - assert (golden == cycled) +testSvg path = testCase (takeBaseName path) $ + assert =<< checkCycled path -- Sanitize SVG using rsvg-convert -sanitizeSvg :: String -> IO String -sanitizeSvg = readProcess "rsvg-convert" ["--format", "svg"] +sanitizeSvg :: String -> IO BS.ByteString +sanitizeSvg inp = do + let inpT = T.pack inp + evaluate (T.length inpT) + (stdout, stderr) <- readProcess_ $ + setStdin (textInput inpT) $ + proc "rsvg-convert" ["--format", "png"] + return stdout +textInput :: T.Text -> StreamSpec 'STInput () +textInput = byteStringInput . BS.fromStrict . T.encodeUtf8 + -- Ugly hack to ignore the differences between #FFF and #fff. lowerHashValues :: String -> String -lowerHashValues ('#':more) = '#' : map toLower before ++ lowerHashValues after +lowerHashValues ('#' : more) = '#' : map toLower before ++ lowerHashValues after where (before, after) = splitAt 6 more -lowerHashValues (c:cs) = c:lowerHashValues cs +lowerHashValues (c : cs) = c : lowerHashValues cs lowerHashValues [] = [] -prettyPrintSvg :: String -> IO String -prettyPrintSvg = fmap lowerHashValues . - readProcess "svgo" ["--input=-", "--output=-", "--pretty" - , "--enable=sortAttrs,convertColors" - , "--disable=cleanupIDs,prefixIds,convertTransform,mergePaths,collapseGroups" ] +-- prettyPrintSvg :: String -> IO String +-- prettyPrintSvg = +-- fmap lowerHashValues +-- . readProcess +-- "svgo" +-- [ "--input=-", +-- "--output=-", +-- "--pretty", +-- "--enable=sortAttrs,convertColors", +-- "--disable=cleanupIDs,prefixIds,convertTransform,mergePaths,collapseGroups" +-- ] -- Parse and print SVG with reanimate-svg library. cycleSvg :: String -> String -cycleSvg = - maybe "Failed to parse" ppDocument . parseSvgFile "input" . BS.pack +cycleSvg = + maybe "Failed to parse" ppDocument . parseSvgFile "input" . T.pack