module Text.XML.HXT.Compilation.XmlTree
( compileXmlTree
+ , compileXmlTrees
+ , compileXNode
+ , compileDTDElem
+ , compileAttributes
+ , compileQName
)
where
import Text.XML.HXT.DOM.TypeDefs
-compileXmlTrees :: XmlTrees -> HsExp
-compileXmlTrees = HsList . map compileXmlTree
-
-
compileXmlTree :: XmlTree -> HsExp
compileXmlTree t
= let node = compileXNode (getNode t)
children = HsList (map compileXmlTree (getChildren t))
in
- xn "mkTree" $: node $: children
+ unq "mkTree" $: HsParen node $: children
+
+
+compileXmlTrees :: XmlTrees -> HsExp
+compileXmlTrees = HsList . map compileXmlTree
compileXNode :: XNode -> HsExp
-compileXNode (XText s) = xn "mkText" $: litStr s
-compileXNode (XCharRef n) = xn "mkCharRef" $: litInt n
-compileXNode (XEntityRef s) = xn "mkEntityRef" $: litStr s
-compileXNode (XCmt s) = xn "mkCmt" $: litStr s
-compileXNode (XCdata s) = xn "mkCdata" $: litStr s
-compileXNode (XPi qn ts) = xn "mkPi" $: compileQName qn $: compileXmlTrees ts
-compileXNode (XTag qn ts) = xn "mkElementNode" $: compileQName qn $: compileXmlTrees ts
-compileXNode (XDTD de as) = xn "mkDTDNode" $: compileDTDElem de $: compileAttributes as
-compileXNode (XAttr qn) = xn "mkAttrNode" $: compileQName qn
-compileXNode (XError n s) = xn "mkError" $: litInt n $: litStr s
+compileXNode (XText s) = unq "mkText" $: litStr s
+compileXNode (XCharRef n) = unq "mkCharRef" $: litInt n
+compileXNode (XEntityRef s) = unq "mkEntityRef" $: litStr s
+compileXNode (XCmt s) = unq "mkCmt" $: litStr s
+compileXNode (XCdata s) = unq "mkCdata" $: litStr s
+compileXNode (XPi qn ts) = unq "mkPi" $: HsParen (compileQName qn) $: compileXmlTrees ts
+compileXNode (XTag qn ts) = unq "mkElementNode" $: HsParen (compileQName qn) $: compileXmlTrees ts
+compileXNode (XDTD de as) = unq "mkDTDNode" $: compileDTDElem de $: compileAttributes as
+compileXNode (XAttr qn) = unq "mkAttrNode" $: HsParen (compileQName qn)
+compileXNode (XError n s) = unq "mkError" $: litInt n $: litStr s
compileDTDElem :: DTDElem -> HsExp
-compileDTDElem = error "compileDTDElem: FIXME: not implemented"
+compileDTDElem DOCTYPE = unq "DOCTYPE"
+compileDTDElem ELEMENT = unq "ELEMENT"
+compileDTDElem CONTENT = unq "CONTENT"
+compileDTDElem ATTLIST = unq "ATTLIST"
+compileDTDElem ENTITY = unq "ENTITY"
+compileDTDElem PENTITY = unq "PENTITY"
+compileDTDElem NOTATION = unq "NOTATION"
+compileDTDElem CONDSECT = unq "CONDSECT"
+compileDTDElem NAME = unq "NAME"
+compileDTDElem PEREF = unq "PEREF"
compileAttributes :: Attributes -> HsExp
-compileAttributes = error "compileAttributes: FIXME: not implemented"
+compileAttributes = HsList . map compileAttr
+ where
+ compileAttr :: (String, String) -> HsExp
+ compileAttr (k, v) = HsTuple [ litStr k, litStr v ]
-xn :: String -> HsExp
-xn = HsVar . Qual (Module "XN") . HsIdent
+unq :: String -> HsExp
+unq = HsVar . UnQual . HsIdent
litStr :: String -> HsExp
litInt = HsLit . HsInt . toInteger
-infixl $:
+infixr 5 $:
($:) :: HsExp -> HsExp -> HsExp
-($:) = HsApp
+a $: b = HsApp a b
compileQName :: QName -> HsExp
-compileQName (QN prefix local ns)
- = xn "mkQName" $: litStr prefix $: litStr local $: litStr ns
+compileQName qn
+ = let prefix = namePrefix qn
+ local = localPart qn
+ ns = namespaceUri qn
+ in
+ unq "mkQName" $: litStr prefix $: litStr local $: litStr ns