module Network.AdHoc.XMLRenderer
(renderDocument
,escaper
) where
import Data.List(concatMap)
import Text.XML.HaXml.Types
import Text.XML.HaXml.Escape (XmlEscaper,mkXmlEscaper)
escaper :: XmlEscaper
escaper = mkXmlEscaper
[('<',"lt")
,('>',"gt")
,('&',"amp")
,('\'',"apos")
,('\"',"quot")] (\ch -> case ch of
'<' -> True
'>' -> True
'&' -> True
'\'' -> True
'\"' -> True
_ -> False)
renderDocument :: Document i -> String
renderDocument (Document prolog tab root msc)
= renderProlog prolog
++ renderSymtab tab
++ renderElement root
++ concatMap renderMisc msc
renderProlog :: Prolog -> String
renderProlog (Prolog decl msc1 dtd msc2)
= maybe "" renderXMLDecl decl
++ concatMap renderMisc msc1
++ maybe "" renderDocTypeDecl dtd
++ concatMap renderMisc msc2
xmlEscape :: String -> String
xmlEscape ('<':xs) = "<"++xmlEscape xs
xmlEscape ('>':xs) = ">"++xmlEscape xs
xmlEscape ('\"':xs) = """++xmlEscape xs
xmlEscape (x:xs) = x:(xmlEscape xs)
xmlEscape "" = ""
renderXMLDecl :: XMLDecl -> String
renderXMLDecl (XMLDecl vers encdec st)
= "<?xml version=\""++xmlEscape vers++"\""
++(maybe "" (\(EncodingDecl decl) -> " encoding=\""++xmlEscape decl++"\"") encdec)
++(maybe "" (\rst -> " standalone=\""++if rst then "yes" else "no"++"\"") st)
++"?>"
renderMisc :: Misc -> String
renderMisc (Comment str) = "<!--"++xmlEscape str++"-->"
renderMisc (PI (target,str)) = "<?"++target++" "++str++"?>"
renderDocTypeDecl :: DocTypeDecl -> String
renderDocTypeDecl = error "renderDocTypeDecl isn't implemented"
renderSymtab :: SymTab EntityDef -> String
renderSymtab = const ""
renderElement :: Element i -> String
renderElement (Elem name attrs cont)
= "<"++name
++ concatMap renderAttribute attrs
++ (if null cont
then "/>"
else ">"++concatMap renderContent cont++"</"++name++">")
renderAttribute :: Attribute -> String
renderAttribute (name,val) = " "++name++"=\""++renderAttValue val++"\""
renderAttValue :: AttValue -> String
renderAttValue (AttValue els) = concatMap (either xmlEscape renderReference) els
renderReference :: Reference -> String
renderReference (RefEntity str) = "&"++str++";"
renderReference (RefChar num) = "&#"++show num++";"
renderContent :: Content i -> String
renderContent (CElem el _) = renderElement el
renderContent (CString _ cd _) = xmlEscape cd
renderContent (CRef ref _) = renderReference ref
renderContent (CMisc msc _) = renderMisc msc