module Main where

import Concurrent
import Network
import System.Posix
import IO
import System (getArgs)
import Char(isControl,ord)

main :: IO ()
main =
  do port_num <- getArgs >>= return . read . head :: IO Integer
     s <- listenOn (PortNumber (fromInteger port_num))
     ch <- newChan
     loop s ch

loop :: Socket -> Chan String -> IO ()
loop s ch = 
  do (handle, wh, p) <- accept s
     hSetBuffering handle NoBuffering
     installHandler sigPIPE Ignore Nothing
     putStrLn ("New connection from "++ wh++ 
               " on port "++ show p)
     ch2 <- dupChan ch
     forkIO (catch (newUser handle wh ch2)
                   (\_ -> hClose handle))
     loop s ch2

newUser :: Handle-> String-> Chan String -> IO ()
newUser socket wh msgch = 
  do hPutStrLn socket "Hello there. Please send your nickname."
     nick <- do nm <- hGetLine socket 
                return (filter (not . isControl) nm)
     hPutStrLn socket ("Nice to meet you!")
     writeChan msgch (nick ++ "@" ++ wh ++ " has joined.")

     wp <- forkIO write
     catch (read ((nick ++ ": ")++)) $
      \e-> do killThread wp
              if isEOFError e then 
                writeChan msgch (nick++ "@"++ wh++ " has left.")
                else writeChan msgch (nick++ "@"++ wh++ 
                                      " left hastily ("++ 
                                      ioeGetErrorString e++ ")")
              hClose socket where
   read :: (String-> String)-> IO ()
   read f = hGetLine socket >>= writeChan msgch. f >> read f 
   write :: IO ()
   write = readChan msgch >>= hPutStrLn socket >> write