Search code examples
xmlhaskellhxt

HXT attach XML namespace to only root element


I'm using ghc-7.10 and hxt-9.3.1.15. I have simple Open XML Word generator prog like

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 ()

It's generating valid XML like

<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>

However I'd like to keep xmlns:w=... only at top node.

Any attempt to replace attachNsEnv (toNsEnv [("w", wordNS)]) with uniqueNamespaces or uniqueNamespacesFromDeclAndQNames leads to result with no namespace declarations at all.

How can I actually cleanup my XML output?


Solution

  • I did achieve desired output manually creating xmlns:w attribute at toplevel node :

    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"
    

    But I still searching for more convenient solution.