--
-- A very simple "talk" server progam
--
-- To compile: ghc -package net -package concurrent \
--                 -o simple-talk simple-talk.hs

module Main where

import Concurrent
import Socket
import IO
import System (getArgs)

newUser :: Handle-> Chan String -> IO ()
newUser socket msgch = 
  forkIO read >> write 
    where read :: IO ()
          read  = hGetLine socket >>= writeChan msgch >> read
	  write :: IO ()
          write = readChan msgch >>= hPutStrLn socket >> write

loop :: Socket -> Chan String -> IO ()
loop s ch = 
  do (handle, wh, p) <- accept s
     putStrLn ("New connection from "++ wh ++ " on " ++ show p)
     ch2    <- dupChan ch
     forkIO (newUser handle ch)
     loop s ch2

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