diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,31 @@ +Copyright 2001-2005, The University Court of the University of +Glasgow, Bjorn Bringert, Andy Gill, Ian Lynagh, Erik Meijer, Sven Panne + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +- Redistributions of source code must retain the above copyright notice, +this list of conditions and the following disclaimer. + +- Redistributions in binary form must reproduce the above copyright notice, +this list of conditions and the following disclaimer in the documentation +and/or other materials provided with the distribution. + +- Neither name of the University nor the names of its contributors may be +used to endorse or promote products derived from this software without +specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF +GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, +INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND +FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE +UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH +DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,6 @@ +module Main (main) where + +import Distribution.Simple (defaultMainWithHooks, defaultUserHooks) + +main :: IO () +main = defaultMainWithHooks defaultUserHooks diff --git a/Text/XHtml.hs b/Text/XHtml.hs new file mode 100644 --- /dev/null +++ b/Text/XHtml.hs @@ -0,0 +1,66 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Text.XHtml +-- Copyright : (c) Andy Gill, and the Oregon Graduate Institute of +-- Science and Technology, 1999-2001, +-- (c) Bjorn Bringert, 2004-2006 +-- License : BSD-style (see the file LICENSE) +-- Maintainer : Bjorn Bringert +-- Stability : experimental +-- Portability : portable +-- +-- An XHTML combinator library. +-- +-- Based on the original Text.Html library by Andy Gill. +-- See for +-- an introduction to that library. +-- +-- This module re-exports "Text.XHtml.Transitional", which produces +-- XHTML 1.0 Transitional. +-- Use "Text.XHtml.Strict" if you want XHTML 1.0 Strict, +-- and "Text.XHtml.Frameset" if you want +-- to produce XHTML 1.0 Frameset. +-- +-- See for more information about +-- XHTML 1.0. +----------------------------------------------------------------------------- + +{- +-- Changes by Bjorn Bringert: +-- +-- * produces XHTML 1.0 Transitional () +-- +-- * escapes characters inside attribute values +-- +-- * changed 'height' to a String attribute +-- +-- * added 'Monoid' instance for 'Html'. +-- +-- * added elements from HTML 4.0: 'abbr', 'acronym', 'bdo', 'button', 'col', +-- 'colgroup', 'del', 'iframe', 'ins', 'label', 'legend', 'noframes', +-- 'noscript', 'object', 'optgroup', 'script', 'strike', 'tbody', 'tfoot', +-- 'thead', and 'quote'. +-- +-- * 'defList' no longer makes terms bold. +-- +-- * deprecated functions for elements and attributes +-- deprecated in HTML 4.0 +-- +-- * hid or removed some internal functions. +-- +-- TODO: +-- +-- * add new attributes introduced in HTML 4.0 +-- +-- * character encoding +-} +module Text.XHtml ( + module Text.XHtml.Transitional, + module Text.XHtml.Table, + module Text.XHtml.Debug + ) where + +import Text.XHtml.Transitional +import Text.XHtml.Table +import Text.XHtml.Debug + diff --git a/Text/XHtml/BlockTable.hs b/Text/XHtml/BlockTable.hs new file mode 100644 --- /dev/null +++ b/Text/XHtml/BlockTable.hs @@ -0,0 +1,166 @@ +-- #hide + +----------------------------------------------------------------------------- +-- | +-- Module : Text.XHtml.BlockTable +-- 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 +-- Portability : portable +-- +-- An XHTML combinator library +-- +-- These combinators can be used to build formated 2D tables. +-- The specific target usage is for HTML table generation. +----------------------------------------------------------------------------- + +{- + Examples of use: + + > table1 :: BlockTable String + > table1 = single "Hello" +-----+ + |Hello| + This is a 1x1 cell +-----+ + Note: single has type + + single :: a -> BlockTable a + + So the cells can contain anything. + + > table2 :: BlockTable String + > table2 = single "World" +-----+ + |World| + +-----+ + + + > table3 :: BlockTable String + > table3 = table1 %-% table2 +-----%-----+ + |Hello%World| + % is used to indicate +-----%-----+ + the join edge between + the two Tables. + + > table4 :: BlockTable String + > table4 = table3 %/% table2 +-----+-----+ + |Hello|World| + Notice the padding on the %%%%%%%%%%%%% + smaller (bottom) cell to |World | + force the table to be a +-----------+ + rectangle. + + > table5 :: BlockTable String + > table5 = table1 %-% table4 +-----%-----+-----+ + |Hello%Hello|World| + Notice the padding on the | %-----+-----+ + leftmost cell, again to | %World | + force the table to be a +-----%-----------+ + rectangle. + + Now the table can be rendered with processTable, for example: + Main> processTable table5 + [[("Hello",(1,2)), + ("Hello",(1,1)), + ("World",(1,1))], + [("World",(2,1))]] :: [[([Char],(Int,Int))]] + Main> +-} +module Text.XHtml.BlockTable ( + -- * Datatypes + BlockTable, + -- * Contruction Functions + single, + above, + beside, + -- * Investigation Functions + getMatrix, + showsTable, + showTable, + ) where + +infixr 4 `beside` +infixr 3 `above` + + + +-- +-- * Construction Functions +-- + +-- Perhaps one day I'll write the Show instance +-- to show boxes aka the above ascii renditions. + +instance (Show a) => Show (BlockTable a) where + showsPrec p = showsTable + +type TableI a = [[(a,(Int,Int))]] -> [[(a,(Int,Int))]] + +data BlockTable a = Table (Int -> Int -> TableI a) Int Int + + +-- | Creates a (1x1) table entry +single :: a -> BlockTable a +single a = Table (\ x y z -> [(a,(x+1,y+1))] : z) 1 1 + + +-- | Composes tables vertically. +above :: BlockTable a -> BlockTable a -> BlockTable a + +-- | Composes tables horizontally. +beside :: BlockTable a -> BlockTable a -> BlockTable a + +t1 `above` t2 = trans (combine (trans t1) (trans t2) (.)) + +t1 `beside` t2 = combine t1 t2 (\ lst1 lst2 r -> + let + -- Note this depends on the fact that + -- that the result has the same number + -- of lines as the y dimention; one list + -- per line. This is not true in general + -- 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 + in + beside (lst1 []) (lst2 [])) + +-- | trans flips (transposes) over the x and y axis of +-- the table. It is only used internally, and typically +-- in pairs, ie. (flip ... munge ... (un)flip). +trans :: BlockTable a -> BlockTable a +trans (Table f1 x1 y1) = Table (flip f1) y1 x1 + +combine :: BlockTable a + -> BlockTable b + -> (TableI a -> TableI b -> TableI c) + -> BlockTable c +combine (Table f1 x1 y1) (Table f2 x2 y2) comb = Table new_fn (x1+x2) max_y + where + max_y = max y1 y2 + new_fn x y = + case compare y1 y2 of + EQ -> comb (f1 0 y) (f2 x y) + GT -> comb (f1 0 y) (f2 x (y + y1 - y2)) + LT -> comb (f1 0 (y + y2 - y1)) (f2 x y) + +-- +-- * Investigation Functions +-- + +-- | This is the other thing you can do with a Table; +-- turn it into a 2D list, tagged with the (x,y) +-- sizes of each cell in the table. +getMatrix :: BlockTable a -> [[(a,(Int,Int))]] +getMatrix (Table r _ _) = r 0 0 [] + +-- You can also look at a table + +showsTable :: (Show a) => BlockTable a -> ShowS +showsTable table = shows (getMatrix table) + +showTable :: (Show a) => BlockTable a -> String +showTable table = showsTable table "" diff --git a/Text/XHtml/Debug.hs b/Text/XHtml/Debug.hs new file mode 100644 --- /dev/null +++ b/Text/XHtml/Debug.hs @@ -0,0 +1,109 @@ +-- | This module contains functions for displaying +-- HTML as a pretty tree. +module Text.XHtml.Debug ( HtmlTree(..), treeHtml, treeColors, debugHtml ) where + +import Text.XHtml.Internals +import Text.XHtml.Extras +import Text.XHtml.Table +import Text.XHtml.Strict.Elements +import Text.XHtml.Strict.Attributes + +-- +-- * Tree Displaying Combinators +-- + +-- | The basic idea is you render your structure in the form +-- of this tree, and then use treeHtml to turn it into a Html +-- object with the structure explicit. +data HtmlTree + = HtmlLeaf Html + | HtmlNode Html [HtmlTree] Html + +treeHtml :: [String] -> HtmlTree -> Html +treeHtml colors h = table ! [ + border 0, + cellpadding 0, + cellspacing 2] << treeHtml' colors h + where + manycolors = scanr (:) [] + + treeHtmls :: [[String]] -> [HtmlTree] -> HtmlTable + treeHtmls c ts = aboves (zipWith treeHtml' c ts) + + treeHtml' :: [String] -> HtmlTree -> HtmlTable + treeHtml' (c:_) (HtmlLeaf leaf) = cell + (td ! [width "100%"] + << bold + << leaf) + treeHtml' (c:cs@(c2:_)) (HtmlNode hopen ts hclose) = + if null ts && isNoHtml hclose + then + cell hd + else if null ts + then + hd bar `beside` (td ! [bgcolor' c2] << spaceHtml) + tl + else + hd (bar `beside` treeHtmls morecolors ts) + tl + where + -- This stops a column of colors being the same + -- color as the immeduately outside nesting bar. + morecolors = filter ((/= c).head) (manycolors cs) + bar = td ! [bgcolor' c,width "10"] << spaceHtml + hd = td ! [bgcolor' c] << hopen + tl = td ! [bgcolor' c] << hclose + treeHtml' _ _ = error "The imposible happens" + +instance HTML HtmlTree where + toHtml x = treeHtml treeColors x + +-- type "length treeColors" to see how many colors are here. +treeColors = ["#88ccff","#ffffaa","#ffaaff","#ccffff"] ++ treeColors + + +-- +-- * Html Debugging Combinators +-- + +-- | This uses the above tree rendering function, and displays the +-- Html as a tree structure, allowing debugging of what is +-- actually getting produced. +debugHtml :: (HTML a) => a -> Html +debugHtml obj = table ! [border 0] << + ( th ! [bgcolor' "#008888"] + << underline' + << "Debugging Output" + td << (toHtml (debug' (toHtml obj))) + ) + where + + debug' :: Html -> [HtmlTree] + debug' (Html markups) = map debug markups + + debug :: HtmlElement -> HtmlTree + debug (HtmlString str) = HtmlLeaf (spaceHtml +++ + linesToHtml (lines str)) + debug (HtmlTag { + markupTag = markupTag, + markupContent = markupContent, + markupAttrs = markupAttrs + }) = + case markupContent of + Html [] -> HtmlNode hd [] noHtml + Html xs -> HtmlNode hd (map debug xs) tl + where + args = if null markupAttrs + then "" + else " " ++ unwords (map show markupAttrs) + hd = xsmallFont << ("<" ++ markupTag ++ args ++ ">") + tl = xsmallFont << ("") + +bgcolor' :: String -> HtmlAttr +bgcolor' c = thestyle ("background-color:" ++ c) + +underline' :: Html -> Html +underline' = thespan ! [thestyle ("text-decoration:underline")] + +xsmallFont :: Html -> Html +xsmallFont = thespan ! [thestyle ("font-size:x-small")] diff --git a/Text/XHtml/Extras.hs b/Text/XHtml/Extras.hs new file mode 100644 --- /dev/null +++ b/Text/XHtml/Extras.hs @@ -0,0 +1,126 @@ +-- #hide + +module Text.XHtml.Extras where + +import Text.XHtml.Internals +import Text.XHtml.Strict.Elements +import Text.XHtml.Strict.Attributes + +-- +-- * Converting strings to HTML +-- + +-- | Convert a 'String' to 'Html', converting +-- characters that need to be escaped to HTML entities. +stringToHtml :: String -> Html +stringToHtml = primHtml . stringToHtmlString + +-- | This converts a string, but keeps spaces as non-line-breakable. +lineToHtml :: String -> Html +lineToHtml = primHtml . concatMap htmlizeChar2 . stringToHtmlString + where + htmlizeChar2 ' ' = " " + htmlizeChar2 c = [c] + +-- | This converts a string, but keeps spaces as non-line-breakable, +-- and adds line breaks between each of the strings in the input list. +linesToHtml :: [String] -> Html +linesToHtml [] = noHtml +linesToHtml (x:[]) = lineToHtml x +linesToHtml (x:xs) = lineToHtml x +++ br +++ linesToHtml xs + +-- +-- * Html abbreviations +-- + +primHtmlChar :: String -> Html + +-- | Copyright sign. +copyright :: Html + +-- | Non-breaking space. +spaceHtml :: Html +bullet :: Html + + +primHtmlChar = \ x -> primHtml ("&" ++ x ++ ";") +copyright = primHtmlChar "copy" +spaceHtml = primHtmlChar "nbsp" +bullet = primHtmlChar "#149" + +-- | Same as 'paragraph'. +p :: Html -> Html +p = paragraph + +-- +-- * Hotlinks +-- + +type URL = String + +data HotLink = HotLink { + hotLinkURL :: URL, + hotLinkContents :: Html, + hotLinkAttributes :: [HtmlAttr] + } deriving Show + +instance HTML HotLink where + toHtml hl = anchor ! (href (hotLinkURL hl) : hotLinkAttributes hl) + << hotLinkContents hl + +hotlink :: URL -> Html -> HotLink +hotlink url h = HotLink { + hotLinkURL = url, + hotLinkContents = h, + hotLinkAttributes = [] } + + +-- +-- * Lists +-- + +-- (Abridged from Erik Meijer's Original Html library) + +ordList :: (HTML a) => [a] -> Html +ordList items = olist << map (li <<) items + +unordList :: (HTML a) => [a] -> Html +unordList items = ulist << map (li <<) items + +defList :: (HTML a,HTML b) => [(a,b)] -> Html +defList items + = dlist << [ [ dterm << dt, ddef << dd ] | (dt,dd) <- items ] + +-- +-- * Forms +-- + +widget :: String -> String -> [HtmlAttr] -> Html +widget w n markupAttrs = input ! ([thetype w,name n,identifier n] ++ markupAttrs) + +checkbox :: String -> String -> Html +hidden :: String -> String -> Html +radio :: String -> String -> Html +reset :: String -> String -> Html +submit :: String -> String -> Html +password :: String -> Html +textfield :: String -> Html +afile :: String -> Html +clickmap :: String -> Html + +checkbox n v = widget "checkbox" n [value v] +hidden n v = widget "hidden" n [value v] +radio n v = widget "radio" n [value v] +reset n v = widget "reset" n [value v] +submit n v = widget "submit" n [value v] +password n = widget "password" n [] +textfield n = widget "text" n [] +afile n = widget "file" n [] +clickmap n = widget "image" n [] + +menu :: String -> [Html] -> Html +menu n choices + = select ! [name n] << [ option << p << choice | choice <- choices ] + +gui :: String -> Html -> Html +gui act = form ! [action act,method "post"] diff --git a/Text/XHtml/Frameset.hs b/Text/XHtml/Frameset.hs new file mode 100644 --- /dev/null +++ b/Text/XHtml/Frameset.hs @@ -0,0 +1,52 @@ +-- | Produces XHTML 1.0 Frameset. +module Text.XHtml.Frameset ( + -- * Data types + Html, HtmlAttr, + -- * Classes + HTML(..), ADDATTRS(..), + -- * Primitives and basic combinators + (<<), concatHtml, (+++), + noHtml, isNoHtml, tag, itag, + emptyAttr, intAttr, strAttr, + primHtml, + -- * Rendering + showHtml, renderHtml, prettyHtml, + showHtmlFragment, renderHtmlFragment, prettyHtmlFragment, + module Text.XHtml.Strict.Elements, + module Text.XHtml.Frameset.Elements, + module Text.XHtml.Strict.Attributes, + module Text.XHtml.Frameset.Attributes, + module Text.XHtml.Extras + ) where + +import Text.XHtml.Internals + +import Text.XHtml.Strict.Elements +import Text.XHtml.Frameset.Elements +import Text.XHtml.Strict.Attributes +import Text.XHtml.Frameset.Attributes + +import Text.XHtml.Extras + +docType = + "" + +-- | Output the HTML without adding newlines or spaces within the markup. +-- This should be the most time and space efficient way to +-- render HTML, though the ouput is quite unreadable. +showHtml :: HTML html => html -> String +showHtml = showHtmlInternal docType + +-- | Outputs indented HTML. Because space matters in +-- HTML, the output is quite messy. +renderHtml :: HTML html => html -> String +renderHtml = renderHtmlInternal docType + +-- | Outputs indented HTML, with indentation inside elements. +-- This can change the meaning of the HTML document, and +-- is mostly useful for debugging the HTML output. +-- The implementation is inefficient, and you are normally +-- better off using 'showHtml' or 'renderHtml'. +prettyHtml :: HTML html => html -> String +prettyHtml = prettyHtmlInternal docType diff --git a/Text/XHtml/Frameset/Attributes.hs b/Text/XHtml/Frameset/Attributes.hs new file mode 100644 --- /dev/null +++ b/Text/XHtml/Frameset/Attributes.hs @@ -0,0 +1,22 @@ +-- #hide + +module Text.XHtml.Frameset.Attributes where + +import Text.XHtml.Internals + +-- * Extra attributes in XHTML Frameset + +frameborder :: Int -> HtmlAttr +frameborder = intAttr "frameborder" + +marginheight :: Int -> HtmlAttr +marginheight = intAttr "marginheight" + +marginwidth :: Int -> HtmlAttr +marginwidth = intAttr "marginwidth" + +noresize :: HtmlAttr +noresize = emptyAttr "noresize" + +scrolling :: String -> HtmlAttr +scrolling = strAttr "scrolling" diff --git a/Text/XHtml/Frameset/Elements.hs b/Text/XHtml/Frameset/Elements.hs new file mode 100644 --- /dev/null +++ b/Text/XHtml/Frameset/Elements.hs @@ -0,0 +1,16 @@ +-- #hide + +module Text.XHtml.Frameset.Elements where + +import Text.XHtml.Internals + +-- * Extra elements in XHTML Frameset + +frame :: Html -> Html +frame = tag "frame" + +frameset :: Html -> Html +frameset = tag "frameset" + +noframes :: Html -> Html +noframes = tag "noframes" diff --git a/Text/XHtml/Internals.hs b/Text/XHtml/Internals.hs new file mode 100644 --- /dev/null +++ b/Text/XHtml/Internals.hs @@ -0,0 +1,328 @@ +-- #hide + +----------------------------------------------------------------------------- +-- | +-- Module : Text.XHtml.internals +-- Copyright : (c) Andy Gill, and the Oregon Graduate Institute of +-- Science and Technology, 1999-2001, +-- (c) Bjorn Bringert, 2004-2006 +-- License : BSD-style (see the file LICENSE) +-- Maintainer : Bjorn Bringert +-- Stability : experimental +-- Portability : portable +-- +-- Internals of the XHTML combinator library. +----------------------------------------------------------------------------- +module Text.XHtml.Internals where + +import Data.Char +import Data.Monoid + +infixr 2 +++ -- combining Html +infixr 7 << -- nesting Html +infixl 8 ! -- adding optional arguments + +-- +-- * Data types +-- + +-- | A important property of Html is that all strings inside the +-- structure are already in Html friendly format. +data HtmlElement + = HtmlString String + -- ^ ..just..plain..normal..text... but using © and &amb;, etc. + | HtmlTag { + markupTag :: String, + markupAttrs :: [HtmlAttr], + markupContent :: Html + } + -- ^ tag with internal markup + +-- | Attributes with name and value. +data HtmlAttr = HtmlAttr String String + + +newtype Html = Html { getHtmlElements :: [HtmlElement] } + + +-- +-- * Classes +-- + +instance Show Html where + showsPrec _ html = showString (renderHtmlFragment html) + showList htmls = foldr (.) id (map shows htmls) + +instance Show HtmlAttr where + showsPrec _ (HtmlAttr str val) = + showString str . + showString "=" . + shows val + +instance Monoid Html where + mempty = noHtml + mappend = (+++) + +-- | HTML is the class of things that can be validly put +-- inside an HTML tag. So this can be one or more 'Html' elements, +-- or a 'String', for example. +class HTML a where + toHtml :: a -> Html + toHtmlFromList :: [a] -> Html + + toHtmlFromList xs = Html (concat [ x | (Html x) <- map toHtml xs]) + +instance HTML Html where + toHtml a = a + +instance HTML Char where + toHtml a = toHtml [a] + toHtmlFromList [] = Html [] + toHtmlFromList str = Html [HtmlString (stringToHtmlString str)] + +instance (HTML a) => HTML [a] where + toHtml xs = toHtmlFromList xs + +class ADDATTRS a where + (!) :: a -> [HtmlAttr] -> a + +instance (ADDATTRS b) => ADDATTRS (a -> b) where + fn ! attr = \ arg -> fn arg ! attr + +instance ADDATTRS Html where + (Html htmls) ! attr = Html (map addAttrs htmls) + where + addAttrs (html@(HtmlTag { markupAttrs = markupAttrs }) ) + = html { markupAttrs = markupAttrs ++ attr } + addAttrs html = html + + +-- +-- * Html primitives and basic combinators +-- + +-- | Put something inside an HTML element. +(<<) :: (HTML a) => + (Html -> b) -- ^ Parent + -> a -- ^ Child + -> b +fn << arg = fn (toHtml arg) + + +concatHtml :: (HTML a) => [a] -> Html +concatHtml as = Html (concat (map (getHtmlElements.toHtml) as)) + +-- | Create a piece of HTML which is the concatenation +-- of two things which can be made into HTML. +(+++) :: (HTML a,HTML b) => a -> b -> Html +a +++ b = Html (getHtmlElements (toHtml a) ++ getHtmlElements (toHtml b)) + +-- | An empty piece of HTML. +noHtml :: Html +noHtml = Html [] + +-- | Checks whether the given piece of HTML is empty. +isNoHtml :: Html -> Bool +isNoHtml (Html xs) = null xs + +-- | Constructs an element with a custom name. +tag :: String -- ^ Element name + -> Html -- ^ Element contents + -> Html +tag str htmls = Html [ + HtmlTag { + markupTag = str, + markupAttrs = [], + markupContent = htmls }] + +-- | Constructs an element with a custom name, and +-- without any children. +itag :: String -> Html +itag str = tag str noHtml + +emptyAttr :: String -> HtmlAttr +emptyAttr s = HtmlAttr s s + +intAttr :: String -> Int -> HtmlAttr +intAttr s i = HtmlAttr s (show i) + +strAttr :: String -> String -> HtmlAttr +strAttr s t = HtmlAttr s (stringToHtmlString t) + + +{- +foldHtml :: (String -> [HtmlAttr] -> [a] -> a) + -> (String -> a) + -> Html + -> a +foldHtml f g (HtmlTag str attr fmls) + = f str attr (map (foldHtml f g) fmls) +foldHtml f g (HtmlString str) + = g str + +-} + +-- | Processing Strings into Html friendly things. +stringToHtmlString :: String -> String +stringToHtmlString = concatMap fixChar + where + fixChar '<' = "<" + fixChar '>' = ">" + fixChar '&' = "&" + fixChar '"' = """ + fixChar c | ord c < 0xff = [c] + fixChar c = "&#" ++ show (ord c) ++ ";" + + +-- | This is not processed for special chars. +-- use stringToHtml or lineToHtml instead, for user strings, +-- because they understand special chars, like @'<'@. +primHtml :: String -> Html +primHtml x = Html [HtmlString x] + + + +-- +-- * Html Rendering +-- + +-- | Output the HTML without adding newlines or spaces within the markup. +-- This should be the most time and space efficient way to +-- render HTML, though the ouput is quite unreadable. +showHtmlInternal :: HTML html => + String -- ^ DOCTYPE declaration + -> html -> String +showHtmlInternal docType theHtml = + docType ++ showHtmlFragment (tag "html" << theHtml) + +-- | Outputs indented HTML. Because space matters in +-- HTML, the output is quite messy. +renderHtmlInternal :: HTML html => + String -- ^ DOCTYPE declaration + -> html -> String +renderHtmlInternal docType theHtml = + docType ++ "\n" ++ renderHtmlFragment (tag "html" << theHtml) ++ "\n" + +-- | Outputs indented HTML, with indentation inside elements. +-- This can change the meaning of the HTML document, and +-- is mostly useful for debugging the HTML output. +-- The implementation is inefficient, and you are normally +-- better off using 'showHtml' or 'renderHtml'. +prettyHtmlInternal :: HTML html => + String -- ^ DOCTYPE declaration + -> html -> String +prettyHtmlInternal docType theHtml = + docType ++ "\n" ++ prettyHtmlFragment (tag "html" << theHtml) + +-- | Render a piece of HTML without adding a DOCTYPE declaration +-- or root element. Does not add any extra whitespace. +showHtmlFragment :: HTML html => html -> String +showHtmlFragment h = + (foldr (.) id $ map showHtml' $ getHtmlElements $ toHtml h) "" + +-- | Render a piece of indented HTML without adding a DOCTYPE declaration +-- or root element. Only adds whitespace where it does not change +-- the meaning of the document. +renderHtmlFragment :: HTML html => html -> String +renderHtmlFragment h = + (foldr (.) id $ map (renderHtml' 0) $ getHtmlElements $ toHtml h) "" + +-- | Render a piece of indented HTML without adding a DOCTYPE declaration +-- or a root element. +-- The indentation is done inside elements. +-- This can change the meaning of the HTML document, and +-- is mostly useful for debugging the HTML output. +-- The implementation is inefficient, and you are normally +-- better off using 'showHtmlFragment' or 'renderHtmlFragment'. +prettyHtmlFragment :: HTML html => html -> String +prettyHtmlFragment = + unlines . concat . map prettyHtml' . getHtmlElements . toHtml + +-- | Show a single HTML element, without adding whitespace. +showHtml' :: HtmlElement -> ShowS +showHtml' (HtmlString str) = (++) str +showHtml'(HtmlTag { markupTag = name, + markupContent = html, + markupAttrs = markupAttrs }) + = if isNoHtml html && elem name validHtmlITags + then renderTag True name markupAttrs "" + else (renderTag False name markupAttrs "" + . foldr (.) id (map showHtml' (getHtmlElements html)) + . renderEndTag name "") + +renderHtml' :: Int -> HtmlElement -> ShowS +renderHtml' _ (HtmlString str) = (++) str +renderHtml' n (HtmlTag + { markupTag = name, + markupContent = html, + markupAttrs = markupAttrs }) + = if isNoHtml html && elem name validHtmlITags + then renderTag True name markupAttrs (nl n) + else (renderTag False name markupAttrs (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) ' ' + + +prettyHtml' :: HtmlElement -> [String] +prettyHtml' (HtmlString str) = [str] +prettyHtml' (HtmlTag + { markupTag = name, + markupContent = html, + markupAttrs = markupAttrs }) + = if isNoHtml html && elem name validHtmlITags + then + [rmNL (renderTag True name markupAttrs "" "")] + else + [rmNL (renderTag False name markupAttrs "" "")] ++ + shift (concat (map prettyHtml' (getHtmlElements html))) ++ + [rmNL (renderEndTag name "" "")] + where + shift = map (\x -> " " ++ x) + rmNL = filter (/= '\n') + + +-- | Show a start tag +renderTag :: Bool -- ^ 'True' if the empty tag shorthand should be used + -> String -- ^ Tag name + -> [HtmlAttr] -- ^ Attributes + -> String -- ^ Whitespace to add after attributes + -> ShowS +renderTag empty name attrs nl r + = "<" ++ name ++ showAttrs attrs ++ nl ++ close ++ r + where + close = if empty then " />" else ">" + + showAttrs attrs = concat [' ':showPair attr | attr <- attrs ] + + showPair :: HtmlAttr -> String + showPair (HtmlAttr tag val) + = tag ++ "=\"" ++ val ++ "\"" + +-- | Show an end tag +renderEndTag :: String -- ^ Tag name + -> String -- ^ Whitespace to add after tag name + -> ShowS +renderEndTag name nl r = "" ++ r + + +-- | The names of all elements which can represented using the empty tag +-- short-hand. +validHtmlITags :: [String] +validHtmlITags = [ + "area", + "base", + "basefont", + "br", + "col", + "frame", + "hr", + "img", + "input", + "isindex", + "link", + "meta", + "param" + ] diff --git a/Text/XHtml/Strict.hs b/Text/XHtml/Strict.hs new file mode 100644 --- /dev/null +++ b/Text/XHtml/Strict.hs @@ -0,0 +1,47 @@ +-- | Produces XHTML 1.0 Strict. +module Text.XHtml.Strict ( + -- * Data types + Html, HtmlAttr, + -- * Classes + HTML(..), ADDATTRS(..), + -- * Primitives and basic combinators + (<<), concatHtml, (+++), + noHtml, isNoHtml, tag, itag, + emptyAttr, intAttr, strAttr, + primHtml, + -- * Rendering + showHtml, renderHtml, prettyHtml, + showHtmlFragment, renderHtmlFragment, prettyHtmlFragment, + module Text.XHtml.Strict.Elements, + module Text.XHtml.Strict.Attributes, + module Text.XHtml.Extras + ) where + +import Text.XHtml.Internals +import Text.XHtml.Strict.Elements +import Text.XHtml.Strict.Attributes +import Text.XHtml.Extras + + +docType = "" + +-- | Output the HTML without adding newlines or spaces within the markup. +-- This should be the most time and space efficient way to +-- render HTML, though the ouput is quite unreadable. +showHtml :: HTML html => html -> String +showHtml = showHtmlInternal docType + +-- | Outputs indented HTML. Because space matters in +-- HTML, the output is quite messy. +renderHtml :: HTML html => html -> String +renderHtml = renderHtmlInternal docType + +-- | Outputs indented HTML, with indentation inside elements. +-- This can change the meaning of the HTML document, and +-- is mostly useful for debugging the HTML output. +-- The implementation is inefficient, and you are normally +-- better off using 'showHtml' or 'renderHtml'. +prettyHtml :: HTML html => html -> String +prettyHtml = prettyHtmlInternal docType + diff --git a/Text/XHtml/Strict/Attributes.hs b/Text/XHtml/Strict/Attributes.hs new file mode 100644 --- /dev/null +++ b/Text/XHtml/Strict/Attributes.hs @@ -0,0 +1,106 @@ +-- #hide + +module Text.XHtml.Strict.Attributes where + +import Text.XHtml.Internals + +-- * Attributes in XHTML Strict + +action :: String -> HtmlAttr +align :: String -> HtmlAttr + +alt :: String -> HtmlAttr +altcode :: String -> HtmlAttr +archive :: String -> HtmlAttr +base :: String -> HtmlAttr +border :: Int -> HtmlAttr +bordercolor :: String -> HtmlAttr +cellpadding :: Int -> HtmlAttr +cellspacing :: Int -> HtmlAttr +checked :: HtmlAttr +codebase :: String -> HtmlAttr +cols :: String -> HtmlAttr +colspan :: Int -> HtmlAttr +content :: String -> HtmlAttr +coords :: String -> HtmlAttr +disabled :: HtmlAttr +enctype :: String -> HtmlAttr +height :: String -> HtmlAttr +href :: String -> HtmlAttr +httpequiv :: String -> HtmlAttr +identifier :: String -> HtmlAttr +ismap :: HtmlAttr +lang :: String -> HtmlAttr +maxlength :: Int -> HtmlAttr +method :: String -> HtmlAttr +multiple :: HtmlAttr +name :: String -> HtmlAttr +nohref :: HtmlAttr +rel :: String -> HtmlAttr +rev :: String -> HtmlAttr +rows :: String -> HtmlAttr +rowspan :: Int -> HtmlAttr +rules :: String -> HtmlAttr +selected :: HtmlAttr +shape :: String -> HtmlAttr +size :: String -> HtmlAttr +src :: String -> HtmlAttr +theclass :: String -> HtmlAttr +thefor :: String -> HtmlAttr +thestyle :: String -> HtmlAttr +thetype :: String -> HtmlAttr +title :: String -> HtmlAttr +usemap :: String -> HtmlAttr +valign :: String -> HtmlAttr +value :: String -> HtmlAttr +width :: String -> HtmlAttr + +action = strAttr "action" +align = strAttr "align" +alt = strAttr "alt" +altcode = strAttr "altcode" +archive = strAttr "archive" +base = strAttr "base" +border = intAttr "border" +bordercolor = strAttr "bordercolor" +cellpadding = intAttr "cellpadding" +cellspacing = intAttr "cellspacing" +checked = emptyAttr "checked" +codebase = strAttr "codebase" +cols = strAttr "cols" +colspan = intAttr "colspan" +content = strAttr "content" +coords = strAttr "coords" +disabled = emptyAttr "disabled" +enctype = strAttr "enctype" +height = strAttr "height" +href = strAttr "href" +httpequiv = strAttr "http-equiv" +identifier = strAttr "id" +ismap = emptyAttr "ismap" +lang = strAttr "lang" +maxlength = intAttr "maxlength" +method = strAttr "method" +multiple = emptyAttr "multiple" +name = strAttr "name" +nohref = emptyAttr "nohref" +rel = strAttr "rel" +rev = strAttr "rev" +rows = strAttr "rows" +rowspan = intAttr "rowspan" +rules = strAttr "rules" +selected = emptyAttr "selected" +shape = strAttr "shape" +size = strAttr "size" +src = strAttr "src" +theclass = strAttr "class" +thefor = strAttr "for" +thestyle = strAttr "style" +thetype = strAttr "type" +title = strAttr "title" +usemap = strAttr "usemap" +valign = strAttr "valign" +value = strAttr "value" +width = strAttr "width" + + diff --git a/Text/XHtml/Strict/Elements.hs b/Text/XHtml/Strict/Elements.hs new file mode 100644 --- /dev/null +++ b/Text/XHtml/Strict/Elements.hs @@ -0,0 +1,163 @@ +-- #hide + +module Text.XHtml.Strict.Elements where + +import Text.XHtml.Internals + +-- * Elements in XHTML Strict + +abbr :: Html -> Html +acronym :: Html -> Html +address :: Html -> Html +anchor :: Html -> Html +area :: Html +bdo :: Html -> Html +big :: Html -> Html +blockquote :: Html -> Html +body :: Html -> Html +bold :: Html -> Html +br :: Html +button :: Html -> Html +caption :: Html -> Html +cite :: Html -> Html +col :: Html -> Html +colgroup :: Html -> Html +del :: Html -> Html +ddef :: Html -> Html +define :: Html -> Html +dlist :: Html -> Html +dterm :: Html -> Html +emphasize :: Html -> Html +fieldset :: Html -> Html +form :: Html -> Html +h1 :: Html -> Html +h2 :: Html -> Html +h3 :: Html -> Html +h4 :: Html -> Html +h5 :: Html -> Html +h6 :: Html -> Html +header :: Html -> Html +hr :: Html +image :: Html +input :: Html +ins :: Html -> Html +italics :: Html -> Html +keyboard :: Html -> Html +label :: Html -> Html +legend :: Html -> Html +li :: Html -> Html +meta :: Html +noscript :: Html -> Html +object :: Html -> Html +olist :: Html -> Html +optgroup :: Html -> Html +option :: Html -> Html +paragraph :: Html -> Html +param :: Html +pre :: Html -> Html +quote :: Html -> Html +sample :: Html -> Html +script :: Html -> Html +select :: Html -> Html +small :: Html -> Html +strong :: Html -> Html +style :: Html -> Html +sub :: Html -> Html +sup :: Html -> Html +table :: Html -> Html +tbody :: Html -> Html +td :: Html -> Html +textarea :: Html -> Html +tfoot :: Html -> Html +th :: Html -> Html +thead :: Html -> Html +thebase :: Html +thecode :: Html -> Html +thediv :: Html -> Html +thehtml :: Html -> Html +thelink :: Html -> Html +themap :: Html -> Html +thespan :: Html -> Html +thetitle :: Html -> Html +tr :: Html -> Html +tt :: Html -> Html +ulist :: Html -> Html +variable :: Html -> Html + +abbr = tag "abbr" +acronym = tag "acronym" +address = tag "address" +anchor = tag "a" +area = itag "area" +bdo = tag "bdo" +big = tag "big" +blockquote = tag "blockquote" +body = tag "body" +bold = tag "b" +button = tag "button" +br = itag "br" +caption = tag "caption" +cite = tag "cite" +col = tag "col" +colgroup = tag "colgroup" +ddef = tag "dd" +define = tag "dfn" +del = tag "del" +dlist = tag "dl" +dterm = tag "dt" +emphasize = tag "em" +fieldset = tag "fieldset" +form = tag "form" +h1 = tag "h1" +h2 = tag "h2" +h3 = tag "h3" +h4 = tag "h4" +h5 = tag "h5" +h6 = tag "h6" +header = tag "head" +hr = itag "hr" +image = itag "img" +input = itag "input" +ins = tag "ins" +italics = tag "i" +keyboard = tag "kbd" +label = tag "label" +legend = tag "legend" +li = tag "li" +meta = itag "meta" +noscript = tag "noscript" +object = tag "object" +olist = tag "ol" +optgroup = tag "optgroup" +option = tag "option" +paragraph = tag "p" +param = itag "param" +pre = tag "pre" +quote = tag "q" +sample = tag "samp" +script = tag "script" +select = tag "select" +small = tag "small" +strong = tag "strong" +style = tag "style" +sub = tag "sub" +sup = tag "sup" +table = tag "table" +tbody = tag "tbody" +td = tag "td" +textarea = tag "textarea" +tfoot = tag "tfoot" +th = tag "th" +thead = tag "thead" +thebase = itag "base" +thecode = tag "code" +thediv = tag "div" +thehtml = tag "html" +thelink = tag "link" +themap = tag "map" +thespan = tag "span" +thetitle = tag "title" +tr = tag "tr" +tt = tag "tt" +ulist = tag "ul" +variable = tag "var" diff --git a/Text/XHtml/Table.hs b/Text/XHtml/Table.hs new file mode 100644 --- /dev/null +++ b/Text/XHtml/Table.hs @@ -0,0 +1,110 @@ +-- | Table combinators for XHTML. +module Text.XHtml.Table (HtmlTable, HTMLTABLE(..), + (), above, (<->), beside, + aboves, besides, + simpleTable) where + +import Text.XHtml.Internals +import Text.XHtml.Strict.Elements +import Text.XHtml.Strict.Attributes + +import qualified Text.XHtml.BlockTable as BT + + +infixr 3 -- combining table cells +infixr 4 <-> -- combining table cells + +-- +-- * Tables +-- + +class HTMLTABLE ht where + cell :: ht -> HtmlTable + +instance HTMLTABLE HtmlTable where + cell = id + +instance HTMLTABLE Html where + cell h = + let + cellFn x y = h ! (add x colspan $ add y rowspan $ []) + add 1 fn rest = rest + add n fn rest = fn n : rest + r = BT.single cellFn + in + mkHtmlTable r + +-- | We internally represent the Cell inside a Table with an +-- object of the type +-- +-- > Int -> Int -> Html +-- +-- When we render it later, we find out how many columns +-- or rows this cell will span over, and can +-- include the correct colspan\/rowspan command. +newtype HtmlTable + = HtmlTable (BT.BlockTable (Int -> Int -> Html)) + + +mkHtmlTable :: BT.BlockTable (Int -> Int -> Html) -> HtmlTable +mkHtmlTable r = HtmlTable r + +-- We give both infix and nonfix, take your pick. +-- Notice that there is no concept of a row/column +-- of zero items. + +(),above,(<->),beside :: (HTMLTABLE ht1,HTMLTABLE ht2) + => ht1 -> ht2 -> HtmlTable +above a b = combine BT.above (cell a) (cell b) +() = above +beside a b = combine BT.beside (cell a) (cell b) +(<->) = beside + + +combine fn (HtmlTable a) (HtmlTable b) = mkHtmlTable (a `fn` b) + +-- Both aboves and besides presume a non-empty list. +-- here is no concept of a empty row or column in these +-- table combinators. + +aboves :: (HTMLTABLE ht) => [ht] -> HtmlTable +aboves [] = error "aboves []" +aboves xs = foldr1 () (map cell xs) + +besides :: (HTMLTABLE ht) => [ht] -> HtmlTable +besides [] = error "besides []" +besides xs = foldr1 (<->) (map cell xs) + +-- | renderTable takes the HtmlTable, and renders it back into +-- and Html object. +renderTable :: BT.BlockTable (Int -> Int -> Html) -> Html +renderTable theTable + = concatHtml + [tr << [theCell x y | (theCell,(x,y)) <- theRow ] + | theRow <- BT.getMatrix theTable] + +instance HTML HtmlTable where + toHtml (HtmlTable tab) = renderTable tab + +instance Show HtmlTable where + showsPrec _ (HtmlTable tab) = shows (renderTable tab) + + +-- | If you can't be bothered with the above, then you +-- can build simple tables with simpleTable. +-- Just provide the attributes for the whole table, +-- attributes for the cells (same for every cell), +-- and a list of lists of cell contents, +-- and this function will build the table for you. +-- It does presume that all the lists are non-empty, +-- and there is at least one list. +-- +-- Different length lists means that the last cell +-- gets padded. If you want more power, then +-- use the system above, or build tables explicitly. +simpleTable :: [HtmlAttr] -> [HtmlAttr] -> [[Html]] -> Html +simpleTable attr cellAttr lst + = table ! attr + << (aboves + . map (besides . map ((td ! cellAttr) . toHtml)) + ) lst diff --git a/Text/XHtml/Transitional.hs b/Text/XHtml/Transitional.hs new file mode 100644 --- /dev/null +++ b/Text/XHtml/Transitional.hs @@ -0,0 +1,58 @@ +-- | Produces XHTML 1.0 Transitional. +module Text.XHtml.Transitional ( + -- * Data types + Html, HtmlAttr, + -- * Classes + HTML(..), ADDATTRS(..), + -- * Primitives and basic combinators + (<<), concatHtml, (+++), + noHtml, isNoHtml, tag, itag, + emptyAttr, intAttr, strAttr, + primHtml, + -- * Rendering + showHtml, renderHtml, prettyHtml, + showHtmlFragment, renderHtmlFragment, prettyHtmlFragment, + module Text.XHtml.Strict.Elements, + module Text.XHtml.Frameset.Elements, + module Text.XHtml.Transitional.Elements, + module Text.XHtml.Strict.Attributes, + module Text.XHtml.Frameset.Attributes, + module Text.XHtml.Transitional.Attributes, + module Text.XHtml.Extras + ) where + +import Text.XHtml.Internals + +import Text.XHtml.Strict.Elements +import Text.XHtml.Frameset.Elements +import Text.XHtml.Transitional.Elements + +import Text.XHtml.Strict.Attributes +import Text.XHtml.Frameset.Attributes +import Text.XHtml.Transitional.Attributes + +import Text.XHtml.Extras + + +docType = + "" + +-- | Output the HTML without adding newlines or spaces within the markup. +-- This should be the most time and space efficient way to +-- render HTML, though the ouput is quite unreadable. +showHtml :: HTML html => html -> String +showHtml = showHtmlInternal docType + +-- | Outputs indented HTML. Because space matters in +-- HTML, the output is quite messy. +renderHtml :: HTML html => html -> String +renderHtml = renderHtmlInternal docType + +-- | Outputs indented HTML, with indentation inside elements. +-- This can change the meaning of the HTML document, and +-- is mostly useful for debugging the HTML output. +-- The implementation is inefficient, and you are normally +-- better off using 'showHtml' or 'renderHtml'. +prettyHtml :: HTML html => html -> String +prettyHtml = prettyHtmlInternal docType diff --git a/Text/XHtml/Transitional/Attributes.hs b/Text/XHtml/Transitional/Attributes.hs new file mode 100644 --- /dev/null +++ b/Text/XHtml/Transitional/Attributes.hs @@ -0,0 +1,119 @@ +-- #hide + +module Text.XHtml.Transitional.Attributes where + +import Text.XHtml.Internals + +-- * Extra attributes in XHTML Transitional + +{-# DEPRECATED alink "This attribute is deprecated in XHTML 1.0" #-} +alink :: String -> HtmlAttr +alink = strAttr "alink" + +{-# DEPRECATED background "This attribute is deprecated in XHTML 1.0" #-} +background :: String -> HtmlAttr +background = strAttr "background" + +{-# DEPRECATED bgcolor "This attribute is deprecated in XHTML 1.0" #-} +bgcolor :: String -> HtmlAttr +bgcolor = strAttr "bgcolor" + +{-# DEPRECATED clear "This attribute is deprecated in XHTML 1.0" #-} +clear :: String -> HtmlAttr +clear = strAttr "clear" + +{-# DEPRECATED code "This attribute is deprecated in XHTML 1.0" #-} +code :: String -> HtmlAttr +code = strAttr "code" + +{-# DEPRECATED color "This attribute is deprecated in XHTML 1.0" #-} +color :: String -> HtmlAttr +color = strAttr "color" + +{-# DEPRECATED compact "This attribute is deprecated in XHTML 1.0" #-} +compact :: HtmlAttr +compact = emptyAttr "compact" + +{-# DEPRECATED face "This attribute is deprecated in XHTML 1.0" #-} +face :: String -> HtmlAttr +face = strAttr "face" + +{-# DEPRECATED hspace "This attribute is deprecated in XHTML 1.0" #-} +hspace :: Int -> HtmlAttr +hspace = intAttr "hspace" + +{-# DEPRECATED link "This attribute is deprecated in XHTML 1.0" #-} +link :: String -> HtmlAttr +link = strAttr "link" + +{-# DEPRECATED noshade "This attribute is deprecated in XHTML 1.0" #-} +noshade :: HtmlAttr +noshade = emptyAttr "noshade" + +{-# DEPRECATED nowrap "This attribute is deprecated in XHTML 1.0" #-} +nowrap :: HtmlAttr +nowrap = emptyAttr "nowrap" + +{-# DEPRECATED start "This attribute is deprecated in XHTML 1.0" #-} +start :: Int -> HtmlAttr +start = intAttr "start" + +target :: String -> HtmlAttr +target = strAttr "target" + +{-# DEPRECATED text "This attribute is deprecated in XHTML 1.0" #-} +text :: String -> HtmlAttr +text = strAttr "text" + +{-# DEPRECATED version "This attribute is deprecated in XHTML 1.0" #-} +version :: String -> HtmlAttr +version = strAttr "version" + +{-# DEPRECATED vlink "This attribute is deprecated in XHTML 1.0" #-} +vlink :: String -> HtmlAttr +vlink = strAttr "vlink" + +{-# DEPRECATED vspace "This attribute is deprecated in XHTML 1.0" #-} +vspace :: Int -> HtmlAttr +vspace = intAttr "vspace" + + + +-- +-- * Html colors +-- + +{-# DEPRECATED aqua,black,blue,fuchsia,gray,green,lime,maroon,navy,olive,purple,red,silver,teal,yellow,white "The use of color attibutes is deprecated in XHTML 1.0" #-} +aqua :: String +black :: String +blue :: String +fuchsia :: String +gray :: String +green :: String +lime :: String +maroon :: String +navy :: String +olive :: String +purple :: String +red :: String +silver :: String +teal :: String +yellow :: String +white :: String + +aqua = "aqua" +black = "black" +blue = "blue" +fuchsia = "fuchsia" +gray = "gray" +green = "green" +lime = "lime" +maroon = "maroon" +navy = "navy" +olive = "olive" +purple = "purple" +red = "red" +silver = "silver" +teal = "teal" +yellow = "yellow" +white = "white" diff --git a/Text/XHtml/Transitional/Elements.hs b/Text/XHtml/Transitional/Elements.hs new file mode 100644 --- /dev/null +++ b/Text/XHtml/Transitional/Elements.hs @@ -0,0 +1,47 @@ +-- #hide + +module Text.XHtml.Transitional.Elements where + +import Text.XHtml.Internals + +-- * Extra elements in XHTML Transitional + +{-# DEPRECATED applet "This element is deprecated in XHTML 1.0" #-} +applet :: Html -> Html +applet = tag "applet" + +{-# DEPRECATED basefont "This element is deprecated in XHTML 1.0" #-} +basefont :: Html +basefont = itag "basefont" + +{-# DEPRECATED center "This element is deprecated in XHTML 1.0" #-} +center :: Html -> Html +center = tag "center" + +{-# DEPRECATED dir "This element is deprecated in XHTML 1.0" #-} +dir :: Html -> Html +dir = tag "dir" + +{-# DEPRECATED font "This element is deprecated in XHTML 1.0" #-} +font :: Html -> Html +font = tag "font" + + +iframe :: Html -> Html +iframe = tag "iframe" + +{-# DEPRECATED isindex "This element is deprecated in XHTML 1.0" #-} +isindex :: Html +isindex = itag "isindex" + +{-# DEPRECATED themenu "This element is deprecated in XHTML 1.0" #-} +themenu :: Html -> Html +themenu = tag "menu" + +{-# DEPRECATED strike "This element is deprecated in XHTML 1.0" #-} +strike :: Html -> Html +strike = tag "strike" + +{-# DEPRECATED underline "This element is deprecated in XHTML 1.0" #-} +underline :: Html -> Html +underline = tag "u" diff --git a/xhtml.cabal b/xhtml.cabal new file mode 100644 --- /dev/null +++ b/xhtml.cabal @@ -0,0 +1,32 @@ +Name: xhtml +Version: 3000.0.0 +Copyright: Bjorn Bringert 2004-2006, Andy Gill, and the Oregon Graduate + Institute of Science and Technology, 1999-2001 +Maintainer: bjorn@bringert.net +Author: Bjorn Bringert +License: BSD3 +License-file: LICENSE +build-depends: base +Extensions: +Synopsis: An XHTML combinator library +Description: + This package provides combinators for producing + XHTML 1.0, including the Strict, Transitional and Frameset variants. +Exposed-Modules: + Text.XHtml, + Text.XHtml.Frameset, + Text.XHtml.Strict, + Text.XHtml.Transitional, + Text.XHtml.Debug, + Text.XHtml.Table +Other-modules: + Text.XHtml.Strict.Attributes, + Text.XHtml.Strict.Elements, + Text.XHtml.Frameset.Attributes, + Text.XHtml.Frameset.Elements, + Text.XHtml.Transitional.Attributes, + Text.XHtml.Transitional.Elements, + Text.XHtml.BlockTable, + Text.XHtml.Extras, + Text.XHtml.Internals +ghc-options: -O2 -W