Permalink
Browse files

Add CHANGEATTRS and htmlAttrPair

Mistuke has pointed out that (!) does not allow attributes to be added
to a general (X)HTML tag while taking account of the attributes that
are already defined by the tag [1]. This can make it hard to generally
extend tags with attributes while even being sure that correct (X)HTML
is being generated (the standard prohibits the duplication of
attributes[2]).

In order to minimize disruption the existing interface has been
extended with an alternative class to `ADDATTRS` called `CHANGEATTRS`
and a deconstructor function, `htmlAttrPair`, for analysing the
(abstract) `HtmlAttr` type. With `CHANGEATTRS` a function is used to
transform the existing attributes (which can now be analysed with
`htmlAttrPair`) rather than being passed a list of attributes to add
to an HTML tag as is the case with `ADDATTRS`.

[1] #2

[2] http://www.w3.org/WAI/GL/WCAG20-TECHS/H94.html
  • Loading branch information...
1 parent 6b666b2 commit 5c08c761e1137610d5feb56aa8ff28c90754b097 @cdornan cdornan committed May 9, 2012
Showing with 28 additions and 8 deletions.
  1. +2 −0 .gitignore
  2. +2 −2 Text/XHtml/Frameset.hs
  3. +20 −2 Text/XHtml/Internals.hs
  4. +2 −2 Text/XHtml/Strict.hs
  5. +2 −2 Text/XHtml/Transitional.hs
View
@@ -3,3 +3,5 @@ dist
GNUmakefile
dist-install/
ghc.mk
+test.hs
+.hub
View
@@ -7,11 +7,11 @@ module Text.XHtml.Frameset (
-- * Data types
Html, HtmlAttr,
-- * Classes
- HTML(..), ADDATTRS(..),
+ HTML(..), ADDATTRS(..), CHANGEATTRS(..),
-- * Primitives and basic combinators
(<<), concatHtml, (+++),
noHtml, isNoHtml, tag, itag,
- emptyAttr, intAttr, strAttr, htmlAttr,
+ htmlAttrPair, emptyAttr, intAttr, strAttr, htmlAttr,
primHtml,
-- * Rendering
showHtml, renderHtml, prettyHtml,
View
@@ -46,6 +46,10 @@ data HtmlElement
data HtmlAttr = HtmlAttr String String
+htmlAttrPair :: HtmlAttr -> (String,String)
+htmlAttrPair (HtmlAttr n v) = (n,v)
+
+
newtype Html = Html { getHtmlElements :: [HtmlElement] }
@@ -93,14 +97,28 @@ instance HTML a => HTML (Maybe a) where
class ADDATTRS a where
(!) :: a -> [HtmlAttr] -> a
+-- | CHANGEATTRS is a more expressive alternative to ADDATTRS
+class CHANGEATTRS a where
+ changeAttrs :: a -> ([HtmlAttr]->[HtmlAttr]) -> a
+
instance (ADDATTRS b) => ADDATTRS (a -> b) where
- fn ! attr = \ arg -> fn arg ! attr
+ fn ! attr = \ arg -> fn arg ! attr
+
+instance (CHANGEATTRS b) => CHANGEATTRS (a -> b) where
+ changeAttrs fn f = \ arg -> changeAttrs (fn arg) f
instance ADDATTRS Html where
(Html htmls) ! attr = Html (map addAttrs htmls)
where
addAttrs (html@(HtmlTag { markupAttrs = attrs }) )
- = html { markupAttrs = attrs ++ attr }
+ = html { markupAttrs = attrs ++ attr }
+ addAttrs html = html
+
+instance CHANGEATTRS Html where
+ changeAttrs (Html htmls) f = Html (map addAttrs htmls)
+ where
+ addAttrs (html@(HtmlTag { markupAttrs = attrs }) )
+ = html { markupAttrs = f attrs }
addAttrs html = html
View
@@ -7,11 +7,11 @@ module Text.XHtml.Strict (
-- * Data types
Html, HtmlAttr,
-- * Classes
- HTML(..), ADDATTRS(..),
+ HTML(..), ADDATTRS(..), CHANGEATTRS(..),
-- * Primitives and basic combinators
(<<), concatHtml, (+++),
noHtml, isNoHtml, tag, itag,
- emptyAttr, intAttr, strAttr, htmlAttr,
+ htmlAttrPair, emptyAttr, intAttr, strAttr, htmlAttr,
primHtml, stringToHtmlString,
docType,
-- * Rendering
@@ -7,11 +7,11 @@ module Text.XHtml.Transitional (
-- * Data types
Html, HtmlAttr,
-- * Classes
- HTML(..), ADDATTRS(..),
+ HTML(..), ADDATTRS(..), CHANGEATTRS(..),
-- * Primitives and basic combinators
(<<), concatHtml, (+++),
noHtml, isNoHtml, tag, itag,
- emptyAttr, intAttr, strAttr, htmlAttr,
+ htmlAttrPair, emptyAttr, intAttr, strAttr, htmlAttr,
primHtml,
-- * Rendering
showHtml, renderHtml, prettyHtml,

0 comments on commit 5c08c76

Please sign in to comment.