Record before an experiment

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

diff --git a/Rakka/Wiki/Engine.hs b/Rakka/Wiki/Engine.hs
index 2b751d4a47db96bc49bc23e0ef02f0d54e2d2427..ba9151c1a43137f9ae267cd3e07874ee445e5027 100644 (file)
--- a/Rakka/Wiki/Engine.hs
+++ b/Rakka/Wiki/Engine.hs
@@ -30,7 +30,7 @@ formatPage env
     = proc page
     -> do BaseURI baseURI <- getSysConfA (envSysConf env) (BaseURI undefined) -< ()
           wiki            <- wikifyPage env -< page
-          xs              <- interpretCommandsA env -< (pageName page, (Just wiki, wiki))
+          xs              <- interpretCommandsA env -< (pageName page, (Just (page, wiki), wiki))
           formatWikiBlocks -< (baseURI, xs)
 
 
@@ -43,7 +43,7 @@ formatSubPage env
           mainWiki        <- case mainPage of
                                Just page
                                    -> do wiki <- wikifyPage env -< page
-                                         returnA -< Just wiki
+                                         returnA -< Just (page, wiki)
                                Nothing
                                    -> returnA -< Nothing
           subWiki        <- wikifyPage env -< subPage
@@ -75,13 +75,13 @@ wikifyPage env
 
 interpretCommandsA :: ArrowIO a =>
                       Environment
-                   -> a (PageName, (Maybe WikiPage, WikiPage)) WikiPage
+                   -> a (PageName, (Maybe (Page, WikiPage), WikiPage)) WikiPage
 interpretCommandsA = arrIO3 . interpretCommands
 
 
-interpretCommands :: Environment -> PageName -> Maybe WikiPage -> WikiPage -> IO WikiPage
+interpretCommands :: Environment -> PageName -> Maybe (Page, WikiPage) -> WikiPage -> IO WikiPage
 interpretCommands _   _    _        []         = return []
-interpretCommands env name mainTree targetTree
+interpretCommands env name mainPageAndTree targetTree
     = everywhereM' (mkM interpBlockCmd) targetTree
       >>=
       everywhereM' (mkM interpInlineCmd)
@@ -89,7 +89,8 @@ interpretCommands env name mainTree targetTree
       ctx :: InterpreterContext
       ctx = InterpreterContext {
               ctxPageName   = name
-            , ctxMainTree   = mainTree
+            , ctxMainPage   = fmap fst mainPageAndTree
+            , ctxMainTree   = fmap snd mainPageAndTree
             , ctxTargetTree = targetTree
             , ctxStorage    = envStorage env
             , ctxSysConf    = envSysConf env