fix design problem

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

diff --git a/Rakka/Wiki/Interpreter.hs b/Rakka/Wiki/Interpreter.hs
index bfaab67b0cd742d2ea0f02b7ebaf7b0913fffa9a..32e1a3aa0e1760516d67e533b2fdb59a1942df43 100644 (file)
--- a/Rakka/Wiki/Interpreter.hs
+++ b/Rakka/Wiki/Interpreter.hs
@@ -1,11 +1,9 @@
 module Rakka.Wiki.Interpreter
     ( Interpreter(..)
+    , InterpreterContext(..)
 
     , commandName -- private
     , commandType -- private
-
-    , pureInlineInterp
-    , pureBlockInterp
     )
     where
 
@@ -13,24 +11,28 @@ import           Rakka.Page
 import           Rakka.Storage
 import           Rakka.SystemConfig
 import           Rakka.Wiki
+import           Text.XML.HXT.DOM.TypeDefs
 
 
 data Interpreter
     = InlineCommandInterpreter {
-        iciName      :: String
-      , iciInterpret :: InlineCommand
-                     -> Maybe Page
-                     -> Storage
-                     -> SystemConfig
-                     -> IO InlineElement
+        iciName      :: !String
+      , iciInterpret :: !(InterpreterContext -> InlineCommand -> IO InlineElement)
       }
     | BlockCommandInterpreter {
-        bciName      :: String
-      , bciInterpret :: BlockCommand
-                     -> Maybe Page
-                     -> Storage
-                     -> SystemConfig
-                     -> IO BlockElement
+        bciName      :: !String
+      , bciInterpret :: !(InterpreterContext -> BlockCommand -> IO BlockElement)
+      }
+
+
+data InterpreterContext
+    = InterpreterContext {
+        ctxPageName   :: !(Maybe PageName)
+      , ctxMainPage   :: !(Maybe XmlTree)
+      , ctxMainWiki   :: !(Maybe WikiPage)
+      , ctxTargetWiki :: !WikiPage
+      , ctxStorage    :: !Storage
+      , ctxSysConf    :: !SystemConfig
       }
 
 
@@ -42,17 +44,3 @@ commandName (BlockCommandInterpreter  name _) = name
 commandType :: Interpreter -> CommandType
 commandType (InlineCommandInterpreter _ _) = InlineCommandType
 commandType (BlockCommandInterpreter  _ _) = BlockCommandType
-
-
-pureInlineInterp :: String
-                 -> (InlineCommand -> Maybe Page -> InlineElement)
-                 -> Interpreter
-pureInlineInterp name f
-    = InlineCommandInterpreter name $ \ cmd page _ _ -> return $ f cmd page
-
-
-pureBlockInterp :: String
-                -> (BlockCommand -> Maybe Page -> BlockElement)
-                -> Interpreter
-pureBlockInterp name f
-    = BlockCommandInterpreter name $ \ cmd page _ _ -> return $ f cmd page