equal
deleted
inserted
replaced
1 {-# LANGUAGE CPP, PatternSignatures #-} |
1 {-# LANGUAGE CPP, ScopedTypeVariables #-} |
2 |
2 |
3 module Main where |
3 module Main where |
4 |
4 |
5 import Network |
5 import Network |
6 import IO |
6 import IO |
37 atomically $ writeTChan messagesChan ["MINUTELY"] |
37 atomically $ writeTChan messagesChan ["MINUTELY"] |
38 |
38 |
39 socketCloseLoop :: TChan Handle -> IO() |
39 socketCloseLoop :: TChan Handle -> IO() |
40 socketCloseLoop closingChan = forever $ do |
40 socketCloseLoop closingChan = forever $ do |
41 h <- atomically $ readTChan closingChan |
41 h <- atomically $ readTChan closingChan |
42 Control.Exception.handle (\(_ :: Exception) -> putStrLn "error on hClose") $ hClose h |
42 Control.Exception.handle (\(_ :: IOException) -> putStrLn "error on hClose") $ hClose h |
43 |
43 |
44 acceptLoop :: Socket -> TChan ClientInfo -> IO () |
44 acceptLoop :: Socket -> TChan ClientInfo -> IO () |
45 acceptLoop servSock acceptChan = |
45 acceptLoop servSock acceptChan = |
46 Control.Exception.handle (\(_ :: Exception) -> putStrLn "exception on connect" >> acceptLoop servSock acceptChan) $ |
46 Control.Exception.handle (\(_ :: IOException) -> putStrLn "exception on connect" >> acceptLoop servSock acceptChan) $ |
47 do |
47 do |
48 (cHandle, host, _) <- accept servSock |
48 (cHandle, host, _) <- accept servSock |
49 |
49 |
50 currentTime <- getCurrentTime |
50 currentTime <- getCurrentTime |
51 putStrLn $ (show currentTime) ++ " new client: " ++ host |
51 putStrLn $ (show currentTime) ++ " new client: " ++ host |
81 --unless (null recipients) $ putStrLn ("< " ++ (show answer)) |
81 --unless (null recipients) $ putStrLn ("< " ++ (show answer)) |
82 when (head answer == "NICK") $ putStrLn (show answer) |
82 when (head answer == "NICK") $ putStrLn (show answer) |
83 |
83 |
84 clHandles' <- forM recipients $ |
84 clHandles' <- forM recipients $ |
85 \ch -> Control.Exception.handle |
85 \ch -> Control.Exception.handle |
86 (\(e :: Exception) -> if head answer == "BYE" then |
86 (\(e :: IOException) -> if head answer == "BYE" then |
87 return [ch] |
87 return [ch] |
88 else |
88 else |
89 atomically $ writeTChan (chan $ fromJust $ clientByHandle ch clients) ["QUIT", show e] >> return [] -- cannot just remove |
89 atomically $ writeTChan (chan $ fromJust $ clientByHandle ch clients) ["QUIT", show e] >> return [] -- cannot just remove |
90 ) $ |
90 ) $ |
91 do |
91 do |