--
-- A slightly more sophisticated "talk" server progam -- cxl, 17.05.01
--
-- To compile: ghc -package net -package concurrent  -o talk talk.hs
--
-- Usage: talk <portnumber>.
--        Use telnet to connect.

module Main where

import Concurrent
import Socket
import IO
import System (getArgs)
import Char(isControl,ord) 

newUser :: Handle-> String-> Chan String -> IO ()
newUser socket wh msgch = 
  do hPutStrLn socket "Hello there. Please send your nickname."
     nick <- hGetLine socket >>= return . filter (not . isControl)
     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 

loop :: Socket -> Maybe (Chan String) -> IO ()
loop s ch = 
  do (handle, wh, p) <- accept s
     putStrLn ("New connection from "++ wh ++ " on port " ++ show p)
     ch2    <- case ch of Just c  -> dupChan c
                          Nothing -> newChan
     forkIO (catch (newUser handle wh ch2) (\_ -> hClose handle))
     loop s (Just ch2)

main :: IO ()
main =
  do port_num <- getArgs >>= return . mkPortNumber . read . head
     s <- listenOn (PortNumber port_num)
     loop s Nothing