如何关闭 `runTCPServer`？

Question

我正在用 runTCPServer from conduit-extra (formerly known as network-conduit) 编写套接字服务器。我的目标是使用此服务器与我的编辑器交互 --- 从编辑器激活服务器（很可能只是通过调用外部命令），使用它，并在工作完成后终止服务器。

为简单起见，我从一个简单的回显服务器开始，假设我想在连接关闭时关闭整个进程。

所以我尝试了：

{-# LANGUAGE OverloadedStrings #-}
module Main where
import Data.Conduit
import Data.Conduit.Network
import Data.ByteString (ByteString)
import Control.Monad.IO.Class (liftIO)
import System.Exit (exitSuccess)
import Control.Exception

defaultPort :: Int
defaultPort = 4567
main :: IO ()
main = runTCPServer (serverSettings defaultPort "*") $ \ appData ->
        appSource appData $$ conduit =$= appSink appData

conduit :: ConduitM ByteString ByteString IO ()
conduit = do
    msg <- await
    case msg of
         Nothing -> liftIO $ do
             putStrLn "Nothing left"
             exitSuccess
             -- I'd like the server to shut down here
         (Just s) -> do
             yield s
             conduit

但这不起作用 -- 程序继续接受新连接。如果我没记错的话，这是因为侦听我们正在处理的连接的线程以 exitSuccess 退出，但整个过程没有。所以这完全可以理解，但我一直没能找到退出整个过程的方法。

如何通过 runTCPServer 终止服务器运行？ runTCPServer 是应该永远服务的东西吗？

Answer 1

下面是评论中描述的想法的简单实现：

main = do
     mv <- newEmptyMVar
     tid <- forkTCPServer (serverSettings defaultPort "*") $ \ appData ->
        appSource appData $$ conduit mv =$= appSink appData
     () <- takeMVar mv -- < -- wait for done signal
     return ()

conduit :: MVar () -> ConduitM ByteString ByteString IO ()
conduit mv = do
    msg <- await
    case msg of
         Nothing -> liftIO $ do
             putStrLn "Nothing left"
             putMVar mv () -- < -- signal that we're done
         (Just s) -> do
             yield s
             conduit mv

如何关闭 `runTCPServer`？

How do I shut down `runTCPServer`?

haskell

network-conduit