Compilation.XmlTree

diff --git a/Text/XML/HXT/Compilation/XmlTree.hs b/Text/XML/HXT/Compilation/XmlTree.hs
new file mode 100644 (file)
index 0000000..7884c77
--- /dev/null
+++ b/Text/XML/HXT/Compilation/XmlTree.hs
@@ -0,0 +1,64 @@
+module Text.XML.HXT.Compilation.XmlTree
+    ( compileXmlTree
+    )
+    where
+
+import           Language.Haskell.Syntax
+import           Text.XML.HXT.DOM.QualifiedName
+import           Text.XML.HXT.DOM.XmlNode
+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
+
+
+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
+
+
+compileDTDElem :: DTDElem -> HsExp
+compileDTDElem = error "compileDTDElem: FIXME: not implemented"
+
+
+compileAttributes :: Attributes -> HsExp
+compileAttributes = error "compileAttributes: FIXME: not implemented"
+
+
+xn :: String -> HsExp
+xn = HsVar . Qual (Module "XN") . HsIdent
+
+
+litStr :: String -> HsExp
+litStr = HsLit . HsString
+
+
+litInt :: Integral a => a -> HsExp
+litInt = HsLit . HsInt . toInteger
+
+
+infixl $:
+($:) :: HsExp -> HsExp -> HsExp
+($:) = HsApp
+
+
+compileQName :: QName -> HsExp
+compileQName (QN prefix local ns)
+    = xn "mkQName" $: litStr prefix $: litStr local $: litStr ns

diff --git a/hxt-compile.cabal b/hxt-compile.cabal
index a9124df024f05c4299eec241c80228f5b33286d6..e8ba617e4c2370363574deef493d22a57aaf2c6d 100644 (file)
--- a/hxt-compile.cabal
+++ b/hxt-compile.cabal
@@ -11,9 +11,11 @@ Build-Type:          Simple
 
 Library
     Build-Depends:
-        base
+        base, haskell-src, hxt
     Exposed-Modules:
         Text.XML.HXT.Compilation
+        Text.XML.HXT.Compilation.XmlTree
+    GHC-Options:     -Wall
 
 Executable hxt-compile
     Main-Is:         Main.hs