{-# LANGUAGE OverloadedStrings #-}

module Diagrams.SVG.Arguments
    (
    -- * Attribute Parsing of classes of attributes
      coreAttributes
    , conditionalProcessingAttributes
    , documentEventAttributes
    , graphicalEventAttributes
    , presentationAttributes
    , filterPrimitiveAttributes
    , xlinkAttributes
    , xmlnsNameSpaces
    -- * Attributes for basic structure elements
    , svgAttrs
    , gAttrs
    , sAttrs
    , descAttrs
    , symbolAttrs
    , useAttrs
    , switchAttrs
    -- * Attributes for basic shape elements
    , rectAttrs
    , circleAttrs
    , ellipseAttrs
    , lineAttrs
    , polygonAttrs
    , pathAttrs
    -- * Other Attributes
    , clipPathAttrs
    , patternAttrs
    , imageAttrs
    , filterAttrs
    , linearGradAttrs
    , radialGradAttrs
    , setAttrs
    , stopAttrs
    , textAttrs
    , tspanAttrs
    , namedViewAttrs
    , perspectiveAttrs
    -- * Font Attributes
    , fontAttrs
    , fontFaceAttrs
    , glyphAttrs
    , missingGlyphAttrs
    , kernAttrs
    -- * Filter Effect Attributes
    , feBlendAttrs
    , feColorMatrixAttrs
    , feComponentTransferAttrs
    , feCompositeAttrs
    , feConvolveMatrixAttrs
    , feDiffuseLightingAttrs
    , feDisplacementMapAttrs
    , feFloodAttrs
    , feGaussianBlurAttrs
    , feImageAttrs
    , feMergeAttrs
    , feMorphologyAttrs
    , feOffsetAttrs
    , feSpecularLightingAttrs
    , feTileAttrs
    , feTurbulenceAttrs
    )
where
import Text.XML.Stream.Parse
import Diagrams.SVG.Attributes

coreAttributes :: AttrParser CoreAttributes
coreAttributes =
  do [Maybe Text]
l <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> AttrParser (Maybe Text)
attr
      [ Name
"id", Name
"base", Name
"lang", Name
"space"] -- "xml:base", "xml:lang", "xml:space"]
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (\[Maybe Text
a,Maybe Text
b,Maybe Text
c,Maybe Text
d] -> Maybe Text
-> Maybe Text -> Maybe Text -> Maybe Text -> CoreAttributes
CA Maybe Text
a Maybe Text
b Maybe Text
c Maybe Text
d) [Maybe Text]
l

conditionalProcessingAttributes :: AttrParser ConditionalProcessingAttributes
conditionalProcessingAttributes =
  do [Maybe Text]
l <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> AttrParser (Maybe Text)
attr
      [ Name
"requiredFeatures", Name
"requiredExtensions", Name
"systemLanguage"]
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (\[Maybe Text
a,Maybe Text
b,Maybe Text
c] -> Maybe Text
-> Maybe Text -> Maybe Text -> ConditionalProcessingAttributes
CPA Maybe Text
a Maybe Text
b Maybe Text
c) [Maybe Text]
l

documentEventAttributes :: AttrParser DocumentEventAttributes
documentEventAttributes =
  do [Maybe Text]
l <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> AttrParser (Maybe Text)
attr
      [ Name
"onunload", Name
"onabort", Name
"onerror", Name
"onresize", Name
"onscroll", Name
"onzoom"]
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (\[Maybe Text
a,Maybe Text
b,Maybe Text
c,Maybe Text
d,Maybe Text
e,Maybe Text
f] -> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> DocumentEventAttributes
DEA Maybe Text
a Maybe Text
b Maybe Text
c Maybe Text
d Maybe Text
e Maybe Text
f) [Maybe Text]
l

graphicalEventAttributes :: AttrParser GraphicalEventAttributes
graphicalEventAttributes =
  do [Maybe Text]
l <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> AttrParser (Maybe Text)
attr
      [ Name
"onfocusin", Name
"onfocusout", Name
"onactivate", Name
"onclick", Name
"onmousedown", Name
"onmouseup", 
        Name
"onmouseover", Name
"onmousemove", Name
"onmouseout", Name
"onload"]
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (\[Maybe Text
a,Maybe Text
b,Maybe Text
c,Maybe Text
d,Maybe Text
e,Maybe Text
f,Maybe Text
g,Maybe Text
h,Maybe Text
i,Maybe Text
j] -> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> GraphicalEventAttributes
GEA Maybe Text
a Maybe Text
b Maybe Text
c Maybe Text
d Maybe Text
e Maybe Text
f Maybe Text
g Maybe Text
h Maybe Text
i Maybe Text
j) [Maybe Text]
l

presentationAttributes :: AttrParser PresentationAttributes
presentationAttributes =
  do [Maybe Text]
l <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> AttrParser (Maybe Text)
attr
      [Name
"alignmentBaseline",Name
"baseline-shift",Name
"clip",Name
"clip-path", Name
"clip-rule",
       Name
"color", Name
"color-interpolation", Name
"color-interpolation-filters", Name
"color-profile",
       Name
"color-rendering", Name
"cursor", Name
"direction", Name
"display", Name
"dominant-baseline", Name
"enable-background",
       Name
"fill", Name
"fill-opacity", Name
"fill-rule", Name
"filter", Name
"flood-color", Name
"flood-opacity", Name
"font-family",
       Name
"font-size", Name
"font-size-adjust", Name
"font-stretch", Name
"font-style", Name
"font-variant", Name
"font-weight",
       Name
"glyph-orientation-horizontal", Name
"glyph-orientation-vertical", Name
"image-rendering", Name
"kerning",
       Name
"letter-spacing", Name
"lighting-color", Name
"marker-end", Name
"marker-mid", Name
"marker-start", Name
"mask",
       Name
"opacity", Name
"overflow", Name
"pointer-events", Name
"shape-rendering", Name
"stop-color", Name
"stop-opacity",
       Name
"stroke", Name
"stroke-dasharray", Name
"stroke-dashoffset", Name
"stroke-linecap", Name
"stroke-linejoin",
       Name
"stroke-miterlimit", Name
"stroke-opacity", Name
"stroke-width", Name
"text-anchor", Name
"text-decoration",
       Name
"text-rendering", Name
"unicode-bidi", Name
"visibility", Name
"word-spacing", Name
"writing-mode"]
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
      (\[Maybe Text
a,Maybe Text
b,Maybe Text
c0,Maybe Text
c1,Maybe Text
c2,Maybe Text
c3,Maybe Text
c4,Maybe Text
c5,Maybe Text
c6,Maybe Text
c7,Maybe Text
c8,Maybe Text
d0,Maybe Text
d1,Maybe Text
d2,Maybe Text
e,Maybe Text
f0,Maybe Text
f1,Maybe Text
f2,Maybe Text
f3,Maybe Text
f4,Maybe Text
f5,Maybe Text
f6,Maybe Text
f7,Maybe Text
f8,Maybe Text
f9,Maybe Text
f10,Maybe Text
f11,Maybe Text
f12,
        Maybe Text
g0,Maybe Text
g1,Maybe Text
i,Maybe Text
k,Maybe Text
l0,Maybe Text
l1,Maybe Text
m0,Maybe Text
m1,Maybe Text
m2,Maybe Text
m3,Maybe Text
o0,Maybe Text
o1,Maybe Text
p,Maybe Text
s0,Maybe Text
s1,Maybe Text
s2,Maybe Text
s3,Maybe Text
s4,Maybe Text
s5,Maybe Text
s6,Maybe Text
s7,Maybe Text
s8,Maybe Text
s9,Maybe Text
s10,Maybe Text
t0,Maybe Text
t1,Maybe Text
t2,Maybe Text
u,Maybe Text
v,Maybe Text
w0,Maybe Text
w1] ->
        Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> PresentationAttributes
PA Maybe Text
a Maybe Text
b Maybe Text
c0 Maybe Text
c1 Maybe Text
c2 Maybe Text
c3 Maybe Text
c4 Maybe Text
c5 Maybe Text
c6 Maybe Text
c7 Maybe Text
c8 Maybe Text
d0 Maybe Text
d1 Maybe Text
d2 Maybe Text
e Maybe Text
f0 Maybe Text
f1 Maybe Text
f2 Maybe Text
f3 Maybe Text
f4 Maybe Text
f5 Maybe Text
f6 Maybe Text
f7 Maybe Text
f8 Maybe Text
f9 Maybe Text
f10 Maybe Text
f11 Maybe Text
f12
        Maybe Text
g0 Maybe Text
g1 Maybe Text
i Maybe Text
k Maybe Text
l0 Maybe Text
l1 Maybe Text
m0 Maybe Text
m1 Maybe Text
m2 Maybe Text
m3 Maybe Text
o0 Maybe Text
o1 Maybe Text
p Maybe Text
s0 Maybe Text
s1 Maybe Text
s2 Maybe Text
s3 Maybe Text
s4 Maybe Text
s5 Maybe Text
s6 Maybe Text
s7 Maybe Text
s8 Maybe Text
s9 Maybe Text
s10 Maybe Text
t0 Maybe Text
t1 Maybe Text
t2 Maybe Text
u Maybe Text
v Maybe Text
w0 Maybe Text
w1 ) [Maybe Text]
l

