X-Git-Url: https://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FWiki%2FFormatter.hs;h=b81c510594f75253678f9dfc7995899e627615c5;hb=3c5211253dc61c31196a47486c538b64c32d8c5e;hp=a08fe304ff74385cfe66f19cdd8e73d6edece596;hpb=b3c3f333cd48bc74eb33f0f21d56a9d1bc65e0ea;p=Rakka.git diff --git a/Rakka/Wiki/Formatter.hs b/Rakka/Wiki/Formatter.hs index a08fe30..b81c510 100644 --- 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" + }