module Text.XML.Light.Output
( showTopElement, showContent, showElement, showCData, showQName, showAttr
, ppTopElement, ppContent, ppElement
, tagEnd, xml_header
) where
import Text.XML.Light.Types
import Data.Char
import Data.List ( isPrefixOf )
xml_header :: String
xml_header = "<?xml version='1.0' ?>"
ppTopElement :: Element -> String
ppTopElement e = unlines [xml_header,ppElement e]
ppElement :: Element -> String
ppElement e = ppElementS "" e ""
ppContent :: Content -> String
ppContent x = ppContentS "" x ""
ppContentS :: String -> Content -> ShowS
ppContentS i x xs = case x of
Elem e -> ppElementS i e xs
Text c -> ppCData i c xs
CRef r -> showCRefS r xs
ppElementS :: String -> Element -> ShowS
ppElementS i e xs = i ++ (tagStart (elName e) (elAttribs e) $
case elContent e of
[]
| not ("?xml" `isPrefixOf` (qName $ elName e)) -> " />" ++ xs
| otherwise -> " ?>" ++ xs
[Text t] -> ">" ++ ppCData "" t (tagEnd (elName e) xs)
cs -> ">\n" ++ foldr ppSub (i ++ tagEnd (elName e) xs) cs
where ppSub e1 = ppContentS (" " ++ i) e1 . showChar '\n'
)
ppCData :: String -> CData -> ShowS
ppCData i c xs = i ++ if (cdVerbatim c /= CDataText )
then showCDataS c xs
else foldr cons xs (showCData c)
where cons :: Char -> String -> String
cons '\n' ys = "\n" ++ i ++ ys
cons y ys = y : ys
showTopElement :: Element -> String
showTopElement c = xml_header ++ showElement c
showContent :: Content -> String
showContent c = showContentS c ""
showElement :: Element -> String
showElement c = showElementS c ""
showCData :: CData -> String
showCData c = showCDataS c ""
showCRefS :: String -> ShowS
showCRefS r xs = '&' : r ++ ';' : xs
showContentS :: Content -> ShowS
showContentS (Elem e) = showElementS e
showContentS (Text cs) = showCDataS cs
showContentS (CRef cs) = showCRefS cs
showElementS :: Element -> ShowS
showElementS e xs =
tagStart (elName e) (elAttribs e)
$ case elContent e of
[] -> " />" ++ xs
ch -> '>' : foldr showContentS (tagEnd (elName e) xs) ch
showCDataS :: CData -> ShowS
showCDataS cd =
case cdVerbatim cd of
CDataText -> escStr (cdData cd)
CDataVerbatim -> showString "<![CDATA[" . escCData (cdData cd) . showString "]]>"
CDataRaw -> \ xs -> cdData cd ++ xs
escCData :: String -> ShowS
escCData (']' : ']' : '>' : cs) = showString "]]]]><![CDATA[>" . escCData cs
escCData (c : cs) = showChar c . escCData cs
escCData [] = id
escChar :: Char -> ShowS
escChar c = case c of
'<' -> showString "<"
'>' -> showString ">"
'&' -> showString "&"
'"' -> showString """
'\'' -> showString "'"
_ | (oc <= 0x7f && isPrint c) || c == '\n' || c == '\r' -> showChar c
| otherwise -> showString "&#" . shows oc . showChar ';'
where oc = ord c
escStr :: String -> ShowS
escStr cs rs = foldr escChar rs cs
tagEnd :: QName -> ShowS
tagEnd qn rs = '<':'/':showQName qn ++ '>':rs
tagStart :: QName -> [Attr] -> ShowS
tagStart qn as rs = '<':showQName qn ++ as_str ++ rs
where as_str = if null as then "" else ' ' : unwords (map showAttr as)
showAttr :: Attr -> String
showAttr (Attr qn v) = showQName qn ++ '=' : '"' : escStr v "\""
showQName :: QName -> String
showQName q = pre ++ qName q
where pre = case qPrefix q of
Nothing -> ""
Just p -> p ++ ":"