filterOutRootAttrs

diff --git a/Main.hs b/Main.hs
index 387491488ef9dc6f275e7abea59e54d4a08558a6..296b252f881547b713b0e719c74ffa7ab5033c59 100644 (file)
--- a/Main.hs
+++ b/Main.hs
@@ -8,7 +8,7 @@ import qualified System.IO.UTF8 as Uio
 
 
 main :: IO ()
 
 
 main :: IO ()

-main = do let fpath = "examples/tiny.xml"
+main = do let fpath = "examples/utf8.xml"

 
           [hsMod] <- runX ( setErrorMsgHandler False fail
                             >>>
 
           [hsMod] <- runX ( setErrorMsgHandler False fail
                             >>>

diff --git a/Text/XML/HXT/Compilation.hs b/Text/XML/HXT/Compilation.hs
index 01e13e28b48ead8dd963a5cc6f4220ea75d49e4f..c2428de92137d65c3e6904bf749b96ed35337224 100644 (file)
--- 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
 
 compileDocument :: ArrowXml a => a XmlTree (HsQualType, HsExp)
 compileDocument = uniqueNamespacesFromDeclAndQNames

+                  >>>
+                  filterOutRootAttrs

                   >>>
                   ( constA (HsQualType [] (HsTyCon (UnQual (HsIdent "XmlTree"))))
                     &&&
                   >>>
                   ( 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
 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 (file)
index 0000000..9b7d6d1
--- /dev/null
+++ b/examples/utf8.xml
@@ -0,0 +1,4 @@
+<?xml version="1.0" encoding="utf-8"?>
+<はい>
+  <はいじゃないが る="テレーン"/>
+</はい>
\ No newline at end of file

diff --git a/hxt-compile.cabal b/hxt-compile.cabal
index 255be89ec267ae5f773a1e95d74a8f01ac7d6873..e93691ee4c271861b2b4ba0c7d52c29951d79281 100644 (file)
--- a/hxt-compile.cabal
+++ b/hxt-compile.cabal
@@ -11,6 +11,7 @@ Build-Type:          Simple
 
 Extra-Source-Files:
     examples/tiny.xml
 
 Extra-Source-Files:
     examples/tiny.xml

+    examples/utf8.xml

 
 Library
     Build-Depends:
 
 Library
     Build-Depends: