-> do tree <- case pageType page of
MIMEType "text" "x-rakka" _
-> do let source = decodeLazy UTF8 (pageContent page)
- formatWikiPage env -< (Just page, source)
+ formatWikiPage env -< (pageName page, source)
attachXHtmlNs -< tree
formatSubPage :: (ArrowXml a, ArrowChoice a, ArrowIO a) =>
Environment
- -> a (Page, Page) XmlTree
+ -> a (PageName, Page) XmlTree
formatSubPage env
- = proc (mainPage, subPage)
+ = proc (mainPageName, subPage)
-> do tree <- case pageType subPage of
MIMEType "text" "x-rakka" _
-> do let source = decodeLazy UTF8 (pageContent subPage)
- formatWikiPage env -< (Just mainPage, source)
+ formatWikiPage env -< (mainPageName, source)
attachXHtmlNs -< tree
formatWikiPage :: (ArrowXml a, ArrowChoice a, ArrowIO a) =>
Environment
- -> a (Maybe Page, String) XmlTree
+ -> a (PageName, String) XmlTree
formatWikiPage env
- = proc (page, source)
+ = proc (name, source)
-> do BaseURI baseURI <- getSysConfA (envSysConf env) (BaseURI undefined) -< ()
interpTable <- getInterpTableA env -< ()
-> formatParseError -< err
Right blocks
- -> do xs <- interpretCommandsA env -< (interpTable, (page, blocks))
+ -> do xs <- interpretCommandsA env -< (interpTable, (name, blocks))
formatWikiBlocks -< (baseURI, xs)
where
tableToFunc :: InterpTable -> String -> Maybe CommandType
interpretCommandsA :: ArrowIO a =>
Environment
- -> a (InterpTable, (Maybe Page, WikiPage)) WikiPage
+ -> a (InterpTable, (PageName, WikiPage)) WikiPage
interpretCommandsA = arrIO3 . interpretCommands
-interpretCommands :: Environment -> InterpTable -> Maybe Page -> WikiPage -> IO WikiPage
+interpretCommands :: Environment -> InterpTable -> PageName -> WikiPage -> IO WikiPage
interpretCommands _ _ _ [] = return []
-interpretCommands env table page blocks = everywhereM' (mkM interpBlockCmd) blocks
+interpretCommands env table name blocks = everywhereM' (mkM interpBlockCmd) blocks
>>=
everywhereM' (mkM interpInlineCmd)
where
ctx :: InterpreterContext
ctx = InterpreterContext {
- ctxPage = page
- , ctxTree = blocks
- , ctxStorage = envStorage env
- , ctxSysConf = envSysConf env
- }
+ ctxPageName = name
+ , ctxTree = blocks
+ , ctxStorage = envStorage env
+ , ctxSysConf = envSysConf env
+ }
interpBlockCmd :: BlockElement -> IO BlockElement
interpBlockCmd (BlockCmd cmd) = interpBlockCmd' cmd