From: PHO Date: Tue, 9 Mar 2010 06:52:18 +0000 (+0900) Subject: filterOutRootAttrs X-Git-Url: https://git.cielonegro.org/gitweb.cgi?a=commitdiff_plain;h=13dc5a370f4d7d3223937346fc63ce94c8aa85a8;p=hxt-compile.git filterOutRootAttrs --- 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: