Haskell管道和分支

Question

問題

我正在嘗試使用Haskell和Pipes庫實現一個簡單的Web服務器。 我現在明白管道不可能使用循環或鑽石拓撲，但我認為我想要的是。 因此我想要的拓撲結構是：

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

我有HTTPRequest RequestLine Headers Message和HTTPResponse StatusLine Headers Message鏈中使用的HTTPResponse StatusLine Headers Message類型。 socketReadS從套接字中獲取字節並將它們轉發給parseRequest ，后者使用Attoparsec將字節解析為HTTPRequest對象。 然后，我希望管道分支至少兩次，可能更多，具體取決於我實現的HTTP方法數量。 每個handle<method>函數都應該從上游接收HTTPRequest對象，並將HTTPResponse對象轉發到packRequest ，它簡單地將HTTPResponse對象打包在准備與socketWriteS一起發送的ByteString 。

如果我讓GHC推斷出routeRequest'''的類型，那么下面的代碼類型routeRequest''' （我的某種方式似乎有些routeRequest''' ）。 但是，在parseRequest之后似乎沒有執行任何操作。 任何人都可以幫我找出原因嗎？

碼

我有routeRequest的以下代碼，它應該處理分支。

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 :: 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

代理人有以下簡介：

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

最后，我像這樣運行整個事情：

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

Answer 1

我原來說你無法處理鑽石拓撲時錯了。 后來我發現了一種使用ArrowChoice類接口的合理方法，並以leftD和rightD組合器的形式包含了leftD pipes-3.2.0中的解決方案。 我會解釋它是如何工作的：

您可以使用Left或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

然后，您可以有選擇地將每個處理程序應用於每個分支，然后合並分支：

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

如果有兩個以上的分支，那么你將不得不窩Either S，而這僅僅是如何限制ArrowChoice工作。

Answer 2

我沒有運行你的代碼，但我認為我發現了一個問題。

routeRequest'' = runProxyK $ routeRequest''' <-< unitU

routeRequest'''正在請求來自unitU的數據，該數據沒有供應，因此它會掛起。

:t runProxy $ unitU >-> printD

將鍵入檢查但沒有運行。

看起來數據被發送到monad變換器的錯誤級別，流入routeRequest數據應該流入routeRequest''' 。 流入monad變換器的錯誤級別的數據可能導致您需要保留類型簽名以獲取要檢查的所有內容。 使用類型簽名routeRequest期望a ()來自上游，我敢打賭，沒有類型簽名，它被允許是多態的。

在你對routeRequest的定義中，你可以“關閉管道”，我認為這就是所謂的，通過使用unitD，即使在routeRequest'''沒有類型簽名時也會禁止你的構造。