module HtmlPrinter(printHtml,printTag) where import Html hiding (implicit) import HtmlTags import TagAttrs hiding (implicit) import HtmlEntities(encode) import Data.Char(isAlpha,isDigit) printHtml :: Html -> String printHtml = concatMap printItem where printItem i = case i of HtmlCommand tag -> printTag tag HtmlContext tag@(name,_) html -> case impl of Implicit -> printHtml html ImplicitEnd -> printTag (name,attrs) ++ printHtml html Explicit -> printTag tag ++ printHtml html ++ printEndTag tag where (impl,attrs) = implicit tag -- HtmlChars s -> s -- escape special chars !? HtmlChars s -> encode s -- yes HtmlGarbage tag -> printGarb tag printTag :: HtmlTag -> String printTag = pt "" printEndTag (n,_) = pt "/" (n,noAttrs) --printGarb (n,as) = pt' "?" n as printGarb (n,as) = pt' "" n as pt s (n,as) = pt' s (show n) as pt' s n as = "<"++s++n++printAttrs as++">" where printAttrs (TA as) = concatMap printAttr as --printAttr (n,"") = " "++n --printAttr (n,v) | n==v = " "++n printAttr (n,v) = " "++n++"="++optquote v optquote "" = quote "" optquote v = if all isNoQuote v then v else quote v isNoQuote c = isAlpha c || isDigit c || c=='.' || c=='-' quote s = q++s++q q = ['"'] -------------------------------------------------------------------------------- data Implicit = Explicit | ImplicitEnd | Implicit implicit (name,attrs0) = case attr1 of "implicit" -> (Implicit,attrs) "implicitend" -> (ImplicitEnd,attrs) _ -> case name of LI -> implicitend DT -> implicitend DD -> implicitend TR -> implicitend TH -> implicitend TD -> implicitend _ -> (Explicit,attrs0) where implicitend = (ImplicitEnd,attrs0) where (attr1,attrs) = case attrs0 of TA ((a,_):attrs) -> (a,TA attrs) _ -> ("",attrs0)