3

並行スレッドマネージャーの次の実装があります

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見るものを書きたいと思います。ThreadStatusThreadWorker

が終了するThreadWorkerと、から削除されThreadManagerます。例外がスローされた場合は、それを処理する必要があり（たとえば、stdoutへの出力は問題ありません）、クエリを処理するために新しいスレッドをフォークして（関数の存在を想定） 、それ以外の場合はスレッド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私を使用してこの関数を実装することは可能ですか、ThreadManagerそれともより良い抽象化がありますか？

編集：ThomasM.DuBuissonのフォールドの使用の提案で、私は今、次のようになっています

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ですが、そんなものは存在せず、自分で作曲するのに苦労しています。

明らかにunsafePerformIO、IOモナドをエスケープしてコンパイラーを満足させるために使用できますが、それは最後の手段としてのみ使用します。これは使用するのが理にかなっている状況unsafePerformIOですか？

4

1 に答える 1

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構成が可能であると推測できます。 以下は私の解決策です。 foldrfoldM

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
于 2013-01-29T14:11:05.183 に答える