具有下游狀態且沒有損失的慣用雙向管道

Question

假設我有簡單的生產者/消費者模型，消費者希望將一些狀態傳遞給生產者。 例如，讓下游流動的對象成為我們想要寫入文件的對象，上游對象是表示在文件中寫入對象的位置的一些標記（例如，偏移）。

這兩個進程可能看起來像這樣（使用pipes-4.0 ），

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

import Pipes
import Pipes.Core
import Control.Monad.Trans.State       
import Control.Monad

newtype Object = Obj Int
               deriving (Show)

newtype ObjectId = ObjId Int
                 deriving (Show, Num)

writeObjects :: Proxy ObjectId Object () X IO r
writeObjects = evalStateT (forever go) (ObjId 0)
  where go = do i <- get
                obj <- lift $ request i
                lift $ lift $ putStrLn $ "Wrote "++show obj
                modify (+1)

produceObjects :: [Object] -> Proxy X () ObjectId Object IO ()
produceObjects = go
  where go [] = return ()
        go (obj:rest) = do
            lift $ putStrLn $ "Producing "++show obj
            objId <- respond obj
            lift $ putStrLn $ "Object "++show obj++" has ID "++show objId
            go rest

objects = [ Obj i | i <- [0..10] ]

雖然這可能很簡單，但我在如何撰寫它們時遇到了相當大的困難。 理想情況下，我們需要基於推送的控制流程，如下所示，

1. writeObjects通過阻塞request開始，已經向上游發送了初始的ObjId 0 。
2. produceObjects向下游發送第一個對象Obj 0
3. writeObjects寫入對象並遞增其狀態，並在request時等待，這次向上游發送ObjId 1
4. respond在produceObjects回報與ObjId 0
5. produceObjects在步驟（2）繼續第二個對象Obj 1

我最初的嘗試是基於推送的組合，如下所示，

main = void $ run $ produceObjects objects >>~ const writeObjects

注意使用const來解決其他不兼容的類型（這可能是問題所在）。 然而，在這種情況下，我們發現ObjId 0被吃掉了，

Producing Obj 0
Wrote Obj 0
Object Obj 0 has ID ObjId 1
Producing Obj 1
...

基於拉的方法，

main = void $ run $ const (produceObjects objects) +>> writeObjects

遇到類似的問題，這次丟棄了Obj 0 。

怎么可能以理想的方式組成這些作品呢？

Answer 1

選擇使用哪種成分取決於哪個成分應該啟動整個過程。 如果您希望下游管道啟動該過程，那么您希望使用基於拉的合成（即(>+>) / (+>>) ），但如果您希望上游管道啟動該過程，那么您應該使用push-基於組合（即(>>~) / (>~>) ）。 您獲得的類型錯誤實際上警告您代碼中存在邏輯錯誤：您尚未明確確定哪個組件首先啟動該進程。

從您的描述中，很明顯您希望控制流從produceObjects開始，因此您希望使用基於推送的合成。 使用基於推送的合成后，合成運算符的類型將告訴您需要了解的有關如何修復代碼的所有信息。 我將采用它的類型並將其專門化為你的構圖鏈：

-- Here I'm using the `Server` and `Client` type synonyms to simplify the types
(>>~) :: Server ObjectId Object IO ()
      -> (Object -> Client ObjectId Object IO ())
      -> Effect IO ()

正如您已經注意到的，當您嘗試使用(>>~)時遇到的類型錯誤告訴您缺少類型為Object的參數到writeObjects函數。 這靜態地強制您在接收第一個Object （通過初始參數）之前不能在writeObjects運行任何代碼。

解決方案是重寫writeObjects函數，如下所示：

writeObjects :: Object -> Proxy ObjectId Object () X IO r
writeObjects obj0 = evalStateT (go obj0) (ObjId 0)
  where go obj = do i <- get
                    lift $ lift $ putStrLn $ "Wrote "++ show obj
                    modify (+1)
                    obj' <- lift $ request i
                    go obj'

