Question

我正在编写一个受Simon Marlow's book启发的简单（聊天）服务器。我正在编写一些单元测试，在每种情况下，我都会启动服务器，等待它，并将其杀死。

我想要的是以这样的方式定义主服务器线程：如果它死了，它产生的所有线程都会被终止。

目前服务器看起来如下：

serve :: IO ()
serve = withSocketsDo $ do
  bracket acquireSocket releaseSocket doServe
  where
    acquireSocket = do
      putStrLn "Starting chat server"
      listenOn Config.port

    releaseSocket socket = do
      sClose socket
      putStrLn "Stopping chat server"

    doServe socket = forever $ do
        (h, host, port) <- accept socket
        a <- async $ talk h `finally` hClose h
        -- How do we cancel all the asynchronous processes if an exception is
        -- raised?
        return ()

如果我使用定义为：

的简单talk函数运行测试

talk :: Handle -> IO ()
talk h = do
  putStrLn $ (show h) ++ " bla bla bla ..."
  defaultDelay
  talk h

我可以看到，正如预期的那样，talk线程继续＆＃34;说话＆＃34;他们的父母去世后。

在Marlow的书中，展示了如何使用withAsync创建线程层次结构，这样如果父级死亡，其所有子级都将被终止。使用此函数，可以按如下方式重写doServe函数：

doServe socket = do
  (h, host, port) <- accept socket
  withAsync (talk h `finally` hClose h) (\_ -> doServe socket)

请注意，我已通过递归调用forever替换了doServe。

此解决方案具有预期的行为，我喜欢它的简单性，但是，我担心它的内存消耗。

我已经勾画了其他解决方案，但我无法想出一些相当简单和高效的方法。如果我不得不维护大型数据结构，我宁愿坚持withAsync解决方案。

有什么想法吗？

简单服务器，在终止时取消所有分叉线程

0 个答案: