module Text.XHtml.Extras where
import Text.XHtml.Internals
import Text.XHtml.Strict.Elements
import Text.XHtml.Strict.Attributes
stringToHtml :: String -> Html
stringToHtml = primHtml . stringToHtmlString
lineToHtml :: String -> Html
lineToHtml = primHtml . concatMap htmlizeChar2 . stringToHtmlString
where
htmlizeChar2 ' ' = " "
htmlizeChar2 c = [c]
linesToHtml :: [String] -> Html
linesToHtml [] = noHtml
linesToHtml (x:[]) = lineToHtml x
linesToHtml (x:xs) = lineToHtml x +++ br +++ linesToHtml xs
primHtmlChar :: String -> Html
copyright :: Html
spaceHtml :: Html
bullet :: Html
primHtmlChar = \ x -> primHtml ("&" ++ x ++ ";")
copyright = primHtmlChar "copy"
spaceHtml = primHtmlChar "nbsp"
bullet = primHtmlChar "#149"
p :: Html -> Html
p = paragraph
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
instance ADDATTRS HotLink where
hl ! attr = hl { hotLinkAttributes = hotLinkAttributes hl ++ attr }
hotlink :: URL -> Html -> HotLink
hotlink url h = HotLink {
hotLinkURL = url,
hotLinkContents = h,
hotLinkAttributes = [] }
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 ]
widget :: String -> String -> [HtmlAttr] -> Html
widget w n attrs = input ! ([thetype w] ++ ns ++ attrs)
where ns = if null n then [] else [name n,identifier n]
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"]