equal
deleted
inserted
replaced
1 {-# LANGUAGE CPP, PatternSignatures #-} |
1 {-# LANGUAGE ScopedTypeVariables #-} |
2 module ClientIO where |
2 module ClientIO where |
3 |
3 |
4 #if defined(NEW_EXCEPTIONS) |
|
5 import qualified Control.OldException as Exception |
|
6 #else |
|
7 import qualified Control.Exception as Exception |
4 import qualified Control.Exception as Exception |
8 #endif |
|
9 import Control.Concurrent.Chan |
5 import Control.Concurrent.Chan |
10 import Control.Monad |
6 import Control.Monad |
11 import System.IO |
7 import System.IO |
12 ---------------- |
8 ---------------- |
13 import CoreTypes |
9 import CoreTypes |
32 |
28 |
33 clientSendLoop :: Handle -> Chan CoreMessage -> Chan [String] -> Int -> IO() |
29 clientSendLoop :: Handle -> Chan CoreMessage -> Chan [String] -> Int -> IO() |
34 clientSendLoop handle coreChan chan clientID = do |
30 clientSendLoop handle coreChan chan clientID = do |
35 answer <- readChan chan |
31 answer <- readChan chan |
36 doClose <- Exception.handle |
32 doClose <- Exception.handle |
37 (\(e :: Exception.Exception) -> if isQuit answer then return True else sendQuit e >> return False) $ do |
33 (\(e :: Exception.IOException) -> if isQuit answer then return True else sendQuit e >> return False) $ do |
38 forM_ answer (\str -> hPutStrLn handle str) |
34 forM_ answer (\str -> hPutStrLn handle str) |
39 hPutStrLn handle "" |
35 hPutStrLn handle "" |
40 hFlush handle |
36 hFlush handle |
41 return $ isQuit answer |
37 return $ isQuit answer |
42 |
38 |
43 if doClose then |
39 if doClose then |
44 Exception.handle (\(_ :: Exception.Exception) -> putStrLn "error on hClose") $ hClose handle |
40 Exception.handle (\(_ :: Exception.IOException) -> putStrLn "error on hClose") $ hClose handle |
45 else |
41 else |
46 clientSendLoop handle coreChan chan clientID |
42 clientSendLoop handle coreChan chan clientID |
47 |
43 |
48 where |
44 where |
49 sendQuit e = writeChan coreChan $ ClientMessage (clientID, ["QUIT", show e]) |
45 sendQuit e = writeChan coreChan $ ClientMessage (clientID, ["QUIT", show e]) |