Client Message SEnding
[darcs-mirror-haskell-partty.git] / Partty.hs
index f02f899..ab68a75 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
-                              undefined -- send_client_messages client_messages
+               Left dm  -> do (client_messages, d') <- callDayCallback dcb ps' d dm
+                              mapM_ (sendClientMessage h) 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)
@@ -154,6 +167,15 @@ getNextUserMessage h ps = do
 parseIncomingMessage :: String -> IncomingMessage
 parseIncomingMessage = undefined
 
+sendClientMessage :: Handle -> ClientMessage -> IO ()
+sendClientMessage h msg = hPutStrLn h (toString msg)
+  where toString (Goto place)                    = unwords ["goto", show place]
+        toString (Tell player (PartyAt place))   = unwords ["party",    show player, show place]
+        toString (Tell player (NoPartyAt place)) = unwords ["no_party", show player, show place]
+        toString (Tell player (Liar other))      = unwords ["liar",     show player, show other]
+        toString (Tell player (NoLiar other))    = unwords ["recommand",show player, show other]
+
+
 -- Convenience functions for accessing the state
 
 whoIsHere :: (MonadReader ParttyState m) => m [Player]