Adds more message types.

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

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 =

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)