Fixed breakage on newer HXT

[Rakka.git] / Rakka / Wiki / Formatter.hs

diff --git a/Rakka/Wiki/Formatter.hs b/Rakka/Wiki/Formatter.hs
index 0dfe02e4e66c606592abefa1d9ae93097a2fb669..90687f4e8479a1c11593e770b6cf899fd67f71ee 100644 (file)
--- a/Rakka/Wiki/Formatter.hs
+++ b/Rakka/Wiki/Formatter.hs
@@ -4,7 +4,9 @@ module Rakka.Wiki.Formatter
     where
 
 import           Control.Arrow
+import           Control.Arrow.ArrowIf
 import           Control.Arrow.ArrowList
+import           Control.Arrow.ArrowTree
 import           Data.Char
 import           Data.List
 import           Data.Maybe
@@ -20,7 +22,7 @@ formatWikiBlocks
     = proc (baseURI, blocks)
     -> do block   <- arrL id     -< blocks
           tree    <- formatBlock -< (baseURI, block)
-          returnA -< tree
+          attachXHtmlNS -< tree
 
 
 formatElement :: (ArrowXml a, ArrowChoice a) => a (URI, Element) XmlTree
@@ -273,3 +275,11 @@ mkAnchor :: (ArrowXml a) => a (String, String) XmlTree
 mkAnchor = eelem "a"
            += attr "href" (arr fst >>> mkText)
            += (arr snd >>> mkText)
+
+
+attachXHtmlNS :: (ArrowXml a) => a XmlTree XmlTree
+attachXHtmlNS = processTopDown (changeQName attach `when` isElem)
+    where
+      attach :: QName -> QName
+      attach = setNamePrefix'   (newXName "xhtml") .
+               setNamespaceUri' (newXName "http://www.w3.org/1999/xhtml")