Adds strictness.
This commit is contained in:
parent
887b385879
commit
973b0cc926
@ -5,15 +5,16 @@ import Control.Concurrent (forkFinally, newMVar, modifyMVar, modifyMVar_)
|
||||
import Control.Monad (forever)
|
||||
import Network (withSocketsDo, listenOn, accept, PortID(..))
|
||||
import System.IO (hClose, hSetNewlineMode, hSetBuffering, BufferMode(..),
|
||||
universalNewlineMode, hGetLine, Handle)
|
||||
universalNewlineMode, hGetLine, Handle, stdout)
|
||||
import Text.Printf (printf, hPrintf)
|
||||
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.Map.Strict as Map
|
||||
|
||||
import Link.Types
|
||||
|
||||
runServer :: Int -> IO ()
|
||||
runServer port = withSocketsDo $ do
|
||||
hSetBuffering stdout LineBuffering
|
||||
serverUsers <- newMVar Map.empty
|
||||
let server = Server serverUsers
|
||||
sock <- listenOn . PortNumber . fromIntegral $ port
|
||||
@ -38,12 +39,11 @@ talk 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
|
||||
readName
|
||||
hPrintf handle
|
||||
"The name %s is in use, please choose another\n" name
|
||||
readName
|
||||
Just client ->
|
||||
runClient server client
|
||||
`finally` removeClient server user
|
||||
runClient server client `finally` removeClient server user
|
||||
|
||||
checkAddClient :: Server -> User -> Handle -> IO (Maybe Client)
|
||||
checkAddClient Server {..} user@User {..} handle = do
|
||||
@ -52,7 +52,7 @@ checkAddClient Server {..} user@User {..} handle = do
|
||||
then return (clientMap, Nothing)
|
||||
else do
|
||||
let client = Client user handle
|
||||
printf "New user connected: %s" userName
|
||||
printf "New user connected: %s\n" userName
|
||||
return (Map.insert user client clientMap, Just client)
|
||||
|
||||
runClient :: Server -> Client -> IO ()
|
||||
|
@ -4,12 +4,12 @@ import System.IO (Handle)
|
||||
import Control.Concurrent (MVar)
|
||||
import qualified Data.Map as Map
|
||||
|
||||
data User = User { userName :: String }
|
||||
data User = User { userName :: !String }
|
||||
deriving (Show, Eq, Ord)
|
||||
|
||||
data Client = Client {
|
||||
clientUser :: User
|
||||
, clientHandle :: Handle
|
||||
clientUser :: !User
|
||||
, clientHandle :: !Handle
|
||||
} deriving (Show, Eq)
|
||||
|
||||
data Server = Server {
|
||||
|
Loading…
Reference in New Issue
Block a user