1 module Text.XML.HXT.Compilation.XmlTree
11 import Language.Haskell.Syntax
12 import Text.XML.HXT.DOM.QualifiedName
13 import Text.XML.HXT.DOM.XmlNode
14 import Text.XML.HXT.DOM.TypeDefs
17 compileXmlTree :: XmlTree -> HsExp
19 = let node = compileXNode (getNode t)
20 children = HsList (map compileXmlTree (getChildren t))
22 unq "mkTree" $: HsParen node $: children
25 compileXmlTrees :: XmlTrees -> HsExp
26 compileXmlTrees = HsList . map compileXmlTree
29 compileXNode :: XNode -> HsExp
30 compileXNode (XText s) = unq "mkText" $: litStr s
31 compileXNode (XCharRef n) = unq "mkCharRef" $: litInt n
32 compileXNode (XEntityRef s) = unq "mkEntityRef" $: litStr s
33 compileXNode (XCmt s) = unq "mkCmt" $: litStr s
34 compileXNode (XCdata s) = unq "mkCdata" $: litStr s
35 compileXNode (XPi qn ts) = unq "mkPi" $: HsParen (compileQName qn) $: compileXmlTrees ts
36 compileXNode (XTag qn ts) = unq "mkElementNode" $: HsParen (compileQName qn) $: compileXmlTrees ts
37 compileXNode (XDTD de as) = unq "mkDTDNode" $: compileDTDElem de $: compileAttributes as
38 compileXNode (XAttr qn) = unq "mkAttrNode" $: HsParen (compileQName qn)
39 compileXNode (XError n s) = unq "mkError" $: litInt n $: litStr s
42 compileDTDElem :: DTDElem -> HsExp
43 compileDTDElem DOCTYPE = unq "DOCTYPE"
44 compileDTDElem ELEMENT = unq "ELEMENT"
45 compileDTDElem CONTENT = unq "CONTENT"
46 compileDTDElem ATTLIST = unq "ATTLIST"
47 compileDTDElem ENTITY = unq "ENTITY"
48 compileDTDElem PENTITY = unq "PENTITY"
49 compileDTDElem NOTATION = unq "NOTATION"
50 compileDTDElem CONDSECT = unq "CONDSECT"
51 compileDTDElem NAME = unq "NAME"
52 compileDTDElem PEREF = unq "PEREF"
55 compileAttributes :: Attributes -> HsExp
56 compileAttributes = HsList . map compileAttr
58 compileAttr :: (String, String) -> HsExp
59 compileAttr (k, v) = HsTuple [ litStr k, litStr v ]
62 unq :: String -> HsExp
63 unq = HsVar . UnQual . HsIdent
66 litStr :: String -> HsExp
67 litStr = HsLit . HsString
70 litInt :: Integral a => a -> HsExp
71 litInt = HsLit . HsInt . toInteger
75 ($:) :: HsExp -> HsExp -> HsExp
79 compileQName :: QName -> HsExp
81 = let prefix = namePrefix qn
85 unq "mkQName" $: litStr prefix $: litStr local $: litStr ns