haskell - 由内而外构造管道代理

是否可以制作一个函数，以便可以从内向外构造pipes中的Proxy？由内而外，我的意思是从连接上游和下游连接的函数创建代理。最理想的（但不可能的）签名是

makeProxy :: (Monad m) =>
             (Server a' a m r -> Client b' b m r -> Effect m r) ->
              Proxy  a' a               b' b               m r

我们遇到的第一个问题是构造Proxy的机械问题。除了让每个函数都为Server之外，我们无法知道该函数查看的是Client还是M，在这种情况下，我们只会知道它查看的是哪个，而不是尝试的值发送上游或下游。如果我们专注于上游端，那么我们唯一了解的就是试图弄清楚上游代理是什么，因此我们需要决定是始终导致更上游的Request还是Respond。无论采用哪种方式回答，唯一可以提供的值就是()。这意味着我们可以对上游生产者或Request ()立即创建Respond ()。如果我们考虑为两端做出选择，则只有四个可能的功能。以下函数是根据其上游和下游连接向下游（D）或上游（U）发送有趣的数据而命名的。

betweenDD :: (Monad m) =>
             (Server () a m r -> Client () b m r -> Effect m r) ->
              Proxy  () a               () b               m r
betweenDD = undefined

betweenDU :: (Monad m) =>
             (Server () a m r -> Client b' () m r -> Effect m r) ->
              Proxy  () a               b' ()               m r
betweenDU = undefined

betweenUU :: (Monad m) =>
             (Server a' () m r -> Client b' () m r -> Effect m r) ->
              Proxy  a' ()               b' ()               m r
betweenUU f = reflect (betweenDD g)
    where g source sink = f (reflect sink) (reflect source)


betweenUD :: (Monad m) =>
             (Server a' () m r -> Client () b m r -> Effect m r) ->
              Proxy  a' ()               () b               m r
betweenUD = undefined

betweenDD是最有趣的，它将在Producer和Consumer之间建立管道。 betweenUU将对在上游运行的管道执行相同的操作。 betweenDU会消耗从两个来源之一请求它的数据。 betweenUD会产生数据，并将其发送到两个目的地之一。

我们可以提供betweenDD的定义吗？如果不是，我们可以为以下更简单的函数提供定义吗？

belowD :: (Monad m) =>
          (Producer a m r -> Producer b m r) ->
           Proxy () a              () b m r

aboveD :: (Monad m) =>
          (Consumer b m r -> Consumer a m r) ->
           Proxy () a              () b m r

这个问题的动机是试图写belowD用于回答question about P.zipWith。

例

这个例子恰好是the question that inspired this question.。

假设我们要创建一个Pipe，它将对通过它的值进行number传递。 Pipe的值a从上流向下游，值(n, a)的流向则在下游；换句话说，它将是Pipe a (n, a)。

我们将通过zip输入数字来解决此问题。用数字进行zip的结果是从(->)到Producer a的函数Producer (n, a)。

import qualified Pipes.Prelude as P

number' :: (Monad m, Num n, Enum n) => Producer a m () -> Producer (n, a) m ()
number' = P.zip (fromList [1..])

即使Pipe从上游消耗a，但从函数的角度来看，它仍需要Producer的a来提供这些值。如果我们有belowD的定义，我们可以写

number :: (Monad m, Num n, Enum n) => Pipe a (n, a) m ()
number = belowD (P.zip (fromList [1..]))

给fromList一个合适的定义

fromList :: (Monad m) => [a] -> Producer a m ()
fromList []     = return ()
fromList (x:xs) = do
    yield x
    fromList xs

最佳答案

实际上，如果您稍微更改类型，我认为makeProxy是可能的。我正在用手机打电话，所以我现在还不能输入检查内容，但是我相信这是可行的：

{-# LANGUAGE RankNTypes #-}

import Control.Monad.Trans.Class (lift)
import Pipes.Core

makeProxy
    ::  Monad m
    =>  (   forall n. Monad n
        =>  (a' -> Server a' a n r)
        ->  (b  -> Client b' b n r)
        ->         Effect      n r
        )
    ->  Proxy a' a b' b m r
makeProxy k = runEffect (k up dn)
  where
    up = lift . request \>\ pull
    dn = push />/ lift . respond

假定k定义为：

k up dn = up ->> k >>~ dn

编辑：是的，如果您为lift添加导入，则可以使用

我将逐步解释为什么这样做。

首先，让我列出一些pipes定义和法律：

-- Definition of `push` and `pull`
(1) pull = request >=> push
(2) push = respond >=> pull

-- Read this as: f * (g + h) = (f * g) + (f * h)
(3) f \>\ (g >=> h) = (f \>\ g) >=> (f \>\ h)

-- Read this as: (g + h) * f = (g * f) + (h * f)
(4) (g >=> h) />/ f = (g />/ f) >=> (h />/ f)

-- Right identity law for the request category
(5) f \>\ request = f

-- Left identity law for the respond category
(6) respond />/ f = f

-- Free theorems (equations you can prove from the types alone!)
(7) f \>\ respond = respond
(8) request />/ f = request

现在，让我们使用这些方程式扩展up和dn：

up = (lift . request) \>\ pull
   = (lift . request) \>\ (request >=> push)  -- Equation (1)
   = (lift . request \>\ request) >=> (lift . request \>\ push)  -- Equation (3)
   = lift . request >=> (lift . request \>\ push)                -- Equation (5)
   = lift . request >=> (lift . request \>\ (respond >=> pull))  -- Equation (2)
   = lift . request >=> (lift . request \>\ respond) >=> (lift . request \>\ pull) -- Equation (3)
   = lift . request >=> respond >=> (lift . request \>\ pull)    -- Equation (7)
up = lift . request >=> respond >=> up

-- Same steps, except symmetric
dn = lift . respond >=> request >=> dn

换句话说，up将所有从request上游接口传出的k转换为lift . request，而dn将所有从respond下游接口传出的k转换为。实际上，我们可以证明：

(9)  (f \>\ pull) ->> p = f \>\ p
(10) p >>~ (push />/ f) = p />/ f

...如果将这些等式应用于lift . respond，我们将得到：

  (lift . request \>\ pull) ->> k >>~ (push />/ lift . respond)
= lift . request \>\ k />/ lift . respond

这说了同样的话，只是更直接：我们将k中的每个request替换为k，并将lift . request中的每个respond替换为k。

将所有lift . respond和request降低到基本单声道后，我们最终得到以下类型：

lift . request \>\ k />/ lift . respond :: Effect' (Proxy a' a b' b m) r

现在我们可以使用respond删除外部的Effect。这留下了“由内而外”的runEffect。

这也是Proxy用于将Pipes.Lift.distribute monad与其下面的monad交换顺序的相同技巧：

http://hackage.haskell.org/package/pipes-4.1.4/docs/src/Pipes-Lift.html#distribute