module Server.Users where

import Control.Concurrent (forkIO,
                           readChan,
                           writeChan,
                           readChan,
                           dupChan)
import Control.Exception  (handle,
                           SomeException(..))
import Network.Socket     (Socket,
                           socketToHandle,
                           SockAddr)
import System.IO          (hGetLine,
                           hClose,
                           hPutStrLn,
                           hSetBuffering,
                           Handle,
                           IOMode(..),
                           BufferMode(..))
import Server.Util        (getHost,
                           SChan)

userInit :: (Socket, SockAddr) -> SChan -> SChan -> IO ()
userInit (sock, addr) sRead sWrite = do
  hdl <- socketToHandle sock ReadWriteMode
  hSetBuffering hdl NoBuffering
  hPutStrLn hdl "Hi, what's your name?"
  name <- hGetLine hdl
  host <- getHost addr
  writeChan sRead ("new",name,host)
  putStrLn $ show (name,host)
  _sWrite  <- dupChan sWrite
  forkIO $ userWriteLoop hdl _sWrite name
  handle (\(SomeException _) -> return ()) $ userReadLoop  hdl sRead name
  writeChan sRead ("exit", name , "")

userWriteLoop :: Handle -> SChan -> String -> IO ()
userWriteLoop hdl chan name = do
  (comand, a1, a2) <- readChan chan
  case comand of
    "connect" -> if a1 == name
                 then (hPutStrLn hdl $ "c:"++a2) >> hClose hdl
                 else userWriteLoop hdl chan name
    "serve"   -> if a1 == name
                 then (hPutStrLn hdl $ "s:"++a2) >> hClose hdl
                 else userWriteLoop hdl chan name
    "close"   -> if a1 == name
                 then return ()
                 else userWriteLoop hdl chan name
    "msg"     -> hPutStrLn hdl a1
                 >> userWriteLoop hdl chan name
    other     -> hPutStrLn hdl other
                 >> userWriteLoop hdl chan name

userReadLoop :: Handle -> SChan -> String -> IO ()
userReadLoop hdl chan name = do
  line <- hGetLine hdl
  case line of
    'c':':':addr -> writeChan chan ("connect",name,addr)
    "exit"   -> return ()
    other    -> (putStrLn $ name ++ "> " ++ other)
                >> userReadLoop hdl chan name
