nano-svg (empty) → 0.1.0.0

raw patch · 12 files changed

+2723/−0 lines, 12 filesdep +QuickCheckdep +basedep +bytestring

Dependencies added: QuickCheck, base, bytestring, containers, flatparse, hexml, nano-svg, primitive, tasty, tasty-hunit, tasty-quickcheck

Files

• CHANGELOG.md +5/−0
• LICENSE +20/−0
• README.md +68/−0
• lib/Graphics/NanoSvg.hs +331/−0
• lib/Graphics/NanoSvg/Color.hs +371/−0
• lib/Graphics/NanoSvg/Internal/Parser.hs +179/−0
• lib/Graphics/NanoSvg/Number.hs +262/−0
• lib/Graphics/NanoSvg/Path.hs +290/−0
• lib/Graphics/NanoSvg/Types.hs +362/−0
• lib/Graphics/NanoSvg/Xml.hs +185/−0
• nano-svg.cabal +94/−0
• test/Main.hs +556/−0

@@ -0,0 +1,5 @@+# Revision history for nano-svg
+
+## 0.1.0.0
+
+* First version.

@@ -0,0 +1,20 @@+Copyright (c) 2026 goolord
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be included
+in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

@@ -0,0 +1,68 @@+# nano-svg
+
+A fast SVG parser for Haskell. Bytes in, a flat array of shapes out.
+
+For geometry renderers, rasterizers and UI toolkits that need SVG icons and
+static vector artwork as paths. The library parses and normalizes geometry;
+the caller handles rendering and viewport mapping.
+
+## Quick start
+
+`parseSvg :: ByteString -> Either String Document` reads UTF-8 SVG directly
+from a strict `ByteString`—no text-decoding step needed.
+
+```haskell
+import Graphics.NanoSvg
+import qualified Data.ByteString as BS
+
+main :: IO ()
+main = do
+  bytes <- BS.readFile "clock.svg"
+  case parseSvg bytes of
+    Left err -> putStrLn err
+    Right doc -> print (documentSize doc, length (documentShapes doc))
+```
+
+A `Document` contains the viewport size, the `viewBox` and a `SmallArray` of
+`Shape`s in paint order. Each shape carries its path, the `Matrix` that maps
+it into the `viewBox`, and its resolved `Style`. Relative path commands,
+shorthands and basic shapes become a common set of absolute path segments.
+The renderer walks segments without resolving an SVG tree, style inheritance
+or a transform stack. It still tracks the current point and subpath start.
+
+## SVG scope
+
+Supports paths, rectangles, circles, ellipses, lines, polylines and polygons;
+groups and `use` references; fills, strokes and inline styles; and SVG
+transforms. The focus is the static geometry used in icons and vector assets.
+
+Not supported: gradients, patterns and other paint servers; `text`;
+`clipPath`, `mask` and `filter`; `marker`; CSS in a `style` element or an
+external sheet, and so `class` selectors; animation; and
+`preserveAspectRatio`, which is left to the renderer.
+
+Unknown elements are skipped along with their children. Group opacity is
+multiplied into each shape rather than preserved as a compositing group.
+Nested `svg` and referenced `symbol` elements do not establish viewports.
+
+## Modules
+
+The parsing modules can also be used independently for individual path,
+transform, color or length values.
+
+| Module | Purpose |
+| --- | --- |
+| `Graphics.NanoSvg` | `parseSvg`, and the types re-exported |
+| `Graphics.NanoSvg.Types` | the document model, on its own |
+| `Graphics.NanoSvg.Xml` | the tree, entity decoding, `DOCTYPE` and prefix stripping |
+| `Graphics.NanoSvg.Path` | path and transform parsing; basic shapes as segments |
+| `Graphics.NanoSvg.Color` | paints, colors, the keyword table |
+| `Graphics.NanoSvg.Number` | numbers, lengths, number and point lists |
+
+## Build
+
+```
+cabal build
+cabal test
+cabal haddock --open
+```