filterPrimitiveAttributes :: AttrParser FilterPrimitiveAttributes
filterPrimitiveAttributes =
  do [Maybe Text]
l <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> AttrParser (Maybe Text)
attr
      [ Name
"x",Name
"y",Name
"widh",Name
"height",Name
"result"]
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (\[Maybe Text
x,Maybe Text
y,Maybe Text
w,Maybe Text
h,Maybe Text
r] -> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> FilterPrimitiveAttributes
FPA Maybe Text
x Maybe Text
y Maybe Text
w Maybe Text
h Maybe Text
r) [Maybe Text]
l


-- prefix :: Maybe T.Text -> T.Text -> Data.XML.Types.Name
-- prefix ns attribute = Name attribute ns Nothing

xlinkAttributes :: AttrParser XlinkAttributes
xlinkAttributes = -- xlinkNamespace is usually http://www.w3.org/1999/xlink
  do [Maybe Text]
l <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> AttrParser (Maybe Text)
attr
      [ Name
"{http://www.w3.org/1999/xlink}href", Name
"{http://www.w3.org/1999/xlink}show", Name
"{http://www.w3.org/1999/xlink}actuate",
        Name
"{http://www.w3.org/1999/xlink}type", Name
"{http://www.w3.org/1999/xlink}role", Name
"{http://www.w3.org/1999/xlink}arcrole",
        Name
"{http://www.w3.org/1999/xlink}title"]
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (\[Maybe Text
a,Maybe Text
b,Maybe Text
c,Maybe Text
d,Maybe Text
e,Maybe Text
f,Maybe Text
g] -> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> XlinkAttributes
XLA Maybe Text
a Maybe Text
b Maybe Text
c Maybe Text
d Maybe Text
e Maybe Text
f Maybe Text
g) [Maybe Text]
l

xmlnsNameSpaces :: AttrParser NameSpaces
xmlnsNameSpaces =
  do [Maybe Text]
l <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> AttrParser (Maybe Text)
attr
      [ Name
"{http://www.w3.org/2000/svg}xlink",Name
"{http://www.w3.org/2000/svg}dc", Name
"{http://www.w3.org/2000/svg}cc",
        Name
"{http://www.w3.org/2000/svg}rdf", Name
"{http://www.w3.org/2000/svg}svg", Name
"{http://www.w3.org/2000/svg}sodipodi",
        Name
"{http://www.w3.org/2000/svg}inkscape" ]
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (\[Maybe Text
xlink,Maybe Text
dc,Maybe Text
cc,Maybe Text
rdf,Maybe Text
svg,Maybe Text
sodipodi,Maybe Text
inkscape] -> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> NameSpaces
NSP Maybe Text
xlink Maybe Text
dc Maybe Text
cc Maybe Text
rdf Maybe Text
svg Maybe Text
sodipodi Maybe Text
inkscape) [Maybe Text]
l

xmlNameSpaces :: AttrParser (Maybe Text)
xmlNameSpaces =
  do [Maybe Text]
l <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> AttrParser (Maybe Text)
attr
      [ Name
"{http://www.w3.org/XML/1998/namespace}space" ] -- the only attribute that seems to be used so far in the xml namespace is  xml:space="preserve"
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (\[Maybe Text
space] -> Maybe Text
space) [Maybe Text]
l

--------------------------------------------------------------------------------------
-- Attributes for basic structure tags, see http://www.w3.org/TR/SVG/struct.html
--------------------------------------------------------------------------------------

-- | Attributes for \<svg\>, see <http://www.w3.org/TR/SVG/struct.html#SVGElement>
svgAttrs :: AttrParser
  (ConditionalProcessingAttributes, CoreAttributes,
   GraphicalEventAttributes, PresentationAttributes, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, NameSpaces, Maybe Text)
svgAttrs =
  do ConditionalProcessingAttributes
cpa <- AttrParser ConditionalProcessingAttributes
conditionalProcessingAttributes
     CoreAttributes
ca <- AttrParser CoreAttributes
coreAttributes
     GraphicalEventAttributes
gea <- AttrParser GraphicalEventAttributes
graphicalEventAttributes
     PresentationAttributes
pa <- AttrParser PresentationAttributes
presentationAttributes
     NameSpaces
xmlns <- AttrParser NameSpaces
xmlnsNameSpaces
     Maybe Text
xml <- AttrParser (Maybe Text)
xmlNameSpaces
     [Maybe Text]
l <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> AttrParser (Maybe Text)
attr
      [Name
"class",Name
"style",Name
"externalResourcesRequired",Name
"x",Name
"y",Name
"width",Name
"height",Name
"viewBox",Name
"preserveAspectRatio",
       Name
"zoomAndPan", Name
"version", Name
"baseProfile", Name
"contentScriptType", Name
"contentStyleType"]
     AttrParser ()
ignoreAttrs
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (\[Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
x,Maybe Text
y,Maybe Text
w,Maybe Text
h,Maybe Text
view,Maybe Text
ar,Maybe Text
zp,Maybe Text
ver,Maybe Text
baseprof,Maybe Text
cScripT,Maybe Text
cStyleT] -> 
              (ConditionalProcessingAttributes
cpa,CoreAttributes
ca,GraphicalEventAttributes
gea,PresentationAttributes
pa,Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
x,Maybe Text
y,Maybe Text
w,Maybe Text
h,Maybe Text
view,Maybe Text
ar,Maybe Text
zp,Maybe Text
ver,Maybe Text
baseprof,Maybe Text
cScripT,Maybe Text
cStyleT,NameSpaces
xmlns,Maybe Text
xml)) [Maybe Text]
l

-- | Attributes for \<g\> and \<defs\>, see <http://www.w3.org/TR/SVG/struct.html#GElement>
gAttrs :: AttrParser
  (ConditionalProcessingAttributes, CoreAttributes,
   GraphicalEventAttributes, PresentationAttributes, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text)
gAttrs =
  do ConditionalProcessingAttributes
cpa <- AttrParser ConditionalProcessingAttributes
conditionalProcessingAttributes
     CoreAttributes
ca <- AttrParser CoreAttributes
coreAttributes
     GraphicalEventAttributes
gea <- AttrParser GraphicalEventAttributes
graphicalEventAttributes
     PresentationAttributes
pa <- AttrParser PresentationAttributes
presentationAttributes
     Maybe Text
class_ <- Name -> AttrParser (Maybe Text)
attr Name
"class"
     Maybe Text
style <- Name -> AttrParser (Maybe Text)
attr Name
"style"
     Maybe Text
ext <- Name -> AttrParser (Maybe Text)
attr Name
"externalResourceRequired"
     Maybe Text
tr <- Name -> AttrParser (Maybe Text)
attr Name
"transform"
     AttrParser ()
ignoreAttrs
     forall (m :: * -> *) a. Monad m => a -> m a
return (ConditionalProcessingAttributes
cpa,CoreAttributes
ca,GraphicalEventAttributes
gea,PresentationAttributes
pa,Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
tr)

-- | Attributes for \<g\> and \<defs\>, see <http://www.w3.org/TR/SVG/struct.html#GElement>
sAttrs :: AttrParser (CoreAttributes, Maybe Text, Maybe Text, Maybe Text)
sAttrs =
  do CoreAttributes
ca <- AttrParser CoreAttributes
coreAttributes
     Maybe Text
type_ <- Name -> AttrParser (Maybe Text)
attr Name
"type"
     Maybe Text
media <- Name -> AttrParser (Maybe Text)
attr Name
"media"
     Maybe Text
title <- Name -> AttrParser (Maybe Text)
attr Name
"title"
     AttrParser ()
ignoreAttrs
     forall (m :: * -> *) a. Monad m => a -> m a
return (CoreAttributes
ca,Maybe Text
type_,Maybe Text
media,Maybe Text
title)

-- | Attributes for \<desc\>, see <http://www.w3.org/TR/SVG/struct.html#DescriptionAndTitleElements>
descAttrs :: AttrParser (CoreAttributes, Maybe Text, Maybe Text)
descAttrs =
  do CoreAttributes
ca <- AttrParser CoreAttributes
coreAttributes
     Maybe Text
class_ <- Name -> AttrParser (Maybe Text)
attr Name
"class"
     Maybe Text
style <- Name -> AttrParser (Maybe Text)
attr Name
"style"
     AttrParser ()
ignoreAttrs
     forall (m :: * -> *) a. Monad m => a -> m a
return (CoreAttributes
ca,Maybe Text
class_,Maybe Text
style)

