equal
deleted
inserted
replaced
59 sendAnswers ((handlesFunc, answer):answers) client clients rooms = do |
59 sendAnswers ((handlesFunc, answer):answers) client clients rooms = do |
60 let recipients = handlesFunc client clients rooms |
60 let recipients = handlesFunc client clients rooms |
61 unless (null recipients) $ putStrLn ("< " ++ (show answer)) |
61 unless (null recipients) $ putStrLn ("< " ++ (show answer)) |
62 |
62 |
63 clHandles' <- forM recipients $ |
63 clHandles' <- forM recipients $ |
64 \ch -> Control.Exception.handle (handleException ch) $ -- cannot just remove |
64 \ch -> Control.Exception.handle (\e -> putStrLn ("handle exception: " ++ show e) >> if head answer == "BYE" then return [ch] else return []) $ -- cannot just remove |
65 do |
65 do |
66 forM_ answer (\str -> hPutStrLn ch str) |
66 forM_ answer (\str -> hPutStrLn ch str) |
67 hPutStrLn ch "" |
67 hPutStrLn ch "" |
68 hFlush ch |
68 hFlush ch |
69 if head answer == "BYE" then hClose ch >> return [ch] else return [] |
69 if head answer == "BYE" then hClose ch >> return [ch] else return [] |
71 let mclients = remove clients $ concat clHandles' |
71 let mclients = remove clients $ concat clHandles' |
72 |
72 |
73 sendAnswers answers client mclients rooms |
73 sendAnswers answers client mclients rooms |
74 where |
74 where |
75 remove list rmClHandles = deleteFirstsBy2t (\ a b -> (Miscutils.handle a) == b) list rmClHandles |
75 remove list rmClHandles = deleteFirstsBy2t (\ a b -> (Miscutils.handle a) == b) list rmClHandles |
76 handleException ch e = do |
|
77 putStrLn ("handle exception: " ++ show e) |
|
78 handleInfo <- hShow ch |
|
79 putStrLn ("handle info: " ++ handleInfo) |
|
80 |
|
81 cl <- hIsClosed ch |
|
82 unless cl (hClose ch) |
|
83 |
|
84 if head answer == "BYE" then return [ch] else return [] |
|
85 |
76 |
86 |
77 |
87 reactCmd :: [String] -> ClientInfo -> [ClientInfo] -> [RoomInfo] -> IO ([ClientInfo], [RoomInfo]) |
78 reactCmd :: [String] -> ClientInfo -> [ClientInfo] -> [RoomInfo] -> IO ([ClientInfo], [RoomInfo]) |
88 reactCmd cmd client clients rooms = do |
79 reactCmd cmd client clients rooms = do |
89 putStrLn ("> " ++ show cmd) |
80 putStrLn ("> " ++ show cmd) |