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

Question

是否可以创建一个函数，以便来自pipes的代理可以从里到外 build 吗？由内而外，我的意思是从连接上游和下游连接的函数创建一个代理。最理想(但不可能)的签名是

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 还是 响应。无论我们如何回答，我们唯一可以提供的值是()。这意味着我们可以立即向上游生产者发出 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 将具有来自上方下游的值 a 和来自下方下游的值 (n, a)；换句话说，它将是一个Pipe a (n, a)。

我们将通过使用数字zipping 来解决这个问题。对数字进行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 的 >as 来提供这些值。如果我们有 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

Answer 1

实际上，我认为如果稍微改变一下类型，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 的导入，它就会起作用

我将详细说明为什么它有效。

首先，让我列出一些管道定义和法则:

-- 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 会将所有从 k 的上游接口(interface)发出的 request 转换为 lift 。 request 和 dn 将所有从 k 下游接口(interface)发出的 respond 转换为 lift 。响应。事实上，我们可以证明:

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

...如果我们将这些方程应用于 k，我们会得到:

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

这说的是同样的事情，只是更直接:我们将 k 中的每个 request 替换为 lift 。 request 并将 k 中的每个 respond 替换为 lift 。回复。

一旦我们降低了对基本 monad 的所有请求和响应，我们最终会得到这种类型:

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

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

这也与 Pipes.Lift.distribute 使用相同的技巧来交换 Proxy monad 与其下面的 monad 的顺序:

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