Add an empty weapon to avoid selection of weapons which aren't yet ready. Might all be useful to switch to amNothing in certain situations, like after using up all ropes, instead of bazooka.
{-# LANGUAGE ScopedTypeVariables #-}
module ClientIO where
import qualified Control.Exception as Exception
import Control.Concurrent.Chan
import Control.Monad
import System.IO
----------------
import CoreTypes
listenLoop :: Handle -> Int -> [String] -> Chan CoreMessage -> Int -> IO ()
listenLoop handle linesNumber buf chan clientID = do
str <- hGetLine handle
if (linesNumber > 50) || (length str > 450) then
writeChan chan $ ClientMessage (clientID, ["QUIT", "Protocol violation"])
else
if str == "" then do
writeChan chan $ ClientMessage (clientID, buf)
listenLoop handle 0 [] chan clientID
else
listenLoop handle (linesNumber + 1) (buf ++ [str]) chan clientID
clientRecvLoop :: Handle -> Chan CoreMessage -> Int -> IO ()
clientRecvLoop handle chan clientID =
listenLoop handle 0 [] chan clientID
`catch` (\e -> clientOff (show e) >> return ())
where clientOff msg = writeChan chan $ ClientMessage (clientID, ["QUIT", msg]) -- if the client disconnects, we perform as if it sent QUIT message
clientSendLoop :: Handle -> Chan CoreMessage -> Chan [String] -> Int -> IO()
clientSendLoop handle coreChan chan clientID = do
answer <- readChan chan
doClose <- Exception.handle
(\(e :: Exception.IOException) -> if isQuit answer then return True else sendQuit e >> return False) $ do
forM_ answer (hPutStrLn handle)
hPutStrLn handle ""
hFlush handle
return $ isQuit answer
if doClose then
Exception.handle (\(_ :: Exception.IOException) -> putStrLn "error on hClose") $ hClose handle
else
clientSendLoop handle coreChan chan clientID
where
sendQuit e = writeChan coreChan $ ClientMessage (clientID, ["QUIT", show e])
isQuit ("BYE":xs) = True
isQuit _ = False