mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-24 03:52:50 -06:00
Add GF.Data.XML from old source. This is required by the SRGS printer.
This commit is contained in:
53
src-3.0/GF/Data/XML.hs
Normal file
53
src-3.0/GF/Data/XML.hs
Normal file
@@ -0,0 +1,53 @@
|
|||||||
|
----------------------------------------------------------------------
|
||||||
|
-- |
|
||||||
|
-- Module : XML
|
||||||
|
--
|
||||||
|
-- Utilities for creating XML documents.
|
||||||
|
----------------------------------------------------------------------
|
||||||
|
module GF.Data.XML (XML(..), Attr, comments, showXMLDoc, showsXMLDoc, showsXML, bottomUpXML) where
|
||||||
|
|
||||||
|
import GF.Data.Utilities
|
||||||
|
|
||||||
|
data XML = Data String | CData String | Tag String [Attr] [XML] | ETag String [Attr] | Comment String | Empty
|
||||||
|
deriving (Ord,Eq,Show)
|
||||||
|
|
||||||
|
type Attr = (String,String)
|
||||||
|
|
||||||
|
comments :: [String] -> [XML]
|
||||||
|
comments = map Comment
|
||||||
|
|
||||||
|
showXMLDoc :: XML -> String
|
||||||
|
showXMLDoc xml = showsXMLDoc xml ""
|
||||||
|
|
||||||
|
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 (ETag 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 " -->"
|
||||||
|
showsXML (Empty) = id
|
||||||
|
|
||||||
|
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 '<' = "<"
|
||||||
|
escChar '>' = ">"
|
||||||
|
escChar '&' = "&"
|
||||||
|
escChar '"' = """
|
||||||
|
escChar c = [c]
|
||||||
|
|
||||||
|
bottomUpXML :: (XML -> XML) -> XML -> XML
|
||||||
|
bottomUpXML f (Tag n attrs cs) = f (Tag n attrs (map (bottomUpXML f) cs))
|
||||||
|
bottomUpXML f x = f x
|
||||||
Reference in New Issue
Block a user