module HSP.HTML (
renderAsHTML
, htmlEscapeChars
, html4Strict
, html4StrictFrag
) where
import Data.List
import HSP.XML
import HSP.XML.PCDATA(escaper)
renderAsHTML :: XML -> String
renderAsHTML xml = renderAsHTML' 0 xml ""
data TagType = Open | Close
renderAsHTML' :: Int -> XML -> ShowS
renderAsHTML' _ (CDATA needsEscape cd) = showString (if needsEscape then (escaper htmlEscapeChars cd) else cd)
renderAsHTML' n elm@(Element name@(Nothing,nm) attrs children)
| nm == "area" = renderTagEmpty children
| nm == "base" = renderTagEmpty children
| nm == "br" = renderTagEmpty children
| nm == "col" = renderTagEmpty children
| nm == "hr" = renderTagEmpty children
| nm == "img" = renderTagEmpty children
| nm == "input" = renderTagEmpty children
| nm == "link" = renderTagEmpty children
| nm == "meta" = renderTagEmpty children
| nm == "param" = renderTagEmpty children
| nm == "script" = renderElement n (Element name attrs (map asCDATA children))
| nm == "style" = renderElement n (Element name attrs (map asCDATA children))
where
renderTagEmpty [] = renderTag Open n name attrs
renderTagEmpty _ = renderElement n elm
asCDATA :: XML -> XML
asCDATA (CDATA _ cd) = (CDATA False cd)
asCDATA o = o
renderAsHTML' n e = renderElement n e
renderElement :: Int -> XML -> String -> String
renderElement n (Element name attrs children) =
let open = renderTag Open n name attrs
cs = renderChildren n children
close = renderTag Close n name []
in open . cs . close
where renderChildren :: Int -> Children -> ShowS
renderChildren n' cs = foldl (.) id $ map (renderAsHTML' (n'+2)) cs
renderTag :: TagType -> Int -> Name -> Attributes -> ShowS
renderTag typ n name attrs =
let (start,end) = case typ of
Open -> (showChar '<', showChar '>')
Close -> (showString "</", showChar '>')
nam = showName name
as = renderAttrs attrs
in start . nam . as . end
where renderAttrs :: Attributes -> ShowS
renderAttrs [] = nl
renderAttrs attrs' = showChar ' ' . ats . nl
where ats = foldl (.) id $ intersperse (showChar ' ') $ fmap renderAttr attrs'
renderAttr :: Attribute -> ShowS
renderAttr (MkAttr (nam, (Value needsEscape val))) = showName nam . showChar '=' . renderAttrVal (if needsEscape then (escaper htmlEscapeChars val) else val)
renderAttrVal :: String -> ShowS
renderAttrVal s = showChar '\"' . showString s . showChar '\"'
showName (Nothing, s) = showString s
showName (Just d, s) = showString d . showChar ':' . showString s
nl = showChar '\n' . showString (replicate n ' ')
htmlEscapeChars :: [(Char, String)]
htmlEscapeChars = [
('&', "amp" ),
('\"', "quot" ),
('<', "lt" ),
('>', "gt" )
]
html4Strict :: Maybe XMLMetaData
html4Strict = Just $
XMLMetaData { doctype = (True, "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01//EN\" \"http://www.w3.org/TR/html4/strict.dtd\">\n")
, contentType = "text/html;charset=utf-8"
, preferredRenderer = renderAsHTML
}
html4StrictFrag :: Maybe XMLMetaData
html4StrictFrag = Just $
XMLMetaData { doctype = (False, "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01//EN\" \"http://www.w3.org/TR/html4/strict.dtd\">\n")
, contentType = "text/html;charset=utf-8"
, preferredRenderer = renderAsHTML
}