Succeeded to compile examples/tiny.xml

[hxt-compile.git] / Text / XML / HXT / Compilation.hs

diff --git a/Text/XML/HXT/Compilation.hs b/Text/XML/HXT/Compilation.hs
index 9b2f105cf207b9ebc11f6ba0d07cc2d629ce85a7..cbcf396b03b57baaabf0eda579874b4c1c77e3e8 100644 (file)
--- a/Text/XML/HXT/Compilation.hs
+++ b/Text/XML/HXT/Compilation.hs
@@ -1,4 +1,31 @@
 module Text.XML.HXT.Compilation
-    (
+    ( compileDocument
+    , wrapIntoModule
     )
     where
+
+import           Language.Haskell.Syntax
+import           Text.XML.HXT.Arrow
+import           Text.XML.HXT.Compilation.XmlTree
+
+
+compileDocument :: ArrowXml a => a XmlTree (HsQualType, HsExp)
+compileDocument = uniqueNamespacesFromDeclAndQNames
+                  >>>
+                  ( constA (HsQualType [] (HsTyCon (UnQual (HsIdent "XmlTree"))))
+                    &&&
+                    arr compileXmlTree
+                  )
+
+
+wrapIntoModule :: Arrow a => a (Module, (HsName, (HsQualType, HsExp))) HsModule
+wrapIntoModule = proc (modName, (symName, (symType, symExp))) ->
+                 do let hsModule = HsModule undefined modName (Just exports) imports decls
+                        exports  = [HsEVar (UnQual symName)]
+                        imports  = [ HsImportDecl undefined (Module "Text.XML.HXT.Arrow") False Nothing Nothing
+                                   , HsImportDecl undefined (Module "Text.XML.HXT.DOM.XmlNode") True (Just (Module "XN")) Nothing
+                                   ]
+                        decls    = [ HsTypeSig undefined [symName] symType
+                                   , HsFunBind [HsMatch undefined symName [] (HsUnGuardedRhs symExp) []]
+                                   ]
+                    returnA -< hsModule