data IncomingMessage = InternalMessage InternalMessage
| DayMessage DayMessage
| NightMessage NightMessage
+ | UnknownMessage String
deriving (Show, Eq)
-- Events that we want to send to the user code and that
-- Events that we want to send to the user code and that
-- can NOT be reacted upon
data NightMessage = Initialize
- | NightStarts
+ | PartyHint Place
deriving (Show, Eq)
-- Pure bookkeeping events
data InternalMessage = MyPlayerId Player
| GameStarting
| MyIdIs Player
| PlayerEnter Player Place
+ | Noise
deriving (Show, Eq)
data ClientMessage = Tell Player Hint
| Goto Place
+ deriving (Show, Eq)
type DayCallback d = DayMessage -> DayMonad d ()
type NightCallback d = NightMessage -> NightMonad d ()
let ps' = updateState msg ps
case msg of
InternalMessage ue -> getNextUserMessage h ps'
+ UnknownMessage s-> do putStrLn $"Got an unknown message:\n"++s
+ getNextUserMessage h ps'
DayMessage dm -> return (Left dm, ps')
NightMessage nm -> return (Right nm, ps')
parseIncomingMessage :: String -> IncomingMessage
parseIncomingMessage msg = case id of
+ -- Errors, no proper handling for now
+ 07 -> error "Game is already in progress, try again later..."
+
+ -- Regular Messages
71 -> InternalMessage (Welcome)
20 -> InternalMessage (PlayerJoined s1)
- _ -> error $ "Unkown or unparseable message:\n" ++ msg
+ 70 -> InternalMessage (Noise) -- welcome
+ 40 -> InternalMessage (Noise) -- waiting for at least .. players
+ 41 -> InternalMessage (Noise) -- game will start in...
+ 42 -> InternalMessage (GameStarting)
+ 43 -> InternalMessage (MyIdIs s1)
+ 22 -> InternalMessage (PlayerEnter s1 int2)
+
+ 50 -> DayMessage (DayStarts)
+
+ 60 -> NightMessage (PartyHint int1)
+
+ _ -> UnknownMessage msg
+ --_ -> error $ "Unkown or unparseable message:\n" ++ msg
where (id_s : num_params : rest) = words msg
id = read id_s
param_s = take (read num_params) rest
int2 = read (param_s !! 2) :: Int
sendClientMessage :: Handle -> ClientMessage -> IO ()
-sendClientMessage h msg = hPutStrLn h (toString msg)
+sendClientMessage h msg = do putStrLn $ "Client says: " ++ (show 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]