我有一个简单的聊天服务器程序在Haskell。我希望用户能够连接到聊天服务器，并能够键入“退出（）”离开。我目前正在运行这一切在ghci。代码如下：
(Edit：在带有GHCi的Windows 10上运行，版本9.4.5）

import Network.Socket
import Control.Monad
import Control.Concurrent
import System.IO
import Control.Monad.Fix

connectToChatRoom :: IO ()
connectToChatRoom = do
    addrinfos <- getAddrInfo
                    Nothing
                    (Just "localhost")
                    (Just "9999")
    let serveraddr = head addrinfos
    serverSock <- socket (addrFamily serveraddr) Stream defaultProtocol
    connect serverSock (addrAddress serveraddr)
    hdl <- socketToHandle serverSock ReadWriteMode   -- make a handle
    hSetBuffering hdl NoBuffering
    listenThread <- forkIO (clientListener hdl)  -- open a new thread that listens
    clientSender hdl -- this thread now sends messages
    putStrLn "####### Left Chat #######"
    killThread listenThread        
    close serverSock

clientSender :: Handle -> IO ()
clientSender hdl = fix $ \loop -> do
    msg <- getLine -- read message from user
    when (msg /= "quit()") $ hPutStrLn hdl msg >> loop -- if not "quit()" send msg and continue looping

clientListener :: Handle -> IO ()
clientListener hdl = fix $ \loop -> do
    msg <- hGetLine hdl -- listen for msg from server
    putStrLn msg -- print to stdout
    loop

字符串
在ghci中：

ghci> connectToChatRoom
Here is a message to send
From User 4: Here is a message sent from another term.
Now I want to leave
quit()
####### Left Chat #######

型
一切看起来都很好，但该程序并没有终止，它只是在等待。在发送“quit（）”之后，我希望clientSender离开fix，我可以确认它确实离开了，因为留下的聊天消息已经发布，但是我一直挂着，直到另一个用户发送聊天。killThread listenThread似乎没有终止clientListener函数。为什么会发生这种情况，我该如何解决？
对代码运行方式的任何其他评论也是值得赞赏的。
下面是服务器的代码，如果它很重要：

type Msg = (ID, String)
type ID = Int

chatRoomServer :: IO ()
chatRoomServer = do
    addrinfos <- getAddrInfo
                    (Just (defaultHints {addrFlags = [AI_PASSIVE]}))
                    Nothing
                    (Just "9999")
    let serveraddr = head addrinfos
    sock <- socket (addrFamily serveraddr) Stream defaultProtocol -- make socket
    bind sock (addrAddress serveraddr) -- bind socket to port
    listen sock 1 -- set up socket listener
    chan <- newChan
    _ <- forkIO $ fix $ \loop -> do -- in a tutorial, something about reading the initial channel
      (_, _) <- readChan chan
      loop
    listenForConnections sock chan -- loops waiting to accept connections

listenForConnections :: Socket -> Chan Msg -> IO ()
listenForConnections sock chan = fix loop_ 1
    where loop_ loop idNum = do
            (clientSock, _) <- accept sock
            _ <- forkIO $ manageConnection clientSock idNum chan
            loop (idNum + 1)

manageConnection :: Socket -> ID -> Chan Msg -> IO ()
manageConnection sock idNum chan = do
    let broadcast msg = writeChan chan msg -- send message to all users
    hdl <- socketToHandle sock ReadWriteMode
    hSetBuffering hdl NoBuffering
    commline <- dupChan chan
    _ <- forkIO $ fix $ \loop -> do -- listen for msg to user
        (idNum', msg) <- readChan commline
        when (idNum' /= idNum) $ hPutStrLn hdl ("From User " ++ show idNum' ++ ": " ++ msg)
        loop
    fix $ \loop -> do    -- listen for msg from user
        msg <- hGetLine hdl
        broadcast (idNum, msg)
        loop

型