Question

我有一个并发线程管理器的以下实现

newtype Query = Query String

type ThreadWorker = (Query, ThreadStatus)
data ThreadStatus = Running | Finished | Threw IOException

newtype ThreadManager = Manager (MVar (M.Map ThreadId (MVar ThreadWorker)

我想写manageWorkers :: ThreadManager -> IO ()遍历Map并查看ThreadStatus的{{1}}。

如果ThreadWorker已完成，则会从ThreadWorker中删除它。如果抛出异常，那么应该处理它（打印到stdout就可以了，例如目的）并且应该分叉一个新线程来处理查询（假设存在函数ThreadManager）并添加到runQuery :: Query -> IO a，否则线程仍在运行，应该保持不变。

我首次尝试实施的是：

ThreadManager

然后我卡住了，似乎无法在manageWorkers :: ThreadManager -> IO () manageWorkers (Manager mgr) = modifyMVar mgr $ \m -> do m' <- M.traverseWithKey manageWorker m return (m', ()) where manageWorker :: ThreadId -> MVar ThreadWorker -> IO (MVar ThreadWorker) manageWorker tid wkr = tryTakeMVar wkr >>= \mwkr -> case mwkr of Just (_, Finished) -> undefined -- need to delete this finished ThreadWorker Just (q, Threw e ) -> do putStrLn ("[ERROR] " ++ show e) tid' <- forkIO $ runQuery q undefined -- need to add new ThreadWorker Just r -> newMVar r _ -> newEmptyMVar中删除或添加到ThreadManager。我不确定是否可以从类似manageWorker的功能中做我想做的事情。

是否可以使用我的traverse实现此manageWorkers函数，或者是否有更好的抽象？

编辑：在ThomasM.DuBuisson建议使用折叠，我现在有以下

ThreadManager

唯一的问题是显然manageWorkers (Manager mgr) = modifyMVar mgr $ \m -> return (M.foldrWithKey manageWorker M.empty m, ()) where manageWorker :: ThreadId -> MVar ThreadWorker -> M.Map ThreadId (MVar ThreadWorker) -> IO (M.Map ThreadId (MVar ThreadWorker)) manageWorker tid wkr ts = tryTakeMVar wkr >>= \mwkr -> case mwkr of Just (q, Threw e) -> do putStrLn ("[ERROR] " ++ show e) wkr' <- newEmptyMVar tid' <- forkIO $ runQuery q return $ M.insert tid' wkr' ts Just (_, Running) -> return $ M.insert tid wkr _ -> return ts的签名不适用于manageWorker。我需要一个M.foldrWithKey但是这样的东西不存在，我自己编写它时遇到了麻烦。

显然我可以使用M.foldrWithKeyM :: Monad m => (k -> a -> b -> m b) -> b -> M.Map k a -> m b来逃避IO monad并满足编译器，但我只会将其作为最后的手段。这是使用unsafePerformIO吗？

的情况

Answer 1

在我看来，你的问题与并发性无关您只想遍历地图，同时从地图中删除一些键或在地图中插入一些键并执行一些IO操作。
问题是traverseWithKey无法从地图中删除密钥或在地图中插入密钥，foldrWithKey无法执行IO操作。
您需要M.foldrWithKeyM :: Monad m => (k -> a -> b -> m b) -> b -> M.Map k a -> m b
的确，这样的事情并不存在。但是如果你看一下foldrWithKey的文档，其中说明了：

foldrWithKey f z == foldr (uncurry f) z . toAscList.

如果我们按M.foldrWithKeyM重新列出foldr，我们可以猜出这样foldM。
以下是我的解决方案。

manageWorkers :: ThreadManager -> IO ()
manageWorkers (Manager mgr) = 
    modifyMVar mgr $ \m -> do
        m' <- foldM manageWorker m (M.toList m)
        return (m', ())
  where manageWorker :: M.Map ThreadId (MVar ThreadWorker) -> (ThreadId, MVar ThreadWorker) -> IO (M.Map ThreadId (MVar ThreadWorker))
        manageWorker ts (tid, wkr) = tryTakeMVar wkr >>= \mwkr ->
            case mwkr of
                 Just (_, Finished) -> return $ M.delete tid ts -- need to delete this finished ThreadWorker
                 Just (q, Threw e ) -> do
                       putStrLn ("[ERROR] " ++ show e)
                       wkr' <- newEmptyMVar
                       tid' <- forkIO $ runQuery q
                       return $ M.insert tid' wkr' ts -- need to add new ThreadWorker
                 _ -> return ts

并发线程管理器

1 个答案: