与其他模块的套接字通信答案

【问题标题】：Communicate with socket from other module与其他模块的套接字通信
【发布时间】：2016-05-16 07:17:43
【问题描述】：

我想运行一个 websocket 服务器并从另一个模块向它发送消息。

到目前为止，我只设法将一个通道传递给启动服务器的模块。但我想拥有像 writeFile 这样的全局变量，可以随时从任何模块调用。

我还想拥有多个sendMessage 的客户。一旦连接关闭，我假设线程仍停留在forever 循环中。

Server.hs

import Network.WebSockets
import Control.Concurrent
import Control.Monad
import Data.ByteString

createServer :: IO (Chan ByteString)
createServer = do
    chan <- newChan
    forkIO $ runServer "127.0.0.1" 8080 (serverApp chan)
    ready <- readChan chan -- wait for client
    return chan

serverApp :: Chan ByteString -> PendingConnection -> IO ()
serverApp chan pending =
    do
        print "Client connected"
        connection <- acceptRequest pending
        writeChan chan "ready"
        forever $ do
            msg <- readChan chan
            sendTextData connection msg

sendMessage :: Chan ByteString -> ByteString -> IO ()
sendMessage = writeChan

Main.hs

main :: IO ()
main = do
    client <- createServer
    sendMessage client ("hello" :: ByteString)

【问题讨论】：

明确传递client 有什么问题？您在 Main 中有对它的引用，因此从 Main 调用的任何模块都可以传递对此的引用。
此代码应该与 ghci 结合使用。所以每次我重新加载环境时，我都必须再次创建服务器，这有点烦人。有没有办法只调用sendMessage 并让它创建服务器（如果还没有的话）？

标签： sockets haskell websocket server

【解决方案1】：

我最终使用了MVar 和unsafePerformIO。虽然不完全推荐，但代码简洁明了。

createServer :: IO ()
createServer = do
    _ <- forkIO $ runServer "127.0.0.1" 8080 serverApp
    return ()

serverApp :: PendingConnection -> IO ()
serverApp pending =
    do
        connection <- acceptRequest pending
        forever $ do
            msg <- takeMVar channel
            sendTextData connection msg

channel :: MVar ByteString
{-# NOINLINE channel #-}
channel = unsafePerformIO newEmptyMVar

sendMessage :: ByteString -> IO ()
sendMessage = putMVar channel

代码仍然缺少异常处理，它仅适用于 1 个连接的客户端。

【讨论】：