module Server.Client (clientProcessing) where import Control.Applicative ((<$>)) import Control.Concurrent import Control.Exception import Control.Monad (forever) import Data.Time.Clock (getCurrentTime) import System.IO import qualified Data.Traversable as DT import Hach.Types import Server.History import Server.Message import Server.Storage readC :: Chan (Int, S2C) -> Handle -> IO () readC ch h = hPrint h =<< snd <$> readChan ch clientProcessing :: History -> NickStorage -> Chan (Int, S2C) -> Handle -> Int -> IO () clientProcessing history storage ch h cId = do ch' <- dupChan ch forkIO $ handle_ $ forever $ readC ch' h forever $ do message <- hGetLine h maybeNick <- getNick storage cId t <- getCurrentTime case maybeNick of Just nick -> do go nick $ read message putStrLn message where go :: Nick -> C2S -> IO () go n (C2S a CPlain) = do writeChan ch' (cId, m) putMessage history m where m = S2C a (SPlain n) t go n (C2S a CAction) = do writeChan ch' (cId, m) putMessage history m where m = S2C a (SAction n) t go n (C2S a CSetNick) = do nickExists <- doesNickExist storage a if nickExists then hPrint h $ existedNickM a t else do writeChan ch' (cId, m) putMessage history m putNick storage cId a where m = settedNickM n a t Nothing -> do go $ read message putStrLn message where go :: C2S -> IO () go (C2S n CSetNick) = do nickExists <- doesNickExist storage n if nickExists then do hPrint h $ existedNickM n t hPrint h $ undefinedNickM t else do DT.mapM (hPrint h) . lastNMinutes 10 t =<< getMessages history writeChan ch' (cId, m) putMessage history m putNick storage cId n where m = connectedClientM n t go (C2S _ _) = hPrint h $ undefinedNickM t where handle_ = handle $ \(SomeException e) -> print e