Repository : ssh://darcs.haskell.org//srv/darcs/packages/xhtml On branch : master
http://hackage.haskell.org/trac/ghc/changeset/5c08c761e1137610d5feb56aa8ff28c90754b097 >--------------------------------------------------------------- commit 5c08c761e1137610d5feb56aa8ff28c90754b097 Author: Chris Dornan <[email protected]> Date: Wed May 9 18:38:37 2012 +0100 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] https://github.com/haskell/xhtml/issues/2 [2] http://www.w3.org/WAI/GL/WCAG20-TECHS/H94.html >--------------------------------------------------------------- .gitignore | 2 ++ Text/XHtml/Frameset.hs | 4 ++-- Text/XHtml/Internals.hs | 22 ++++++++++++++++++++-- Text/XHtml/Strict.hs | 4 ++-- Text/XHtml/Transitional.hs | 4 ++-- 5 files changed, 28 insertions(+), 8 deletions(-) diff --git a/.gitignore b/.gitignore index 8fa219b..468db0f 100644 --- a/.gitignore +++ b/.gitignore @@ -3,3 +3,5 @@ dist GNUmakefile dist-install/ ghc.mk +test.hs +.hub diff --git a/Text/XHtml/Frameset.hs b/Text/XHtml/Frameset.hs index befc499..453bff1 100644 --- a/Text/XHtml/Frameset.hs +++ b/Text/XHtml/Frameset.hs @@ -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, diff --git a/Text/XHtml/Internals.hs b/Text/XHtml/Internals.hs index ed13e7d..083f19a 100644 --- a/Text/XHtml/Internals.hs +++ b/Text/XHtml/Internals.hs @@ -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 diff --git a/Text/XHtml/Strict.hs b/Text/XHtml/Strict.hs index fdb2a39..73dd343 100644 --- a/Text/XHtml/Strict.hs +++ b/Text/XHtml/Strict.hs @@ -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 diff --git a/Text/XHtml/Transitional.hs b/Text/XHtml/Transitional.hs index 71a8bce..99af40c 100644 --- a/Text/XHtml/Transitional.hs +++ b/Text/XHtml/Transitional.hs @@ -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, _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
