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 xn "mkTree" $: HsParen node $: children
25 compileXmlTrees :: XmlTrees -> HsExp
26 compileXmlTrees = HsList . map compileXmlTree
29 compileXNode :: XNode -> HsExp
30 compileXNode (XText s) = xn "mkText" $: litStr s
31 compileXNode (XCharRef n) = xn "mkCharRef" $: litInt n
32 compileXNode (XEntityRef s) = xn "mkEntityRef" $: litStr s
33 compileXNode (XCmt s) = xn "mkCmt" $: litStr s
34 compileXNode (XCdata s) = xn "mkCdata" $: litStr s
35 compileXNode (XPi qn ts) = xn "mkPi" $: HsParen (compileQName qn) $: compileXmlTrees ts
36 compileXNode (XTag qn ts) = xn "mkElementNode" $: HsParen (compileQName qn) $: compileXmlTrees ts
37 compileXNode (XDTD de as) = xn "mkDTDNode" $: compileDTDElem de $: compileAttributes as
38 compileXNode (XAttr qn) = xn "mkAttrNode" $: HsParen (compileQName qn)
39 compileXNode (XError n s) = xn "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 ]
64 --xn = HsVar . Qual (Module "XN") . HsIdent
67 unq :: String -> HsExp
68 unq = HsVar . UnQual . HsIdent
71 litStr :: String -> HsExp
72 litStr = HsLit . HsString
75 litInt :: Integral a => a -> HsExp
76 litInt = HsLit . HsInt . toInteger
80 ($:) :: HsExp -> HsExp -> HsExp
84 compileQName :: QName -> HsExp
86 = let prefix = namePrefix qn
90 unq "mkQName" $: litStr prefix $: litStr local $: litStr ns