HXT присоединяет пространство имен XML только к корневому элементу

Question

Я использую ghc-7.10 и hxt-9.3.1.15. У меня есть простой генератор прог XML Open XML, как

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 или же uniqueNamespacesFromDeclAndQNames приводит к результату без объявлений пространства имен вообще.

Как я могу на самом деле очистить мой вывод XML?

Answer 1

Я добился желаемого результата, создавая вручную 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"

Но я все еще ищу более удобное решение.