GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-05-23 01:52:50 -06:00
Code Issues Packages Projects Releases Wiki Activity

XML module: added CData support. Escape stuff that needs to be escaped in XML.

Browse Source
This commit is contained in:
bringert
2006-03-03 10:38:49 +00:00
parent 0453d5c45e
commit cbcdc01380
1 changed files with 8 additions and 5 deletions
Download Patch File Download Diff File Expand all files Collapse all files

13
src/GF/Data/XML.hs
View File

@@ -12,8 +12,8 @@ module GF.Data.XML (XML(..), Attr, comments, showsXMLDoc, showsXML) where
import GF.Data.Utilities import GF.Data.Utilities
data XML = Data String | Tag String [Attr] [XML] | Comment String data XML = Data String | CData String | Tag String [Attr] [XML] | Comment String
deriving (Eq,Show) deriving (Ord,Eq,Show)
type Attr = (String,String) type Attr = (String,String)
@@ -26,6 +26,7 @@ showsXMLDoc xml = showString header . showsXML xml
showsXML :: XML -> ShowS showsXML :: XML -> ShowS
showsXML (Data s) = showString s showsXML (Data s) = showString s
showsXML (CData s) = showString "<![CDATA[" . showString s .showString "]]>"
showsXML (Tag t as []) = showChar '<' . showString t . showsAttrs as . showString "/>" showsXML (Tag t as []) = showChar '<' . showString t . showsAttrs as . showString "/>"
showsXML (Tag t as cs) = showsXML (Tag t as cs) =
showChar '<' . showString t . showsAttrs as . showChar '>' showChar '<' . showString t . showsAttrs as . showChar '>'
@@ -38,9 +39,11 @@ showsAttrs = concatS . map (showChar ' ' .) . map showsAttr
showsAttr :: Attr -> ShowS showsAttr :: Attr -> ShowS
showsAttr (n,v) = showString n . showString "=\"" . showString (escape v) . showString "\"" showsAttr (n,v) = showString n . showString "=\"" . showString (escape v) . showString "\""
-- FIXME: escape strange charachters with &#xxx;
escape :: String -> String escape :: String -> String
escape = concatMap escChar escape = concatMap escChar
where where
escChar c | c `elem` ['"','\\'] = '\\':[c] escChar '<' = "&lt;"
| otherwise = [c] escChar '>' = "&gt;"
escChar '&' = "&amp;"
escChar '"' = "&quot;"
escChar c = [c]