Wie kann ich "runTCPServer" herunterfahren?

Question

Ich schreibe einen Socket-Server mit runTCPServer von conduit-extra (früher bekannt als network-conduit). Mein Ziel ist es, mit meinem Editor über diesen Server zu interagieren --- den Server vom Editor aus zu aktivieren (höchstwahrscheinlich nur durch Aufruf eines externen Befehls), ihn zu benutzen und den Server zu beenden, wenn die Arbeit erledigt ist.

Der Einfachheit halber beginne ich mit einem einfachen Echo-Server, und sagen wir, ich möchte den gesamten Prozess herunterfahren, wenn die Verbindung geschlossen wird.

Also habe ich versucht:

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

Aber das funktioniert nicht - das Programm weiterhin neue Verbindungen zu akzeptieren. Wenn ich mich nicht irre, liegt das daran, dass der Thread, der die Verbindung abhört, mit der wir es zu tun haben, mit exitSuccess ausgeht, aber der gesamte Prozess nicht. Das ist völlig verständlich, aber ich war nicht in der Lage, einen Weg zu finden, den gesamten Prozess zu beenden.

Wie kann ich einen Server beenden, der von runTCPServer ausgeführt wird? Ist runTCPServer etwas, das für immer dienen soll?

Answer 1

Hier ist eine einfache Umsetzung der Idee in den Kommentaren beschrieben:

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