然后，這給出了正確的行為：

>>> run $ produceObjects objects >>~ writeObjects
Producing Obj 0
Wrote Obj 0
Object Obj 0 has ID ObjId 0
Producing Obj 1
Wrote Obj 1
Object Obj 1 has ID ObjId 1
Producing Obj 2
Wrote Obj 2
Object Obj 2 has ID ObjId 2
Producing Obj 3
Wrote Obj 3
Object Obj 3 has ID ObjId 3
Producing Obj 4
Wrote Obj 4
Object Obj 4 has ID ObjId 4
Producing Obj 5
Wrote Obj 5
Object Obj 5 has ID ObjId 5
Producing Obj 6
Wrote Obj 6
Object Obj 6 has ID ObjId 6
Producing Obj 7
Wrote Obj 7
Object Obj 7 has ID ObjId 7
Producing Obj 8
Wrote Obj 8
Object Obj 8 has ID ObjId 8
Producing Obj 9
Wrote Obj 9
Object Obj 9 has ID ObjId 9
Producing Obj 10
Wrote Obj 10
Object Obj 10 has ID ObjId 10

您可能想知道為什么這兩個管道中的一個管道采用初始參數的要求是有道理的，除了抽象的理由，這是類別法律所要求的。 簡單的英語解釋是，在writeObjects到達第一個request語句之前，你需要在兩個管道之間“緩沖”第一個傳輸的Object 。 這種方法產生了許多有問題的行為和錯誤的角落情況，但可能最重要的問題是管道組合將不再是關聯的，並且效果的順序將根據您組合事物的順序而改變。

雙向管道組合操作員的好處是，這些類型可以解決，因此您可以通過研究類型來總是推斷出組件是“活動”（即啟動控制）還是“被動”（即等待輸入） 。 如果組合說某個管道（比如writeObjects ）必須接受一個參數，那么它就是被動的。 如果它不帶參數（如produceObjects ），則它處於活動狀態並啟動控制。 因此，組合強制您在管道中最多有一個活動管道（不接受初始參數的管道），這是開始控制的管道。

Answer 2

'const'是您丟棄數據的地方。 為了獲取所有數據，您可能希望執行基於推送的工作流程，如下所示：

writeObjects :: Object -> Proxy ObjectId Object () X IO r
writeObjects obj = go 0 obj
  where
    go objid obj = do
        lift $ putStrLn $ "Wrote "++show obj
        obj' <- request objid
        go (objid + 1) obj'

-- produceObjects as before

main = void $ run $ produceObjects objects >>~ writeObjects

Answer 3

我們一直在郵件列表上討論這個問題，但我想我會把它放在這里以及那些感興趣的人。

你的問題是你有兩個協同程序，它們都准備互相吐出值。 為了產生價值，兩者都不需要另一個的輸入。 那么誰先走了？ 嗯，你自己說：

writeObjects通過阻塞請求開始，已經向上游發送了初始的ObjId 0

那么，這意味着我們需要延遲produceObjects以便在吐出相應的對象之前等待ObjId信號（即使它顯然不需要所述ID）。

深入代理內部，這是我現在不會非常仔細解釋的神奇咒語。 基本的想法是在需要之前輸入輸入，然后在需要時應用輸入，但然后假裝你需要一個新的輸入（即使你還不需要那個輸入）：

delayD :: (Monad m) => Proxy a' a b' b m r -> b' -> Proxy a' a b' b m r
delayD p0 b' = case p0 of
    Request a' f -> Request a' (go . f)
    Respond b  g -> Respond b  (delayD (g b'))
    M m          -> M (liftM go m)
    Pure r       -> Pure r
  where
    go p = delayD p b'

現在，您可以在produceObjects objects而不是const上使用它，並且您的第二次嘗試可以produceObjects objects運行：

delayD (produceObjects objects) +>> writeObjects

我們正在討論郵件列表中的delayD ，看看它是否值得包含在標准的Pipes delayD節目中。