summaryrefslogtreecommitdiff
path: root/src/GF/Data/XML.hs
blob: 03965fba757413bae430e187ed83881992490145 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
----------------------------------------------------------------------
-- |
-- Module      : XML
-- Maintainer  : BB
-- Stability   : (stable)
-- Portability : (portable)
--
-- Utilities for creating XML documents.
-----------------------------------------------------------------------------

module GF.Data.XML (XML(..), Attr, comments, showsXMLDoc, showsXML) where

import GF.Data.Utilities

data XML = Data String | CData String | Tag String [Attr] [XML] | Comment String
 deriving (Ord,Eq,Show)

type Attr = (String,String)

comments :: [String] -> [XML]
comments = map Comment

showsXMLDoc :: XML -> ShowS
showsXMLDoc xml = showString header . showsXML xml 
  where header = "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>"

showsXML :: XML -> ShowS
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 cs) = 
    showChar '<' . showString t . showsAttrs as . showChar '>' 
		 . concatS (map showsXML cs) . showString "</" . showString t . showChar '>'
showsXML (Comment c) = showString "<!-- " . showString c . showString " -->"

showsAttrs :: [Attr] -> ShowS
showsAttrs = concatS . map (showChar ' ' .) . map showsAttr

showsAttr :: Attr -> ShowS
showsAttr (n,v) = showString n . showString "=\"" . showString (escape v) . showString "\""

escape :: String -> String
escape = concatMap escChar
  where
  escChar '<'  = "&lt;"
  escChar '>'  = "&gt;"
  escChar '&'  = "&amp;"
  escChar '"'  = "&quot;"
  escChar c    = [c]