Implement first LineEater
authorJoachim Breitner <mail@joachim-breitner.de>
Sat, 5 Jul 2008 00:44:09 +0000 (00:44 +0000)
committerJoachim Breitner <mail@joachim-breitner.de>
Sat, 5 Jul 2008 00:44:09 +0000 (00:44 +0000)
Partty.hs

index 3ee8df9..bff0e0a 100644 (file)
--- a/Partty.hs
+++ b/Partty.hs
@@ -17,16 +17,16 @@ data Hint = PartyAt Place
          | NoPartyAt Place
          | Liar Player
          | NoLiar Player
-     deriving (Show, Eq)
+     deriving (Show)
 
 data Score = NoScore | ToFew | Scored
-                    deriving (Show, Eq)
+                    deriving (Show)
 
 data IncomingMessage = InternalMessage InternalMessage
                      | DayMessage      DayMessage
                      | NightMessage    NightMessage
                     | UnknownMessage  String
-                    deriving (Show, Eq)
+                    deriving (Show)
        
 -- Events that we want to send to the user code and that
 -- can be reacted upon
@@ -34,7 +34,7 @@ data DayMessage      = DayStarts Int
                      | DayEndsIn Int
                      | DayEnds
                     | GotHint Player Hint
-                    deriving (Show, Eq)
+                    deriving (Show)
 
 -- Events that we want to send to the user code and that
 -- can NOT be reacted upon
@@ -47,7 +47,7 @@ data NightMessage    = Initialize
                      | GotScore Score
                     | NewContact Player
                     | LostContact Player
-                    deriving (Show, Eq)
+                    deriving (Show)
 -- Pure bookkeeping events
 data InternalMessage = MyPlayerId Player
                      | Welcome
@@ -59,13 +59,18 @@ data InternalMessage = MyPlayerId Player
                     | PlayerEnter Player Place
                     | PlayerLeave Player Place
                     | ActionsLeft Int
+                    | MultiLine Int LineEater
+                    | PlayerList [String]
                     | Noise
-                    deriving (Show, Eq)
+                    deriving (Show)
 
+-- Type hack to use auto-derive for InternalMessage, although it contains a function
+newtype LineEater  = LineEater { eatLinesWith :: ([String] -> IncomingMessage) }
+instance Show LineEater where show _ = "<LineEater>"
 
 data ClientMessage = Tell Player Hint
                   | Goto Place
-                    deriving (Show, Eq)
+                    deriving (Show)
 
 type DayCallback d   = DayMessage -> DayMonad d ()
 type NightCallback d = NightMessage -> NightMonad d ()
@@ -176,7 +181,10 @@ getNextMessage :: Handle -> IO (IncomingMessage)
 getNextMessage h = do
        line <- hGetLine h
        let msg = parseIncomingMessage line
-       return msg
+       case msg of
+               InternalMessage (MultiLine n f) -> do
+                       eatLinesWith f `liftM` mapM (const (hGetLine h)) [1..n]
+               msg                             -> return msg
 
 parseIncomingMessage :: String -> IncomingMessage
 parseIncomingMessage msg = case id of
@@ -229,6 +237,8 @@ parseIncomingMessage msg = case id of
 
        60 -> NightMessage    (PartyHint int1)
 
+       31 -> InternalMessage (MultiLine int1 (LineEater $ \l -> InternalMessage (PlayerList l)))
+
        
        --_  -> UnknownMessage msg
        _  -> error $ "Unkown or unparseable message:\n" ++ msg