@@ -0,0 +1,331 @@+{-# LANGUAGE BangPatterns #-}
+
+-- |
+-- Module      : Graphics.NanoSvg
+-- Copyright   : (c) 2026 goolord
+-- License     : MIT
+--
+-- Read an SVG document into a flat array of shapes.
+-- For geometry renderers, rasterizers and UI toolkits drawing static SVGs.
+-- Shapes contain absolute path segments, a transform and a resolved style.
+-- Rendering and viewport mapping are left to the caller.
+--
+-- > import Graphics.NanoSvg
+-- > import qualified Data.ByteString as BS
+-- >
+-- > main :: IO ()
+-- > main = do
+-- >   bytes <- BS.readFile "clock.svg"
+-- >   case parseSvg bytes of
+-- >     Left err -> putStrLn err
+-- >     Right doc -> print (documentSize doc, length (documentShapes doc))
+--
+-- = Supported SVG
+--
+-- The elements @svg@, @g@, @a@, @switch@, @use@, @path@, @rect@, @circle@,
+-- @ellipse@, @line@, @polyline@ and @polygon@, with @use@ resolved against
+-- @defs@ and @symbol@ by @id@.
+--
+-- The presentation properties @fill@, @stroke@, @stroke-width@,
+-- @stroke-linecap@, @stroke-linejoin@, @stroke-miterlimit@, @fill-rule@,
+-- @opacity@, @fill-opacity@, @stroke-opacity@, @display@ and @visibility@,
+-- written either as attributes or in a @style@ attribute, which wins.
+--
+-- @transform@ in all six of its forms, colors in all of theirs (see
+-- "Graphics.NanoSvg.Color"), and lengths in absolute units (see
+-- "Graphics.NanoSvg.Number").
+--
+-- = Limitations
+--
+-- Gradients, patterns and other paint servers; @text@; @clipPath@, @mask@
+-- and @filter@; @marker@; CSS in a @style@ element or an external sheet,
+-- and so @class@ selectors; and animation are not supported.
+-- The renderer must handle @preserveAspectRatio@.
+--
+-- Unknown elements and their children are skipped. Group opacity is
+-- multiplied into each shape, not preserved as a compositing group.
+-- Nested @svg@ and referenced @symbol@ elements do not establish viewports.
+module Graphics.NanoSvg
+  ( -- * Parsing
+    parseSvg
+
+    -- * Documents
+  , Document (..)
+  , documentWidth
+  , documentHeight
+
+    -- * Shapes
+  , Shape (..)
+  , Segment (..)
+  , Style (..)
+  , defaultStyle
+
+    -- * Paint
+  , Paint (..)
+  , FillRule (..)
+  , LineCap (..)
+  , LineJoin (..)
+  , RGBA (..)
+  , rgba
+  , rgbaR
+  , rgbaG
+  , rgbaB
+  , rgbaA
+  , withAlpha
+  , black
+  , transparent
+
+    -- * Geometry
+  , Point (..)
+  , Box (..)
+  , Matrix (..)
+  , identity
+  , multiply
+  , transformPoint
+  , averageScale
+
+    -- * Standalone parsers
+    -- $pieces
+  )
+where
+
+import Data.Bits (xor)
+import Data.ByteString (ByteString)
+import Data.ByteString qualified as BS
+import Data.ByteString.Char8 qualified as BC
+import Data.List (find)
+import Data.Map.Strict (Map)
+import Data.Map.Strict qualified as Map
+import Data.Maybe (fromMaybe)
+import Data.Primitive.SmallArray (smallArrayFromList)
+import Data.Set (Set)
+import Data.Set qualified as Set
+import Data.Word (Word64)
+import Graphics.NanoSvg.Color (parsePaint)
+import Graphics.NanoSvg.Internal.Parser (clamp01, lowercase, strip)
+import Graphics.NanoSvg.Number (Length (..), Unit (..), parseLength, parseNumberList, parsePointList, parseUserUnits, toUserUnits)
+import Graphics.NanoSvg.Path
+import Graphics.NanoSvg.Types
+import Graphics.NanoSvg.Xml
+
+-- $pieces
+--
+-- These modules can be used independently:
+-- "Graphics.NanoSvg.Xml" for the tree, "Graphics.NanoSvg.Path" for @d@ and
+-- @transform@, "Graphics.NanoSvg.Color" for paints and
+-- "Graphics.NanoSvg.Number" for numbers and lengths.
+
+--------------------------------------------------------------------------------
+-- Parsing
+--------------------------------------------------------------------------------
+
+-- | Parse UTF-8 SVG bytes. Returns 'Left' on XML parse failure or when no
+-- top-level @svg@ element exists. Invalid attribute values are ignored;
+-- malformed paths retain the segments parsed before the error.
+--
+-- Accepts a UTF-8 byte-order mark and a DOCTYPE. No prior text decoding is
+-- needed. The resulting t'Document' contains values, not source-buffer slices.
+parseSvg :: ByteString -> Either String Document
+parseSvg src = do
+  elements <- parseXml src
+  root <- case find ((== "svg") . elementName) elements of
+    Just r -> Right r
+    Nothing -> Left "no svg element"
+  let (box, extent) = geometry root
+      shapes = smallArrayFromList (collect (identified root) Set.empty identity defaultStyle root)
+  pure
+    Document
+      { documentViewBox = box
+      , documentSize = extent
+      , documentShapes = shapes
+      , documentKey = hashBytes src
+      , documentMonochrome = all monochrome shapes
+      }
+
+-- | Resolve the root viewBox and output size. Missing dimensions use the
+-- viewBox extent; without a valid viewBox, each missing dimension is 24.
+geometry :: Element -> (Box, (Float, Float))
+geometry root = (box, (fromMaybe (boxW box) width, fromMaybe (boxH box) height))
+  where
+    side k = attribute k root >>= parseUserUnits
+    width = side "width"
+    height = side "height"
+    box = case maybe [] parseNumberList (attribute "viewBox" root) of
+      [x, y, w, h] | w > 0, h > 0 -> Box x y w h
+      -- Default to a 24-unit extent for each unresolved dimension.
+      _ -> Box 0 0 (fromMaybe 24 width) (fromMaybe 24 height)
+
+-- | Unspecified paints and @currentColor@ follow the caller's tint; one
+-- explicit color anywhere makes the drawing multicolored.
+monochrome :: Shape -> Bool
+monochrome sh = tintable (styleFill s) && tintable (styleStroke s)
+  where
+    s = shapeStyle sh
+    tintable = \case
+      Just (PaintColor _) -> False
+      _ -> True
+
+-- | FNV-1a over the source, for callers that cache what they draw.
+hashBytes :: ByteString -> Int
+hashBytes = fromIntegral . BS.foldl' step (0xcbf29ce484222325 :: Word64)
+  where
+    step !h !w = (h `xor` fromIntegral w) * 0x100000001b3
+
+--------------------------------------------------------------------------------
+-- The tree
+--------------------------------------------------------------------------------
+
+-- | Index all IDs, including those under @defs@. The first duplicate wins.
+identified :: Element -> Map ByteString Element
+identified root =
+  Map.fromListWith
+    (\_new old -> old)
+    [(i, el) | el <- descendants root, Just i <- [attribute "id" el]]
+
+-- | IDs currently being expanded by @use@. Tracking active IDs stops cycles
+-- before branching references can cause exponential expansion.
+type Open = Set ByteString
+
+-- | The shapes an element and its descendants draw, in paint order.
+collect ::
+  Map ByteString Element -> Open -> Matrix -> Style -> Element -> [Shape]
+collect defs open outer inherited el = case elementName el of
+  "svg" -> drawable descend
+  "g" -> drawable descend
+  "a" -> drawable descend
+  -- Conditional processing attributes are ignored: use the first child
+  -- that produces shapes.
+  "switch" ->
+    drawable (fromMaybe [] (find (not . null) (map into (elementChildren el))))
+  "use" -> drawable used
+  "path" -> shape (parsePath (value "d"))
+  "rect" ->
+    shape
+      ( rectSegments
+          (num "x")
+          (num "y")
+          (num "width")
+          (num "height")
+          (len "rx")
+          (len "ry")
+      )
+  "circle" -> shape (circleSegments (num "cx") (num "cy") (num "r"))
+  "ellipse" -> shape (ellipseSegments (num "cx") (num "cy") (num "rx") (num "ry"))
+  "line" -> shape (lineSegments (num "x1") (num "y1") (num "x2") (num "y2"))
+  "polyline" -> shape (polySegments False (parsePointList (value "points")))
+  "polygon" -> shape (polySegments True (parsePointList (value "points")))
+  -- Skip unsupported elements and their subtrees.
+  _ -> []
+  where
+    -- Inline styles follow presentation attributes so later declarations win.
+    properties =
+      [(attributeName a, attributeValue a) | a <- elementAttributes el]
+        <> styleProperties (value "style")
+
+    -- Check visibility before evaluating geometry.
+    drawable shapes = if hidden then [] else shapes
+    hidden = uncurry (||) (foldl' seen (False, False) properties)
+      where
+        -- Last one wins, so a later declaration can un-hide as well as hide.
+        seen acc@(off, invisible) (k, v) = case k of
+          "display" -> (keyword v == "none", invisible)
+          "visibility" -> (off, keyword v `elem` ["hidden", "collapse"])
+          _ -> acc
+        keyword = lowercase . strip
+
+    transform = maybe outer (multiply outer . parseTransform) (attribute "transform" el)
+
+    -- Resolve local opacity, then multiply by the ancestor product.
+    -- This approximates group opacity; overlapping shapes are not composited
+    -- as a group.
+    style = own {styleOpacity = styleOpacity inherited * styleOpacity own}
+      where
+        own = foldl' applyProperty inherited {styleOpacity = 1} properties
+
+    into = collect defs open transform style
+    descend = concatMap into (elementChildren el)
+    shape segs
+      | hidden = []
+      | null segs = []
+      | otherwise = [Shape (smallArrayFromList segs) transform style]
+
+    value k = fromMaybe "" (attribute k el)
+    len k = attribute k el >>= parseUserUnits
+    num k = fromMaybe 0 (len k)
+
+    -- Apply the use element's offset and style to its local reference.
+    -- For symbol/svg targets, expand only their children; target attributes
+    -- and viewport mapping are skipped.
+    used = case reference of
+      Nothing -> []
+      Just (key, target)
+        | key `Set.member` open -> [] -- Already drawing this one.
+        | elementName target `elem` ["symbol", "svg"] ->
+            concatMap (deeper key) (elementChildren target)
+        | otherwise -> deeper key target
+      where
+        reference = do
+          href <- attribute "href" el
+          key <- BS.stripPrefix "#" (strip href)
+          target <- Map.lookup key defs
+          pure (key, target)
+        deeper key =
+          collect
+            defs
+            (Set.insert key open)
+            (transform `multiply` translation (num "x") (num "y"))
+            style
+
+--------------------------------------------------------------------------------
+-- Presentation properties
+--------------------------------------------------------------------------------
+
+-- | Parse and clamp opacity to [0, 1]. Percentages are divided by 100;
+-- other accepted lengths use the same conversion as geometry attributes.
+opacityValue :: ByteString -> Maybe Float
+opacityValue v =
+  clamp01 <$> case parseLength v of
+    Just (Length x Percent) -> Just (x / 100)
+    Just l -> toUserUnits l
+    Nothing -> Nothing
+
+-- | Split inline declarations at semicolons and the first colon.
+-- Entries without a colon are dropped. This is not a full CSS parser.
+styleProperties :: ByteString -> [(ByteString, ByteString)]
+styleProperties =
+  concatMap declaration . BC.split ';'
+  where
+    declaration d = case BC.break (== ':') d of
+      (k, v)
+        | BS.null v -> []
+        | otherwise -> [(lowercase (strip k), strip (BS.drop 1 v))]
+
+-- | Apply a supported declaration. Invalid or unsupported values, including
+-- @inherit@ and @url()@ paints, leave the current style unchanged.
+applyProperty :: Style -> (ByteString, ByteString) -> Style
+applyProperty s (k, raw) = case k of
+  "opacity" -> maybe s (\o -> s {styleOpacity = o}) (opacityValue v)
+  "fill" -> maybe s (\p -> s {styleFill = Just p}) (parsePaint v)
+  "stroke" -> maybe s (\p -> s {styleStroke = Just p}) (parsePaint v)
+  "stroke-width" -> maybe s (\w -> s {styleStrokeWidth = max 0 w}) (parseUserUnits v)
+  "stroke-miterlimit" -> maybe s (\l -> s {styleMiterLimit = max 1 l}) (parseUserUnits v)
+  "fill-opacity" -> maybe s (\o -> s {styleFillOpacity = o}) (opacityValue v)
+  "stroke-opacity" -> maybe s (\o -> s {styleStrokeOpacity = o}) (opacityValue v)
+  "stroke-linecap" -> case keyword of
+    "butt" -> s {styleCap = CapButt}
+    "round" -> s {styleCap = CapRound}
+    "square" -> s {styleCap = CapSquare}
+    _ -> s
+  "stroke-linejoin" -> case keyword of
+    "miter" -> s {styleJoin = JoinMiter}
+    "round" -> s {styleJoin = JoinRound}
+    "bevel" -> s {styleJoin = JoinBevel}
+    _ -> s
+  "fill-rule" -> case keyword of
+    "nonzero" -> s {styleFillRule = NonZero}
+    "evenodd" -> s {styleFillRule = EvenOdd}
+    _ -> s
+  _ -> s
+  where
+    v = strip raw
+    keyword = lowercase v

@@ -0,0 +1,371 @@+-- |
+-- Module      : Graphics.NanoSvg.Color
+-- Copyright   : (c) 2026 goolord
+-- License     : MIT
+--
+-- Colors and paints.
+--
+-- Supports @none@, @transparent@ and @currentColor@; the
+-- hexadecimal forms @#rgb@, @#rgba@, @#rrggbb@ and @#rrggbbaa@; the
+-- functions @rgb()@, @rgba()@, @hsl()@ and @hsla()@, with their arguments
+-- separated by commas or by spaces and an alpha after a slash as CSS Color
+-- 4 writes them; and all 148 named CSS colors. Names are case-insensitive.
+-- Hue accepts degrees only, with an optional @deg@ suffix.
+--
+-- Paint servers (@url()@), @inherit@ and system colors are unsupported.
+-- 'parsePaint' and 'parseColor' return 'Nothing' for invalid or unsupported
+-- values and require the whole input, apart from surrounding whitespace.
+module Graphics.NanoSvg.Color
+  ( -- * Paints
+    paint
+  , parsePaint
+
+    -- * Colors
+  , color
+  , parseColor
+
+    -- * Named colors
+  , namedColor
+  , namedColors
+  )
+where
+
+import Data.ByteString (ByteString)
+import Data.ByteString qualified as BS
+import Data.Map.Strict (Map)
+import Data.Map.Strict qualified as Map
+import Data.Word (Word8)
+import FlatParse.Basic qualified as F
+import Graphics.NanoSvg.Internal.Parser
+import Graphics.NanoSvg.Number (number)
+import Graphics.NanoSvg.Types (Paint (..), RGBA, rgba)
+
+--------------------------------------------------------------------------------
+-- Paints
+--------------------------------------------------------------------------------
+
+-- | Parse a paint with optional surrounding whitespace. Both @none@ and
+-- @transparent@ become 'PaintNone'; @currentColor@ becomes 'PaintCurrent'.
+paint :: P Paint
+paint = skipWsp *> value <* skipWsp
+  where
+    value =
+      F.withOption
+        (skipSatisfyByte (== 0x23))
+        (const (PaintColor <$> hexColor))
+        (named keyword (fmap PaintColor . functional) (fmap PaintColor . namedColor))
+    keyword = \case
+      "none" -> Just PaintNone
+      "transparent" -> Just PaintNone
+      "currentcolor" -> Just PaintCurrent
+      _ -> Nothing
+
+-- | Parse a complete @fill@ or @stroke@ value. 'Nothing' lets the caller
+-- ignore the declaration and retain the previous paint.
+parsePaint :: ByteString -> Maybe Paint
+parsePaint src = evaluate src paint
+
+--------------------------------------------------------------------------------
+-- Colors
+--------------------------------------------------------------------------------
+
+-- | Parse a hex, RGB, HSL or named color without surrounding whitespace.
+-- Paint-only keywords (@none@, @transparent@, @currentColor@) are rejected.
+color :: P RGBA
+color =
+  F.withOption
+    (skipSatisfyByte (== 0x23))
+    (const hexColor)
+    (named (const Nothing) functional namedColor)
+
+-- | Read and lowercase a name, then dispatch to a keyword, function or table.
+named :: (ByteString -> Maybe a) -> (ByteString -> P a) -> (ByteString -> Maybe a) -> P a
+named keyword call table = do
+  name <- lowercase <$> takeWhileByte isAsciiAlpha
+  if BS.null name
+    then F.failed
+    else case keyword name of
+      Just a -> a <$ F.fails (skipSatisfyByte (== 0x28))
+      -- An opening parenthesis distinguishes functions from named colors.
+      Nothing ->
+        F.withOption
+          (skipSatisfyByte (== 0x28))
+          (const (call name))
+          (maybe F.failed pure (table name))
+
+-- | Parse a complete color with optional surrounding whitespace.
+-- Accepts the forms supported by 'color', not paint-only keywords.
+parseColor :: ByteString -> Maybe RGBA
+parseColor src = evaluate src (skipWsp *> color <* skipWsp)
+
+-- | The digits after a @#@: three, four, six or eight of them, the short
+-- forms doubling each digit so that @#f90@ is @#ff9900@.
+hexColor :: P RGBA
+hexColor = do
+  ds <- takeWhileByte isHexDigit
+  let at i = hexValue (BS.index ds i)
+      wide i = at (2 * i) * 16 + at (2 * i + 1)
+      short i = let v = at i in v * 16 + v
+  case BS.length ds of
+    3 -> pure (rgba (short 0) (short 1) (short 2) 0xFF)
+    4 -> pure (rgba (short 0) (short 1) (short 2) (short 3))
+    6 -> pure (rgba (wide 0) (wide 1) (wide 2) 0xFF)
+    8 -> pure (rgba (wide 0) (wide 1) (wide 2) (wide 3))
+    _ -> F.failed
+
+-- | Parse a color function after its name and opening parenthesis.
+functional :: ByteString -> P RGBA
+functional name = do
+  c <- case name of
+    "rgb" -> rgbBody
+    "rgba" -> rgbBody
+    "hsl" -> hslBody
+    "hsla" -> hslBody
+    _ -> F.failed
+  skipWsp
+  skipSatisfyByte (== 0x29)
+  pure c
+
+rgbBody :: P RGBA
+rgbBody = do
+  skipWsp
+  r <- channel
+  argSep
+  g <- channel
+  argSep
+  b <- channel
+  a <- opacity
+  pure (rgba r g b a)
+
+hslBody :: P RGBA
+hslBody = do
+  skipWsp
+  h <- hue
+  argSep
+  s <- percentage
+  argSep
+  l <- percentage
+  a <- opacity
+  let (r, g, b) = hslToRgb h s l
+  pure (rgba r g b a)
+
+-- | A number, scaled if a @%@ follows it: @full@ is what @100%@ stands for.
+scaled :: Float -> P Float
+scaled full = do
+  x <- number
+  F.withOption (skipSatisfyByte (== 0x25)) (const (pure (x * full / 100))) (pure x)
+
+-- | One of @r@, @g@ or @b@: a number out of 255, or a percentage.
+channel :: P Word8
+channel = round8 <$> scaled 255
+
+-- | Hue in degrees, optionally followed by @deg@.
+hue :: P Float
+hue = number <* F.optional_ (F.byteString "deg")
+
+-- | Percentage converted to [0, 1]. Also accepts a bare number as a percentage.
+percentage :: P Float
+percentage = do
+  x <- number
+  F.optional_ (skipSatisfyByte (== 0x25))
+  pure (clamp01 (x / 100))
+
+-- | The alpha argument, if there is one. It may be introduced by a comma,
+-- as @rgba()@ writes it, or by a slash, as CSS Color 4 does.
+opacity :: P Word8
+opacity = (argSep *> alpha) F.<|> pure 0xFF
+  where
+    alpha = round8 . (255 *) . clamp01 <$> scaled 1
+
+-- | Whitespace, at most one comma or slash, whitespace.
+argSep :: P ()
+argSep = do
+  skipWsp
+  F.optional_ (skipSatisfyByte (\w -> w == 0x2C || w == 0x2F))
+  skipWsp
+
+--------------------------------------------------------------------------------
+-- Named colors
+--------------------------------------------------------------------------------
+
+-- | Look up one of the CSS color keywords. The name must already be
+-- lowercase.
+namedColor :: ByteString -> Maybe RGBA
+namedColor name = Map.lookup name namedColorMap
+
+namedColorMap :: Map ByteString RGBA
+namedColorMap = Map.fromList namedColors
+{-# NOINLINE namedColorMap #-}
+
+--------------------------------------------------------------------------------
+-- Conversions
+--------------------------------------------------------------------------------
+
+-- | CSS Color 3's conversion, with hue wrapped into a turn and saturation
+-- and lightness already clamped.
+hslToRgb :: Float -> Float -> Float -> (Word8, Word8, Word8)
+hslToRgb h s l = (round8 (255 * f 0), round8 (255 * f 8), round8 (255 * f 4))
+  where
+    h' = h / 30
+    a = s * min l (1 - l)
+    f n =
+      let k = wrap12 (n + h')
+       in l - a * max (-1) (min 1 (min (k - 3) (9 - k)))
+    wrap12 x = x - 12 * fromIntegral (floor (x / 12) :: Int)
+
+{-# INLINE round8 #-}
+round8 :: Float -> Word8
+round8 x = fromIntegral (max 0 (min 255 (round x :: Int)))
+
+-- | The 148 named CSS colors, sorted by lowercase name. Excludes paint keywords.
+namedColors :: [(ByteString, RGBA)]
+namedColors =
+  [ ("aliceblue", rgba 0xf0 0xf8 0xff 0xFF)
+  , ("antiquewhite", rgba 0xfa 0xeb 0xd7 0xFF)
+  , ("aqua", rgba 0x00 0xff 0xff 0xFF)
+  , ("aquamarine", rgba 0x7f 0xff 0xd4 0xFF)
+  , ("azure", rgba 0xf0 0xff 0xff 0xFF)
+  , ("beige", rgba 0xf5 0xf5 0xdc 0xFF)
+  , ("bisque", rgba 0xff 0xe4 0xc4 0xFF)
+  , ("black", rgba 0x00 0x00 0x00 0xFF)
+  , ("blanchedalmond", rgba 0xff 0xeb 0xcd 0xFF)
+  , ("blue", rgba 0x00 0x00 0xff 0xFF)
+  , ("blueviolet", rgba 0x8a 0x2b 0xe2 0xFF)
+  , ("brown", rgba 0xa5 0x2a 0x2a 0xFF)
+  , ("burlywood", rgba 0xde 0xb8 0x87 0xFF)
+  , ("cadetblue", rgba 0x5f 0x9e 0xa0 0xFF)
+  , ("chartreuse", rgba 0x7f 0xff 0x00 0xFF)
+  , ("chocolate", rgba 0xd2 0x69 0x1e 0xFF)
+  , ("coral", rgba 0xff 0x7f 0x50 0xFF)
+  , ("cornflowerblue", rgba 0x64 0x95 0xed 0xFF)
+  , ("cornsilk", rgba 0xff 0xf8 0xdc 0xFF)
+  , ("crimson", rgba 0xdc 0x14 0x3c 0xFF)
+  , ("cyan", rgba 0x00 0xff 0xff 0xFF)
+  , ("darkblue", rgba 0x00 0x00 0x8b 0xFF)
+  , ("darkcyan", rgba 0x00 0x8b 0x8b 0xFF)
+  , ("darkgoldenrod", rgba 0xb8 0x86 0x0b 0xFF)
+  , ("darkgray", rgba 0xa9 0xa9 0xa9 0xFF)
+  , ("darkgreen", rgba 0x00 0x64 0x00 0xFF)
+  , ("darkgrey", rgba 0xa9 0xa9 0xa9 0xFF)
+  , ("darkkhaki", rgba 0xbd 0xb7 0x6b 0xFF)
+  , ("darkmagenta", rgba 0x8b 0x00 0x8b 0xFF)
+  , ("darkolivegreen", rgba 0x55 0x6b 0x2f 0xFF)
+  , ("darkorange", rgba 0xff 0x8c 0x00 0xFF)
+  , ("darkorchid", rgba 0x99 0x32 0xcc 0xFF)
+  , ("darkred", rgba 0x8b 0x00 0x00 0xFF)
+  , ("darksalmon", rgba 0xe9 0x96 0x7a 0xFF)
+  , ("darkseagreen", rgba 0x8f 0xbc 0x8f 0xFF)
+  , ("darkslateblue", rgba 0x48 0x3d 0x8b 0xFF)
+  , ("darkslategray", rgba 0x2f 0x4f 0x4f 0xFF)
+  , ("darkslategrey", rgba 0x2f 0x4f 0x4f 0xFF)
+  , ("darkturquoise", rgba 0x00 0xce 0xd1 0xFF)
+  , ("darkviolet", rgba 0x94 0x00 0xd3 0xFF)
+  , ("deeppink", rgba 0xff 0x14 0x93 0xFF)
+  , ("deepskyblue", rgba 0x00 0xbf 0xff 0xFF)
+  , ("dimgray", rgba 0x69 0x69 0x69 0xFF)
+  , ("dimgrey", rgba 0x69 0x69 0x69 0xFF)
+  , ("dodgerblue", rgba 0x1e 0x90 0xff 0xFF)
+  , ("firebrick", rgba 0xb2 0x22 0x22 0xFF)
+  , ("floralwhite", rgba 0xff 0xfa 0xf0 0xFF)
+  , ("forestgreen", rgba 0x22 0x8b 0x22 0xFF)
+  , ("fuchsia", rgba 0xff 0x00 0xff 0xFF)
+  , ("gainsboro", rgba 0xdc 0xdc 0xdc 0xFF)
+  , ("ghostwhite", rgba 0xf8 0xf8 0xff 0xFF)
+  , ("gold", rgba 0xff 0xd7 0x00 0xFF)
+  , ("goldenrod", rgba 0xda 0xa5 0x20 0xFF)
+  , ("gray", rgba 0x80 0x80 0x80 0xFF)
+  , ("green", rgba 0x00 0x80 0x00 0xFF)
+  , ("greenyellow", rgba 0xad 0xff 0x2f 0xFF)
+  , ("grey", rgba 0x80 0x80 0x80 0xFF)
+  , ("honeydew", rgba 0xf0 0xff 0xf0 0xFF)
+  , ("hotpink", rgba 0xff 0x69 0xb4 0xFF)
+  , ("indianred", rgba 0xcd 0x5c 0x5c 0xFF)
+  , ("indigo", rgba 0x4b 0x00 0x82 0xFF)
+  , ("ivory", rgba 0xff 0xff 0xf0 0xFF)
+  , ("khaki", rgba 0xf0 0xe6 0x8c 0xFF)
+  , ("lavender", rgba 0xe6 0xe6 0xfa 0xFF)
+  , ("lavenderblush", rgba 0xff 0xf0 0xf5 0xFF)
+  , ("lawngreen", rgba 0x7c 0xfc 0x00 0xFF)
+  , ("lemonchiffon", rgba 0xff 0xfa 0xcd 0xFF)
+  , ("lightblue", rgba 0xad 0xd8 0xe6 0xFF)
+  , ("lightcoral", rgba 0xf0 0x80 0x80 0xFF)
+  , ("lightcyan", rgba 0xe0 0xff 0xff 0xFF)
+  , ("lightgoldenrodyellow", rgba 0xfa 0xfa 0xd2 0xFF)
+  , ("lightgray", rgba 0xd3 0xd3 0xd3 0xFF)
+  , ("lightgreen", rgba 0x90 0xee 0x90 0xFF)
+  , ("lightgrey", rgba 0xd3 0xd3 0xd3 0xFF)
+  , ("lightpink", rgba 0xff 0xb6 0xc1 0xFF)
+  , ("lightsalmon", rgba 0xff 0xa0 0x7a 0xFF)
+  , ("lightseagreen", rgba 0x20 0xb2 0xaa 0xFF)
+  , ("lightskyblue", rgba 0x87 0xce 0xfa 0xFF)
+  , ("lightslategray", rgba 0x77 0x88 0x99 0xFF)
+  , ("lightslategrey", rgba 0x77 0x88 0x99 0xFF)
+  , ("lightsteelblue", rgba 0xb0 0xc4 0xde 0xFF)
+  , ("lightyellow", rgba 0xff 0xff 0xe0 0xFF)
+  , ("lime", rgba 0x00 0xff 0x00 0xFF)
+  , ("limegreen", rgba 0x32 0xcd 0x32 0xFF)
+  , ("linen", rgba 0xfa 0xf0 0xe6 0xFF)
+  , ("magenta", rgba 0xff 0x00 0xff 0xFF)
+  , ("maroon", rgba 0x80 0x00 0x00 0xFF)
+  , ("mediumaquamarine", rgba 0x66 0xcd 0xaa 0xFF)
+  , ("mediumblue", rgba 0x00 0x00 0xcd 0xFF)
+  , ("mediumorchid", rgba 0xba 0x55 0xd3 0xFF)
+  , ("mediumpurple", rgba 0x93 0x70 0xdb 0xFF)
+  , ("mediumseagreen", rgba 0x3c 0xb3 0x71 0xFF)
+  , ("mediumslateblue", rgba 0x7b 0x68 0xee 0xFF)
+  , ("mediumspringgreen", rgba 0x00 0xfa 0x9a 0xFF)
+  , ("mediumturquoise", rgba 0x48 0xd1 0xcc 0xFF)
+  , ("mediumvioletred", rgba 0xc7 0x15 0x85 0xFF)
+  , ("midnightblue", rgba 0x19 0x19 0x70 0xFF)
+  , ("mintcream", rgba 0xf5 0xff 0xfa 0xFF)
+  , ("mistyrose", rgba 0xff 0xe4 0xe1 0xFF)
+  , ("moccasin", rgba 0xff 0xe4 0xb5 0xFF)
+  , ("navajowhite", rgba 0xff 0xde 0xad 0xFF)
+  , ("navy", rgba 0x00 0x00 0x80 0xFF)
+  , ("oldlace", rgba 0xfd 0xf5 0xe6 0xFF)
+  , ("olive", rgba 0x80 0x80 0x00 0xFF)
+  , ("olivedrab", rgba 0x6b 0x8e 0x23 0xFF)
+  , ("orange", rgba 0xff 0xa5 0x00 0xFF)
+  , ("orangered", rgba 0xff 0x45 0x00 0xFF)
+  , ("orchid", rgba 0xda 0x70 0xd6 0xFF)
+  , ("palegoldenrod", rgba 0xee 0xe8 0xaa 0xFF)
+  , ("palegreen", rgba 0x98 0xfb 0x98 0xFF)
+  , ("paleturquoise", rgba 0xaf 0xee 0xee 0xFF)
+  , ("palevioletred", rgba 0xdb 0x70 0x93 0xFF)
+  , ("papayawhip", rgba 0xff 0xef 0xd5 0xFF)
+  , ("peachpuff", rgba 0xff 0xda 0xb9 0xFF)
+  , ("peru", rgba 0xcd 0x85 0x3f 0xFF)
+  , ("pink", rgba 0xff 0xc0 0xcb 0xFF)
+  , ("plum", rgba 0xdd 0xa0 0xdd 0xFF)
+  , ("powderblue", rgba 0xb0 0xe0 0xe6 0xFF)
+  , ("purple", rgba 0x80 0x00 0x80 0xFF)
+  , ("rebeccapurple", rgba 0x66 0x33 0x99 0xFF)
+  , ("red", rgba 0xff 0x00 0x00 0xFF)
+  , ("rosybrown", rgba 0xbc 0x8f 0x8f 0xFF)
+  , ("royalblue", rgba 0x41 0x69 0xe1 0xFF)
+  , ("saddlebrown", rgba 0x8b 0x45 0x13 0xFF)
+  , ("salmon", rgba 0xfa 0x80 0x72 0xFF)
+  , ("sandybrown", rgba 0xf4 0xa4 0x60 0xFF)
+  , ("seagreen", rgba 0x2e 0x8b 0x57 0xFF)
+  , ("seashell", rgba 0xff 0xf5 0xee 0xFF)
+  , ("sienna", rgba 0xa0 0x52 0x2d 0xFF)
+  , ("silver", rgba 0xc0 0xc0 0xc0 0xFF)
+  , ("skyblue", rgba 0x87 0xce 0xeb 0xFF)
+  , ("slateblue", rgba 0x6a 0x5a 0xcd 0xFF)
+  , ("slategray", rgba 0x70 0x80 0x90 0xFF)
+  , ("slategrey", rgba 0x70 0x80 0x90 0xFF)
+  , ("snow", rgba 0xff 0xfa 0xfa 0xFF)
+  , ("springgreen", rgba 0x00 0xff 0x7f 0xFF)
+  , ("steelblue", rgba 0x46 0x82 0xb4 0xFF)
+  , ("tan", rgba 0xd2 0xb4 0x8c 0xFF)
+  , ("teal", rgba 0x00 0x80 0x80 0xFF)
+  , ("thistle", rgba 0xd8 0xbf 0xd8 0xFF)
+  , ("tomato", rgba 0xff 0x63 0x47 0xFF)
+  , ("turquoise", rgba 0x40 0xe0 0xd0 0xFF)
+  , ("violet", rgba 0xee 0x82 0xee 0xFF)
+  , ("wheat", rgba 0xf5 0xde 0xb3 0xFF)
+  , ("white", rgba 0xff 0xff 0xff 0xFF)
+  , ("whitesmoke", rgba 0xf5 0xf5 0xf5 0xFF)
+  , ("yellow", rgba 0xff 0xff 0x00 0xFF)
+  , ("yellowgreen", rgba 0x9a 0xcd 0x32 0xFF)
+  ]

@@ -0,0 +1,179 @@+-- |
+-- Module      : Graphics.NanoSvg.Internal.Parser
+-- Copyright   : (c) 2026 goolord
+-- License     : MIT
+--
+-- Shared @flatparse@ type, byte combinators and attribute parser runners.
+--
+-- Parsers carry no error messages. Callers choose whole-input validation
+-- with 'evaluate' or prefix parsing with 'runPartial'.
+--
+-- Exposed because public parser signatures use 'P'; this module's API is
+-- not stable.
+module Graphics.NanoSvg.Internal.Parser
+  ( -- * Parsers
+    P
+
+    -- * Running
+  , evaluate
+  , runPartial
+
+    -- * Bytes
+  , satisfyByte
+  , skipSatisfyByte
+  , skipWhileByte
+  , takeWhileByte
+  , peekByte
+
+    -- * Character classes
+  , isWsp
+  , isDigitByte
+  , isHexDigit
+  , isAsciiAlpha
+  , hexValue
+  , lower
+  , lowercase
+
+    -- * Whitespace
+  , skipWsp
+  , skipWspComma
+  , strip
+
+    -- * Numbers
+  , clamp01
+  )
+where
+
+import Data.Bits ((.|.))
+import Data.ByteString (ByteString)
+import Data.ByteString qualified as BS
+import Data.Word (Word8)
+import FlatParse.Basic qualified as F
+
+--------------------------------------------------------------------------------
+-- Types
+--------------------------------------------------------------------------------
+
+-- | Pure byte parser without diagnostic errors.
+type P = F.Parser ()
+
+--------------------------------------------------------------------------------
+-- Running
+--------------------------------------------------------------------------------
+
+-- | Run a parser, requiring complete input consumption. Returns 'Nothing'
+-- on failure or leftover input. Does not skip whitespace automatically.
+evaluate :: ByteString -> P a -> Maybe a
+evaluate src p = case F.runParser (p <* F.eof) src of
+  F.OK a _ -> Just a
+  _ -> Nothing
+{-# INLINE evaluate #-}
+
+-- | Run a parser and return its value and unconsumed input.
+-- Returns 'Nothing' on failure.
+runPartial :: ByteString -> P a -> Maybe (a, ByteString)
+runPartial src p = case F.runParser p src of
+  F.OK a rest -> Just (a, rest)
+  _ -> Nothing
+{-# INLINE runPartial #-}
+
+--------------------------------------------------------------------------------
+-- Bytes
+--------------------------------------------------------------------------------
+
+-- | One byte matching a predicate.
+satisfyByte :: (Word8 -> Bool) -> P Word8
+satisfyByte f = F.withAnyWord8 \w -> if f w then pure w else F.failed
+{-# INLINE satisfyByte #-}
+
+-- | One byte matching a predicate, discarded.
+skipSatisfyByte :: (Word8 -> Bool) -> P ()
+skipSatisfyByte f = F.withAnyWord8 \w -> if f w then pure () else F.failed
+{-# INLINE skipSatisfyByte #-}
+
+-- | Skip zero or more consecutive bytes matching a predicate.
+skipWhileByte :: (Word8 -> Bool) -> P ()
+skipWhileByte f = F.skipMany (skipSatisfyByte f)
+{-# INLINE skipWhileByte #-}
+
+-- | Read zero or more matching bytes as a slice sharing the input buffer.
+takeWhileByte :: (Word8 -> Bool) -> P ByteString
+takeWhileByte f = F.byteStringOf (skipWhileByte f)
+{-# INLINE takeWhileByte #-}
+
+-- | The next byte without consuming it, or 'Nothing' at the end of input.
+peekByte :: P (Maybe Word8)
+peekByte = F.lookahead (F.optional F.anyWord8)
+{-# INLINE peekByte #-}
+
+--------------------------------------------------------------------------------
+-- Character classes
+--------------------------------------------------------------------------------
+
+-- | Accepted whitespace: space, tab, line feed, carriage return or form feed.
+{-# INLINE isWsp #-}
+isWsp :: Word8 -> Bool
+isWsp w = w == 0x20 || w == 0x09 || w == 0x0A || w == 0x0D || w == 0x0C
+
+-- | An ASCII digit.
+{-# INLINE isDigitByte #-}
+isDigitByte :: Word8 -> Bool
+isDigitByte w = w >= 0x30 && w <= 0x39
+
+-- | A hexadecimal digit, in either case.
+{-# INLINE isHexDigit #-}
+isHexDigit :: Word8 -> Bool
+isHexDigit w =
+  isDigitByte w || (w >= 0x41 && w <= 0x46) || (w >= 0x61 && w <= 0x66)
+
+-- | An ASCII letter.
+{-# INLINE isAsciiAlpha #-}
+isAsciiAlpha :: Word8 -> Bool
+isAsciiAlpha w = (w >= 0x41 && w <= 0x5A) || (w >= 0x61 && w <= 0x7A)
+
+-- | Numeric value of a hex digit. Requires 'isHexDigit'; other inputs give
+-- unspecified results.
+{-# INLINE hexValue #-}
+hexValue :: Word8 -> Word8
+hexValue w
+  | isDigitByte w = w - 0x30
+  | otherwise = lower w - 0x61 + 10
+
+-- | Lowercase an ASCII letter; leave other bytes unchanged.
+{-# INLINE lower #-}
+lower :: Word8 -> Word8
+lower w = if w >= 0x41 && w <= 0x5A then w .|. 0x20 else w
+
+-- | ASCII lowercase. Returns the original buffer if no uppercase letters
+-- occur; otherwise copies it. Intended for case-insensitive names.
+lowercase :: ByteString -> ByteString
+lowercase s
+  | BS.all (\w -> w < 0x41 || w > 0x5A) s = s
+  | otherwise = BS.map lower s
+
+--------------------------------------------------------------------------------
+-- Whitespace
+--------------------------------------------------------------------------------
+
+-- | Skip whitespace.
+skipWsp :: P ()
+skipWsp = skipWhileByte isWsp
+{-# INLINE skipWsp #-}
+
+-- | Skip any sequence of whitespace and commas, including repeated commas.
+skipWspComma :: P ()
+skipWspComma = skipWhileByte \w -> isWsp w || w == 0x2C
+{-# INLINE skipWspComma #-}
+
+-- | Drop the whitespace either side of a value.
+strip :: ByteString -> ByteString
+strip = BS.dropWhile isWsp . BS.dropWhileEnd isWsp
+
+--------------------------------------------------------------------------------
+-- Numbers
+--------------------------------------------------------------------------------
+
+-- | Clamp to [0, 1].
+{-# INLINE clamp01 #-}
+clamp01 :: Float -> Float
+clamp01 = max 0 . min 1

@@ -0,0 +1,262 @@+{-# LANGUAGE BangPatterns #-}
+
+-- |
+-- Module      : Graphics.NanoSvg.Number
+-- Copyright   : (c) 2026 goolord
+-- License     : MIT
+--
+-- Parse SVG numbers, lengths and coordinate lists.
+--
+-- Numbers accept an optional sign, decimal point and exponent, including
+-- @.5@, @1.@, @1e3@ and @-.5E-3@. Nonfinite results are rejected.
+--
+-- Absolute lengths convert at 96 user units per inch. Relative units
+-- (@%@, @em@, @ex@) are parsed but 'toUserUnits' returns 'Nothing' for them.
+module Graphics.NanoSvg.Number
+  ( -- * Numbers
+    number
+  , parseNumber
+
+    -- * Lengths
+  , Unit (..)
+  , Length (..)
+  , length_
+  , parseLength
+  , toUserUnits
+  , parseUserUnits
+
+    -- * Lists
+  , numberList
+  , parseNumberList
+  , coordinatePair
+  , pointList
+  , parsePointList
+
+    -- * Flags
+  , flag
+  )
+where
+
+import Data.ByteString (ByteString)
+import Data.Primitive.PrimArray (PrimArray, indexPrimArray, primArrayFromList)
+import FlatParse.Basic qualified as F
+import GHC.Float (double2Float)
+import Graphics.NanoSvg.Internal.Parser
+import Graphics.NanoSvg.Types (Point (..))
+
+--------------------------------------------------------------------------------
+-- Numbers
+--------------------------------------------------------------------------------
+
+-- | Parse one finite SVG number without leading whitespace.
+-- An incomplete exponent is left unconsumed; underflow may produce zero.
+number :: P Float
+number = do
+  negative <- sign
+  -- The integer part, then the fraction. Either may be empty, but not both.
+  whole <- digits False (Acc 0 0 0)
+  Acc m n e <- (dot *> digits True whole) F.<|> pure whole
+  if n == 0
+    then F.failed
+    else do
+      -- An @e@ with no digits after it belongs to whatever follows, as in
+      -- the @1ex@ of a length, so the exponent backtracks as a whole.
+      e' <- (exponentMark *> exponentValue) F.<|> pure 0
+      let !x = assemble negative m (e + e')
+      -- Reject overflow and NaN, including 0e400 (zero times infinity).
+      if isNaN x || isInfinite x then F.failed else pure x
+  where
+    dot = skipSatisfyByte (== 0x2E)
+    exponentMark = skipSatisfyByte (\w -> w == 0x65 || w == 0x45)
+
+-- | Mantissa, digit count and decimal exponent.
+data Acc = Acc {-# UNPACK #-} !Word {-# UNPACK #-} !Int {-# UNPACK #-} !Int
+
+-- | Accumulate digits up to 'mantissaLimit'. Further integer digits increase
+-- the exponent; further fractional digits are discarded.
+{-# INLINE digits #-}
+digits :: Bool -> Acc -> P Acc
+digits !fractional = go
+  where
+    go acc@(Acc m n e) =
+      F.withOption
+        (satisfyByte isDigitByte)
+        ( \w ->
+            let !d = fromIntegral (w - 0x30)
+             in go
+                  if m < mantissaLimit
+                    then Acc (m * 10 + d) (n + 1) (if fractional then e - 1 else e)
+                    else Acc m (n + 1) (if fractional then e else e + 1)
+        )
+        (pure acc)
+
+-- | Mantissa accumulation limit, retaining more precision than 'Float' needs.
+mantissaLimit :: Word
+mantissaLimit = 100000000000000000
+
+-- | A leading @-@ or @+@, and whether it was a minus.
+sign :: P Bool
+sign =
+  F.withOption
+    (satisfyByte (\w -> w == 0x2D || w == 0x2B))
+    (\w -> pure (w == 0x2D))
+    (pure False)
+{-# INLINE sign #-}
+
+-- | The digits of an exponent, with their sign. An @e@ with nothing usable
+-- after it is not an exponent, and the number ends before it.
+exponentValue :: P Int
+exponentValue = do
+  negative <- sign
+  Acc m n _ <- digits False (Acc 0 0 0)
+  if n == 0
+    then F.failed
+    else pure $! (if negative then negate else id) (fromIntegral (min 10000 m))
+
+-- | Scale in 'Double', then narrow to 'Float'. 'number' rejects nonfinite
+-- results from either step.
+assemble :: Bool -> Word -> Int -> Float
+assemble negative m e = double2Float (if negative then negate d else d)
+  where
+    d = fromIntegral m * powerOfTen e :: Double
+
+powerOfTen :: Int -> Double
+powerOfTen e
+  | e >= 0, e <= 22 = indexPrimArray tenTable e
+  | e < 0, e >= -22 = 1 / indexPrimArray tenTable (negate e)
+  | otherwise = 10 ** fromIntegral e
+
+-- | @10 ^ k@ for @k@ up to 22, the largest power of ten a 'Double' holds
+-- exactly.
+tenTable :: PrimArray Double
+tenTable = primArrayFromList [10 ^ k | k <- [0 :: Int .. 22]]
+{-# NOINLINE tenTable #-}
+
+-- | Parse one complete number with optional surrounding whitespace.
+-- Returns 'Nothing' for invalid input, trailing content or nonfinite results.
+parseNumber :: ByteString -> Maybe Float
+parseNumber src = evaluate src (skipWsp *> number <* skipWsp)
+
+--------------------------------------------------------------------------------
+-- Lengths
+--------------------------------------------------------------------------------
+
+-- | The unit a length was written in.
+data Unit
+  = -- | No unit: already user units.
+    UserSpace
+  | -- | @px@, which SVG defines as one user unit.
+    Px
+  | -- | @pt@: 1\/72 inch.
+    Pt
+  | -- | @pc@: 1\/6 inch.
+    Pc
+  | -- | @in@.
+    Inch
+  | -- | @cm@.
+    Cm
+  | -- | @mm@.
+    Mm
+  | -- | @em@: relative to the font size.
+    Em
+  | -- | @ex@: relative to the x-height.
+    Ex
+  | -- | @%@: relative to the viewport.
+    Percent
+  deriving (Eq, Show)
+
+-- | A number and its unit.
+data Length = Length {-# UNPACK #-} !Float !Unit
+  deriving (Eq, Show)
+
+-- | Parse a number and optional unit without leading whitespace.
+-- Unit suffixes are case-insensitive and must immediately follow the number.
+length_ :: P Length
+length_ = Length <$> number <*> (unit F.<|> pure UserSpace)
+  where
+    unit =
+      F.withAnyWord8 \a -> case a of
+        0x25 -> pure Percent
+        _ ->
+          F.withAnyWord8 \b -> case (lower a, lower b) of
+            (0x70, 0x78) -> pure Px -- px
+            (0x70, 0x74) -> pure Pt -- pt
+            (0x70, 0x63) -> pure Pc -- pc
+            (0x69, 0x6E) -> pure Inch -- in
+            (0x63, 0x6D) -> pure Cm -- cm
+            (0x6D, 0x6D) -> pure Mm -- mm
+            (0x65, 0x6D) -> pure Em -- em
+            (0x65, 0x78) -> pure Ex -- ex
+            _ -> F.failed
+
+-- | Parse one complete length with optional surrounding whitespace.
+-- Unknown units or trailing content return 'Nothing'.
+parseLength :: ByteString -> Maybe Length
+parseLength src = evaluate src (skipWsp *> length_ <* skipWsp)
+
+-- | Convert at 96 user units per inch. Returns 'Nothing' for 'Em', 'Ex' and
+-- 'Percent', which require font or viewport context.
+toUserUnits :: Length -> Maybe Float
+toUserUnits (Length x u) = case u of
+  UserSpace -> Just x
+  Px -> Just x
+  Pt -> Just (x * 96 / 72)
+  Pc -> Just (x * 16)
+  Inch -> Just (x * 96)
+  Cm -> Just (x * 96 / 2.54)
+  Mm -> Just (x * 96 / 25.4)
+  Em -> Nothing
+  Ex -> Nothing
+  Percent -> Nothing
+
+-- | 'parseLength' followed by 'toUserUnits'.
+parseUserUnits :: ByteString -> Maybe Float
+parseUserUnits src = parseLength src >>= toUserUnits
+
+--------------------------------------------------------------------------------
+-- Lists
+--------------------------------------------------------------------------------
+
+-- | Numbers separated by whitespace and commas, stopping at the first thing
+-- that is not a number.
+numberList :: P [Float]
+numberList = skipWspComma *> go
+  where
+    go = F.withOption number (\x -> (x :) <$> (skipWspComma *> go)) (pure [])
+
+-- | Parse the initial number list, ignoring any malformed tail.
+-- Returns @[]@ if no number can be read.
+parseNumberList :: ByteString -> [Float]
+parseNumberList src = maybe [] fst (runPartial src numberList)
+
+-- | Two numbers, which may be separated by a comma, whitespace, or in the
+-- case of @1-2@ or @1.5.5@ by nothing at all.
+coordinatePair :: P Point
+coordinatePair = do
+  x <- number
+  skipWspComma
+  y <- number
+  pure (Point x y)
+{-# INLINE coordinatePair #-}
+
+-- | Parse coordinate pairs separated by whitespace or commas.
+-- Stops before an incomplete pair or malformed tail.
+pointList :: P [Point]
+pointList = skipWspComma *> go
+  where
+    go = F.withOption coordinatePair (\p -> (p :) <$> (skipWspComma *> go)) (pure [])
+
+-- | Parse a @points@ attribute. Keeps complete pairs before a malformed tail
+-- and drops an unmatched final coordinate.
+parsePointList :: ByteString -> [Point]
+parsePointList src = maybe [] fst (runPartial src pointList)
+
+--------------------------------------------------------------------------------
+-- Flags
+--------------------------------------------------------------------------------
+
+-- | An arc flag: a single @0@ or @1@, which may run straight into the
+-- number after it, as in @a1 1 0 00.5.5@.
+flag :: P Bool
+flag = satisfyByte (\w -> w == 0x30 || w == 0x31) >>= \w -> pure (w == 0x31)
+{-# INLINE flag #-}

@@ -0,0 +1,290 @@+{-# LANGUAGE BangPatterns #-}
+
+-- |
+-- Module      : Graphics.NanoSvg.Path
+-- Copyright   : (c) 2026 goolord
+-- License     : MIT
+--
+-- Parse path data and transforms, and convert basic SVG shapes to paths.
+--
+-- Paths use absolute 'Segment's. Parsing resolves relative coordinates,
+-- @H@, @V@, @S@, @T@ and implicit command repetition. Renderers still track
+-- the current point and subpath start; transforms are returned separately.
+--
+-- Malformed path data retains the complete segments before the error.
+module Graphics.NanoSvg.Path
+  ( -- * Path data
+    pathData
+  , parsePath
+
+    -- * Transforms
+  , transformList
+  , parseTransform
+
+    -- * The shape elements
+  , rectSegments
+  , circleSegments
+  , ellipseSegments
+  , lineSegments
+  , polySegments
+  )
+where
+
+import Control.Applicative ((<|>))
+import Data.ByteString (ByteString)
+import Data.Maybe (fromMaybe)
+import Data.Word (Word8)
+import FlatParse.Basic qualified as F
+import Graphics.NanoSvg.Internal.Parser
+import Graphics.NanoSvg.Number (coordinatePair, flag, number, numberList)
+import Graphics.NanoSvg.Types
+
+--------------------------------------------------------------------------------
+-- Path data
+--------------------------------------------------------------------------------
+
+-- | The @d@ attribute of a @path@, as absolute segments.
+--
+-- Always succeeds, stopping at the first unknown or incomplete command.
+pathData :: P [Segment]
+pathData = walk (St 0x4D origin origin NoCtrl)
+  where
+    origin = Point 0 0
+
+-- | Parse a @d@ attribute into absolute segments. Ignores a malformed tail;
+-- returns @[]@ when no complete segment can be read.
+parsePath :: ByteString -> [Segment]
+parsePath src = maybe [] fst (runPartial src pathData)
+
+-- | State carried between path commands.
+data St = St
+  { stCommand :: !Word8
+  -- ^ The command to repeat when a run of arguments follows.
+  , stCurrent :: !Point
+  , stSubpath :: !Point
+  -- ^ Where the open subpath began, for @Z@.
+  , stControl :: !Ctrl
+  }
+
+-- | Previous control point: @S@ reflects only a cubic control point and @T@
+-- only a quadratic one. Otherwise, the current point is used.
+data Ctrl = NoCtrl | CubicCtrl !Point | QuadCtrl !Point
+
+walk :: St -> P [Segment]
+walk st = do
+  skipWspComma
+  peekByte >>= \case
+    Nothing -> pure []
+    Just w
+      | isAsciiAlpha w -> F.skip 1 *> skipWspComma *> step st {stCommand = w}
+      -- A run of arguments repeats the command that introduced it.
+      | otherwise -> step st
+
+-- | Read one argument group, stopping the path if it is incomplete.
+step :: St -> P [Segment]
+step st@(St cmd current@(Point cx cy) subpath ctrl) = case lower cmd of
+  0x6D -> ending do
+    -- m: moveto
+    p <- point
+    -- A second pair after a moveto is a lineto, and a relative moveto
+    -- makes them relative linetos.
+    (MoveTo p :)
+      <$> walk
+        st
+          { stCommand = if relative then 0x6C else 0x4C
+          , stCurrent = p
+          , stSubpath = p
+          , stControl = NoCtrl
+          }
+  0x6C -> ending do
+    -- l: lineto
+    p <- point
+    (LineTo p :) <$> continue p NoCtrl
+  0x68 -> ending do
+    -- h: horizontal lineto
+    x <- number
+    let p = Point (if relative then cx + x else x) cy
+    (LineTo p :) <$> continue p NoCtrl
+  0x76 -> ending do
+    -- v: vertical lineto
+    y <- number
+    let p = Point cx (if relative then cy + y else y)
+    (LineTo p :) <$> continue p NoCtrl
+  0x63 -> ending do
+    -- c: curveto
+    c1 <- point
+    skipWspComma
+    c2 <- point
+    skipWspComma
+    p <- point
+    (CubicTo c1 c2 p :) <$> continue p (CubicCtrl c2)
+  0x73 -> ending do
+    -- s: smooth curveto
+    c2 <- point
+    skipWspComma
+    p <- point
+    let c1 = case ctrl of
+          CubicCtrl q -> reflect current q
+          _ -> current
+    (CubicTo c1 c2 p :) <$> continue p (CubicCtrl c2)
+  0x71 -> ending do
+    -- q: quadratic curveto
+    c1 <- point
+    skipWspComma
+    p <- point
+    (QuadTo c1 p :) <$> continue p (QuadCtrl c1)
+  0x74 -> ending do
+    -- t: smooth quadratic curveto
+    p <- point
+    let c1 = case ctrl of
+          QuadCtrl q -> reflect current q
+          _ -> current
+    (QuadTo c1 p :) <$> continue p (QuadCtrl c1)
+  0x61 -> ending do
+    -- a: elliptical arc
+    rx <- number
+    skipWspComma
+    ry <- number
+    skipWspComma
+    rot <- number
+    skipWspComma
+    -- Single-digit flags need no separators: a1 1 0 00.5.5 has seven arguments.
+    large <- flag
+    skipWspComma
+    sweep <- flag
+    skipWspComma
+    p <- point
+    (ArcTo (abs rx) (abs ry) rot large sweep p :) <$> continue p NoCtrl
+  0x7A ->
+    -- z: closepath. The current point returns to where the subpath began,
+    -- and a bare coordinate pair after it starts a new one.
+    (ClosePath :)
+      <$> walk
+        st
+          { stCommand = if relative then 0x6D else 0x4D
+          , stCurrent = subpath
+          , stControl = NoCtrl
+          }
+  _ -> pure [] -- Not a command: the path ends.
+  where
+    relative = cmd >= 0x61
+    point = do
+      Point x y <- coordinatePair
+      pure (if relative then Point (cx + x) (cy + y) else Point x y)
+    continue p c = walk st {stCurrent = p, stControl = c}
+    reflect (Point x y) (Point qx qy) = Point (2 * x - qx) (2 * y - qy)
+    ending p = F.withOption p pure (pure [])
+
+--------------------------------------------------------------------------------
+-- Transforms
+--------------------------------------------------------------------------------
+
+-- | Compose a transform list in SVG order; the rightmost transform acts first.
+--
+-- Always succeeds. Unknown functions or wrong argument counts contribute
+-- identity if their numeric argument list parses. Malformed syntax ends
+-- the list, retaining the transforms already read.
+transformList :: P Matrix
+transformList = skipWspComma *> go identity
+  where
+    go m = F.withOption transformItem (\m' -> go (m `multiply` m')) (pure m)
+
+-- | Parse a @transform@ attribute using 'transformList'. Returns 'identity'
+-- when no usable transform is read.
+parseTransform :: ByteString -> Matrix
+parseTransform src = maybe identity fst (runPartial src transformList)
+
+transformItem :: P Matrix
+transformItem = do
+  name <- takeWhileByte isAsciiAlpha
+  skipWsp
+  skipSatisfyByte (== 0x28)
+  args <- numberList
+  skipWsp
+  skipSatisfyByte (== 0x29)
+  skipWspComma
+  pure case name of
+    "matrix" | [a, b, c, d, e, f] <- args -> Matrix a b c d e f
+    "translate" -> case args of
+      [x] -> translation x 0
+      [x, y] -> translation x y
+      _ -> identity
+    "scale" -> case args of
+      [k] -> scaling k k
+      [sx, sy] -> scaling sx sy
+      _ -> identity
+    "rotate" -> case args of
+      [a] -> rotation a
+      [a, cx, cy] ->
+        translation cx cy `multiply` rotation a `multiply` translation (-cx) (-cy)
+      _ -> identity
+    "skewX" | [a] <- args -> Matrix 1 0 (tan (radians a)) 1 0 0
+    "skewY" | [a] <- args -> Matrix 1 (tan (radians a)) 0 1 0 0
+    _ -> identity
+  where
+    radians a = a * pi / 180
+
+--------------------------------------------------------------------------------
+-- The shape elements
+--------------------------------------------------------------------------------
+
+-- | @rectSegments x y width height rx ry@ constructs a closed rectangle.
+-- Missing corner radii default to each other, or zero if both are absent.
+-- Radii are made nonnegative and capped at half the corresponding side.
+-- Nonpositive width or height returns @[]@.
+rectSegments ::
+  Float -> Float -> Float -> Float -> Maybe Float -> Maybe Float -> [Segment]
+rectSegments x y w h mrx mry
+  | w <= 0 || h <= 0 = []
+  | rx <= 0 || ry <= 0 =
+      [ MoveTo (Point x y)
+      , LineTo (Point (x + w) y)
+      , LineTo (Point (x + w) (y + h))
+      , LineTo (Point x (y + h))
+      , ClosePath
+      ]
+  | otherwise =
+      [ MoveTo (Point (x + rx) y)
+      , LineTo (Point (x + w - rx) y)
+      , corner (Point (x + w) (y + ry))
+      , LineTo (Point (x + w) (y + h - ry))
+      , corner (Point (x + w - rx) (y + h))
+      , LineTo (Point (x + rx) (y + h))
+      , corner (Point x (y + h - ry))
+      , LineTo (Point x (y + ry))
+      , corner (Point (x + rx) y)
+      , ClosePath
+      ]
+  where
+    rx = min (w / 2) (abs (fromMaybe 0 (mrx <|> mry)))
+    ry = min (h / 2) (abs (fromMaybe 0 (mry <|> mrx)))
+    -- A quarter ellipse, the short way round, clockwise on screen.
+    corner = ArcTo rx ry 0 False True
+
+-- | @circleSegments cx cy radius@ constructs a closed circle from two arcs.
+-- A nonpositive radius returns @[]@.
+circleSegments :: Float -> Float -> Float -> [Segment]
+circleSegments cx cy r = ellipseSegments cx cy r r
+
+-- | @ellipseSegments cx cy rx ry@ constructs a closed ellipse from two arcs.
+-- Either radius being nonpositive returns @[]@.
+ellipseSegments :: Float -> Float -> Float -> Float -> [Segment]
+ellipseSegments cx cy rx ry
+  | rx <= 0 || ry <= 0 = []
+  | otherwise =
+      [ MoveTo (Point (cx + rx) cy)
+      , ArcTo rx ry 0 False True (Point (cx - rx) cy)
+      , ArcTo rx ry 0 False True (Point (cx + rx) cy)
+      , ClosePath
+      ]
+
+-- | @lineSegments x1 y1 x2 y2@ constructs an open line between two endpoints.
+lineSegments :: Float -> Float -> Float -> Float -> [Segment]
+lineSegments x1 y1 x2 y2 = [MoveTo (Point x1 y1), LineTo (Point x2 y2)]
+
+-- | Connect points with straight lines. 'True' appends 'ClosePath' for a
+-- polygon; 'False' produces an open polyline. An empty input returns @[]@.
+polySegments :: Bool -> [Point] -> [Segment]
+polySegments closed = \case
+  [] -> []
+  p : ps -> MoveTo p : map LineTo ps <> [ClosePath | closed]

@@ -0,0 +1,362 @@+{-# LANGUAGE DerivingStrategies #-}
+
+-- |
+-- Module      : Graphics.NanoSvg.Types
+-- Copyright   : (c) 2026 goolord
+-- License     : MIT
+--
+-- The flattened document model used by "Graphics.NanoSvg".
+--
+-- A t'Document' holds t'Shape's in paint order. Each shape has a path in local
+-- coordinates, a t'Matrix' mapping it into the document viewBox, and a
+-- resolved t'Style'. Viewport mapping and rendering are the caller's job.
+module Graphics.NanoSvg.Types
+  ( -- * Colors
+    RGBA (..)
+  , rgba
+  , rgbaR
+  , rgbaG
+  , rgbaB
+  , rgbaA
+  , withAlpha
+  , black
+  , transparent
+
+    -- * Geometry
+  , Point (..)
+  , Box (..)
+
+    -- * Transforms
+  , Matrix (..)
+  , identity
+  , multiply
+  , translation
+  , scaling
+  , rotation
+  , transformPoint
+  , averageScale
+
+    -- * Path segments
+  , Segment (..)
+
+    -- * Paint
+  , Paint (..)
+  , FillRule (..)
+  , LineCap (..)
+  , LineJoin (..)
+  , Style (..)
+  , defaultStyle
+
+    -- * Shapes
+  , Shape (..)
+
+    -- * Documents
+  , Document (..)
+  , documentWidth
+  , documentHeight
+  )
+where
+
+import Data.Bits (shiftL, shiftR, (.&.), (.|.))
+import Data.Char (intToDigit)
+import Data.Primitive.SmallArray (SmallArray)
+import Data.Word (Word32, Word8)
+
+--------------------------------------------------------------------------------
+-- Colors
+--------------------------------------------------------------------------------
+
+-- | An opaque or translucent color, packed as @0xRRGGBBAA@.
+-- Channels are not premultiplied by alpha.
+newtype RGBA = RGBA {rgbaToWord32 :: Word32}
+  deriving newtype (Eq, Ord)
+
+-- | Shown as @#rrggbbaa@.
+instance Show RGBA where
+  show c = '#' : concatMap hex2 [rgbaR c, rgbaG c, rgbaB c, rgbaA c]
+    where
+      hex2 w = [digit (w `shiftR` 4), digit (w .&. 0xF)]
+      digit = intToDigit . fromIntegral
+
+-- | Pack red, green, blue and alpha. Alpha 0 is transparent, 255 opaque.
+{-# INLINE rgba #-}
+rgba :: Word8 -> Word8 -> Word8 -> Word8 -> RGBA
+rgba r g b a =
+  RGBA $
+    (w32 r `shiftL` 24)
+      .|. (w32 g `shiftL` 16)
+      .|. (w32 b `shiftL` 8)
+      .|. w32 a
+  where
+    w32 = fromIntegral :: Word8 -> Word32
+
+-- | The red channel.
+{-# INLINE rgbaR #-}
+rgbaR :: RGBA -> Word8
+rgbaR (RGBA w) = fromIntegral (w `shiftR` 24)
+
+-- | The green channel.
+{-# INLINE rgbaG #-}
+rgbaG :: RGBA -> Word8
+rgbaG (RGBA w) = fromIntegral (w `shiftR` 16)
+
+-- | The blue channel.
+{-# INLINE rgbaB #-}
+rgbaB :: RGBA -> Word8
+rgbaB (RGBA w) = fromIntegral (w `shiftR` 8)
+
+-- | The alpha channel.
+{-# INLINE rgbaA #-}
+rgbaA :: RGBA -> Word8
+rgbaA (RGBA w) = fromIntegral w
+
+-- | The color with its alpha replaced.
+{-# INLINE withAlpha #-}
+withAlpha :: Word8 -> RGBA -> RGBA
+withAlpha a (RGBA w) = RGBA ((w .&. 0xFFFFFF00) .|. fromIntegral a)
+
+-- | Opaque black, the initial value of @fill@.
+black :: RGBA
+black = rgba 0 0 0 255
+
+-- | Zero in every channel.
+transparent :: RGBA
+transparent = RGBA 0
+
+--------------------------------------------------------------------------------
+-- Geometry
+--------------------------------------------------------------------------------
+
+-- | A point in user space.
+data Point = Point {-# UNPACK #-} !Float {-# UNPACK #-} !Float
+  deriving stock (Eq, Show)
+
+-- | A rectangle as @x y width height@, the shape of a @viewBox@.
+data Box = Box
+  { boxX :: {-# UNPACK #-} !Float
+  , boxY :: {-# UNPACK #-} !Float
+  , boxW :: {-# UNPACK #-} !Float
+  , boxH :: {-# UNPACK #-} !Float
+  }
+  deriving stock (Eq, Show)
+
+--------------------------------------------------------------------------------
+-- Transforms
+--------------------------------------------------------------------------------
+
+-- | SVG affine transform @matrix(a b c d e f)@:
+--
+-- > | a c e |
+-- > | b d f |
+-- > | 0 0 1 |
+--
+-- Maps @(x, y)@ to @(a*x + c*y + e, b*x + d*y + f)@.
+data Matrix = Matrix
+  { matrixA :: {-# UNPACK #-} !Float
+  , matrixB :: {-# UNPACK #-} !Float
+  , matrixC :: {-# UNPACK #-} !Float
+  , matrixD :: {-# UNPACK #-} !Float
+  , matrixE :: {-# UNPACK #-} !Float
+  , matrixF :: {-# UNPACK #-} !Float
+  }
+  deriving stock (Eq, Show)
+
+-- | Identity transform.
+identity :: Matrix
+identity = Matrix 1 0 0 1 0 0
+
+-- | Compose transforms: @multiply outer inner@ applies @inner@ first.
+{-# INLINE multiply #-}
+multiply :: Matrix -> Matrix -> Matrix
+multiply (Matrix a b c d e f) (Matrix a' b' c' d' e' f') =
+  Matrix
+    (a * a' + c * b')
+    (b * a' + d * b')
+    (a * c' + c * d')
+    (b * c' + d * d')
+    (a * e' + c * f' + e)
+    (b * e' + d * f' + f)
+
+-- | @translate(x, y)@.
+{-# INLINE translation #-}
+translation :: Float -> Float -> Matrix
+translation x y = Matrix 1 0 0 1 x y
+
+-- | @scale(sx, sy)@.
+{-# INLINE scaling #-}
+scaling :: Float -> Float -> Matrix
+scaling sx sy = Matrix sx 0 0 sy 0 0
+
+-- | @rotate(a)@, the angle in degrees, clockwise because y points down.
+{-# INLINE rotation #-}
+rotation :: Float -> Matrix
+rotation deg =
+  let r = deg * pi / 180
+      s = sin r
+      c = cos r
+   in Matrix c s (negate s) c 0 0
+
+-- | Map a point through a transform.
+{-# INLINE transformPoint #-}
+transformPoint :: Matrix -> Point -> Point
+transformPoint (Matrix a b c d e f) (Point x y) =
+  Point (a * x + c * y + e) (b * x + d * y + f)
+
+-- | Square root of the absolute determinant. Exact as a length scale for
+-- uniform scaling; an area-based approximation for nonuniform scaling or
+-- shear. Useful when a renderer represents stroke width with one scalar.
+{-# INLINE averageScale #-}
+averageScale :: Matrix -> Float
+averageScale (Matrix a b c d _ _) = sqrt (abs (a * d - b * c))
+
+--------------------------------------------------------------------------------
+-- Path segments
+--------------------------------------------------------------------------------
+
+-- | A path command in absolute, shape-local coordinates. Relative commands
+-- and shorthands are resolved during parsing; 'shapeTransform' is not baked
+-- into the points. A renderer still tracks the current point and subpath start.
+data Segment
+  = -- | Start a new subpath.
+    MoveTo !Point
+  | -- | Straight line to a point.
+    LineTo !Point
+  | -- | Cubic Bezier: first control point, second control point, endpoint.
+    CubicTo !Point !Point !Point
+  | -- | Quadratic Bezier: control point, endpoint.
+    QuadTo !Point !Point
+  | -- | Elliptical arc: radii, the x-axis rotation in degrees, the
+    --     large-arc and sweep flags, and the endpoint.
+    ArcTo
+      {-# UNPACK #-} !Float
+      {-# UNPACK #-} !Float
+      {-# UNPACK #-} !Float
+      !Bool
+      !Bool
+      !Point
+  | -- | Close the current subpath back to where it started.
+    ClosePath
+  deriving stock (Eq, Show)
+
+--------------------------------------------------------------------------------
+-- Paint
+--------------------------------------------------------------------------------
+
+-- | What fills or strokes a shape.
+data Paint
+  = -- | @none@: draw nothing.
+    PaintNone
+  | -- | @currentColor@: a color supplied by the renderer.
+    PaintCurrent
+  | -- | A literal color.
+    PaintColor !RGBA
+  deriving stock (Eq, Show)
+
+-- | Rule for determining a path's filled interior.
+data FillRule = NonZero | EvenOdd
+  deriving stock (Eq, Show)
+
+-- | Stroke endpoint shape.
+data LineCap = CapButt | CapRound | CapSquare
+  deriving stock (Eq, Show)
+
+-- | Stroke corner shape.
+data LineJoin = JoinMiter | JoinRound | JoinBevel
+  deriving stock (Eq, Show)
+
+-- | Resolved presentation properties in shape-local units.
+--
+-- An unset fill is distinct from explicit black so a renderer can apply an
+-- icon tint. Without a tint, use SVG's default black fill. The default stroke
+-- is 'Just' 'PaintNone'. See 'defaultStyle' and 'documentMonochrome'.
+data Style = Style
+  { styleFill :: !(Maybe Paint)
+  -- ^ Fill paint; 'Nothing' means unspecified.
+  , styleStroke :: !(Maybe Paint)
+  -- ^ Stroke paint; 'Nothing' means unspecified.
+  , styleStrokeWidth :: {-# UNPACK #-} !Float
+  -- ^ Stroke width before 'shapeTransform' is applied.
+  , styleCap :: !LineCap
+  , styleJoin :: !LineJoin
+  , styleMiterLimit :: {-# UNPACK #-} !Float
+  -- ^ Maximum miter length as a multiple of stroke width.
+  , styleFillRule :: !FillRule
+  , styleOpacity :: {-# UNPACK #-} !Float
+  -- ^ Local opacity multiplied by ancestor opacities. This does not preserve
+  --   SVG group compositing for overlapping shapes.
+  , styleFillOpacity :: {-# UNPACK #-} !Float
+  -- ^ Fill opacity, multiplied with paint alpha and 'styleOpacity' when drawn.
+  , styleStrokeOpacity :: {-# UNPACK #-} !Float
+  -- ^ Stroke opacity, multiplied with paint alpha and 'styleOpacity' when drawn.
+  }
+  deriving stock (Eq, Show)
+
+-- | Initial style: unset fill, no stroke, width 1, butt caps, miter joins,
+-- miter limit 4, nonzero fill rule and full opacity.
+defaultStyle :: Style
+defaultStyle =
+  Style
+    { styleFill = Nothing
+    , styleStroke = Just PaintNone
+    , styleStrokeWidth = 1
+    , styleCap = CapButt
+    , styleJoin = JoinMiter
+    , styleMiterLimit = 4
+    , styleFillRule = NonZero
+    , styleOpacity = 1
+    , styleFillOpacity = 1
+    , styleStrokeOpacity = 1
+    }
+
+--------------------------------------------------------------------------------
+-- Shapes
+--------------------------------------------------------------------------------
+
+-- | One drawable path.
+data Shape = Shape
+  { shapeSegments :: !(SmallArray Segment)
+  -- ^ Absolute segments in the shape's own coordinates.
+  , shapeTransform :: !Matrix
+  -- ^ From those coordinates into the document's 'documentViewBox'.
+  , shapeStyle :: !Style
+  -- ^ Presentation properties after inheritance and local declarations.
+  }
+  deriving stock (Eq, Show)
+
+--------------------------------------------------------------------------------
+-- Documents
+--------------------------------------------------------------------------------
+
+-- | A parsed SVG document. Equality compares only 'documentKey', not geometry.
+data Document = Document
+  { documentViewBox :: !Box
+  -- ^ Root @viewBox@ when valid. Otherwise, a box at the origin using root
+  --   dimensions, with 24 for each missing or unresolvable dimension.
+  , documentSize :: {-# UNPACK #-} !(Float, Float)
+  -- ^ Requested width and height in user units. Each unresolved root
+  --   dimension falls back to the corresponding 'documentViewBox' extent.
+  , documentShapes :: !(SmallArray Shape)
+  -- ^ Every shape, in paint order.
+  , documentKey :: {-# UNPACK #-} !Int
+  -- ^ FNV-1a hash of the source bytes, converted to 'Int'. A cache hint, not
+  --   a collision-free identifier; its width depends on the platform.
+  , documentMonochrome :: !Bool
+  -- ^ No shape has a literal 'PaintColor'. Unset paints, 'PaintNone' and
+  --   'PaintCurrent' allow caller tinting. Explicit black counts as a literal
+  --   color; an empty document is monochrome.
+  }
+
+-- | Documents are equal when their sources hash the same.
+instance Eq Document where
+  a == b = documentKey a == documentKey b
+
+instance Show Document where
+  show doc = "<svg " <> show (documentSize doc) <> ">"
+
+-- | The width the document asks to be drawn at.
+documentWidth :: Document -> Float
+documentWidth = fst . documentSize
+
+-- | The height the document asks to be drawn at.
+documentHeight :: Document -> Float
+documentHeight = snd . documentSize

@@ -0,0 +1,185 @@+{-# LANGUAGE BangPatterns #-}
+
+-- |
+-- Module      : Graphics.NanoSvg.Xml
+-- Copyright   : (c) 2026 goolord
+-- License     : MIT
+--
+-- Minimal XML element tree backed by @hexml@.
+--
+-- Names and unmodified attribute values share the parsed input buffer.
+-- SVG-specific preprocessing:
+--
+-- * Replace a DOCTYPE and leading UTF-8 byte-order mark with spaces before
+--   parsing. This preserves byte offsets, but not line numbers within a
+--   multiline DOCTYPE. Custom entities are not expanded.
+--
+-- * Strip namespace prefixes without resolving namespace URIs: @svg:path@
+--   becomes @path@ and @xlink:href@ becomes @href@.
+--
+-- * Decode the five predefined XML entities and decimal or hexadecimal
+--   character references in attribute values.
+--
+-- Text nodes, comments and processing instructions are omitted.
+module Graphics.NanoSvg.Xml
+  ( -- * The tree
+    Element (..)
+  , Attribute (..)
+
+    -- * Parsing
+  , parseXml
+
+    -- * Looking things up
+  , attribute
+  , descendants
+
+    -- * Pieces
+  , localName
+  , decodeEntities
+  , withoutDoctype
+  )
+where
+
+import Data.ByteString (ByteString)
+import Data.ByteString qualified as BS
+import Data.ByteString.Builder qualified as B
+import Data.ByteString.Char8 qualified as BC
+import Data.ByteString.Lazy qualified as BL
+import Data.Char (chr)
+import Data.Maybe (listToMaybe)
+import Graphics.NanoSvg.Internal.Parser (hexValue, isDigitByte, isHexDigit)
+import Text.XML.Hexml qualified as Hexml
+
+--------------------------------------------------------------------------------
+-- The tree
+--------------------------------------------------------------------------------
+
+-- | An element with namespace prefixes removed from its name and attributes.
+data Element = Element
+  { elementName :: !ByteString
+  , elementAttributes :: ![Attribute]
+  , elementChildren :: ![Element]
+  }
+  deriving (Eq, Show)
+
+-- | An attribute with a local name and entity-decoded UTF-8 value.
+data Attribute = Attribute
+  { attributeName :: !ByteString
+  , attributeValue :: !ByteString
+  }
+  deriving (Eq, Show)
+
+--------------------------------------------------------------------------------
+-- Parsing
+--------------------------------------------------------------------------------
+
+-- | Parse top-level elements or return a @hexml@ error. Does not require an
+-- @svg@ root. The returned tree may retain the parsed input buffer.
+parseXml :: ByteString -> Either String [Element]
+parseXml src = case Hexml.parse (withoutDoctype (withoutBom src)) of
+  Left err -> Left (BC.unpack err)
+  Right root -> Right (map element (elements root))
+  where
+    -- hexml exposes processing instructions as elements; filter them out.
+    elements node =
+      [n | n <- Hexml.children node, not (BS.isPrefixOf "<?" (Hexml.outer n))]
+    element node =
+      Element
+        { elementName = localName (Hexml.name node)
+        , elementAttributes =
+            [ Attribute
+                { attributeName = localName (Hexml.attributeName a)
+                , attributeValue = decodeEntities (Hexml.attributeValue a)
+                }
+            | a <- Hexml.attributes node
+            ]
+        , elementChildren = map element (elements node)
+        }
+
+--------------------------------------------------------------------------------
+-- Looking things up
+--------------------------------------------------------------------------------
+
+-- | Find the first attribute with the given local name (case-sensitive).
+-- On a parsed tree, @"href"@ also matches an original @xlink:href@.
+attribute :: ByteString -> Element -> Maybe ByteString
+attribute k el = listToMaybe [v | Attribute n v <- elementAttributes el, n == k]
+{-# INLINE attribute #-}
+
+-- | Every element in the subtree, the root itself first, in document order.
+descendants :: Element -> [Element]
+descendants el = el : concatMap descendants (elementChildren el)
+
+--------------------------------------------------------------------------------
+-- Pieces
+--------------------------------------------------------------------------------
+
+-- | Everything after the last colon: @svg:path@ becomes @path@.
+localName :: ByteString -> ByteString
+localName n = case BS.elemIndexEnd 0x3A n of
+  Just i -> BS.drop (i + 1) n
+  Nothing -> n
+
+-- | The document with a leading UTF-8 byte-order mark replaced by spaces.
+withoutBom :: ByteString -> ByteString
+withoutBom src
+  | BS.isPrefixOf "\xEF\xBB\xBF" src = "   " <> BS.drop 3 src
+  | otherwise = src
+
+-- | Replace the first DOCTYPE, including its internal subset, with spaces.
+-- Preserves byte offsets, not line numbers. The scanner counts brackets;
+-- it does not parse quoted strings or comments inside the declaration.
+withoutDoctype :: ByteString -> ByteString
+withoutDoctype bytes = case BS.breakSubstring "<!DOCTYPE" bytes of
+  (_, rest) | BS.null rest -> bytes
+  (before, rest) -> before <> BS.replicate end 0x20 <> BS.drop end rest
+    where
+      end = close (0 :: Int) 0
+      -- The subset in brackets may itself contain a '>'.
+      close !depth !k
+        | k >= BS.length rest = k
+        | otherwise = case BS.index rest k of
+            0x5B -> close (depth + 1) (k + 1) -- '['
+            0x5D -> close (depth - 1) (k + 1) -- ']'
+            0x3E | depth <= 0 -> k + 1 -- '>'
+            _ -> close depth (k + 1)
+
+-- | Decode predefined XML entities and numeric references to UTF-8.
+-- Unknown or invalid references are left unchanged. Input without @&@
+-- is returned without copying.
+decodeEntities :: ByteString -> ByteString
+decodeEntities v
+  | BS.notElem 0x26 v = v
+  | otherwise = BL.toStrict (B.toLazyByteString (go v))
+  where
+    go s =
+      let (before, rest) = BS.break (== 0x26) s
+       in if BS.null rest
+            then B.byteString before
+            else case entity rest of
+              Just (b, after) -> B.byteString before <> b <> go after
+               -- Preserve unknown or malformed references literally.
+              Nothing -> B.byteString before <> B.word8 0x26 <> go (BS.drop 1 rest)
+
+-- | One reference at the front of the input, and what is left after it.
+entity :: ByteString -> Maybe (B.Builder, ByteString)
+entity s
+  | Just r <- BS.stripPrefix "&amp;" s = Just (B.word8 0x26, r)
+  | Just r <- BS.stripPrefix "&lt;" s = Just (B.word8 0x3C, r)
+  | Just r <- BS.stripPrefix "&gt;" s = Just (B.word8 0x3E, r)
+  | Just r <- BS.stripPrefix "&quot;" s = Just (B.word8 0x22, r)
+  | Just r <- BS.stripPrefix "&apos;" s = Just (B.word8 0x27, r)
+  | Just r <- BS.stripPrefix "&#x" s = numeric 16 isHexDigit (fromIntegral . hexValue) r
+  | Just r <- BS.stripPrefix "&#X" s = numeric 16 isHexDigit (fromIntegral . hexValue) r
+  | Just r <- BS.stripPrefix "&#" s = numeric 10 isDigitByte (fromIntegral . hexValue) r
+  | otherwise = Nothing
+  where
+    numeric base isPart value r =
+      let ds = BS.takeWhile isPart r
+          after = BS.drop (BS.length ds) r
+          code = BS.foldl' (\acc w -> acc * base + value w) (0 :: Int) ds
+       in if BS.null ds || not (BS.isPrefixOf ";" after) || not (isScalar code)
+            then Nothing
+            else Just (B.charUtf8 (chr code), BS.drop 1 after)
+    -- Reject NUL, surrogates and out-of-range code points before calling chr.
+    isScalar c = c > 0 && c <= 0x10FFFF && not (c >= 0xD800 && c <= 0xDFFF)

@@ -0,0 +1,94 @@+cabal-version:      3.0
+name:               nano-svg
+version:            0.1.0.0
+synopsis:           An SVG parser for icons
+
+description:
+    Parse static SVG icons and vector artwork for geometry renderers,
+    rasterizers and UI toolkits.
+
+    Reads UTF-8 @ByteString@ input using @hexml@ for XML and @flatparse@
+    for attribute values. Returns a flat array of shapes in paint order,
+    each with absolute path segments, a transform and a resolved style.
+
+    Path, transform, color, length and coordinate-list parsers can also be
+    used independently. Rendering and viewport mapping are left to the caller.
+
+    Gradients, patterns, text, masks, clipping paths, filters and CSS
+    stylesheets are not supported. See "Graphics.NanoSvg" for supported
+    features and limitations.
+
+license:            MIT
+license-file:       LICENSE
+author:             goolord
+maintainer:         zacharyachurchill@gmail.com
+category:           Graphics
+build-type:         Simple
+tested-with:        GHC ==9.14.1
+extra-doc-files:
+    CHANGELOG.md
+    README.md
+
+common extensions
+    default-language: GHC2021
+    default-extensions:
+        BlockArguments
+        LambdaCase
+        OverloadedStrings
+
+common ghc-options
+    ghc-options:
+        -Wall
+        -Widentities
+        -Wcompat
+        -Wincomplete-record-updates
+        -Wincomplete-uni-patterns
+        -Wmissing-export-lists
+        -Wmissing-home-modules
+        -Wpartial-fields
+        -Wredundant-constraints
+
+common rts-options
+    ghc-options: -rtsopts -threaded "-with-rtsopts=-N"
+
+library
+    import:           extensions
+    import:           ghc-options
+    exposed-modules:
+        Graphics.NanoSvg
+        Graphics.NanoSvg.Color
+        Graphics.NanoSvg.Internal.Parser
+        Graphics.NanoSvg.Number
+        Graphics.NanoSvg.Path
+        Graphics.NanoSvg.Types
+        Graphics.NanoSvg.Xml
+
+    hs-source-dirs:   lib
+
+    -- Inline the small attribute-parser combinators.
+    ghc-options:      -O2
+    build-depends:
+        base       >=4.17  && <4.23,
+        bytestring >=0.11  && <0.13,
+        containers >=0.6   && <0.9,
+        flatparse  >=0.5    && <0.6,
+        hexml      >=0.3.5 && <0.4,
+        primitive  >=0.9   && <0.10
+
+test-suite nano-svg-test
+    import:           extensions
+    import:           ghc-options
+    import:           rts-options
+    type:             exitcode-stdio-1.0
+    hs-source-dirs:   test
+    main-is:          Main.hs
+    ghc-options:      -Wno-missing-export-lists
+    build-depends:
+        base,
+        bytestring,
+        nano-svg,
+        primitive,
+        QuickCheck       >=2.14 && <2.19,
+        tasty            >=1.4  && <1.6,
+        tasty-hunit      >=0.10 && <0.11,
+        tasty-quickcheck >=0.10 && <0.12

@@ -0,0 +1,556 @@+-- | Unit tests for SVG parsing and edge cases, plus properties for number
+-- conversion and relative path commands.
+module Main (main) where
+
+import Data.ByteString (ByteString)
+import Data.ByteString.Char8 qualified as BC
+import Data.Foldable (toList)
+import Graphics.NanoSvg
+import Graphics.NanoSvg.Color (namedColor, parseColor, parsePaint)
+import Graphics.NanoSvg.Number
+import Graphics.NanoSvg.Path (parsePath, parseTransform)
+import Graphics.NanoSvg.Xml
+import Test.Tasty
+import Test.Tasty.HUnit
+import Test.Tasty.QuickCheck
+
+main :: IO ()
+main =
+  defaultMain $
+    testGroup
+      "nano-svg"
+      [ numbers
+      , lengths
+      , colors
+      , paths
+      , transforms
+      , xml
+      , documents
+      ]
+
+--------------------------------------------------------------------------------
+-- Numbers
+--------------------------------------------------------------------------------
+
+numbers :: TestTree
+numbers =
+  testGroup
+    "numbers"
+    [ testCase "the forms the path grammar allows" do
+        parseNumber "1" @?= Just 1
+        parseNumber "-1" @?= Just (-1)
+        parseNumber "+1" @?= Just 1
+        parseNumber "1.5" @?= Just 1.5
+        parseNumber ".5" @?= Just 0.5
+        parseNumber "-.5" @?= Just (-0.5)
+        parseNumber "1." @?= Just 1
+        parseNumber "1e3" @?= Just 1000
+        parseNumber "1E3" @?= Just 1000
+        parseNumber "-.5e-3" @?= Just (-0.0005)
+        parseNumber "1.5e+2" @?= Just 150
+    , testCase "and rejects what is not a number" do
+        parseNumber "" @?= Nothing
+        parseNumber "." @?= Nothing
+        parseNumber "-" @?= Nothing
+        parseNumber "e3" @?= Nothing
+        parseNumber "1 2" @?= Nothing
+        parseNumber "abc" @?= Nothing
+    , testCase "an exponent with no digits is not an exponent" do
+        -- The @e@ belongs to the unit, so this is one em and not a failure.
+        parseLength "1em" @?= Just (Length 1 Em)
+        parseLength "1ex" @?= Just (Length 1 Ex)
+    , testCase "many digits still land on the right value" do
+        parseNumber "0.30000000000000004" @?= Just 0.3
+        parseNumber "123456789012345678901234" @?= Just 1.2345679e23
+    , testCase "a number a Float cannot hold is not a number" do
+        -- Infinity in a coordinate, or the NaN that @0 * Infinity@ makes,
+        -- would reach whatever draws the result.
+        parseNumber "1e400" @?= Nothing
+        parseNumber "-1e400" @?= Nothing
+        parseNumber "0e400" @?= Nothing
+        parseNumber (BC.replicate 400 '9') @?= Nothing
+        parseNumber "1e-400" @?= Just 0
+        parsePath "M1 1L1e400 0" @?= [MoveTo (Point 1 1)]
+        sizeOf "<svg width='1e400' height='1e400'/>" @?= (24, 24)
+    , testCase "lists stop at the first thing that is not a number" do
+        parseNumberList "1 2 3" @?= [1, 2, 3]
+        parseNumberList "1,2 , 3" @?= [1, 2, 3]
+        parseNumberList " 1 2 oops 3" @?= [1, 2]
+        parseNumberList "" @?= []
+    , testCase "a viewBox is four of them" do
+        parseNumberList "0 0 24 24" @?= [0, 0, 24, 24]
+        parseNumberList "0 0 24" @?= [0, 0, 24]
+        parseNumberList "0 0 24 24 24" @?= [0, 0, 24, 24, 24]
+    , testCase "an odd point is dropped" do
+        parsePointList "0,0 1,1 2" @?= [Point 0 0, Point 1 1]
+    , testProperty "agrees with read, to single precision" \(x :: Float) ->
+        let rendered = BC.pack (show x)
+         in counterexample (show rendered) $
+              maybe False (nearly x) (parseNumber rendered)
+    , testProperty "reads a list of them" \(xs :: [Float]) ->
+        let rendered = BC.unwords (map (BC.pack . show) xs)
+            parsed = parseNumberList rendered
+         in length parsed == length xs && and (zipWith nearly xs parsed)
+    ]
+
+-- | Equal to within a single-precision ulp or so, and equal on the
+-- exceptional values.
+nearly :: Float -> Float -> Bool
+nearly a b
+  | isNaN a = isNaN b
+  | isInfinite a || isInfinite b = a == b
+  | otherwise = abs (a - b) <= 1e-5 * max 1 (max (abs a) (abs b))
+
+--------------------------------------------------------------------------------
+-- Lengths
+--------------------------------------------------------------------------------
+
+lengths :: TestTree
+lengths =
+  testGroup
+    "lengths"
+    [ testCase "units are read" do
+        parseLength "10" @?= Just (Length 10 UserSpace)
+        parseLength "10px" @?= Just (Length 10 Px)
+        parseLength "10PX" @?= Just (Length 10 Px)
+        parseLength "10pt" @?= Just (Length 10 Pt)
+        parseLength "10%" @?= Just (Length 10 Percent)
+        parseLength "10 " @?= Just (Length 10 UserSpace)
+        parseLength "10 px" @?= Nothing
+    , testCase "the absolute ones resolve at 96 dpi" do
+        parseUserUnits "10" @?= Just 10
+        parseUserUnits "10px" @?= Just 10
+        parseUserUnits "1in" @?= Just 96
+        parseUserUnits "72pt" @?= Just 96
+        parseUserUnits "6pc" @?= Just 96
+        fmap (round :: Float -> Int) (parseUserUnits "2.54cm") @?= Just 96
+        fmap (round :: Float -> Int) (parseUserUnits "25.4mm") @?= Just 96
+    , testCase "and the relative ones do not" do
+        parseUserUnits "50%" @?= Nothing
+        parseUserUnits "2em" @?= Nothing
+        parseUserUnits "2ex" @?= Nothing
+    ]
+
+--------------------------------------------------------------------------------
+-- Colors
+--------------------------------------------------------------------------------
+
+colors :: TestTree
+colors =
+  testGroup
+    "colors"
+    [ testCase "hexadecimal, short and long" do
+        parseColor "#f00" @?= Just (rgba 255 0 0 255)
+        parseColor "#FF0000" @?= Just (rgba 255 0 0 255)
+        parseColor "#f008" @?= Just (rgba 255 0 0 0x88)
+        parseColor "#ff000080" @?= Just (rgba 255 0 0 0x80)
+        parseColor "#ff00" @?= Just (rgba 255 255 0 0)
+        parseColor "#fffff" @?= Nothing
+    , testCase "rgb, however it is written" do
+        parseColor "rgb(255,0,0)" @?= Just (rgba 255 0 0 255)
+        parseColor "rgb(255 0 0)" @?= Just (rgba 255 0 0 255)
+        parseColor "rgb( 100%, 0%, 0% )" @?= Just (rgba 255 0 0 255)
+        parseColor "rgba(255,0,0,0.5)" @?= Just (rgba 255 0 0 128)
+        parseColor "rgb(255 0 0 / 50%)" @?= Just (rgba 255 0 0 128)
+        parseColor "rgb(300,-20,0)" @?= Just (rgba 255 0 0 255)
+    , testCase "hsl" do
+        parseColor "hsl(0,100%,50%)" @?= Just (rgba 255 0 0 255)
+        parseColor "hsl(120, 100%, 50%)" @?= Just (rgba 0 255 0 255)
+        parseColor "hsl(240deg 100% 50%)" @?= Just (rgba 0 0 255 255)
+        parseColor "hsl(0, 0%, 100%)" @?= Just (rgba 255 255 255 255)
+        parseColor "hsla(0,100%,50%,0.5)" @?= Just (rgba 255 0 0 128)
+    , testCase "all 148 keywords, in any case" do
+        parseColor "red" @?= Just (rgba 255 0 0 255)
+        parseColor "REBECCAPURPLE" @?= Just (rgba 0x66 0x33 0x99 255)
+        parseColor "rebeccapurple" @?= namedColor "rebeccapurple"
+        parseColor "lightgoldenrodyellow" @?= Just (rgba 0xfa 0xfa 0xd2 255)
+        parseColor "grey" @?= parseColor "gray"
+        parseColor "notacolor" @?= Nothing
+    , testCase "paint keywords are not colors" do
+        parsePaint "none" @?= Just PaintNone
+        parsePaint "transparent" @?= Just PaintNone
+        parsePaint "currentColor" @?= Just PaintCurrent
+        parsePaint " currentcolor " @?= Just PaintCurrent
+        parsePaint "red" @?= Just (PaintColor (rgba 255 0 0 255))
+        parsePaint "rgb(0,0,0)" @?= Just (PaintColor (rgba 0 0 0 255))
+    , testCase "and what cannot be read is not a paint" do
+        parsePaint "url(#grad)" @?= Nothing
+        parsePaint "inherit" @?= Nothing
+        parsePaint "" @?= Nothing
+    ]
+
+--------------------------------------------------------------------------------
+-- Paths
+--------------------------------------------------------------------------------
+
+paths :: TestTree
+paths =
+  testGroup
+    "path data"
+    [ testCase "absolute commands" $
+        parsePath "M1 2 L3 4 H5 V6 Z"
+          @?= [ MoveTo (Point 1 2)
+              , LineTo (Point 3 4)
+              , LineTo (Point 5 4)
+              , LineTo (Point 5 6)
+              , ClosePath
+              ]
+    , testCase "relative commands are resolved" $
+        parsePath "m1 2 l1 1 h1 v1 z"
+          @?= [ MoveTo (Point 1 2)
+              , LineTo (Point 2 3)
+              , LineTo (Point 3 3)
+              , LineTo (Point 3 4)
+              , ClosePath
+              ]
+    , testCase "a run of arguments repeats the command" $
+        parsePath "M1 1 2 2 3 3"
+          @?= [MoveTo (Point 1 1), LineTo (Point 2 2), LineTo (Point 3 3)]
+    , testCase "and a relative moveto repeats as a relative lineto" $
+        parsePath "m1 1 1 1 1 1"
+          @?= [MoveTo (Point 1 1), LineTo (Point 2 2), LineTo (Point 3 3)]
+    , testCase "after a closepath the current point is the subpath start" do
+        -- An explicit command after the Z draws from where the subpath
+        -- began, not from where it ended.
+        parsePath "M2 2 L4 4 Z l1 1"
+          @?= [ MoveTo (Point 2 2)
+              , LineTo (Point 4 4)
+              , ClosePath
+              , LineTo (Point 3 3)
+              ]
+        -- A bare pair after it opens a new subpath there instead.
+        parsePath "M2 2 L4 4 Z 1 1"
+          @?= [ MoveTo (Point 2 2)
+              , LineTo (Point 4 4)
+              , ClosePath
+              , MoveTo (Point 1 1)
+              ]
+    , testCase "S reflects a cubic control point" $
+        parsePath "M0 0 C1 1 2 2 3 3 S5 5 6 6"
+          @?= [ CubicTo (Point 1 1) (Point 2 2) (Point 3 3)
+              , CubicTo (Point 4 4) (Point 5 5) (Point 6 6)
+              ]
+            `prefixedByMove` Point 0 0
+    , testCase "but not a quadratic one" $
+        -- The previous command is a Q, so the S has nothing to reflect and
+        -- its first control point is the current point.
+        parsePath "M0 0 Q1 1 2 2 S5 5 6 6"
+          @?= [ QuadTo (Point 1 1) (Point 2 2)
+              , CubicTo (Point 2 2) (Point 5 5) (Point 6 6)
+              ]
+            `prefixedByMove` Point 0 0
+    , testCase "T reflects a quadratic control point" $
+        parsePath "M0 0 Q1 1 2 2 T4 4"
+          @?= [QuadTo (Point 1 1) (Point 2 2), QuadTo (Point 3 3) (Point 4 4)]
+            `prefixedByMove` Point 0 0
+    , testCase "arc flags need no separator" $
+        parsePath "M2 10a8 8 0 1 1 16 0z"
+          @?= parsePath "M2 10a8 8 0 1116 0z"
+    , testCase "and run into the numbers after them" $
+        parsePath "M0 0a1 1 0 00.5.5"
+          @?= [MoveTo (Point 0 0), ArcTo 1 1 0 False False (Point 0.5 0.5)]
+    , testCase "a malformed tail keeps what came before it" do
+        parsePath "M1 1 L2 2 L3" @?= [MoveTo (Point 1 1), LineTo (Point 2 2)]
+        parsePath "M1 1 L2 2 X9 9" @?= [MoveTo (Point 1 1), LineTo (Point 2 2)]
+        parsePath "" @?= []
+        parsePath "nonsense" @?= []
+    , testCase "commas and exponents in a d" $
+        parsePath "M1e1,1e1L2e1,2e1"
+          @?= [MoveTo (Point 10 10), LineTo (Point 20 20)]
+    , testProperty "a relative path draws where the absolute one does" \ps ->
+        let steps = take 12 (map (\(Small a, Small b) -> (a, b)) ps) :: [(Int, Int)]
+            absolute = scanl1 (\(x, y) (dx, dy) -> (x + dx, y + dy)) steps
+            render c = BC.unwords [BC.pack (show a <> " " <> show b) | (a, b) <- c]
+         in not (null steps) ==>
+              parsePath ("M0 0 l" <> render steps)
+                == parsePath ("M0 0 L" <> render absolute)
+    ]
+
+-- | A path's segments after the moveto that opened it.
+prefixedByMove :: [Segment] -> Point -> [Segment]
+prefixedByMove segs p = MoveTo p : segs
+
+--------------------------------------------------------------------------------
+-- Transforms
+--------------------------------------------------------------------------------
+
+transforms :: TestTree
+transforms =
+  testGroup
+    "transforms"
+    [ testCase "each function" do
+        parseTransform "matrix(1 2 3 4 5 6)" @?= Matrix 1 2 3 4 5 6
+        parseTransform "translate(5)" @?= Matrix 1 0 0 1 5 0
+        parseTransform "translate(5, 6)" @?= Matrix 1 0 0 1 5 6
+        parseTransform "scale(2)" @?= Matrix 2 0 0 2 0 0
+        parseTransform "scale(2,3)" @?= Matrix 2 0 0 3 0 0
+        parseTransform "" @?= identity
+        parseTransform "nonsense" @?= identity
+    , testCase "a rotation about a point leaves that point alone" $
+        let m = parseTransform "rotate(90 10 10)"
+            Point x y = transformPoint m (Point 10 10)
+         in (round x, round y) @?= (10 :: Int, 10 :: Int)
+    , testCase "a list composes left to right" $
+        let m = parseTransform "translate(10 0) scale(2)"
+         in transformPoint m (Point 1 1) @?= Point 12 2
+    , testCase "and the outer one is applied last" $
+        let m = parseTransform "scale(2) translate(10 0)"
+         in transformPoint m (Point 1 1) @?= Point 22 2
+    , testCase "a scale shows up in the length factor" do
+        averageScale (parseTransform "scale(3)") @?= 3
+        averageScale (parseTransform "translate(9 9)") @?= 1
+    ]
+
+--------------------------------------------------------------------------------
+-- XML
+--------------------------------------------------------------------------------
+
+xml :: TestTree
+xml =
+  testGroup
+    "xml"
+    [ testCase "elements and attributes" $
+        parseXml "<a x='1'><b/></a>"
+          @?= Right [Element "a" [Attribute "x" "1"] [Element "b" [] []]]
+    , testCase "namespace prefixes are dropped" $
+        fmap (map elementName) (parseXml "<svg:svg><svg:path/></svg:svg>")
+          @?= Right ["svg"]
+    , testCase "comments and instructions are not in the tree" $
+        fmap (map elementName) (parseXml "<?xml version='1.0'?><!--hi--><a/>")
+          @?= Right ["a"]
+    , testCase "a doctype is stepped over" $
+        fmap (map elementName) (parseXml "<!DOCTYPE svg PUBLIC \"x\" \"y\"><svg/>")
+          @?= Right ["svg"]
+    , testCase "including one with an internal subset" $
+        fmap (map elementName) (parseXml "<!DOCTYPE svg [<!ENTITY x \"y\">]><svg/>")
+          @?= Right ["svg"]
+    , testCase "and so is a byte-order mark" $
+        fmap (map elementName) (parseXml "\xEF\xBB\xBF<svg/>")
+          @?= Right ["svg"]
+    , testCase "entities in attribute values" do
+        decodeEntities "a&amp;b" @?= "a&b"
+        decodeEntities "&lt;&gt;&quot;&apos;" @?= "<>\"'"
+        decodeEntities "&#65;&#x42;&#X43;" @?= "ABC"
+        decodeEntities "&#x2713;" @?= "\xE2\x9C\x93"
+        decodeEntities "plain" @?= "plain"
+        decodeEntities "50% &amp; more" @?= "50% & more"
+    , testCase "an ampersand that begins nothing stands for itself" do
+        decodeEntities "a & b" @?= "a & b"
+        decodeEntities "&nosuch;" @?= "&nosuch;"
+        decodeEntities "&#;" @?= "&#;"
+    , testCase "attributes are looked up by local name" do
+        let el = Element "use" [Attribute "href" "#a"] []
+        attribute "href" el @?= Just "#a"
+        attribute "x" el @?= Nothing
+    , testCase "a document that is not one" $
+        assertBool "expected a Left" (isLeft (parseXml "<a><b></a>"))
+    ]
+
+isLeft :: Either a b -> Bool
+isLeft = either (const True) (const False)
+
+--------------------------------------------------------------------------------
+-- Documents
+--------------------------------------------------------------------------------
+
+documents :: TestTree
+documents =
+  testGroup
+    "documents"
+    [ testCase "a document needs an svg element" do
+        assertBool "expected a Left" (isLeft (parseSvg "<nope/>"))
+        assertBool "expected a Left" (isLeft (parseSvg "not xml at all"))
+    , testCase "the size and the box" do
+        sizeOf "<svg width='48' height='32'/>" @?= (48, 32)
+        sizeOf "<svg viewBox='0 0 24 24'/>" @?= (24, 24)
+        sizeOf "<svg width='48' height='48' viewBox='0 0 24 24'/>" @?= (48, 48)
+        sizeOf "<svg width='1in' height='1in'/>" @?= (96, 96)
+        -- A percentage is not a length, so the viewBox decides.
+        sizeOf "<svg width='100%' height='100%' viewBox='0 0 16 16'/>" @?= (16, 16)
+        sizeOf "<svg/>" @?= (24, 24)
+        boxOf "<svg viewBox='1 2 24 25'/>" @?= Box 1 2 24 25
+        -- A viewBox that is not four numbers, or has no extent, is not one.
+        boxOf "<svg width='8' height='9' viewBox='0 0 24'/>" @?= Box 0 0 8 9
+        boxOf "<svg width='8' height='9' viewBox='0 0 24 24 24'/>" @?= Box 0 0 8 9
+        boxOf "<svg width='8' height='9' viewBox='0 0 0 24'/>" @?= Box 0 0 8 9
+    , testCase "shapes come out in paint order" $
+        map (length . toList . shapeSegments) (shapesOf clock) @?= [4, 3]
+    , testCase "an icon drawn in currentColor is monochrome" do
+        fmap documentMonochrome (parseSvg clock) @?= Right True
+        fmap documentMonochrome (parseSvg holed) @?= Right False
+        fmap documentMonochrome (parseSvg "<svg><rect width='1' height='1'/></svg>")
+          @?= Right True
+    , testCase "presentation attributes are inherited" $
+        let sh =
+              oneShape "<svg stroke-width='3'><g stroke='red'><path d='M0 0L1 1'/></g></svg>"
+         in do
+              styleStrokeWidth (shapeStyle sh) @?= 3
+              styleStroke (shapeStyle sh) @?= Just (PaintColor (rgba 255 0 0 255))
+    , testCase "a style attribute outranks them" $
+        let sh = oneShape "<svg><path fill='red' style='fill: blue' d='M0 0L1 1'/></svg>"
+         in styleFill (shapeStyle sh) @?= Just (PaintColor (rgba 0 0 255 255))
+    , testCase "a value that cannot be read leaves the inherited one" $
+        let sh = oneShape "<svg fill='red'><path fill='url(#grad)' d='M0 0L1 1'/></svg>"
+         in styleFill (shapeStyle sh) @?= Just (PaintColor (rgba 255 0 0 255))
+    , testCase "an opacity may be a percentage" do
+        styleOpacity (shapeStyle (oneShape "<svg><path opacity='50%' d='M0 0L1 1'/></svg>"))
+          @?= 0.5
+        styleFillOpacity
+          (shapeStyle (oneShape "<svg><path fill-opacity='25%' d='M0 0L1 1'/></svg>"))
+          @?= 0.25
+    , testCase "opacity multiplies down the tree" $
+        let sh = oneShape "<svg opacity='0.5'><g opacity='0.5'><path d='M0 0L1 1'/></g></svg>"
+         in styleOpacity (shapeStyle sh) @?= 0.25
+    , testCase "and a style attribute outranks a presentation one there too" $
+        styleOpacity
+          ( shapeStyle
+              (oneShape "<svg><path opacity='0.5' style='opacity:0.25' d='M0 0L1 1'/></svg>")
+          )
+          @?= 0.25
+    , testCase "a switch draws the first child that draws anything" do
+        map (length . toList . shapeSegments) (shapesOf switchDoc) @?= [2]
+        shapesOf "<svg><switch><desc>nothing here</desc></switch></svg>" @?= []
+    , testCase "transforms compose down it" $
+        let sh =
+              oneShape
+                "<svg><g transform='translate(5 0)'><g transform='scale(2)'><path d='M1 1L1 1'/></g></g></svg>"
+         in transformPoint (shapeTransform sh) (Point 1 1) @?= Point 7 2
+    , testCase "the shape elements each become segments" do
+        map (length . toList . shapeSegments) (shapesOf rectangles) @?= [5, 10]
+        map
+          (length . toList . shapeSegments)
+          (shapesOf "<svg><circle r='5'/><ellipse rx='5' ry='3'/></svg>")
+          @?= [4, 4]
+        map
+          (length . toList . shapeSegments)
+          (shapesOf "<svg><line x2='5' y2='5'/></svg>")
+          @?= [2]
+        -- A polyline is not closed, so two points are two segments; the
+        -- polygon's three are a moveto, two linetos and a closepath.
+        map (length . toList . shapeSegments) (shapesOf polys) @?= [2, 4]
+    , testCase "a shape with no extent draws nothing" do
+        shapesOf "<svg><rect width='0' height='5'/></svg>" @?= []
+        shapesOf "<svg><circle r='0'/></svg>" @?= []
+        shapesOf "<svg><path d=''/></svg>" @?= []
+    , testCase "defs are not drawn where they stand" $
+        shapesOf "<svg><defs><rect id='r' width='1' height='1'/></defs></svg>" @?= []
+    , testCase "but a use draws them, offset and styled" $
+        let sh = oneShape useDoc
+         in do
+              transformPoint (shapeTransform sh) (Point 0 0) @?= Point 5 6
+              styleFill (shapeStyle sh) @?= Just (PaintColor (rgba 255 0 0 255))
+    , testCase "a use of a symbol draws its children" $
+        length (shapesOf symbolDoc) @?= 2
+    , testCase "the same target may be used more than once" $
+        length (shapesOf twiceDoc) @?= 2
+    , testCase "and a circular one draws each target once" do
+        -- A cycle is cut where it closes, so a group that references
+        -- itself several times cannot fan out: counting depth alone would
+        -- let four self-references become tens of thousands of shapes.
+        length (shapesOf (circularFanout 1)) @?= 1
+        length (shapesOf (circularFanout 4)) @?= 1
+        length (shapesOf (circularFanout 12)) @?= 1
+    , testCase "and a self-referential one terminates" $
+        length (shapesOf circular) <= 8 @?= True
+    , testCase "display and visibility prune the subtree" do
+        shapesOf "<svg><g display='none'><rect width='1' height='1'/></g></svg>" @?= []
+        shapesOf "<svg><rect style='display:none' width='1' height='1'/></svg>" @?= []
+        shapesOf "<svg><g visibility='hidden'><rect width='1' height='1'/></g></svg>"
+          @?= []
+        length
+          (shapesOf "<svg><g visibility='visible'><rect width='1' height='1'/></g></svg>")
+          @?= 1
+    , testCase "and a style declaration outranks the attribute there too" do
+        length
+          ( shapesOf
+              "<svg><rect display='none' style='display:inline' width='1' height='1'/></svg>"
+          )
+          @?= 1
+        shapesOf
+          "<svg><rect display='inline' style='display:none' width='1' height='1'/></svg>"
+          @?= []
+    , testCase "text, gradients and the rest are skipped" $
+        shapesOf
+          "<svg><text x='0'>hi</text><linearGradient id='g'/><foreignObject/></svg>"
+          @?= []
+    , testCase "the key follows the source" do
+        fmap documentKey (parseSvg clock) @?= fmap documentKey (parseSvg clock)
+        assertBool "different sources, different keys" $
+          fmap documentKey (parseSvg clock) /= fmap documentKey (parseSvg holed)
+    , testCase "and two documents are equal when their sources are" do
+        parseSvg clock @?= parseSvg clock
+        assertBool "different sources, different documents" $
+          parseSvg clock /= parseSvg holed
+    ]
+
+--------------------------------------------------------------------------------
+-- Fixtures
+--------------------------------------------------------------------------------
+
+-- | A Lucide-style icon: the shape the overwhelming majority of icon sets
+-- take, down to the comment in the middle.
+clock :: ByteString
+clock =
+  "<svg xmlns=\"http://www.w3.org/2000/svg\" width=\"24\" height=\"24\" viewBox=\"0 0 24 24\" fill=\"none\" \
+  \stroke=\"currentColor\" stroke-width=\"2\" stroke-linecap=\"round\" stroke-linejoin=\"round\">\
+  \<!-- a clock --><circle cx=\"12\" cy=\"12\" r=\"10\"/><path d=\"M12 6v6l4 2\"/></svg>"
+
+holed :: ByteString
+holed =
+  "<svg viewBox='0 0 10 10'><path fill-rule='evenodd' fill='#ff0000' d='M0 0h10v10H0z M3 3h4v4H3z'/>\
+  \<g transform='translate(5 0) scale(0.5)'><rect width='2' height='2' fill='rgb(0,0,255)'/></g></svg>"
+
+rectangles :: ByteString
+rectangles =
+  "<svg><rect width='4' height='4'/><rect width='4' height='4' rx='1'/></svg>"
+
+polys :: ByteString
+polys =
+  "<svg><polyline points='0,0 1,1'/><polygon points='0,0 1,0 1,1'/></svg>"
+
+useDoc :: ByteString
+useDoc =
+  "<svg><defs><rect id='r' width='1' height='1'/></defs>\
+  \<use xlink:href='#r' x='5' y='6' fill='red'/></svg>"
+
+symbolDoc :: ByteString
+symbolDoc =
+  "<svg><symbol id='s'><rect width='1' height='1'/><circle r='1'/></symbol>\
+  \<use href='#s'/></svg>"
+
+twiceDoc :: ByteString
+twiceDoc =
+  "<svg><defs><rect id='r' width='1' height='1'/></defs>\
+  \<use href='#r'/><use href='#r' x='5'/></svg>"
+
+-- | A group that refers to itself @n@ times and also draws one rectangle.
+circularFanout :: Int -> ByteString
+circularFanout n =
+  "<svg><defs><g id='a'>"
+    <> mconcat (replicate n "<use href='#a'/>")
+    <> "<rect width='1' height='1'/></g></defs><use href='#a'/></svg>"
+
+circular :: ByteString
+circular =
+  "<svg><defs><g id='a'><use href='#b'/></g><g id='b'><use href='#a'/>\
+  \<rect width='1' height='1'/></g></defs><use href='#a'/></svg>"
+
+switchDoc :: ByteString
+switchDoc =
+  "<svg><switch><desc>a description is not a drawing</desc>\
+  \<line x2='1' y2='1'/><rect width='9' height='9'/></switch></svg>"
+
+sizeOf :: ByteString -> (Float, Float)
+sizeOf = either (error "parse failed") documentSize . parseSvg
+
+boxOf :: ByteString -> Box
+boxOf = either (error "parse failed") documentViewBox . parseSvg
+
+shapesOf :: ByteString -> [Shape]
+shapesOf = either (error "parse failed") (toList . documentShapes) . parseSvg
+
+-- | The one shape a document was meant to have.
+oneShape :: ByteString -> Shape
+oneShape src = case shapesOf src of
+  [sh] -> sh
+  shs -> error ("expected one shape, got " <> show (length shs))