X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=hxt-compile.git;a=blobdiff_plain;f=Text%2FXML%2FHXT%2FCompilation.hs;h=cbcf396b03b57baaabf0eda579874b4c1c77e3e8;hp=9b2f105cf207b9ebc11f6ba0d07cc2d629ce85a7;hb=5ccdec1d86b750444704312526a44eb68972027b;hpb=9326d59bc2dbf54de0bf3c6a249093704a365a14 diff --git a/Text/XML/HXT/Compilation.hs b/Text/XML/HXT/Compilation.hs index 9b2f105..cbcf396 100644 --- 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