哈斯克尔管道和分支 [英] Haskell Pipes and Branching

问题描述

我试图用Haskell和Pipes库实现一个简单的Web服务器。我现在明白，循环或钻石拓扑结构对于管道是不可能的，但是我想我正在尝试的是。因此，我期望的拓扑是：

I'm attempting to implement a simple web server with Haskell and the Pipes library. I understand now that cyclic or diamond topologies aren't possible with pipes, however I thought that what I am trying to is. My desired topology is thus:

                                 -GET--> handleGET >-> packRequest >-> socketWriteD
                                 |
socketReadS >-> parseRequest >-routeRequest
                                 |
                                 -POST-> handlePOST >-> packRequest >-> socketWriteD

我有 HTTPRequest RequestLine Headers Message 和链中使用的HTTPResponse StatusLine Headers Message 类型。 socketReadS 从套接字获取字节并将它们转发给 parseRequest ，它使用Attoparsec将字节解析为 HTTPRequest 对象。然后，我会喜欢管道分支至少两次，也可能更多，这取决于我实现的HTTP方法的数量。每个句柄< method> 函数都应该接收来自上游和前向的 HTTPRequest 对象 HTTPResponse > packRequest ，它将HTTPResponse对象简单地打包在一个 ByteString 中，准备与 socketWriteS 。

I have HTTPRequest RequestLine Headers Message and HTTPResponse StatusLine Headers Message types which are used in the chain. socketReadS takes bytes from the socket and forwards them to parseRequest, which uses Attoparsec to parse the bytes into an HTTPRequest object. I would then like the pipe to branch at least twice and possibly more depending on how many HTTP methods I implement. Each handle<method> function should receive HTTPRequest objects from upstream and forward HTTPResponse objects to packRequest, which simply packs up the HTTPResponse objects in a ByteString ready to be sent with socketWriteS.

如果我让GHC推断 routeRequest'的类型， '（我似乎稍微偏离了某种程度）。但是在 parseRequest 之后似乎没有任何执行。任何人都可以帮我找出原因吗？

The following code typechecks if I let GHC infer the type for routeRequest''' (mine seems to be slightly off somehow). However nothing seems to be executing after parseRequest. Can anyone help me figure out why?

我有以下代码 routeRequest 它应该处理分支。

I have the following code for routeRequest which should handle the branching.

routeRequest''' ::
    (Monad m, Proxy p1, Proxy p2, Proxy p3)
    => () -> Consumer p1 HTTPRequest (Pipe p2 HTTPRequest HTTPRequest (Pipe p3 HTTPRequest HTTPRequest m)) r
routeRequest''' () = runIdentityP . hoist (runIdentityP . hoist runIdentityP) $ forever $ do
    httpReq <- request ()
    let method = getMethod httpReq
    let (URI uri) = getURI httpReq
    case method of
      GET -> lift $ respond httpReq
      POST -> lift $ lift $ respond httpReq

routeRequest'' = runProxyK $ routeRequest''' <-< unitU
routeRequest' socket = runProxyK $ raiseK (p4 socket <-< handleGET) <-< routeRequest''
routeRequest socket = (p4 socket <-< handlePOST) <-< (routeRequest' socket)

handleGET 和 handlePOST 是这样实现的：

handleGET and handlePOST are implemented as such:

handleGET :: Proxy p => () -> p () HTTPRequest r ByteString IO r
handleGET () = runIdentityP $ do
    httpReq <- request ()
    let (URI uri) = getURI httpReq
    lift $ Prelude.putStrLn "GET"
    respond $ B.append (B.pack "GET ") uri


handlePOST :: Proxy p => () -> p () HTTPRequest r ByteString IO r
handlePOST () = runIdentityP $ do
    httpReq <- request ()
    let (URI uri) = getURI httpReq
    lift $ Prelude.putStrLn "POST"
    respond $ B.append (B.pack "POST ") uri

我有以下代理短格：

I have the following shorthands for proxies:

p1 socket = socketReadS 32 socket
p2 = parseRequestProxy 
p4 socket = socketWriteD socket

最后，我运行如下所示：

Finally, I run the whole thing like this:

main = serveFork (Host "127.0.0.1") "8080" $
    \(socket, remoteAddr) -> do
        ret <- runProxy $ runEitherK $ p1 socket >-> printD >-> p2 >-> printD  >-> routeRequest socket 
        Prelude.putStrLn $ show ret

parseRequestProxy 是这样的：

parseRequestProxy
  :: (Monad m, Proxy p) =>
     ()
     -> Pipe
          (EitherP Control.Proxy.Attoparsec.Types.BadInput p)
          ByteString
          HTTPRequest
          m
          r

编辑

以下是带有源代码的存储库。有人警告说它没有被弄脏，所以使用需要您自担风险。 https://bitbucket.org/Dwilson1234/haskell-web-server/overview

推荐答案

当我最初说你无法处理钻石拓扑时，我错了。后来我发现了一个明智的方法，使用 ArrowChoice 类接口来完成此操作，并将解决方案包含在 pipes-3.2.0 形式为 leftD 和 rightD 组合子。我将解释它是如何工作的：

I was wrong when I originally said you could not handle diamond topologies. I later discovered a sensible way to do this using an ArrowChoice-like interface and included the solution in pipes-3.2.0 in the form of the leftD and rightD combinators. I'll explain how it works:

代替嵌套代理转换器，可以用 Left 或者< Right

Instead of nesting proxy transformers, you wrap the result with a Left or Right

routeRequest ::
    (Monad m, Proxy p)
    => () -> Pipe p HTTPRequest (Either HTTPRequest HTTPRequest) m r
routeRequest () = runIdentityP $ forever $ do
    httpReq <- request ()
    let method = getMethod httpReq
    let (URI uri) = getURI httpReq
    respond $ case method of
      GET  -> Left  httpReq
      POST -> Right httpReq

然后，您可以选择性地将每个处理程序应用于每个分支，然后合并分支：

Then you can selectively apply each handler to each branch and then merge the branches:

routeRequest >-> leftD handleGET >-> rightD handlePOST >-> mapD (either id id)
    :: (Monad m, Proxy p) => () -> Pipe p HTTPRequest ByteString IO r

如果你有两个以上的分支，你将不得不嵌套或者 s，但这只是 ArrowChoice 工作方式的限制。

If you have more than two branches then you will have to nest Eithers, but that is just a limitation of how ArrowChoice works.

这篇关于哈斯克尔管道和分支的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！