From 13dc5a370f4d7d3223937346fc63ce94c8aa85a8 Mon Sep 17 00:00:00 2001 From: PHO Date: Tue, 9 Mar 2010 15:52:18 +0900 Subject: [PATCH] filterOutRootAttrs --- Main.hs | 2 +- Text/XML/HXT/Compilation.hs | 8 ++++++++ examples/utf8.xml | 4 ++++ hxt-compile.cabal | 1 + 4 files changed, 14 insertions(+), 1 deletion(-) create mode 100644 examples/utf8.xml diff --git a/Main.hs b/Main.hs index 3874914..296b252 100644 --- a/Main.hs +++ b/Main.hs @@ -8,7 +8,7 @@ import qualified System.IO.UTF8 as Uio main :: IO () -main = do let fpath = "examples/tiny.xml" +main = do let fpath = "examples/utf8.xml" [hsMod] <- runX ( setErrorMsgHandler False fail >>> diff --git a/Text/XML/HXT/Compilation.hs b/Text/XML/HXT/Compilation.hs index 01e13e2..c2428de 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,6 +20,12 @@ 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 diff --git a/examples/utf8.xml b/examples/utf8.xml new file mode 100644 index 0000000..9b7d6d1 --- /dev/null +++ b/examples/utf8.xml @@ -0,0 +1,4 @@ + +<はい> + <はいじゃないが る="テレーン"/> + \ No newline at end of file diff --git a/hxt-compile.cabal b/hxt-compile.cabal index 255be89..e93691e 100644 --- a/hxt-compile.cabal +++ b/hxt-compile.cabal @@ -11,6 +11,7 @@ Build-Type: Simple Extra-Source-Files: examples/tiny.xml + examples/utf8.xml Library Build-Depends: -- 2.40.0