HXT 仅将 XML 命名空间附加到根元素

HXT attach XML namespace to only root element

我正在使用 ghc-7.10 和 hxt-9.3.1.15。我有简单的 Open XML Word 生成器程序,例如

import Text.XML.HXT.Core
import System.Environment

readParams::IO (String, String)
readParams = do 
  args <- getArgs
  let defaultSrc = "methods.xml"
      defaultDst = "output.docx" 
  return $ case args of    
    [src]      -> (src, defaultDst)
    [src, dst] -> (src, dst)
    _other     -> (defaultSrc, defaultDst)

result::ArrowXml a=>a XmlTree XmlTree
result = structure where
  wordNS = "http://schemas.microsoft.com/office/word/2003/wordml"
  w      = mkqelem . flip (mkQName "w") wordNS
  structure =
    w "wordDocument" [] [
      w "body" [] [
        w "p" [] [
          w "r" [] [
            w "t" [] [txt "Hello World"]
          ]]]] 
    >>> attachNsEnv (toNsEnv [("w", wordNS)])


main::IO ()
main = do
  (src, dst) <- readParams
  _ <- runX $
    readDocument [withValidate no] src
    >>>
    root [] [ deep ( isElem >>> hasName "types" >>> result) ]
    >>>
    writeDocument[withIndent yes] dst 
  return ()

它正在生成有效的 XML 就像

<w:wordDocument xmlns:w="http://schemas.microsoft.com/office/word/2003/wordml">
  <w:body xmlns:w="http://schemas.microsoft.com/office/word/2003/wordml">
    <w:p xmlns:w="http://schemas.microsoft.com/office/word/2003/wordml">
      <w:r xmlns:w="http://schemas.microsoft.com/office/word/2003/wordml">
        <w:t xmlns:w="http://schemas.microsoft.com/office/word/2003/wordml">Hello World</w:t>
      </w:r>
    </w:p>
  </w:body>
</w:wordDocument>

但是我想只在顶部节点保留 xmlns:w=...

任何将 attachNsEnv (toNsEnv [("w", wordNS)]) 替换为 uniqueNamespaces or uniqueNamespacesFromDeclAndQNames 的尝试都会导致根本没有命名空间声明。

我怎样才能真正清理我的 XML 输出?

我确实在顶层节点上手动创建 xmlns:w 属性实现了所需的输出:

we::ArrowXml a=>String->a XmlTree XmlTree->a XmlTree XmlTree
we name child = w name [] [child]  

result::ArrowXml a=>a XmlTree XmlTree
result = 
  w "wordDocument" [sattr "xmlns:w" wordNS] [body children]
  where
    children = txt "Hello World!!!"
    body = we "body" . we "p" .  we "r"

但我仍在寻找更方便的解决方案。