Question

我正在尝试使用pipes-concurrency将生产者列表合并在一起。

我想要的是：

merge :: MonadIO m => [Producer a m ()] -> Producer a m ()

所以给定一个生产者s1和另一个生产者s2：r = merge [s1，s2] 这会产生这种行为：

s1 --1--1--1--|
s2 ---2---2---2|
r  --12-1-21--2|

按照教程页面中的代码，我提出了：

mergeIO :: [Producer a IO ()] -> Producer a IO ()
mergeIO producers = do
    (output, input) <- liftIO $ spawn Unbounded
    _ <- liftIO $ mapM (fork output) producers
    fromInput input
  where
    fork :: Output a -> Producer a IO () -> IO ()
    fork output producer = void $ forkIO $ do runEffect $ producer >-> toOutput output
                                              performGC

按预期工作。

但是我很难概括。

我的尝试：

merge :: (MonadIO m) => [Producer a m ()] -> Producer a m ()
merge producers = do
    (output, input) <- liftIO $ spawn Unbounded
    _ <- liftIO $ mapM (fork output) producers
    fromInput input
  where
    runEffectIO :: Monad m => Effect m r -> IO (m r)
    runEffectIO e = do
        x <- evaluate $ runEffect e
        return x
    fork output producer = forkIO $ do runEffectIO $ producer >-> toOutput output
                                       performGC

不幸的是，这会编译，但不会做太多其他事情。我猜我正在弄乱runEffectIO。我当前runEffectIO的其他方法没有取得更好的结果。

该计划：

main = do
    let producer = merge [repeater 1 (100 * 1000), repeater 2 (150 * 1000)]
    _ <- runEffect $ producer >-> taker 20
  where repeater :: Int -> Int -> Producer Int IO r
        repeater val delay = forever $ do
            lift $ threadDelay delay
            yield val
        taker :: Int -> Consumer Int IO ()
        taker 0 = return ()
        taker n = do
            val <- await
            liftIO $ putStrLn $ "Taker " ++ show n ++ ": " ++ show val
            taker $ n - 1

点击val <- await但未到达liftIO $ putStrLn因此它不会产生任何输出。然而它没有悬挂就退出了。

当我在mergeIO中替换merge时，程序会运行，我希望输出20行。

Answer 1

虽然MonadIO不足以进行此操作，但MonadBaseControl（来自monad-control）旨在允许在基本monad中嵌入任意变换器堆栈。配套包lifted-base提供fork版本，适用于变换器堆栈。我已经汇总了一个使用它来解决问题in the following Gist的例子，尽管主要的魔力是：

import qualified Control.Concurrent.Lifted as L
fork :: (MonadBaseControl IO m, MonadIO m) => Output a -> Producer a m () -> m ThreadId
fork output producer = L.fork $ do
    runEffect $ producer >-> toOutput output
    liftIO performGC

请注意，您应该了解以这种方式处理时monadic状态会发生什么：对子线程中执行的任何可变状态的修改将仅隔离到那些子线程。换句话说，如果您使用StateT，则每个子线程将以分叉时的上下文中的相同状态值开始，但是您将有许多不相互更新的不同状态。

对monad-control有一个appendix in the Yesod book，但坦率地说它有点过时了。我只是不知道最近的教程。

Answer 2

问题似乎是您对evaluate的使用，我认为它是来自evaluate的{{1}}。

您似乎正在使用它来转换＆＃34;通用monad Control.Exception中的值m，但它并没有真正起作用。您只是从IO中获取m值，然后在Effect内返回它而不实际执行它。以下代码不打印＆＃34; foo＆＃34;：

IO

也许您的evaluate (putStrLn "foo") >> return ""函数可以将函数merge作为附加参数，以便m a -> IO a知道如何将merge的结果导入runEffect。

Answer 3

很遗憾，您不能使用Producer基础monad（或任何MonadIO计算）来MonadIO分叉。在分叉计算之前，您需要专门包含运行所有其他monad变换器以获取IO操作所需的逻辑。

推广函数以合并一组Haskell管道生产者

3 个答案: