X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=hxt-compile.git;a=blobdiff_plain;f=Text%2FXML%2FHXT%2FCompilation.hs;h=e8865a153df725fef4ba327d037ef06508b5f9e7;hp=01e13e28b48ead8dd963a5cc6f4220ea75d49e4f;hb=3128cde83c431e117badabba87cbcd9c7de26b52;hpb=fd97e226a965bc39e95b901125ec38f60eeaadfe diff --git a/Text/XML/HXT/Compilation.hs b/Text/XML/HXT/Compilation.hs index 01e13e2..e8865a1 100644 --- a/Text/XML/HXT/Compilation.hs +++ b/Text/XML/HXT/Compilation.hs @@ -11,6 +11,8 @@ import Text.XML.HXT.Compilation.XmlTree compileDocument :: ArrowXml a => a XmlTree (HsQualType, HsExp) compileDocument = uniqueNamespacesFromDeclAndQNames + >>> + filterOutRootAttrs >>> ( constA (HsQualType [] (HsTyCon (UnQual (HsIdent "XmlTree")))) &&& @@ -18,12 +20,18 @@ compileDocument = uniqueNamespacesFromDeclAndQNames ) +filterOutRootAttrs :: ArrowXml a => a XmlTree XmlTree +filterOutRootAttrs = processTopDownUntil (clearAttrs `when` isRoot) + where + clearAttrs = processAttrl none + + wrapIntoModule :: Arrow a => a (Module, ([HsImportDecl], (HsName, (HsQualType, HsExp)))) HsModule wrapIntoModule = proc (modName, (extImports, (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 + imports = [ HsImportDecl undefined (Module "Text.XML.HXT.DOM.Interface") False Nothing Nothing + , HsImportDecl undefined (Module "Text.XML.HXT.DOM.XmlNode" ) False Nothing Nothing ] ++ extImports decls = [ HsTypeSig undefined [symName] symType , HsFunBind [HsMatch undefined symName [] (HsUnGuardedRhs symExp) []]