module Main where

import Network

import IO

import System.IO

import Control.Concurrent

import Control.Concurrent.STM

import Control.Exception (finally)

import Control.Monad (forM, filterM, liftM)

import Miscutils

acceptLoop servSock acceptChan = do

	(cHandle, host, port) <- accept servSock

	cChan <- atomically newTChan

	forkIO $ clientLoop cHandle cChan

	acceptLoop servSock acceptChan

listenLoop :: Handle -> TChan String -> IO ()

listenLoop handle chan = do

	str <- hGetLine handle

	atomically $ writeTChan chan str

	listenLoop handle chan

clientLoop :: Handle -> TChan String -> IO ()

clientLoop handle chan =

	listenLoop handle chan

		`catch` (const $ clientOff >> return ())

		`finally` hClose handle

	where clientOff = atomically $ writeTChan chan "QUIT"

	r <- atomically $ (Left `fmap` readTChan acceptChan) `orElse` (Right `fmap` tselect clients)

	case r of

			clients' <- forM clients $

startServer serverSocket = do

	acceptChan <- atomically newTChan

	forkIO $ acceptLoop serverSocket acceptChan

main = withSocketsDo $ do

	serverSocket <- listenOn $ Service "hedgewars"

	startServer serverSocket `finally` sClose serverSocket