Update State for outgoing messages, implement psPlace
authorJoachim Breitner <mail@joachim-breitner.de>
Sat, 5 Jul 2008 00:31:35 +0000 (00:31 +0000)
committerJoachim Breitner <mail@joachim-breitner.de>
Sat, 5 Jul 2008 00:31:35 +0000 (00:31 +0000)
Partty.hs

index e17248a..0e7002c 100644 (file)
--- a/Partty.hs
+++ b/Partty.hs
@@ -150,12 +150,14 @@ callNightCallback ncb ps d e = do
 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
+       (d',ps'') <- case e of
                Left dm  -> do (client_messages, d') <- callDayCallback dcb ps' d dm
                               mapM_ (sendClientMessage h) client_messages
-                              return d'
-               Right nm -> callNightCallback ncb ps' d nm
-       loop ps' d'
+                              let ps'' = foldr updateStateC ps' client_messages
+                              return (d',ps'')
+               Right nm -> do d' <- callNightCallback ncb ps' d nm
+                              return (d',ps')
+       loop ps'' d'
 
 getNextUserMessage :: Handle -> ParttyState -> IO (Either DayMessage NightMessage, ParttyState)
 getNextUserMessage h ps = do
@@ -249,10 +251,13 @@ sendClientMessage h msg = do putStrLn $ "Client says: " ++ (show msg)
 
 updateState :: IncomingMessage -> ParttyState -> ParttyState
 
-updateState (DayMessage (DayStarts num)) ps = ps {psDay = num}
-
+updateState (DayMessage (DayStarts num)) ps =
+       ps {psDay = num}
 updateState msg ps = ps -- TODO: this is a stub
 
+updateStateC :: ClientMessage -> ParttyState -> ParttyState
+updateStateC (Goto place) ps = ps {psPlace = place}
+updateStateC msg ps = ps
 
 -- Convenience functions for accessing the state