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
= 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
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 qn = qn {
+ namePrefix = "xhtml"
+ , namespaceUri = "http://www.w3.org/1999/xhtml"
+ }