我如何关闭`runtcpserver'

Question

我正在用conduit-extra（以前称为网络符合）编写使用runTCPServer的套接字服务器。我的目标是使用此服务器与编辑器进行互动---从编辑器激活服务器（很可能仅通过调用外部命令），使用它并在完成工作后终止服务器。

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

所以我尝试了：

{-# 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