diff options
Diffstat (limited to 'Text/XML/Light/Output.hs')
| -rw-r--r-- | Text/XML/Light/Output.hs | 150 |
1 files changed, 0 insertions, 150 deletions
diff --git a/Text/XML/Light/Output.hs b/Text/XML/Light/Output.hs deleted file mode 100644 index 65d1bb1af..000000000 --- a/Text/XML/Light/Output.hs +++ /dev/null @@ -1,150 +0,0 @@ --------------------------------------------------------------------- --- | --- Module : Text.XML.Light.Output --- Copyright : (c) Galois, Inc. 2007 --- License : BSD3 --- --- Maintainer: Iavor S. Diatchki <diatchki@galois.com> --- Stability : provisional --- Portability: --- --- Output handling for the lightweight XML lib. --- - -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 ) - --- | The XML 1.0 header -xml_header :: String -xml_header = "<?xml version='1.0' ?>" - --- | Pretty printing renders XML documents faithfully, --- with the exception that whitespace may be added\/removed --- in non-verbatim character data. -ppTopElement :: Element -> String -ppTopElement e = unlines [xml_header,ppElement e] - --- | Pretty printing elements -ppElement :: Element -> String -ppElement e = ppElementS "" e "" - --- | Pretty printing content -ppContent :: Content -> String -ppContent x = ppContentS "" x "" - --- | Pretty printing content using ShowS -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 - - - --------------------------------------------------------------------------------- --- | Adds the <?xml?> header. -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 "" - --- Note: crefs should not contain '&', ';', etc. -showCRefS :: String -> ShowS -showCRefS r xs = '&' : r ++ ';' : xs - --- | Good for transmition (no extra white space etc.) but less readable. -showContentS :: Content -> ShowS -showContentS (Elem e) = showElementS e -showContentS (Text cs) = showCDataS cs -showContentS (CRef cs) = showCRefS cs - --- | Good for transmition (no extra white space etc.) but less readable. -showElementS :: Element -> ShowS -showElementS e xs = - tagStart (elName e) (elAttribs e) - $ case elContent e of - [] -> " />" ++ xs - ch -> '>' : foldr showContentS (tagEnd (elName e) xs) ch - --- | Convert a text element to characters. -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 "'" - -- XXX: Is this really wortherd? - -- We could deal with these issues when we convert characters to bytes. - _ | (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 ++ ":" - - - |