0

我正在编写一个带有runTCPServer来自conduit-extra（以前称为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应该永远服务的东西吗？

4

1 回答 1

2

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

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
于 2016-06-19T20:44:35.867 回答