compileDocument :: ArrowXml a => a XmlTree (HsQualType, HsExp)
compileDocument = uniqueNamespacesFromDeclAndQNames
+ >>>
+ filterOutRootAttrs
>>>
( constA (HsQualType [] (HsTyCon (UnQual (HsIdent "XmlTree"))))
&&&
)
-wrapIntoModule :: Arrow a => a (Module, (HsName, (HsQualType, HsExp))) HsModule
-wrapIntoModule = proc (modName, (symName, (symType, symExp))) ->
+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) []]
]