Adds a channel to client to send messages to.

- Adds message type and parsing for incoming messages.

link.cabal

@@ -16,7 +16,8 @@ cabal-version:       >=1.10
 library
   hs-source-dirs:      src
   exposed-modules:     Link.Server,
-                       Link.Types
+                       Link.Types,
+                       Link.Protocol
   default-extensions:  OverloadedStrings, RecordWildCards, ScopedTypeVariables,
                        BangPatterns, TupleSections, NamedFieldPuns
   build-depends:       base >= 4.7 && < 5,

src/Link/Protocol.hs

@@ -0,0 +1,8 @@
+module Link.Protocol where
+
+import Link.Types
+
+parseCommand :: String -> Maybe Message
+parseCommand command = case (words command) of
+  "PRIVMSG" : userName : msg -> Just $ PrivMsg (User userName) (unwords msg)
+  _  -> Nothing

src/Link/Server.hs

@@ -1,7 +1,8 @@
 module Link.Server where
 
 import Control.Exception  (finally)
-import Control.Concurrent (forkFinally, newMVar, modifyMVar, modifyMVar_)
+import Control.Concurrent (forkFinally, newMVar, modifyMVar, modifyMVar_, newChan,
+                           writeChan, withMVar)
 import Control.Monad      (forever)
 import Network            (withSocketsDo, listenOn, accept, PortID(..))
 import System.IO          (hClose, hSetNewlineMode, hSetBuffering, BufferMode(..),
@@ -10,6 +11,7 @@ import Text.Printf        (printf, hPrintf)
 
 import qualified Data.Map.Strict as Map
 
+import Link.Protocol
 import Link.Types
 
 runServer :: Int -> IO ()
@@ -22,10 +24,10 @@ runServer port = withSocketsDo $ do
   forever $ do
      (handle, host, port') <- accept sock
      printf "Accepted connection from %s: %s\n" host (show port')
-     forkFinally (talk server handle) (\_ -> hClose handle)
+     forkFinally (connectClient server handle) (\_ -> hClose handle)
 
-talk :: Server -> Handle -> IO ()
+connectClient :: Server -> Handle -> IO ()
-talk server handle = do
+connectClient server handle = do
   hSetNewlineMode handle universalNewlineMode
   hSetBuffering handle LineBuffering
   readName
@@ -45,20 +47,33 @@ talk server handle = do
           Just client ->
             runClient server client `finally` removeClient server user
 
+sendMessage :: Message -> Client -> IO ()
+sendMessage message Client {..} = writeChan clientChan message
+
 checkAddClient :: Server -> User -> Handle -> IO (Maybe Client)
 checkAddClient Server {..} user@User {..} handle = do
   modifyMVar serverUsers $ \clientMap ->
     if Map.member user clientMap
       then return (clientMap, Nothing)
       else do
-        let client = Client user handle
+        clientChan <- newChan
+        let client = Client user handle clientChan
         printf "New user connected: %s\n" userName
         return (Map.insert user client clientMap, Just client)
 
 runClient :: Server -> Client -> IO ()
-runClient server Client {..} = forever $ do
+runClient Server {..} Client {..} = forever $ do
   command <- hGetLine clientHandle
-  print command
+  printf "<%s>: %s\n" (userName clientUser) command
+  case parseCommand command of
+    Nothing -> return ()
+    Just com -> handleCommand com
+  where
+    handleCommand message@(PrivMsg user _) =
+      withMVar serverUsers $ \clientMap ->
+        case Map.lookup user clientMap of
+          Nothing -> printf "No such user: %s\n" (userName user)
+          Just client -> sendMessage message client
 
 removeClient :: Server -> User -> IO ()
 removeClient Server {..} user =

src/Link/Types.hs

@@ -1,17 +1,21 @@
 module Link.Types where
 
 import System.IO (Handle)
-import Control.Concurrent (MVar)
+import Control.Concurrent (MVar, Chan)
 import qualified Data.Map as Map
 
 data User = User { userName :: !String }
             deriving (Show, Eq, Ord)
 
 data Client = Client {
-                clientUser :: !User
+                clientUser   :: !User
               , clientHandle :: !Handle
-              } deriving (Show, Eq)
+              , clientChan   :: !(Chan Message)
+              }
 
 data Server = Server {
                 serverUsers :: MVar (Map.Map User Client)
               }
+
+data Message = PrivMsg User String
+               deriving (Show, Eq)