-- | Attributes for \<symbol\>, see <http://www.w3.org/TR/SVG/struct.html#SymbolElement>
symbolAttrs :: AttrParser
  (CoreAttributes, GraphicalEventAttributes, PresentationAttributes,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
symbolAttrs =
  do CoreAttributes
ca <- AttrParser CoreAttributes
coreAttributes
     GraphicalEventAttributes
gea <- AttrParser GraphicalEventAttributes
graphicalEventAttributes
     PresentationAttributes
pa <- AttrParser PresentationAttributes
presentationAttributes
     [Maybe Text]
l <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> AttrParser (Maybe Text)
attr
      [Name
"class",Name
"style",Name
"externalResourcesRequired",Name
"preserveAspectRatio",Name
"viewBox"]
     AttrParser ()
ignoreAttrs
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (\[Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
ar,Maybe Text
viewbox] -> 
               (CoreAttributes
ca,GraphicalEventAttributes
gea,PresentationAttributes
pa,Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
ar,Maybe Text
viewbox) ) [Maybe Text]
l

-- | Attributes for \<use\>, see <http://www.w3.org/TR/SVG/struct.html#UseElement>
useAttrs :: AttrParser
  (CoreAttributes, ConditionalProcessingAttributes,
   GraphicalEventAttributes, PresentationAttributes, XlinkAttributes,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text)
useAttrs =
  do CoreAttributes
ca <- AttrParser CoreAttributes
coreAttributes
     ConditionalProcessingAttributes
cpa <- AttrParser ConditionalProcessingAttributes
conditionalProcessingAttributes
     GraphicalEventAttributes
gea <- AttrParser GraphicalEventAttributes
graphicalEventAttributes
     PresentationAttributes
pa <- AttrParser PresentationAttributes
presentationAttributes
     XlinkAttributes
xlink <- AttrParser XlinkAttributes
xlinkAttributes
     [Maybe Text]
l <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> AttrParser (Maybe Text)
attr
      [Name
"class",Name
"style",Name
"externalResourcesRequired",Name
"transform",Name
"x",Name
"y",Name
"width",Name
"height"]
     AttrParser ()
ignoreAttrs
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (\[Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
tr,Maybe Text
x,Maybe Text
y,Maybe Text
w,Maybe Text
h] -> 
      (CoreAttributes
ca,ConditionalProcessingAttributes
cpa,GraphicalEventAttributes
gea,PresentationAttributes
pa,XlinkAttributes
xlink,Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
tr,Maybe Text
x,Maybe Text
y,Maybe Text
w,Maybe Text
h)) [Maybe Text]
l

-- | Attributes for \<switch\>, see <http://www.w3.org/TR/SVG/struct.html#SwitchElement>
switchAttrs :: AttrParser
  (ConditionalProcessingAttributes, CoreAttributes,
   GraphicalEventAttributes, PresentationAttributes, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text)
switchAttrs =
  do ConditionalProcessingAttributes
cpa <- AttrParser ConditionalProcessingAttributes
conditionalProcessingAttributes
     CoreAttributes
ca <- AttrParser CoreAttributes
coreAttributes
     GraphicalEventAttributes
gea <- AttrParser GraphicalEventAttributes
graphicalEventAttributes
     PresentationAttributes
pa <- AttrParser PresentationAttributes
presentationAttributes
     Maybe Text
class_ <- Name -> AttrParser (Maybe Text)
attr Name
"class"
     Maybe Text
style <- Name -> AttrParser (Maybe Text)
attr Name
"style"
     Maybe Text
ext <- Name -> AttrParser (Maybe Text)
attr Name
"externalResourcesRequired"
     Maybe Text
tr <- Name -> AttrParser (Maybe Text)
attr Name
"transform"
     AttrParser ()
ignoreAttrs
     forall (m :: * -> *) a. Monad m => a -> m a
return (ConditionalProcessingAttributes
cpa,CoreAttributes
ca,GraphicalEventAttributes
gea,PresentationAttributes
pa,Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
tr)

--------------------------------------------------------------------------------------
-- Attributes for basic shape tags
--------------------------------------------------------------------------------------

-- | Attributes for \<rect\>,  see <http://www.w3.org/TR/SVG11/shapes.html#RectElement>
rectAttrs :: AttrParser
  (ConditionalProcessingAttributes, CoreAttributes,
   GraphicalEventAttributes, PresentationAttributes, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
rectAttrs =
  do ConditionalProcessingAttributes
cpa <- AttrParser ConditionalProcessingAttributes
conditionalProcessingAttributes
     CoreAttributes
ca <- AttrParser CoreAttributes
coreAttributes
     GraphicalEventAttributes
gea <- AttrParser GraphicalEventAttributes
graphicalEventAttributes
     PresentationAttributes
pa <- AttrParser PresentationAttributes
presentationAttributes
     [Maybe Text]
l <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> AttrParser (Maybe Text)
attr
      [Name
"class",Name
"style",Name
"externalResourcesRequired",Name
"preserveAspectRatio",Name
"transform",Name
"x",Name
"y",
       Name
"width",Name
"height",Name
"rx",Name
"ry"]
     AttrParser ()
ignoreAttrs
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (\[Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
ar,Maybe Text
tr,Maybe Text
x,Maybe Text
y,Maybe Text
w,Maybe Text
h,Maybe Text
rx,Maybe Text
ry] -> 
               (ConditionalProcessingAttributes
cpa,CoreAttributes
ca,GraphicalEventAttributes
gea,PresentationAttributes
pa,Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
ar,Maybe Text
tr,Maybe Text
x,Maybe Text
y,Maybe Text
w,Maybe Text
h,Maybe Text
rx,Maybe Text
ry) ) [Maybe Text]
l

-- | Attributes for \<circle\>,  see <http://www.w3.org/TR/SVG11/shapes.html#CircleElement>
circleAttrs :: AttrParser
  (ConditionalProcessingAttributes, CoreAttributes,
   GraphicalEventAttributes, PresentationAttributes, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text)
circleAttrs =
  do ConditionalProcessingAttributes
cpa <- AttrParser ConditionalProcessingAttributes
conditionalProcessingAttributes
     CoreAttributes
ca <- AttrParser CoreAttributes
coreAttributes
     GraphicalEventAttributes
gea <- AttrParser GraphicalEventAttributes
graphicalEventAttributes
     PresentationAttributes
pa <- AttrParser PresentationAttributes
presentationAttributes
     [Maybe Text]
l <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> AttrParser (Maybe Text)
attr
      [Name
"class",Name
"style",Name
"externalResourcesRequired",Name
"transform",Name
"r",Name
"cx",Name
"cy"]
     AttrParser ()
ignoreAttrs
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (\[Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
tr,Maybe Text
r,Maybe Text
cx,Maybe Text
cy] -> 
               (ConditionalProcessingAttributes
cpa,CoreAttributes
ca,GraphicalEventAttributes
gea,PresentationAttributes
pa,Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
tr,Maybe Text
r,Maybe Text
cx,Maybe Text
cy) ) [Maybe Text]
l

-- | Attributes for \<ellipse\>,  see <http://www.w3.org/TR/SVG11/shapes.html#EllipseElement>
ellipseAttrs :: AttrParser
  (ConditionalProcessingAttributes, CoreAttributes,
   GraphicalEventAttributes, PresentationAttributes, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text)
ellipseAttrs =
  do ConditionalProcessingAttributes
cpa <- AttrParser ConditionalProcessingAttributes
conditionalProcessingAttributes
     CoreAttributes
ca <- AttrParser CoreAttributes
coreAttributes
     GraphicalEventAttributes
gea <- AttrParser GraphicalEventAttributes
graphicalEventAttributes
     PresentationAttributes
pa <- AttrParser PresentationAttributes
presentationAttributes
     [Maybe Text]
l <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> AttrParser (Maybe Text)
attr
      [Name
"class",Name
"style",Name
"externalResourcesRequired",Name
"transform",Name
"rx",Name
"ry",Name
"cx",Name
"cy"]
     AttrParser ()
ignoreAttrs
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (\[Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
tr,Maybe Text
rx,Maybe Text
ry,Maybe Text
cx,Maybe Text
cy] -> 
               (ConditionalProcessingAttributes
cpa,CoreAttributes
ca,GraphicalEventAttributes
gea,PresentationAttributes
pa,Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
tr,Maybe Text
rx,Maybe Text
ry,Maybe Text
cx,Maybe Text
cy) ) [Maybe Text]
l

-- | Attributes for \<line\>,  see <http://www.w3.org/TR/SVG11/shapes.html#LineElement>
lineAttrs :: AttrParser
  (ConditionalProcessingAttributes, CoreAttributes,
   GraphicalEventAttributes, PresentationAttributes, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text)
lineAttrs =
  do ConditionalProcessingAttributes
cpa <- AttrParser ConditionalProcessingAttributes
conditionalProcessingAttributes
     CoreAttributes
ca <- AttrParser CoreAttributes
coreAttributes
     GraphicalEventAttributes
gea <- AttrParser GraphicalEventAttributes
graphicalEventAttributes
     PresentationAttributes
pa <- AttrParser PresentationAttributes
presentationAttributes
     [Maybe Text]
l <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> AttrParser (Maybe Text)
attr
      [Name
"class",Name
"style",Name
"externalResourcesRequired",Name
"transform",Name
"x1",Name
"y1",Name
"x2",Name
"y2"]
     AttrParser ()
ignoreAttrs
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (\[Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
tr,Maybe Text
x1,Maybe Text
y1,Maybe Text
x2,Maybe Text
y2] -> 
               (ConditionalProcessingAttributes
cpa,CoreAttributes
ca,GraphicalEventAttributes
gea,PresentationAttributes
pa,Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
tr,Maybe Text
x1,Maybe Text
y1,Maybe Text
x2,Maybe Text
y2) ) [Maybe Text]
l

-- | Attributes for \<polygon\>,  see <http://www.w3.org/TR/SVG11/shapes.html#PolygonElement>
polygonAttrs :: AttrParser
  (ConditionalProcessingAttributes, CoreAttributes,
   GraphicalEventAttributes, PresentationAttributes, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text)
polygonAttrs =
  do ConditionalProcessingAttributes
cpa <- AttrParser ConditionalProcessingAttributes
conditionalProcessingAttributes
     CoreAttributes
ca <- AttrParser CoreAttributes
coreAttributes
     GraphicalEventAttributes
gea <- AttrParser GraphicalEventAttributes
graphicalEventAttributes
     PresentationAttributes
pa <- AttrParser PresentationAttributes
presentationAttributes
     [Maybe Text]
l <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> AttrParser (Maybe Text)
attr
      [Name
"class",Name
"style",Name
"externalResourcesRequired",Name
"transform",Name
"points"]
     AttrParser ()
ignoreAttrs
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (\[Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
tr,Maybe Text
points] -> 
               (ConditionalProcessingAttributes
cpa,CoreAttributes
ca,GraphicalEventAttributes
gea,PresentationAttributes
pa,Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
tr,Maybe Text
points) ) [Maybe Text]
l

-- | Attributes for \<path\>,  see <http://www.w3.org/TR/SVG11/paths.html#PathElement>
pathAttrs :: AttrParser
  (ConditionalProcessingAttributes, CoreAttributes,
   GraphicalEventAttributes, PresentationAttributes, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
pathAttrs =
  do ConditionalProcessingAttributes
cpa <- AttrParser ConditionalProcessingAttributes
conditionalProcessingAttributes
     CoreAttributes
ca <- AttrParser CoreAttributes
coreAttributes
     GraphicalEventAttributes
gea <- AttrParser GraphicalEventAttributes
graphicalEventAttributes
     PresentationAttributes
pa <- AttrParser PresentationAttributes
presentationAttributes
     [Maybe Text]
l <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> AttrParser (Maybe Text)
attr
      [Name
"class",Name
"style",Name
"externalResourcesRequired",Name
"transform",Name
"d",Name
"pathLength"]
     AttrParser ()
ignoreAttrs
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (\[Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
tr,Maybe Text
d,Maybe Text
pathLength] -> 
               (ConditionalProcessingAttributes
cpa,CoreAttributes
ca,GraphicalEventAttributes
gea,PresentationAttributes
pa,Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
tr,Maybe Text
d,Maybe Text
pathLength) ) [Maybe Text]
l

-------------------------------------------------------------------------------------
-- | Attributes for \<clipPath\>, see <http://www.w3.org/TR/SVG/masking.html#ClipPathElement>
clipPathAttrs :: AttrParser
  (ConditionalProcessingAttributes, CoreAttributes,
   PresentationAttributes, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text)
clipPathAttrs =
  do ConditionalProcessingAttributes
cpa <- AttrParser ConditionalProcessingAttributes
conditionalProcessingAttributes
     CoreAttributes
ca <- AttrParser CoreAttributes
coreAttributes
     PresentationAttributes
pa <- AttrParser PresentationAttributes
presentationAttributes
     [Maybe Text]
l <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> AttrParser (Maybe Text)
attr
      [Name
"class",Name
"style",Name
"externalResourcesRequired",Name
"transform",Name
"clipPathUnits"]
     AttrParser ()
ignoreAttrs
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (\[Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
tr,Maybe Text
units] -> 
               (ConditionalProcessingAttributes
cpa,CoreAttributes
ca,PresentationAttributes
pa,Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
tr,Maybe Text
units) ) [Maybe Text]
l

-- | Attributes for \<pattern\>, see <http://www.w3.org/TR/SVG/pservers.html#PatternElement>
patternAttrs :: AttrParser
  (ConditionalProcessingAttributes, CoreAttributes,
   PresentationAttributes, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text)
patternAttrs =
  do ConditionalProcessingAttributes
cpa <- AttrParser ConditionalProcessingAttributes
conditionalProcessingAttributes
     CoreAttributes
ca <- AttrParser CoreAttributes
coreAttributes
     PresentationAttributes
pa <- AttrParser PresentationAttributes
presentationAttributes
     [Maybe Text]
l <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> AttrParser (Maybe Text)
attr
      [Name
"class",Name
"style",Name
"externalResourcesRequired",Name
"viewBox",Name
"preserveAspectRatio",Name
"x",Name
"y",
       Name
"width",Name
"height",Name
"patternUnits",Name
"patternContentUnits",Name
"patternTransform"]
     AttrParser ()
ignoreAttrs
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (\[Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
view,Maybe Text
ar,Maybe Text
x,Maybe Text
y,Maybe Text
w,Maybe Text
h,Maybe Text
pUnits,Maybe Text
pCUnits,Maybe Text
pTrans] -> 
               (ConditionalProcessingAttributes
cpa,CoreAttributes
ca,PresentationAttributes
pa,Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
view,Maybe Text
ar,Maybe Text
x,Maybe Text
y,Maybe Text
w,Maybe Text
h,Maybe Text
pUnits,Maybe Text
pCUnits,Maybe Text
pTrans) ) [Maybe Text]
l

-- | Attributes for \<image\>, see <http://www.w3.org/TR/SVG/struct.html#ImageElement>
imageAttrs :: AttrParser
  (CoreAttributes, ConditionalProcessingAttributes,
   GraphicalEventAttributes, XlinkAttributes, PresentationAttributes,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text)
imageAttrs =
  do CoreAttributes
ca <- AttrParser CoreAttributes
coreAttributes
     ConditionalProcessingAttributes
cpa <- AttrParser ConditionalProcessingAttributes
conditionalProcessingAttributes
     GraphicalEventAttributes
gea <- AttrParser GraphicalEventAttributes
graphicalEventAttributes
     XlinkAttributes
xlink <- AttrParser XlinkAttributes
xlinkAttributes
     PresentationAttributes
pa <- AttrParser PresentationAttributes
presentationAttributes
     [Maybe Text]
l <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> AttrParser (Maybe Text)
attr
      [Name
"class",Name
"style",Name
"externalResourcesRequired",Name
"preserveAspectRatio",Name
"transform",
       Name
"x",Name
"y",Name
"width",Name
"height"]
     AttrParser ()
ignoreAttrs
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (\[Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
ar,Maybe Text
tr,Maybe Text
x,Maybe Text
y,Maybe Text
w,Maybe Text
h] -> 
               (CoreAttributes
ca,ConditionalProcessingAttributes
cpa,GraphicalEventAttributes
gea,XlinkAttributes
xlink,PresentationAttributes
pa,Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
ar,Maybe Text
tr,Maybe Text
x,Maybe Text
y,Maybe Text
w,Maybe Text
h) ) [Maybe Text]
l

-- | Attributes for \<font\>
fontAttrs :: AttrParser
  (CoreAttributes, PresentationAttributes, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text)
fontAttrs =
  do CoreAttributes
ca <- AttrParser CoreAttributes
coreAttributes
     PresentationAttributes
pa <- AttrParser PresentationAttributes
presentationAttributes
     [Maybe Text]
l <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> AttrParser (Maybe Text)
attr
      [Name
"class",Name
"style",Name
"externalResourcesRequired",Name
"horiz-origin-x",Name
"horiz-origin-y",Name
"horiz-adv-x",
       Name
"vert-origin-x",Name
"vert-origin-y",Name
"vert-adv-y"]
     AttrParser ()
ignoreAttrs
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (\[Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
horizOriginX,Maybe Text
horizOriginY,Maybe Text
horizAdvX,Maybe Text
vertOriginX,Maybe Text
vertOriginY,Maybe Text
vertAdvY] -> 
               (CoreAttributes
ca,PresentationAttributes
pa,Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
horizOriginX,Maybe Text
horizOriginY,Maybe Text
horizAdvX,Maybe Text
vertOriginX,Maybe Text
vertOriginY,Maybe Text
vertAdvY) ) [Maybe Text]
l

-- | Attributes for \<font-face\>
fontFaceAttrs :: AttrParser
  (CoreAttributes, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text)
fontFaceAttrs =
  do CoreAttributes
ca <- AttrParser CoreAttributes
coreAttributes
     [Maybe Text]
l <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> AttrParser (Maybe Text)
attr
      [Name
"font-family",Name
"font-style",Name
"font-variant",Name
"font-weight",Name
"font-stretch",Name
"font-size",Name
"unicode-range",Name
"units-per-em",Name
"panose-1",
       Name
"stemv",Name
"stemh",Name
"slope",Name
"cap-height",Name
"x-height",Name
"accent-height", Name
"ascent", Name
"descent", Name
"widths", Name
"bbox", Name
"ideographic",
       Name
"alphabetic",Name
"mathematical", Name
"hanging", Name
"v-ideographic", Name
"v-alphabetic", Name
"v-mathematical", Name
"v-hanging", Name
"underline-position",
       Name
"underline-thickness", Name
"strikethrough-position", Name
"strikethrough-thickness", Name
"overline-position", Name
"overline-thickness"]
     AttrParser ()
ignoreAttrs
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (\[Maybe Text
fontFamily,Maybe Text
fontStyle,Maybe Text
fontVariant,Maybe Text
fontWeight,Maybe Text
fontStretch,Maybe Text
fontSize,Maybe Text
unicodeRange,Maybe Text
unitsPerEm,Maybe Text
panose1,
                 Maybe Text
stemv,Maybe Text
stemh,Maybe Text
slope,Maybe Text
capHeight,Maybe Text
xHeight,Maybe Text
accentHeight,Maybe Text
ascent,Maybe Text
descent,Maybe Text
widths,Maybe Text
bbox,Maybe Text
ideographic,Maybe Text
alphabetic,Maybe Text
mathematical,
                 Maybe Text
hanging,Maybe Text
vIdeographic,Maybe Text
vAlphabetic,Maybe Text
vMathematical,Maybe Text
vHanging,Maybe Text
underlinePosition,Maybe Text
underlineThickness,Maybe Text
strikethroughPosition,
                 Maybe Text
strikethroughThickness,Maybe Text
overlinePosition,Maybe Text
overlineThickness] -> 
               (CoreAttributes
ca,Maybe Text
fontFamily,Maybe Text
fontStyle,Maybe Text
fontVariant,Maybe Text
fontWeight,Maybe Text
fontStretch,Maybe Text
fontSize,Maybe Text
unicodeRange,Maybe Text
unitsPerEm,Maybe Text
panose1,
                 Maybe Text
stemv,Maybe Text
stemh,Maybe Text
slope,Maybe Text
capHeight,Maybe Text
xHeight,Maybe Text
accentHeight,Maybe Text
ascent,Maybe Text
descent,Maybe Text
widths,Maybe Text
bbox,Maybe Text
ideographic,Maybe Text
alphabetic,Maybe Text
mathematical,
                 Maybe Text
hanging,Maybe Text
vIdeographic,Maybe Text
vAlphabetic,Maybe Text
vMathematical,Maybe Text
vHanging,Maybe Text
underlinePosition,Maybe Text
underlineThickness,Maybe Text
strikethroughPosition,
                 Maybe Text
strikethroughThickness,Maybe Text
overlinePosition,Maybe Text
overlineThickness) ) [Maybe Text]
l

missingGlyphAttrs :: AttrParser
  (CoreAttributes, PresentationAttributes, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
missingGlyphAttrs =
  do CoreAttributes
ca <- AttrParser CoreAttributes
coreAttributes
     PresentationAttributes
pa <- AttrParser PresentationAttributes
presentationAttributes
     [Maybe Text]
l <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> AttrParser (Maybe Text)
attr
      [Name
"class",Name
"style",Name
"d",Name
"horiz-adv-x",Name
"vert-origin-x",Name
"vert-origin-y",Name
"vert-adv-y"]
     AttrParser ()
ignoreAttrs
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (\[Maybe Text
class_,Maybe Text
style,Maybe Text
d,Maybe Text
horizAdvX,Maybe Text
vertOriginX,Maybe Text
vertOriginY,Maybe Text
vertAdvY] -> 
               (CoreAttributes
ca,PresentationAttributes
pa,Maybe Text
class_,Maybe Text
style,Maybe Text
d,Maybe Text
horizAdvX,Maybe Text
vertOriginX,Maybe Text
vertOriginY,Maybe Text
vertAdvY) ) [Maybe Text]
l

glyphAttrs :: AttrParser
  (CoreAttributes, PresentationAttributes, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
glyphAttrs =
  do CoreAttributes
ca <- AttrParser CoreAttributes
coreAttributes
     PresentationAttributes
pa <- AttrParser PresentationAttributes
presentationAttributes
     [Maybe Text]
l <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> AttrParser (Maybe Text)
attr
      [Name
"class",Name
"style",Name
"d",Name
"horiz-adv-x",Name
"vert-origin-x",Name
"vert-origin-y",Name
"vert-adv-y",Name
"unicode",Name
"glyph-name",
       Name
"orientation",Name
"arabic-form",Name
"lang"]
     AttrParser ()
ignoreAttrs
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (\[Maybe Text
class_,Maybe Text
style,Maybe Text
d,Maybe Text
horizAdvX,Maybe Text
vertOriginX,Maybe Text
vertOriginY,Maybe Text
vertAdvY,Maybe Text
unicode,Maybe Text
glyphName,Maybe Text
orientation,Maybe Text
arabicForm,Maybe Text
lang] -> 
               (CoreAttributes
ca,PresentationAttributes
pa,Maybe Text
class_,Maybe Text
style,Maybe Text
d,Maybe Text
horizAdvX,Maybe Text
vertOriginX,Maybe Text
vertOriginY,Maybe Text
vertAdvY,Maybe Text
unicode,Maybe Text
glyphName,Maybe Text
orientation,Maybe Text
arabicForm,Maybe Text
lang) ) [Maybe Text]
l

kernAttrs :: AttrParser
  (CoreAttributes, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text)
kernAttrs =
  do CoreAttributes
ca <- AttrParser CoreAttributes
coreAttributes
     [Maybe Text]
l <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> AttrParser (Maybe Text)
attr
      [Name
"u1",Name
"g1",Name
"u2",Name
"g2",Name
"k"]
     AttrParser ()
ignoreAttrs
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (\[Maybe Text
u1,Maybe Text
g1,Maybe Text
u2,Maybe Text
g2,Maybe Text
k] -> 
               (CoreAttributes
ca,Maybe Text
u1,Maybe Text
g1,Maybe Text
u2,Maybe Text
g2,Maybe Text
k) ) [Maybe Text]
l


-- | Attributes for \<filter\>, see <http://www.w3.org/TR/SVG/filters.html#FilterElement>
filterAttrs :: AttrParser
  (CoreAttributes, PresentationAttributes, XlinkAttributes,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
filterAttrs =
  do CoreAttributes
ca <- AttrParser CoreAttributes
coreAttributes
     PresentationAttributes
pa <- AttrParser PresentationAttributes
presentationAttributes
     XlinkAttributes
xlink <- AttrParser XlinkAttributes
xlinkAttributes
     [Maybe Text]
l <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> AttrParser (Maybe Text)
attr
      [Name
"class",Name
"style",Name
"externalResourcesRequired",Name
"x",Name
"y",Name
"width",Name
"height",Name
"filterRes",Name
"filterUnits",Name
"primitiveUnits"]
     AttrParser ()
ignoreAttrs
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (\[Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
x,Maybe Text
y,Maybe Text
w,Maybe Text
h,Maybe Text
filterRes,Maybe Text
filterUnits,Maybe Text
primUnits] -> 
                (CoreAttributes
ca,PresentationAttributes
pa,XlinkAttributes
xlink,Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
x,Maybe Text
y,Maybe Text
w,Maybe Text
h,Maybe Text
filterRes,Maybe Text
filterUnits,Maybe Text
primUnits) ) [Maybe Text]
l

linearGradAttrs :: AttrParser
  (CoreAttributes, PresentationAttributes, XlinkAttributes,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
linearGradAttrs =
  do CoreAttributes
ca <- AttrParser CoreAttributes
coreAttributes
     PresentationAttributes
pa <- AttrParser PresentationAttributes
presentationAttributes
     XlinkAttributes
xlink <- AttrParser XlinkAttributes
xlinkAttributes
     [Maybe Text]
l <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> AttrParser (Maybe Text)
attr
      [Name
"class",Name
"style",Name
"externalResourcesRequired",Name
"x1",Name
"y1",Name
"x2",Name
"y2",Name
"gradientUnits",Name
"gradientTransform",Name
"spreadMethod"]
     AttrParser ()
ignoreAttrs
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$        (\[Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
x1,Maybe Text
y1,Maybe Text
x2,Maybe Text
y2,Maybe Text
gradientUnits,Maybe Text
gradientTransform,Maybe Text
spreadMethod] -> 
       (CoreAttributes
ca,PresentationAttributes
pa,XlinkAttributes
xlink,Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
x1,Maybe Text
y1,Maybe Text
x2,Maybe Text
y2,Maybe Text
gradientUnits,Maybe Text
gradientTransform,Maybe Text
spreadMethod) ) [Maybe Text]
l

radialGradAttrs :: AttrParser
  (CoreAttributes, PresentationAttributes, XlinkAttributes,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text)
radialGradAttrs =
  do CoreAttributes
ca <- AttrParser CoreAttributes
coreAttributes
     PresentationAttributes
pa <- AttrParser PresentationAttributes
presentationAttributes
     XlinkAttributes
xlink <- AttrParser XlinkAttributes
xlinkAttributes
     [Maybe Text]
l <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> AttrParser (Maybe Text)
attr
      [Name
"class",Name
"style",Name
"externalResourcesRequired",Name
"cx",Name
"cy",Name
"r",Name
"fx",Name
"fy",Name
"gradientUnits",Name
"gradientTransform",Name
"spreadMethod"]
     AttrParser ()
ignoreAttrs
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$        (\[Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
cx,Maybe Text
cy,Maybe Text
r,Maybe Text
fx,Maybe Text
fy,Maybe Text
gradientUnits,Maybe Text
gradientTransform,Maybe Text
spreadMethod] -> 
       (CoreAttributes
ca,PresentationAttributes
pa,XlinkAttributes
xlink,Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
cx,Maybe Text
cy,Maybe Text
r,Maybe Text
fx,Maybe Text
fy,Maybe Text
gradientUnits,Maybe Text
gradientTransform,Maybe Text
spreadMethod) ) [Maybe Text]
l

setAttrs :: AttrParser
  (CoreAttributes, PresentationAttributes, XlinkAttributes)
setAttrs =
  do CoreAttributes
ca <- AttrParser CoreAttributes
coreAttributes
     PresentationAttributes
pa <- AttrParser PresentationAttributes
presentationAttributes
     XlinkAttributes
xlink <- AttrParser XlinkAttributes
xlinkAttributes
     AttrParser ()
ignoreAttrs
     forall (m :: * -> *) a. Monad m => a -> m a
return (CoreAttributes
ca,PresentationAttributes
pa,XlinkAttributes
xlink)

stopAttrs :: AttrParser
  (CoreAttributes, PresentationAttributes, XlinkAttributes,
   Maybe Text, Maybe Text, Maybe Text)
stopAttrs =
  do CoreAttributes
ca <- AttrParser CoreAttributes
coreAttributes
     PresentationAttributes
pa <- AttrParser PresentationAttributes
presentationAttributes
     XlinkAttributes
xlink <- AttrParser XlinkAttributes
xlinkAttributes
     Maybe Text
class_ <- Name -> AttrParser (Maybe Text)
attr Name
"class"
     Maybe Text
style  <- Name -> AttrParser (Maybe Text)
attr Name
"style"
     Maybe Text
offset <- Name -> AttrParser (Maybe Text)
attr Name
"offset"
     AttrParser ()
ignoreAttrs
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (CoreAttributes
ca,PresentationAttributes
pa,XlinkAttributes
xlink,Maybe Text
class_,Maybe Text
style,Maybe Text
offset)

-- | Attributes for \<text\>, see <http://www.w3.org/TR/SVG/text.html#TextElement>
textAttrs :: AttrParser
  (ConditionalProcessingAttributes, CoreAttributes,
   GraphicalEventAttributes, PresentationAttributes, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
textAttrs =
  do ConditionalProcessingAttributes
cpa <- AttrParser ConditionalProcessingAttributes
conditionalProcessingAttributes
     CoreAttributes
ca <- AttrParser CoreAttributes
coreAttributes
     GraphicalEventAttributes
gea <- AttrParser GraphicalEventAttributes
graphicalEventAttributes
     PresentationAttributes
pa <- AttrParser PresentationAttributes
presentationAttributes
     [Maybe Text]
l <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> AttrParser (Maybe Text)
attr
      [Name
"class",Name
"style",Name
"externalResourcesRequired",Name
"transform",Name
"lengthAdjust",
       Name
"x",Name
"y",Name
"dx",Name
"dy",Name
"rotate",Name
"textLength"]
     AttrParser ()
ignoreAttrs
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (\[Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
tr,Maybe Text
la,Maybe Text
x,Maybe Text
y,Maybe Text
dx,Maybe Text
dy,Maybe Text
rot,Maybe Text
textlen] -> 
               (ConditionalProcessingAttributes
cpa,CoreAttributes
ca,GraphicalEventAttributes
gea,PresentationAttributes
pa,Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
tr,Maybe Text
la,Maybe Text
x,Maybe Text
y,Maybe Text
dx,Maybe Text
dy,Maybe Text
rot,Maybe Text
textlen) ) [Maybe Text]
l

tspanAttrs :: AttrParser
  (ConditionalProcessingAttributes, CoreAttributes,
   GraphicalEventAttributes, PresentationAttributes, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
tspanAttrs =
  do ConditionalProcessingAttributes
cpa <- AttrParser ConditionalProcessingAttributes
conditionalProcessingAttributes
     CoreAttributes
ca <- AttrParser CoreAttributes
coreAttributes
     GraphicalEventAttributes
gea <- AttrParser GraphicalEventAttributes
graphicalEventAttributes
     PresentationAttributes
pa <- AttrParser PresentationAttributes
presentationAttributes
     [Maybe Text]
p <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> AttrParser (Maybe Text)
attr
      [ Name
"class",Name
"style",Name
"externalResourcesRequired", Name
"x", Name
"y", Name
"dx", Name
"dy", Name
"rotate", Name
"textLength", Name
"lengthAdjust", 
        Name
"{http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd}role" ]
     AttrParser ()
ignoreAttrs
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ( \[Maybe Text
class_, Maybe Text
style, Maybe Text
ext, Maybe Text
x, Maybe Text
y, Maybe Text
dx, Maybe Text
dy, Maybe Text
rotate, Maybe Text
textlen, Maybe Text
lAdjust, Maybe Text
role] -> 
                 (ConditionalProcessingAttributes
cpa,CoreAttributes
ca,GraphicalEventAttributes
gea,PresentationAttributes
pa,Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
x,Maybe Text
y,Maybe Text
dx,Maybe Text
dy,Maybe Text
rotate,Maybe Text
textlen,Maybe Text
lAdjust,Maybe Text
role) ) [Maybe Text]
p

namedViewAttrs :: AttrParser
  (Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text)
namedViewAttrs =
  do [Maybe Text]
l <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> AttrParser (Maybe Text)
attr
      [Name
"pagecolor",Name
"bordercolor",Name
"borderopacity",Name
"objecttolerance",Name
"gridtolerance",
       Name
"guidetolerance", Name
"id",Name
"showgrid"]
     [Maybe Text]
inkscape <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> AttrParser (Maybe Text)
attr
       [ Name
"{http://www.inkscape.org/namespaces/inkscape}pageopacity", Name
"{http://www.inkscape.org/namespaces/inkscape}pageshadow",
         Name
"{http://www.inkscape.org/namespaces/inkscape}window-width", Name
"{http://www.inkscape.org/namespaces/inkscape}window-height",
         Name
"{http://www.inkscape.org/namespaces/inkscape}zoom",
         Name
"{http://www.inkscape.org/namespaces/inkscape}cx", Name
"{http://www.inkscape.org/namespaces/inkscape}cy",
         Name
"{http://www.inkscape.org/namespaces/inkscape}window-x", Name
"{http://www.inkscape.org/namespaces/inkscape}window-y",
         Name
"{http://www.inkscape.org/namespaces/inkscape}window-maximized", Name
"{http://www.inkscape.org/namespaces/inkscape}current-layer"]
     AttrParser ()
ignoreAttrs
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (\[Maybe Text
pc,Maybe Text
bc,Maybe Text
bo,Maybe Text
ot,Maybe Text
gt,Maybe Text
gut,Maybe Text
id1,Maybe Text
sg] [Maybe Text
po,Maybe Text
ps,Maybe Text
ww,Maybe Text
wh,Maybe Text
zoom,Maybe Text
cx,Maybe Text
cy,Maybe Text
wx,Maybe Text
wy,Maybe Text
wm,Maybe Text
cl]->
                (Maybe Text
pc,Maybe Text
bc,Maybe Text
bo,Maybe Text
ot,Maybe Text
gt,Maybe Text
gut,Maybe Text
po,Maybe Text
ps,Maybe Text
ww,Maybe Text
wh,Maybe Text
id1,Maybe Text
sg,Maybe Text
zoom,Maybe Text
cx,Maybe Text
cy,Maybe Text
wx,Maybe Text
wy,Maybe Text
wm,Maybe Text
cl) ) [Maybe Text]
l [Maybe Text]
inkscape

{-   <inkscape:perspective
       sodipodi:type="inkscape:persp3d"
       inkscape:vp_x="0 : 212.5 : 1"
       inkscape:vp_y="0 : 1000 : 0"
       inkscape:vp_z="428.75 : 212.5 : 1"
       inkscape:persp3d-origin="214.375 : 141.66667 : 1"
       id="perspective5175" />
-}
perspectiveAttrs :: AttrParser
  (Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text)
perspectiveAttrs =
  do [Maybe Text]
p <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> AttrParser (Maybe Text)
attr
       [ Name
"{http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd}type",
         Name
"{http://www.inkscape.org/namespaces/inkscape}vp_x",
         Name
"{http://www.inkscape.org/namespaces/inkscape}vp_y",
         Name
"{http://www.inkscape.org/namespaces/inkscape}vp_z",
         Name
"{http://www.inkscape.org/namespaces/inkscape}persp3d-origin",
         Name
"id"]
     AttrParser ()
ignoreAttrs
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (\[Maybe Text
typ,Maybe Text
vp_x,Maybe Text
vp_y,Maybe Text
vp_z,Maybe Text
persp3d_origin,Maybe Text
id_] -> 
                (Maybe Text
typ,Maybe Text
vp_x,Maybe Text
vp_y,Maybe Text
vp_z,Maybe Text
persp3d_origin,Maybe Text
id_) ) [Maybe Text]
p

-------------------------------------------------------------------------------------------------------------

feBlendAttrs :: AttrParser
  (CoreAttributes, PresentationAttributes, FilterPrimitiveAttributes,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
feBlendAttrs =
  do CoreAttributes
ca <- AttrParser CoreAttributes
coreAttributes
     PresentationAttributes
pa <- AttrParser PresentationAttributes
presentationAttributes
     FilterPrimitiveAttributes
fpa <- AttrParser FilterPrimitiveAttributes
filterPrimitiveAttributes
     [Maybe Text]
l <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> AttrParser (Maybe Text)
attr
      [Name
"class",Name
"style",Name
"in",Name
"in2",Name
"mode"]
     AttrParser ()
ignoreAttrs
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (\[Maybe Text
class_,Maybe Text
style,Maybe Text
in1,Maybe Text
in2,Maybe Text
mode] -> (CoreAttributes
ca,PresentationAttributes
pa,FilterPrimitiveAttributes
fpa,Maybe Text
class_,Maybe Text
style,Maybe Text
in1,Maybe Text
in2,Maybe Text
mode) ) [Maybe Text]
l

feColorMatrixAttrs :: AttrParser
  (CoreAttributes, PresentationAttributes, FilterPrimitiveAttributes,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
feColorMatrixAttrs =
  do CoreAttributes
ca <- AttrParser CoreAttributes
coreAttributes
     PresentationAttributes
pa <- AttrParser PresentationAttributes
presentationAttributes
     FilterPrimitiveAttributes
fpa <- AttrParser FilterPrimitiveAttributes
filterPrimitiveAttributes
     [Maybe Text]
l <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> AttrParser (Maybe Text)
attr
      [Name
"class",Name
"style",Name
"in",Name
"type",Name
"values"]
     AttrParser ()
ignoreAttrs
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (\[Maybe Text
class_,Maybe Text
style,Maybe Text
in1,Maybe Text
type1,Maybe Text
values] -> (CoreAttributes
ca,PresentationAttributes
pa,FilterPrimitiveAttributes
fpa,Maybe Text
class_,Maybe Text
style,Maybe Text
in1,Maybe Text
type1,Maybe Text
values) ) [Maybe Text]
l

feComponentTransferAttrs :: AttrParser
  (CoreAttributes, PresentationAttributes, FilterPrimitiveAttributes,
   Maybe Text, Maybe Text, Maybe Text)
feComponentTransferAttrs =
  do CoreAttributes
ca <- AttrParser CoreAttributes
coreAttributes
     PresentationAttributes
pa <- AttrParser PresentationAttributes
presentationAttributes
     FilterPrimitiveAttributes
fpa <- AttrParser FilterPrimitiveAttributes
filterPrimitiveAttributes
     [Maybe Text]
l <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> AttrParser (Maybe Text)
attr
      [Name
"class",Name
"style",Name
"in"]
     AttrParser ()
ignoreAttrs
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (\[Maybe Text
class_,Maybe Text
style,Maybe Text
in1] -> (CoreAttributes
ca,PresentationAttributes
pa,FilterPrimitiveAttributes
fpa,Maybe Text
class_,Maybe Text
style,Maybe Text
in1) ) [Maybe Text]
l
feCompositeAttrs :: AttrParser
  (CoreAttributes, PresentationAttributes, FilterPrimitiveAttributes,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text)
feCompositeAttrs =
  do CoreAttributes
ca <- AttrParser CoreAttributes
coreAttributes
     PresentationAttributes
pa <- AttrParser PresentationAttributes
presentationAttributes
     FilterPrimitiveAttributes
fpa <- AttrParser FilterPrimitiveAttributes
filterPrimitiveAttributes
     [Maybe Text]
l <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> AttrParser (Maybe Text)
attr
      [Name
"class",Name
"style",Name
"in",Name
"in2",Name
"operator",Name
"k1",Name
"k2",Name
"k3",Name
"k4"]
     AttrParser ()
ignoreAttrs
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (\[Maybe Text
class_,Maybe Text
style,Maybe Text
in1,Maybe Text
in2,Maybe Text
operator,Maybe Text
k1,Maybe Text
k2,Maybe Text
k3,Maybe Text
k4] -> (CoreAttributes
ca,PresentationAttributes
pa,FilterPrimitiveAttributes
fpa,Maybe Text
class_,Maybe Text
style,Maybe Text
in1,Maybe Text
in2,Maybe Text
operator,Maybe Text
k1,Maybe Text
k2,Maybe Text
k3,Maybe Text
k4) ) [Maybe Text]
l

feConvolveMatrixAttrs :: AttrParser
  (CoreAttributes, Maybe Text, FilterPrimitiveAttributes, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
feConvolveMatrixAttrs =
  do CoreAttributes
ca <- AttrParser CoreAttributes
coreAttributes
     PresentationAttributes
pa <- AttrParser PresentationAttributes
presentationAttributes
     FilterPrimitiveAttributes
fpa <- AttrParser FilterPrimitiveAttributes
filterPrimitiveAttributes
     [Maybe Text]
l <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> AttrParser (Maybe Text)
attr
      [Name
"class",Name
"style",Name
"in",Name
"order",Name
"kernelMatrix",Name
"divisor",Name
"bias",Name
"targetX",Name
"targetY",Name
"edgeMode",Name
"kernelUnitLength",Name
"preserveAlpha"]
     AttrParser ()
ignoreAttrs
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (\[Maybe Text
class_,Maybe Text
style,Maybe Text
order,Maybe Text
km,Maybe Text
d,Maybe Text
bias,Maybe Text
tx,Maybe Text
ty,Maybe Text
em,Maybe Text
ku,Maybe Text
pa] -> (CoreAttributes
ca,Maybe Text
pa,FilterPrimitiveAttributes
fpa,Maybe Text
class_,Maybe Text
style,Maybe Text
order,Maybe Text
km,Maybe Text
d,Maybe Text
bias,Maybe Text
tx,Maybe Text
ty,Maybe Text
em,Maybe Text
ku,Maybe Text
pa) ) [Maybe Text]
l

feDiffuseLightingAttrs :: AttrParser
  (CoreAttributes, PresentationAttributes, FilterPrimitiveAttributes,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text)
feDiffuseLightingAttrs =
  do CoreAttributes
ca <- AttrParser CoreAttributes
coreAttributes
     PresentationAttributes
pa <- AttrParser PresentationAttributes
presentationAttributes
     FilterPrimitiveAttributes
fpa <- AttrParser FilterPrimitiveAttributes
filterPrimitiveAttributes
     [Maybe Text]
l <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> AttrParser (Maybe Text)
attr
      [Name
"class",Name
"style",Name
"in",Name
"surfaceScale",Name
"diffuseConstant",Name
"kernelUnitLength"]
     AttrParser ()
ignoreAttrs
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (\[Maybe Text
class_,Maybe Text
style,Maybe Text
in1,Maybe Text
surfaceScale,Maybe Text
diffuseConstant,Maybe Text
kuLength] -> (CoreAttributes
ca,PresentationAttributes
pa,FilterPrimitiveAttributes
fpa,Maybe Text
class_,Maybe Text
style,Maybe Text
in1,Maybe Text
surfaceScale,Maybe Text
diffuseConstant,Maybe Text
kuLength) ) [Maybe Text]
l

feDisplacementMapAttrs :: AttrParser
  (CoreAttributes, PresentationAttributes, FilterPrimitiveAttributes,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text)
feDisplacementMapAttrs =
  do CoreAttributes
ca <- AttrParser CoreAttributes
coreAttributes
     PresentationAttributes
pa <- AttrParser PresentationAttributes
presentationAttributes
     FilterPrimitiveAttributes
fpa <- AttrParser FilterPrimitiveAttributes
filterPrimitiveAttributes
     [Maybe Text]
l <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> AttrParser (Maybe Text)
attr
      [Name
"class",Name
"style",Name
"in",Name
"in2",Name
"scale",Name
"xChannelSelector",Name
"yChannelSelector"]
     AttrParser ()
ignoreAttrs
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (\[Maybe Text
class_,Maybe Text
style,Maybe Text
in1,Maybe Text
in2,Maybe Text
sc,Maybe Text
xChan,Maybe Text
yChan] -> (CoreAttributes
ca,PresentationAttributes
pa,FilterPrimitiveAttributes
fpa,Maybe Text
class_,Maybe Text
style,Maybe Text
in1,Maybe Text
in2,Maybe Text
sc,Maybe Text
xChan,Maybe Text
yChan) ) [Maybe Text]
l

feFloodAttrs :: AttrParser
  (CoreAttributes, PresentationAttributes, FilterPrimitiveAttributes,
   Maybe Text, Maybe Text)
feFloodAttrs =
  do CoreAttributes
ca <- AttrParser CoreAttributes
coreAttributes
     PresentationAttributes
pa <- AttrParser PresentationAttributes
presentationAttributes
     FilterPrimitiveAttributes
fpa <- AttrParser FilterPrimitiveAttributes
filterPrimitiveAttributes
     [Maybe Text]
l <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> AttrParser (Maybe Text)
attr
      [Name
"class",Name
"style"]
     AttrParser ()
ignoreAttrs
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (\[Maybe Text
class_,Maybe Text
style] -> (CoreAttributes
ca,PresentationAttributes
pa,FilterPrimitiveAttributes
fpa,Maybe Text
class_,Maybe Text
style) ) [Maybe Text]
l

feGaussianBlurAttrs :: AttrParser
  (CoreAttributes, PresentationAttributes, FilterPrimitiveAttributes,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text)
feGaussianBlurAttrs =
  do CoreAttributes
ca <- AttrParser CoreAttributes
coreAttributes
     PresentationAttributes
pa <- AttrParser PresentationAttributes
presentationAttributes
     FilterPrimitiveAttributes
fpa <- AttrParser FilterPrimitiveAttributes
filterPrimitiveAttributes
     [Maybe Text]
l <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> AttrParser (Maybe Text)
attr
      [Name
"class",Name
"style",Name
"in",Name
"stdDeviation"]
     AttrParser ()
ignoreAttrs
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (\[Maybe Text
class_,Maybe Text
style,Maybe Text
in1,Maybe Text
stdDeviation] -> (CoreAttributes
ca,PresentationAttributes
pa,FilterPrimitiveAttributes
fpa,Maybe Text
class_,Maybe Text
style,Maybe Text
in1,Maybe Text
stdDeviation) ) [Maybe Text]
l

feImageAttrs :: AttrParser
  (CoreAttributes, Maybe Text, FilterPrimitiveAttributes,
   XlinkAttributes, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
feImageAttrs =
  do CoreAttributes
ca <- AttrParser CoreAttributes
coreAttributes
     PresentationAttributes
pa <- AttrParser PresentationAttributes
presentationAttributes
     FilterPrimitiveAttributes
fpa <- AttrParser FilterPrimitiveAttributes
filterPrimitiveAttributes
     XlinkAttributes
xlink <- AttrParser XlinkAttributes
xlinkAttributes
     [Maybe Text]
l <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> AttrParser (Maybe Text)
attr
      [Name
"class",Name
"style",Name
"externalResourcesRequired",Name
"preserveAspectRatio"]
     AttrParser ()
ignoreAttrs
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (\[Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
pa] -> (CoreAttributes
ca,Maybe Text
pa,FilterPrimitiveAttributes
fpa,XlinkAttributes
xlink,Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
pa) ) [Maybe Text]
l

feMergeAttrs :: AttrParser
  (CoreAttributes, PresentationAttributes, FilterPrimitiveAttributes,
   Maybe Text, Maybe Text)
feMergeAttrs =
  do CoreAttributes
ca <- AttrParser CoreAttributes
coreAttributes
     PresentationAttributes
pa <- AttrParser PresentationAttributes
presentationAttributes
     FilterPrimitiveAttributes
fpa <- AttrParser FilterPrimitiveAttributes
filterPrimitiveAttributes
     [Maybe Text]
l <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> AttrParser (Maybe Text)
attr
      [Name
"class",Name
"style"]
     AttrParser ()
ignoreAttrs
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (\[Maybe Text
class_,Maybe Text
style] -> (CoreAttributes
ca,PresentationAttributes
pa,FilterPrimitiveAttributes
fpa,Maybe Text
class_,Maybe Text
style) ) [Maybe Text]
l

feMorphologyAttrs :: AttrParser
  (CoreAttributes, PresentationAttributes, FilterPrimitiveAttributes,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
feMorphologyAttrs =
  do CoreAttributes
ca <- AttrParser CoreAttributes
coreAttributes
     PresentationAttributes
pa <- AttrParser PresentationAttributes
presentationAttributes
     FilterPrimitiveAttributes
fpa <- AttrParser FilterPrimitiveAttributes
filterPrimitiveAttributes
     [Maybe Text]
l <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> AttrParser (Maybe Text)
attr
      [Name
"class",Name
"style",Name
"in",Name
"operator",Name
"radius"]
     AttrParser ()
ignoreAttrs 
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (\[Maybe Text
class_,Maybe Text
style,Maybe Text
in1,Maybe Text
operator,Maybe Text
radius] -> (CoreAttributes
ca,PresentationAttributes
pa,FilterPrimitiveAttributes
fpa,Maybe Text
class_,Maybe Text
style,Maybe Text
in1,Maybe Text
operator,Maybe Text
radius) ) [Maybe Text]
l

feOffsetAttrs :: AttrParser
  (CoreAttributes, PresentationAttributes, FilterPrimitiveAttributes,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
feOffsetAttrs =
  do CoreAttributes
ca <- AttrParser CoreAttributes
coreAttributes
     PresentationAttributes
pa <- AttrParser PresentationAttributes
presentationAttributes
     FilterPrimitiveAttributes
fpa <- AttrParser FilterPrimitiveAttributes
filterPrimitiveAttributes
     [Maybe Text]
l <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> AttrParser (Maybe Text)
attr
      [Name
"class",Name
"style",Name
"in",Name
"dx",Name
"dy"]
     AttrParser ()
ignoreAttrs
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (\[Maybe Text
class_,Maybe Text
style,Maybe Text
in1,Maybe Text
dx,Maybe Text
dy] -> (CoreAttributes
ca,PresentationAttributes
pa,FilterPrimitiveAttributes
fpa,Maybe Text
class_,Maybe Text
style,Maybe Text
in1,Maybe Text
dx,Maybe Text
dy) ) [Maybe Text]
l

feSpecularLightingAttrs :: AttrParser
  (CoreAttributes, PresentationAttributes, FilterPrimitiveAttributes,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text)
feSpecularLightingAttrs =
  do CoreAttributes
ca <- AttrParser CoreAttributes
coreAttributes
     PresentationAttributes
pa <- AttrParser PresentationAttributes
presentationAttributes
     FilterPrimitiveAttributes
fpa <- AttrParser FilterPrimitiveAttributes
filterPrimitiveAttributes
     [Maybe Text]
l <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> AttrParser (Maybe Text)
attr
      [Name
"class",Name
"style",Name
"in",Name
"surfaceScale",Name
"specularConstant",Name
"specularExponent",Name
"kernelUnitLength"]
     AttrParser ()
ignoreAttrs
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (\[Maybe Text
class_,Maybe Text
style,Maybe Text
in1,Maybe Text
surfaceScale,Maybe Text
sc,Maybe Text
se,Maybe Text
ku] -> (CoreAttributes
ca,PresentationAttributes
pa,FilterPrimitiveAttributes
fpa,Maybe Text
class_,Maybe Text
style,Maybe Text
in1,Maybe Text
surfaceScale,Maybe Text
sc,Maybe Text
se,Maybe Text
ku) ) [Maybe Text]
l

feTileAttrs :: AttrParser
  (CoreAttributes, PresentationAttributes, FilterPrimitiveAttributes,
   Maybe Text, Maybe Text, Maybe Text)
feTileAttrs =
  do CoreAttributes
ca <- AttrParser CoreAttributes
coreAttributes
     PresentationAttributes
pa <- AttrParser PresentationAttributes
presentationAttributes
     FilterPrimitiveAttributes
fpa <- AttrParser FilterPrimitiveAttributes
filterPrimitiveAttributes
     [Maybe Text]
l <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> AttrParser (Maybe Text)
attr
      [Name
"class",Name
"style",Name
"in"]
     AttrParser ()
ignoreAttrs
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (\[Maybe Text
class_,Maybe Text
style,Maybe Text
in1] -> (CoreAttributes
ca,PresentationAttributes
pa,FilterPrimitiveAttributes
fpa,Maybe Text
class_,Maybe Text
style,Maybe Text
in1) ) [Maybe Text]
l

feTurbulenceAttrs :: AttrParser
  (CoreAttributes, PresentationAttributes, FilterPrimitiveAttributes,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
feTurbulenceAttrs =
  do CoreAttributes
ca <- AttrParser CoreAttributes
coreAttributes
     PresentationAttributes
pa <- AttrParser PresentationAttributes
presentationAttributes
     FilterPrimitiveAttributes
fpa <- AttrParser FilterPrimitiveAttributes
filterPrimitiveAttributes
     [Maybe Text]
l <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> AttrParser (Maybe Text)
attr
      [Name
"class",Name
"style",Name
"in",Name
"in2",Name
"mode"]
     AttrParser ()
ignoreAttrs
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (\[Maybe Text
class_,Maybe Text
style,Maybe Text
in1,Maybe Text
in2,Maybe Text
mode] -> (CoreAttributes
ca,PresentationAttributes
pa,FilterPrimitiveAttributes
fpa,Maybe Text
class_,Maybe Text
style,Maybe Text
in1,Maybe Text
in2,Maybe Text
mode) ) [Maybe Text]
l