假设我有简单的生产者/消费者模型,消费者希望将某些状态传递回生产者。例如,让下游流动对象成为我们想要写入文件的对象,上游对象是表示文件在文件中写入位置的一些标记(例如偏移量)。
这两个过程可能看起来像这样(使用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] ]
这很简单,我在如何撰写它们方面遇到了相当大的困难。理想情况下,我们需要基于推送的控制流程,如下所示,
writeObjects
首先阻止了request
,发送了最初的ObjId 0
上游。produceObjects
发送第一个对象Obj 0
,下游writeObjects
写入对象并递增其状态,并等待request
,这次发送ObjId 1
上游respond
中的produceObjects
返回ObjId 0
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
。
如何以理想的方式创作这些作品?
答案 0 :(得分:14)
选择使用哪种成分取决于哪个成分应该启动整个过程。如果您希望下游管道启动该过程,那么您希望使用基于拉的合成(即(>+>)
/ (+>>)
),但如果您希望上游管道启动该过程,那么您应该使用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
的参数。这会静态强制您在收到第一个writeObjects
(通过初始参数)之前无法在Object
中运行任何代码。
解决方案是重写您的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
你可能想知道为什么这两个管道中的一个管道采用初始论证的要求是有道理的,除了抽象的理由,这是类别法律所要求的。简单的英语解释是,替代方案是,在Object
到达其第一个writeObjects
语句之前,您需要在两个管道之间缓冲第一个传输的request
“。这种方法产生了许多有问题的行为和错误的极端情况,但可能最重要的问题是管道组合将不再是关联的,并且效果的顺序将根据您编写事物的顺序而改变。
双向管道组合运算符的优点在于类型可以解决,因此您可以总是推断组件是否“活动”(即启动控制)或“被动”(即等待输入)纯粹由研究类型。如果组合说某个管道(如writeObjects
)必须接受一个参数,那么它就是被动的。如果它不需要参数(如produceObjects
),则它处于活动状态并启动控制。因此,组合强制您在管道中最多有一个活动管道(不接受初始参数的管道),这就是开始控制的管道。
答案 1 :(得分:4)
'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
答案 2 :(得分:2)
我们一直在邮件列表上讨论这个问题,但我想我会把它放在这里以及那些感兴趣的人。
你的问题是你有两个协同程序,它们都准备互相吐出值。为了产生价值,两者都不需要另一个的输入。那么谁先走了?嗯,你自己说:
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
上使用此功能,并且您的第二次尝试可以根据需要运行:
delayD (produceObjects objects) +>> writeObjects
我们正在讨论邮件列表中的delayD
,看它是否值得纳入标准管道套路。