diff --git a/.project b/.project new file mode 100644 --- /dev/null +++ b/.project @@ -0,0 +1,11 @@ + + + xhtml + + + + + + + + diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,2 @@ +This package provides combinators for producing XHTML 1.0, including +the Strict, Transitional and Frameset variants. diff --git a/Text/XHtml.hs b/Text/XHtml.hs --- a/Text/XHtml.hs +++ b/Text/XHtml.hs @@ -5,8 +5,8 @@ -- Science and Technology, 1999-2001, -- (c) Bjorn Bringert, 2004-2006 -- License : BSD-style (see the file LICENSE) --- Maintainer : Bjorn Bringert --- Stability : experimental +-- Maintainer : Chris Dornan +-- Stability : stable -- Portability : portable -- -- An XHTML combinator library. diff --git a/Text/XHtml/BlockTable.hs b/Text/XHtml/BlockTable.hs --- a/Text/XHtml/BlockTable.hs +++ b/Text/XHtml/BlockTable.hs @@ -6,8 +6,8 @@ -- Copyright : (c) Andy Gill, and the Oregon Graduate Institute of -- Science and Technology, 1999-2001 -- License : BSD-style (see the file LICENSE) --- Maintainer : Bjorn Bringert --- Stability : experimental +-- Maintainer : Chris Dornan +-- Stability : stable -- Portability : portable -- -- An XHTML combinator library @@ -121,12 +121,12 @@ -- but is always true for these combinators. -- I should assert this! -- I should even prove this. - beside (x:xs) (y:ys) = (x ++ y) : beside xs ys - beside (x:xs) [] = x : xs ++ r - beside [] (y:ys) = y : ys ++ r - beside [] [] = r + beside' (x:xs) (y:ys) = (x ++ y) : beside' xs ys + beside' (x:xs) [] = x : xs ++ r + beside' [] (y:ys) = y : ys ++ r + beside' [] [] = r in - beside (lst1 []) (lst2 [])) + beside' (lst1 []) (lst2 [])) -- | trans flips (transposes) over the x and y axis of -- the table. It is only used internally, and typically diff --git a/Text/XHtml/Debug.hs b/Text/XHtml/Debug.hs --- a/Text/XHtml/Debug.hs +++ b/Text/XHtml/Debug.hs @@ -31,7 +31,7 @@ treeHtmls c ts = aboves (zipWith treeHtml' c ts) treeHtml' :: [String] -> HtmlTree -> HtmlTable - treeHtml' (c:_) (HtmlLeaf leaf) = cell + treeHtml' _ (HtmlLeaf leaf) = cell (td ! [width "100%"] << bold << leaf) @@ -86,19 +86,19 @@ debug (HtmlString str) = HtmlLeaf (spaceHtml +++ linesToHtml (lines str)) debug (HtmlTag { - markupTag = markupTag, - markupContent = markupContent, - markupAttrs = markupAttrs + markupTag = tag', + markupContent = content', + markupAttrs = attrs }) = - case markupContent of + case content' of Html [] -> HtmlNode hd [] noHtml Html xs -> HtmlNode hd (map debug xs) tl where - args = if null markupAttrs + args = if null attrs then "" - else " " ++ unwords (map show markupAttrs) - hd = xsmallFont << ("<" ++ markupTag ++ args ++ ">") - tl = xsmallFont << ("") + else " " ++ unwords (map show attrs) + hd = xsmallFont << ("<" ++ tag' ++ args ++ ">") + tl = xsmallFont << ("") bgcolor' :: String -> HtmlAttr bgcolor' c = thestyle ("background-color:" ++ c) diff --git a/Text/XHtml/Extras.hs b/Text/XHtml/Extras.hs --- a/Text/XHtml/Extras.hs +++ b/Text/XHtml/Extras.hs @@ -99,7 +99,7 @@ -- widget :: String -> String -> [HtmlAttr] -> Html -widget w n markupAttrs = input ! ([thetype w] ++ ns ++ markupAttrs) +widget w n attrs = input ! ([thetype w] ++ ns ++ attrs) where ns = if null n then [] else [name n,identifier n] checkbox :: String -> String -> Html diff --git a/Text/XHtml/Frameset.hs b/Text/XHtml/Frameset.hs --- a/Text/XHtml/Frameset.hs +++ b/Text/XHtml/Frameset.hs @@ -28,6 +28,7 @@ import Text.XHtml.Extras +docType :: String docType = "" diff --git a/Text/XHtml/Internals.hs b/Text/XHtml/Internals.hs --- a/Text/XHtml/Internals.hs +++ b/Text/XHtml/Internals.hs @@ -7,8 +7,8 @@ -- Science and Technology, 1999-2001, -- (c) Bjorn Bringert, 2004-2006 -- License : BSD-style (see the file LICENSE) --- Maintainer : Bjorn Bringert --- Stability : experimental +-- Maintainer : Chris Dornan +-- Stability : stable -- Portability : portable -- -- Internals of the XHTML combinator library. @@ -95,8 +95,8 @@ instance ADDATTRS Html where (Html htmls) ! attr = Html (map addAttrs htmls) where - addAttrs (html@(HtmlTag { markupAttrs = markupAttrs }) ) - = html { markupAttrs = markupAttrs ++ attr } + addAttrs (html@(HtmlTag { markupAttrs = attrs }) ) + = html { markupAttrs = attrs ++ attr } addAttrs html = html @@ -253,10 +253,10 @@ showHtml' (HtmlString str) = (++) str showHtml'(HtmlTag { markupTag = name, markupContent = html, - markupAttrs = markupAttrs }) + markupAttrs = attrs }) = if isNoHtml html && elem name validHtmlITags - then renderTag True name markupAttrs "" - else (renderTag False name markupAttrs "" + then renderTag True name attrs "" + else (renderTag False name attrs "" . foldr (.) id (map showHtml' (getHtmlElements html)) . renderEndTag name "") @@ -265,15 +265,15 @@ renderHtml' n (HtmlTag { markupTag = name, markupContent = html, - markupAttrs = markupAttrs }) + markupAttrs = attrs }) = if isNoHtml html && elem name validHtmlITags - then renderTag True name markupAttrs (nl n) - else (renderTag False name markupAttrs (nl n) + then renderTag True name attrs (nl n) + else (renderTag False name attrs (nl n) . foldr (.) id (map (renderHtml' (n+2)) (getHtmlElements html)) . renderEndTag name (nl n)) where - nl n = "\n" ++ replicate (n `div` 8) '\t' - ++ replicate (n `mod` 8) ' ' + nl n' = "\n" ++ replicate (n' `div` 8) '\t' + ++ replicate (n' `mod` 8) ' ' prettyHtml' :: HtmlElement -> [String] @@ -281,12 +281,12 @@ prettyHtml' (HtmlTag { markupTag = name, markupContent = html, - markupAttrs = markupAttrs }) + markupAttrs = attrs }) = if isNoHtml html && elem name validHtmlITags then - [rmNL (renderTag True name markupAttrs "" "")] + [rmNL (renderTag True name attrs "" "")] else - [rmNL (renderTag False name markupAttrs "" "")] ++ + [rmNL (renderTag False name attrs "" "")] ++ shift (concat (map prettyHtml' (getHtmlElements html))) ++ [rmNL (renderEndTag name "" "")] where @@ -301,15 +301,15 @@ -> String -- ^ Whitespace to add after attributes -> ShowS renderTag empty name attrs nl r - = "<" ++ name ++ showAttrs attrs ++ nl ++ close ++ r + = "<" ++ name ++ shownAttrs ++ nl ++ close ++ r where close = if empty then " />" else ">" - showAttrs attrs = concat [' ':showPair attr | attr <- attrs ] + shownAttrs = concat [' ':showPair attr | attr <- attrs ] showPair :: HtmlAttr -> String - showPair (HtmlAttr tag val) - = tag ++ "=\"" ++ val ++ "\"" + showPair (HtmlAttr key val) + = key ++ "=\"" ++ val ++ "\"" -- | Show an end tag renderEndTag :: String -- ^ Tag name diff --git a/Text/XHtml/Strict.hs b/Text/XHtml/Strict.hs --- a/Text/XHtml/Strict.hs +++ b/Text/XHtml/Strict.hs @@ -24,6 +24,7 @@ import Text.XHtml.Extras -- | The @DOCTYPE@ for XHTML 1.0 Strict. +docType :: String docType = "" diff --git a/Text/XHtml/Table.hs b/Text/XHtml/Table.hs --- a/Text/XHtml/Table.hs +++ b/Text/XHtml/Table.hs @@ -28,7 +28,7 @@ cell h = let cellFn x y = h ! (add x colspan $ add y rowspan $ []) - add 1 fn rest = rest + add 1 _ rest = rest add n fn rest = fn n : rest r = BT.single cellFn in @@ -60,7 +60,12 @@ beside a b = combine BT.beside (cell a) (cell b) (<->) = beside - +combine :: (BT.BlockTable (Int -> Int -> Html) -> + BT.BlockTable (Int -> Int -> Html) -> + BT.BlockTable (Int -> Int -> Html)) + -> HtmlTable + -> HtmlTable + -> HtmlTable combine fn (HtmlTable a) (HtmlTable b) = mkHtmlTable (a `fn` b) -- Both aboves and besides presume a non-empty list. diff --git a/Text/XHtml/Transitional.hs b/Text/XHtml/Transitional.hs --- a/Text/XHtml/Transitional.hs +++ b/Text/XHtml/Transitional.hs @@ -34,6 +34,7 @@ import Text.XHtml.Extras +docType :: String docType = "" diff --git a/xhtml.cabal b/xhtml.cabal --- a/xhtml.cabal +++ b/xhtml.cabal @@ -1,14 +1,16 @@ Name: xhtml -Version: 3000.2.0.1 +Version: 3000.2.0.2 Copyright: Bjorn Bringert 2004-2006, Andy Gill, and the Oregon Graduate Institute of Science and Technology, 1999-2001 -Maintainer: bjorn@bringert.net +Maintainer: Chris Dornan Author: Bjorn Bringert License: BSD3 License-file: LICENSE -build-depends: base +Build-depends: base >= 4.0 && < 4.5 Extensions: Synopsis: An XHTML combinator library +Category: Web, XML, Pretty Printer +Stability: Stable Description: This package provides combinators for producing XHTML 1.0, including the Strict, Transitional and Frameset variants. @@ -30,4 +32,4 @@ Text.XHtml.BlockTable, Text.XHtml.Extras, Text.XHtml.Internals -ghc-options: -O2 -W +ghc-options: -Wall