netserver/newhwserv.hs
changeset 1082 596b1dcdc1df
parent 1081 5be338fa4e2c
child 1302 4290ba4a14ca
--- a/netserver/newhwserv.hs	Tue Jul 15 16:40:50 2008 +0000
+++ b/netserver/newhwserv.hs	Mon Jul 21 09:45:40 2008 +0000
@@ -17,20 +17,23 @@
 	cChan <- atomically newTChan
 	forkIO $ clientLoop cHandle cChan
 	atomically $ writeTChan acceptChan (ClientInfo cChan cHandle "" 0 "" False)
-	hPutStrLn cHandle "CONNECTED"
+	hPutStrLn cHandle "CONNECTED\n"
 	acceptLoop servSock acceptChan
 
-listenLoop :: Handle -> TChan String -> IO ()
-listenLoop handle chan = do
+listenLoop :: Handle -> [String] -> TChan [String] -> IO ()
+listenLoop handle buf chan = do
 	str <- hGetLine handle
-	atomically $ writeTChan chan str
-	listenLoop handle chan
+	if str == "" then do
+		atomically $ writeTChan chan buf
+		listenLoop handle [] chan
+		else
+		listenLoop handle (buf ++ [str]) chan
 
-clientLoop :: Handle -> TChan String -> IO ()
+clientLoop :: Handle -> TChan [String] -> IO ()
 clientLoop handle chan =
-	listenLoop handle chan
+	listenLoop handle [] chan
 		`catch` (const $ clientOff >> return ())
-	where clientOff = atomically $ writeTChan chan "QUIT"
+	where clientOff = atomically $ writeTChan chan ["QUIT"]
 
 mainLoop :: Socket -> TChan ClientInfo -> [ClientInfo] -> [RoomInfo] -> IO ()
 mainLoop servSock acceptChan clients rooms = do
@@ -38,17 +41,24 @@
 	case r of
 		Left ci -> do
 			mainLoop servSock acceptChan (ci:clients) rooms
-		Right (line, clhandle) -> do
-			let (mclients, mrooms, recipients, strs) = handleCmd clhandle clients rooms $ words line
+		Right (cmd, client) -> do
+			print ("> " ++ show cmd)
+			let (clientsFunc, roomsFunc, handlesFunc, answer) = handleCmd client clients rooms $ cmd
+			print ("< " ++ show answer)
 
+			let mclients = clientsFunc clients
+			let mrooms = roomsFunc rooms
+			let recipients = handlesFunc client clients rooms
+			
 			clHandles' <- forM recipients $
 					\ch -> do
-							forM_ strs (\str -> hPutStrLn ch str)
+							forM_ answer (\str -> hPutStrLn ch str)
+							hPutStrLn ch ""
 							hFlush ch
-							if (not $ null strs) && (head strs == "ROOMABANDONED") then hClose ch >> return [ch] else return []
+							if (not $ null answer) && (head answer == "ROOMABANDONED") then hClose ch >> return [ch] else return []
 					`catch` const (hClose ch >> return [ch])
 
-			clHandle' <- if (not $ null strs) && (head strs == "QUIT") then hClose clhandle >> return [clhandle] else return []
+			clHandle' <- if (not $ null answer) && (head answer == "QUIT") then hClose (handle client) >> return [handle client] else return []
 
 			mainLoop servSock acceptChan (remove (remove mclients (concat clHandles')) clHandle') mrooms
 			where