34 |
34 |
35 clientLoop :: Handle -> TChan [String] -> IO () |
35 clientLoop :: Handle -> TChan [String] -> IO () |
36 clientLoop handle chan = |
36 clientLoop handle chan = |
37 listenLoop handle [] chan |
37 listenLoop handle [] chan |
38 `catch` (const $ clientOff >> return ()) |
38 `catch` (const $ clientOff >> return ()) |
39 where clientOff = atomically $ writeTChan chan ["QUIT"] -- если клиент отключается, то делаем вид, что от него пришла команда QUIT |
39 where clientOff = atomically $ writeTChan chan ["QUIT"] -- if the client disconnects, we perform as if it sent QUIT message |
40 |
40 |
41 |
41 |
42 sendAnswers [] _ clients _ = return clients |
42 sendAnswers [] _ clients _ = return clients |
43 sendAnswers ((handlesFunc, answer):answers) client clients rooms = do |
43 sendAnswers ((handlesFunc, answer):answers) client clients rooms = do |
44 let recipients = handlesFunc client clients rooms |
44 let recipients = handlesFunc client clients rooms |
45 putStrLn ("< " ++ (show answer) ++ " (" ++ (show $ length recipients) ++ " recipients)") |
45 putStrLn ("< " ++ (show answer) ++ " (" ++ (show $ length recipients) ++ " recipients)") |
46 |
46 |
47 clHandles' <- forM recipients $ |
47 clHandles' <- forM recipients $ |
48 \ch -> Control.Exception.handle (\e -> putStrLn (show e) >> hClose ch >> return [ch]) $ |
48 \ch -> Control.Exception.handle (\e -> putStrLn (show e) >> hClose ch >> return [ch]) $ |
|
49 if (not $ null answer) && (head answer == "off") then hClose ch >> return [ch] else -- probably client with exception, don't send him anything |
49 do |
50 do |
50 forM_ answer (\str -> hPutStrLn ch str) |
51 forM_ answer (\str -> hPutStrLn ch str) |
51 hPutStrLn ch "" |
52 hPutStrLn ch "" |
52 hFlush ch |
53 hFlush ch |
53 if (not $ null answer) && (head answer == "BYE") then hClose ch >> return [ch] else return [] |
54 if (not $ null answer) && (head answer == "BYE") then hClose ch >> return [ch] else return [] |