diff -r f5b1b3fd70cc -r ff8863ebde17 netserver/newhwserv.hs
--- a/netserver/newhwserv.hs	Sat Oct 18 08:59:43 2008 +0000
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,94 +0,0 @@
-module Main where
-
-import Network
-import IO
-import System.IO
-import Control.Concurrent
-import Control.Concurrent.STM
-import Control.Exception (setUncaughtExceptionHandler, handle, finally)
-import Control.Monad (forM, forM_, filterM, liftM)
-import Maybe (fromMaybe)
-import Data.List
-import Miscutils
-import HWProto
-import Opts
-
-acceptLoop :: Socket -> TChan ClientInfo -> IO ()
-acceptLoop servSock acceptChan = do
-	(cHandle, host, port) <- accept servSock
-	cChan <- atomically newTChan
-	forkIO $ clientLoop cHandle cChan
-	atomically $ writeTChan acceptChan (ClientInfo cChan cHandle "" 0 "" False)
-	hPutStrLn cHandle "CONNECTED\n"
-	hFlush cHandle
-	acceptLoop servSock acceptChan
-
-
-listenLoop :: Handle -> [String] -> TChan [String] -> IO ()
-listenLoop handle buf chan = do
-	str <- hGetLine handle
-	if str == "" then do
-		atomically $ writeTChan chan buf
-		listenLoop handle [] chan
-		else
-		listenLoop handle (buf ++ [str]) chan
-
-
-clientLoop :: Handle -> TChan [String] -> IO ()
-clientLoop handle chan =
-	listenLoop handle [] chan
-		`catch` (const $ clientOff >> return ())
-	where clientOff = atomically $ writeTChan chan ["QUIT"] -- if the client disconnects, we perform as if it sent QUIT message
-
-
-sendAnswers [] _ clients _ = return clients
-sendAnswers ((handlesFunc, answer):answers) client clients rooms = do
-	let recipients = handlesFunc client clients rooms
-	putStrLn ("< " ++ (show answer))
-
-	clHandles' <- forM recipients $
-		\ch -> Control.Exception.handle (\e -> putStrLn (show e) >> hClose ch >> return [ch]) $
-			if (not $ null answer) && (head answer == "off") then hClose ch >> return [ch] else -- probably client with exception, don't send him anything
-			do
-			forM_ answer (\str -> hPutStrLn ch str)
-			hPutStrLn ch ""
-			hFlush ch
-			if (not $ null answer) && (head answer == "BYE") then hClose ch >> return [ch] else return []
-
-	let mclients = remove clients $ concat clHandles'
-
-	sendAnswers answers client mclients rooms
-	where
-		remove list rmClHandles = deleteFirstsBy2t (\ a b -> (Miscutils.handle a) == b) list rmClHandles
-
-
-mainLoop :: Socket -> TChan ClientInfo -> [ClientInfo] -> [RoomInfo] -> IO ()
-mainLoop servSock acceptChan clients rooms = do
-	r <- atomically $ (Left `fmap` readTChan acceptChan) `orElse` (Right `fmap` tselect clients)
-	case r of
-		Left ci -> do
-			mainLoop servSock acceptChan (clients ++ [ci]) rooms
-		Right (cmd, client) -> do
-			putStrLn ("> " ++ show cmd)
-
-			let (clientsFunc, roomsFunc, answers) = handleCmd client clients rooms $ cmd
-			let mrooms = roomsFunc rooms
-			let mclients = (clientsFunc clients)
-			let mclient = fromMaybe client $ find (== client) mclients
-
-			clientsIn <- sendAnswers answers mclient mclients mrooms
-			
-			mainLoop servSock acceptChan clientsIn mrooms
-
-
-startServer serverSocket = do
-	acceptChan <- atomically newTChan
-	forkIO $ acceptLoop serverSocket acceptChan
-	mainLoop serverSocket acceptChan [] []
-
-
-main = withSocketsDo $ do
-	flags <- opts
-	putStrLn $ "Listening on port " ++ show (getPort flags)
-	serverSocket <- listenOn $ PortNumber (getPort flags)
-	startServer serverSocket `finally` sClose serverSocket