Rakka/Wiki/Engine.hs

   1 module Rakka.Wiki.Engine
   2     ( formatPage
   3     )
   4     where
   5
   6 import           Control.Arrow
   7 import           Control.Arrow.ArrowTree
   8 import           Data.Encoding
   9 import           Data.Encoding.UTF8
  10 import           Network.HTTP.Lucu
  11 import           Rakka.Page
  12 import           Rakka.Wiki.Parser
  13 import           Rakka.Wiki.Formatter
  14 import           Text.ParserCombinators.Parsec
  15 import           Text.XML.HXT.Arrow.XmlArrow
  16 import           Text.XML.HXT.DOM.TypeDefs
  17
  18
  19 formatPage :: (ArrowXml a, ArrowChoice a) =>
  20               a Page XmlTree
  21 formatPage
  22     = proc page
  23     -> do tree <- case pageType page of
  24                     MIMEType "text" "x-rakka" _
  25                         -> formatWikiPage -< page
  26           attachXHtmlNs -< tree
  27
  28
  29 formatWikiPage :: (ArrowXml a, ArrowChoice a) =>
  30                   a Page XmlTree
  31 formatWikiPage
  32     = proc page
  33     -> do let source = decodeLazy UTF8 (pageContent page)
  34           case parse wikiPage "" source of
  35             Left  err   -> formatParseError   -< err
  36             Right elems -> formatWikiElements -< elems
  37
  38
  39 formatParseError :: ArrowXml a => a ParseError XmlTree
  40 formatParseError
  41     = proc err -> (eelem "pre" += txt (show err)) -<< ()
  42
  43
  44 attachXHtmlNs :: ArrowXml a => a XmlTree XmlTree
  45 attachXHtmlNs = processBottomUp (changeQName attach')
  46     where
  47       attach' :: QName -> QName
  48       attach' qn = qn {
  49                      namePrefix   = "xhtml"
  50                    , namespaceUri = "http://www.w3.org/1999/xhtml"
  51                    }