Implemented the outline command

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

diff --git a/Rakka/Wiki/Formatter.hs b/Rakka/Wiki/Formatter.hs
index a08fe304ff74385cfe66f19cdd8e73d6edece596..b81c510594f75253678f9dfc7995899e627615c5 100644 (file)
--- a/Rakka/Wiki/Formatter.hs
+++ b/Rakka/Wiki/Formatter.hs
@@ -5,6 +5,7 @@ module Rakka.Wiki.Formatter
 
 import           Control.Arrow
 import           Control.Arrow.ArrowList
+import           Control.Arrow.ArrowTree
 import           Data.Char
 import           Data.List
 import           Data.Maybe
@@ -18,8 +19,9 @@ import           Text.XML.HXT.DOM.TypeDefs
 formatWikiBlocks :: (ArrowXml a, ArrowChoice a) => a (URI, [BlockElement]) XmlTree
 formatWikiBlocks
     = proc (baseURI, blocks)
-    -> do block <- arrL id -< blocks
-          formatBlock -< (baseURI, block)
+    -> do block   <- arrL id     -< blocks
+          tree    <- formatBlock -< (baseURI, block)
+          attachXHtmlNs -< tree
 
 
 formatBlock :: (ArrowXml a, ArrowChoice a) => a (URI, BlockElement) XmlTree
@@ -46,6 +48,9 @@ formatBlock
 
          Div attrs contents
              -> formatElem "div" -< (baseURI, attrs, contents)
+
+         EmptyBlock
+             -> none -< ()
     where
       formatElem :: (ArrowXml a, ArrowChoice a) =>
                     String
@@ -178,6 +183,9 @@ formatInline
 
          Anchor attrs contents
              -> formatElem "a" -< (baseURI, attrs, contents)
+
+         EmptyInline
+             -> none -< ()
     where
       formatElem :: (ArrowXml a, ArrowChoice a) =>
                     String
@@ -229,3 +237,13 @@ formatExternalLink
            += attr "href" (arr fst >>> mkText)
            += (arr snd >>> mkText)
          ) -< (href, label)
+
+
+attachXHtmlNs :: ArrowXml a => a XmlTree XmlTree
+attachXHtmlNs = processBottomUp (changeQName attach')
+    where
+      attach' :: QName -> QName
+      attach' qn = qn {
+                     namePrefix   = "xhtml"
+                   , namespaceUri = "http://www.w3.org/1999/xhtml"
+                   }