From fbac64d78a263aeb74f87cbaa8a6fe1591ba55c3 Mon Sep 17 00:00:00 2001
From: Abhinav Sarkar <abhinav@abhinavsarkar.net>
Date: Thu, 10 Sep 2015 00:43:53 +0530
Subject: [PATCH] Adds more message types.

---
 src/Link/Protocol.hs |  7 +++++++
 src/Link/Server.hs   | 12 +++++++-----
 src/Link/Types.hs    |  8 ++++++--
 3 files changed, 20 insertions(+), 7 deletions(-)

diff --git a/src/Link/Protocol.hs b/src/Link/Protocol.hs
index b5166ef..3620963 100644
--- a/src/Link/Protocol.hs
+++ b/src/Link/Protocol.hs
@@ -1,8 +1,15 @@
 module Link.Protocol where
 
+import Text.Printf (printf)
+
 import Link.Types
 
 parseCommand :: String -> Maybe Message
 parseCommand command = case words command of
   "PRIVMSG" : userName : msg -> Just $ PrivMsg (User userName) (unwords msg)
   _  -> Nothing
+
+formatMessage :: Message -> String
+formatMessage (PrivMsg user msg) = printf "PRIVMSG %s %s" (userName user) msg
+formatMessage (NameInUse name)   = printf "NAMEINUSE %s" name
+formatMessage (Connected name)   = printf "CONNECTED %s" name
diff --git a/src/Link/Server.hs b/src/Link/Server.hs
index e2e06f4..b5e14dc 100644
--- a/src/Link/Server.hs
+++ b/src/Link/Server.hs
@@ -26,6 +26,9 @@ runServer port = withSocketsDo $ do
      printf "Accepted connection from %s: %s\n" host (show port')
      forkFinally (connectClient server handle) (\_ -> hClose handle)
 
+printToHandle :: Handle -> String -> IO ()
+printToHandle handle str = hPrintf handle "%s\n" str
+
 connectClient :: Server -> Handle -> IO ()
 connectClient server handle = do
   hSetNewlineMode handle universalNewlineMode
@@ -41,10 +44,10 @@ connectClient server handle = do
         ok <- checkAddClient server user handle
         case ok of
           Nothing -> do
-            hPrintf handle
-              "The name %s is in use, please choose another\n" name
+            printToHandle handle $ formatMessage (NameInUse name)
             readName
-          Just client ->
+          Just client -> do
+            printToHandle handle $ formatMessage (Connected name)
             runClient server client `finally` removeClient server user
 
 checkAddClient :: Server -> User -> Handle -> IO (Maybe Client)
@@ -97,8 +100,7 @@ runClient Server {..} Client {..} = forever $ do
           Nothing -> printf "No such user: %s\n" (userName user)
           Just client -> sendMessage (PrivMsg clientUser msg) client
 
-    handleMessage (PrivMsg user msg) =
-      hPrintf clientHandle "PRIVMSG %s %s\n" (userName user) msg
+    handleMessage = printToHandle clientHandle . formatMessage
 
 removeClient :: Server -> User -> IO ()
 removeClient Server {..} user =
diff --git a/src/Link/Types.hs b/src/Link/Types.hs
index d77fe68..67c641b 100644
--- a/src/Link/Types.hs
+++ b/src/Link/Types.hs
@@ -4,7 +4,9 @@ import System.IO (Handle)
 import Control.Concurrent (MVar, Chan)
 import qualified Data.Map as Map
 
-data User = User { userName :: !String }
+type UserName = String
+
+data User = User { userName :: !UserName }
             deriving (Show, Eq, Ord)
 
 data Client = Client {
@@ -17,5 +19,7 @@ data Server = Server {
                 serverUsers :: MVar (Map.Map User Client)
               }
 
-data Message = PrivMsg User String
+data Message = NameInUse UserName
+             | Connected UserName
+             | PrivMsg User String
                deriving (Show, Eq)