Monad Voodo for alling the event handlers
authorJoachim Breitner <mail@joachim-breitner.de>
Fri, 4 Jul 2008 22:28:07 +0000 (22:28 +0000)
committerJoachim Breitner <mail@joachim-breitner.de>
Fri, 4 Jul 2008 22:28:07 +0000 (22:28 +0000)
Partty.hs

index f02f899..6e0a326 100644 (file)
--- a/Partty.hs
+++ b/Partty.hs
@@ -126,19 +126,32 @@ runPartty host port username password dcb ncb initialData = do
        -- The rest of the events are handled in the regular loop. Run the initial event
        -- and call the runner
        
-       d' <- undefined {- run -} ncb initialState initialData Initialize
+       d' <- callNightCallback ncb initialState initialData Initialize
 
        runner h dcb ncb initialState d'
 
+callDayCallback :: DayCallback d -> ParttyState -> d -> DayMessage -> IO ([ClientMessage], d)
+callDayCallback dcb ps d e = do
+       flip runStateT d $
+               flip runReaderT ps $ do
+                       execWriterT $ do
+                               dcb e
+
+callNightCallback :: NightCallback d -> ParttyState -> d -> NightMessage -> IO d
+callNightCallback ncb ps d e = do
+       flip execStateT d $
+               flip runReaderT ps $ do
+                       ncb e
+                               
 
 runner :: Handle -> DayCallback d -> NightCallback d -> ParttyState -> d -> IO ()
 runner h dcb ncb = fix $ \loop ps d -> do
        (e,ps') <- getNextUserMessage h ps
        d' <- case e of
-               Left dm  -> do (client_messages, d') <- undefined {- run -} dcb dm
+               Left dm  -> do (client_messages, d') <- callDayCallback dcb ps' d dm
                               undefined -- send_client_messages client_messages
                               return d'
-               Right nm -> undefined {- run -} ncb nm
+               Right nm -> callNightCallback ncb ps' d nm
        loop ps' d'
 
 getNextUserMessage :: Handle -> ParttyState -> IO (Either DayMessage NightMessage, ParttyState)