泛化合並一組Haskell管道生產者的函數

Question

我正在使用Haskell管道包 。

我正在嘗試使用管道並發將生產者列表合並在一起。

我想得出的是：

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內。 配套套件的提升底座提供了一個版本的fork ，可用於變壓器堆。 我在下面的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

請注意，以這種方式處理時，您應該了解單子狀態會發生什么：對子線程中執行的任何可變狀態的修改將僅與那些子線程隔離。 換句話說，如果您使用StateT ，則每個子線程將以與派生時上下文中相同的狀態值開始，但是隨后您將具有許多彼此不更新的不同狀態。

Yesod書中有一個關於monad-control的附錄 ，盡管坦率地說它有些過時了。 我只是不知道任何最新的教程。

Answer 2

問題似乎是您對evaluate的使用，我認為這是Control.Exception的evaluate 。

您似乎正在使用它將通用monad m的值“轉換”為IO ，但實際上並不能那樣工作。 您只是從Effect獲取m值，然后將其返回到IO而不實際執行它。 以下代碼不顯示“ foo”：

evaluate (putStrLn "foo") >> return ""

也許您的merge功能可以merge函數runEffect ma -> IO a作為附加參數，以便merge知道如何將runEffect的結果帶入IO 。

Answer 3

不幸的是，您不能用MonadIO基本monad（或與此MonadIO任何MonadIO計算）派生Producer 。 在派生計算之前，您需要特別包括運行所有其他monad轉換器以獲取IO操作所需的邏輯。