Question

async package的文档将withAsync函数描述为：

在单独的线程中生成异步操作，并传递其异步处理提供的功能。当函数返回或抛出时异常，在Async上调用uninterruptibleCancel。这是一个 async的有用变体，可确保Async永远不会运行无意的。

过去2个小时我一直在盯着它，并且无法弄清楚如何启动监视器线程，这会产生多个工作线程，这样：

如果监视器线程死亡，则应该杀死所有工作线程
但是，如果任何工作线程死亡，其他工作线程都不会受到影响。应通知监视器并且应该能够重新启动工作线程

Answer 1

似乎我们需要两个函数：一个启动所有异步任务，另一个监视它们，并在它们死亡时重新启动它们。

第一个可以这样写：

withAsyncMany :: [IO t] -> ([Async t] -> IO b) -> IO b
withAsyncMany []     f = f []
withAsyncMany (t:ts) f = withAsync t $ \a -> withAsyncMany ts (f . (a:))

如果我们使用managed包，我们也可以这样写：

import Control.Monad.Managed (with,managed)

withAsyncMany' :: [IO t] -> ([Async t] -> IO b) -> IO b
withAsyncMany' = with . traverse (\t -> managed (withAsync t))

重启函数将循环asyncs列表，轮询其状态并在失败时更新它们：

{-# language NumDecimals #-}
import Control.Concurrent (threadDelay)

resurrect :: IO t -> [Async t] -> IO ()
resurrect restartAction = go []
    where
    go ts [] = do
        threadDelay 1e6    -- wait a little before the next round of polling
        go [] (reverse ts)
    go past (a:pending) = do
        status <- poll a   -- has the task died, or finished?
        case status of
            Nothing -> go (a:past) pending
            Just _  -> withAsync restartAction $ \a' -> go (a':past) pending

我担心许多嵌套withAsyncs会导致某种类型的资源泄漏的可能性（因为必须在每个withAsync安装某种异常处理程序，以便在父级的情况下通知子级线程死了）。

因此，在这种情况下，最好使用普通async生成工作者，将Async的集合存储到某种可变引用中，并在监视器线程中安装单个异常处理程序，它将遍历容器，终止每项任务。

Answer 2

这是另一个答案，它使用async代替withAsync。主要功能是

monitor :: Int -> IO () -> IO ()
monitor count task =
    bracket (do asyncs <- replicateM count (async task)
                newIORef asyncs)
            (\ref -> forever (do
                threadDelay 1e6
                asyncs <- readIORef ref
                vivify task (writeIORef ref) asyncs))
            (\ref -> do
                asyncs <- readIORef ref
                mapM_ uninterruptibleCancel asyncs)

它使用辅助vivify函数遍历Async列表，恢复死亡列表并将更新后的列表写回IORef：

vivify :: IO () -> ([Async ()] -> IO ()) -> [Async ()] -> IO ()
vivify task write asyncs = go [] asyncs
    where
    go _    [] = do
        return ()
    go past (a:pending) = do
        status <- poll a
        case status of
            Nothing -> do
                go (a:past) pending
            Just _  -> do
                past' <- mask_ $ do
                    a' <- async task
                    write (reverse (a':past) ++ pending)
                    return (a':past)
                go past' pending

我们在Async中创建新IOref和“持久”它之间的间隔中屏蔽异步异常，因为否则如果异步异常到达并杀死了监视器线程，那么{{1会保持悬空。

如何将父异步与多个子异步链接相关联

2 个答案: