+makeMainXHTML :: (ArrowXml a, ArrowChoice a, ArrowIO a) =>
+ Storage
+ -> SystemConfig
+ -> InterpTable
+ -> a XmlTree XmlTree
+makeMainXHTML sto sysConf interpTable
+ = proc tree
+ -> do BaseURI baseURI <- getSysConfA sysConf -< ()
+ wiki <- wikifyPage interpTable -< tree
+ pName <- getXPathTreesInDoc "/page/@name/text()" >>> getText -< tree
+ interpreted <- interpretCommands sto sysConf interpTable
+ -< (pName, Just (tree, wiki), wiki)
+ formatWikiBlocks -< (baseURI, interpreted)
+
+
+makeSubXHTML :: (ArrowXml a, ArrowChoice a, ArrowIO a) =>
+ Storage
+ -> SystemConfig
+ -> InterpTable
+ -> a (PageName, Maybe XmlTree, XmlTree) XmlTree
+makeSubXHTML sto sysConf interpTable
+ = proc (mainPageName, mainPage, subPage)
+ -> do BaseURI baseURI <- getSysConfA sysConf -< ()
+ mainWiki <- case mainPage of
+ Just page
+ -> do wiki <- wikifyPage interpTable -< page
+ returnA -< Just (page, wiki)
+ Nothing
+ -> returnA -< Nothing
+ subWiki <- wikifyPage interpTable -< subPage
+ interpreted <- interpretCommands sto sysConf interpTable
+ -< (mainPageName, mainWiki, subWiki)
+ formatWikiBlocks -< (baseURI, interpreted)
+
+
+interpretCommands :: (ArrowXml a, ArrowChoice a, ArrowIO a) =>
+ Storage
+ -> SystemConfig
+ -> InterpTable
+ -> a (PageName, Maybe (XmlTree, WikiPage), WikiPage) WikiPage
+interpretCommands sto sysConf interpTable
+ = proc (name, mainPageAndWiki, targetWiki)
+ -> let ctx = InterpreterContext {
+ ctxPageName = name
+ , ctxMainPage = fmap fst mainPageAndWiki
+ , ctxMainWiki = fmap snd mainPageAndWiki
+ , ctxTargetWiki = targetWiki
+ , ctxStorage = sto
+ , ctxSysConf = sysConf
+ }
+ in
+ ( arrIO (everywhereM' (mkM $ interpBlockCmd ctx))
+ >>>
+ arrIO (everywhereM' (mkM $ interpInlineCmd ctx))
+ ) -<< targetWiki