{-# LANGUAGE CPP, PatternSignatures #-}

module ClientIO where

#if defined(NEW_EXCEPTIONS)

import qualified Control.OldException as Exception

#else

import qualified Control.Exception as Exception

#endif

import Control.Concurrent.Chan

import Control.Monad

import System.IO

----------------

import CoreTypes

listenLoop :: Handle -> Int -> [String] -> Chan CoreMessage -> Int -> IO ()

listenLoop handle linesNumber buf chan clientID = do

	str <- hGetLine handle

	if (linesNumber > 50) || (length str > 450) then

		writeChan chan $ ClientMessage (clientID, ["QUIT", "Protocol violation"])

		else

		if str == "" then do

			writeChan chan $ ClientMessage (clientID, buf)

			listenLoop handle 0 [] chan clientID

			else

			listenLoop handle (linesNumber + 1) (buf ++ [str]) chan clientID

clientRecvLoop :: Handle -> Chan CoreMessage -> Int -> IO ()

clientRecvLoop handle chan clientID =

	listenLoop handle 0 [] chan clientID

		`catch` (\e -> (clientOff $ show e) >> return ())

	where clientOff msg = writeChan chan $ ClientMessage (clientID, ["QUIT", msg]) -- if the client disconnects, we perform as if it sent QUIT message

clientSendLoop :: Handle -> Chan CoreMessage -> Chan [String] -> Int -> IO()

clientSendLoop handle coreChan chan clientID = do

	answer <- readChan chan

	doClose <- Exception.handle

		(\(e :: Exception.Exception) -> if isQuit answer then return True else sendQuit e >> return False) $ do

		forM_ answer (\str -> hPutStrLn handle str)

		hPutStrLn handle ""

		hFlush handle

		return $ isQuit answer

	if doClose then

		Exception.handle (\(_ :: Exception.Exception) -> putStrLn "error on hClose") $ hClose handle

		else

		clientSendLoop handle coreChan chan clientID

	where

		sendQuit e = writeChan coreChan $ ClientMessage (clientID, ["QUIT", show e])

		isQuit ("BYE":xs) = True

		isQuit _ = False