Farewell the dream of plug-in system... It's way too hard to implement nicely. Many...

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

diff --git a/Rakka/Wiki/Engine.hs b/Rakka/Wiki/Engine.hs
index eb986ea0b46c23a36d6acdc336a7ac3abda516ab..2b751d4a47db96bc49bc23e0ef02f0d54e2d2427 100644 (file)
--- a/Rakka/Wiki/Engine.hs
+++ b/Rakka/Wiki/Engine.hs
@@ -29,9 +29,8 @@ formatPage :: (ArrowXml a, ArrowChoice a, ArrowIO a) =>
 formatPage env
     = proc page
     -> do BaseURI baseURI <- getSysConfA (envSysConf env) (BaseURI undefined) -< ()
-          interpTable     <- getInterpTableA env -< ()
-          wiki            <- wikifyPage env -< (interpTable, page)
-          xs              <- interpretCommandsA env -< (interpTable, (pageName page, (Just wiki, wiki)))
+          wiki            <- wikifyPage env -< page
+          xs              <- interpretCommandsA env -< (pageName page, (Just wiki, wiki))
           formatWikiBlocks -< (baseURI, xs)
 
 
@@ -41,27 +40,26 @@ formatSubPage :: (ArrowXml a, ArrowChoice a, ArrowIO a) =>
 formatSubPage env
     = proc (mainPageName, (mainPage, subPage))
     -> do BaseURI baseURI <- getSysConfA (envSysConf env) (BaseURI undefined) -< ()
-          interpTable     <- getInterpTableA env -< ()
           mainWiki        <- case mainPage of
                                Just page
-                                   -> do wiki <- wikifyPage env -< (interpTable, page)
+                                   -> do wiki <- wikifyPage env -< page
                                          returnA -< Just wiki
                                Nothing
                                    -> returnA -< Nothing
-          subWiki        <- wikifyPage env -< (interpTable, subPage)
-          xs             <- interpretCommandsA env -< (interpTable, (mainPageName, (mainWiki, subWiki)))
+          subWiki        <- wikifyPage env -< subPage
+          xs             <- interpretCommandsA env -< (mainPageName, (mainWiki, subWiki))
           formatWikiBlocks -< (baseURI, xs)
 
 
 wikifyPage :: (ArrowXml a, ArrowChoice a, ArrowIO a) =>
                  Environment
-              -> a (InterpTable, Page) WikiPage
+              -> a Page WikiPage
 wikifyPage env
-    = proc (interpTable, page)
+    = proc page
     -> case pageType page of
          MIMEType "text" "x-rakka" _
              -> do let source = decodeLazy UTF8 (pageContent page)
-                       parser = wikiPage (tableToFunc interpTable)
+                       parser = wikiPage tableToFunc
 
                    case parse parser "" source of
                      Left  err
@@ -70,20 +68,20 @@ wikifyPage env
                      Right xs
                          -> returnA -< xs
     where
-      tableToFunc :: InterpTable -> String -> Maybe CommandType
-      tableToFunc table name
-          = fmap commandType (M.lookup name table)
+      tableToFunc :: String -> Maybe CommandType
+      tableToFunc name
+          = fmap commandType (M.lookup name (envInterpTable env))
 
 
 interpretCommandsA :: ArrowIO a =>
                       Environment
-                   -> a (InterpTable, (PageName, (Maybe WikiPage, WikiPage))) WikiPage
-interpretCommandsA = arrIO4 . interpretCommands
+                   -> a (PageName, (Maybe WikiPage, WikiPage)) WikiPage
+interpretCommandsA = arrIO3 . interpretCommands
 
 
-interpretCommands :: Environment -> InterpTable -> PageName -> Maybe WikiPage -> WikiPage -> IO WikiPage
-interpretCommands _   _     _    _        []         = return []
-interpretCommands env table name mainTree targetTree
+interpretCommands :: Environment -> PageName -> Maybe WikiPage -> WikiPage -> IO WikiPage
+interpretCommands _   _    _        []         = return []
+interpretCommands env name mainTree targetTree
     = everywhereM' (mkM interpBlockCmd) targetTree
       >>=
       everywhereM' (mkM interpInlineCmd)
@@ -103,7 +101,7 @@ interpretCommands env table name mainTree targetTree
 
       interpBlockCmd' :: BlockCommand -> IO BlockElement
       interpBlockCmd' cmd
-          = case M.lookup (bCmdName cmd) table of
+          = case M.lookup (bCmdName cmd) (envInterpTable env) of
               Nothing
                   -> fail ("no such interpreter: " ++ bCmdName cmd)
 
@@ -117,7 +115,7 @@ interpretCommands env table name mainTree targetTree
 
       interpInlineCmd' :: InlineCommand -> IO InlineElement
       interpInlineCmd' cmd
-          = case M.lookup (iCmdName cmd) table of
+          = case M.lookup (iCmdName cmd) (envInterpTable env) of
               Nothing
                   -> fail ("no such interpreter: " ++ iCmdName cmd)