Added code for xml library (Text.XML.Light) to source tree,

since there is currently no debian package.  Removed
dependency on xml library.  Added license to debian/copyright.


git-svn-id: https://pandoc.googlecode.com/svn/trunk@1351 788f1e2b-df1e-0410-8736-df70ead52e1b

1 files changed, 150 insertions, 0 deletions

diff --git a/Text/XML/Light/Output.hs b/Text/XML/Light/Output.hs
new file mode 100644
index 000000000..65d1bb1af
--- /dev/null
+++ b/Text/XML/Light/Output.hs
@@ -0,0 +1,150 @@
+--------------------------------------------------------------------
+-- |
+-- 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 "&lt;"
+  '>'   -> showString "&gt;"
+  '&'   -> showString "&amp;"
+  '"'   -> showString "&quot;"
+  '\''  -> showString "&apos;"
+  -- 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 ++ ":"
+
+
+