Haskell 懒惰 - 我如何强制 IO 更快发生？

Question

我刚开始学习 Haskell。下面是一些用命令式编写的代码，它实现了一个简单的服务器——它打印出 HTTP 请求标头。除了我需要在 Haskell 中重新考虑它以使用惰性列表和高阶函数这一事实之外，我还想清楚地看到为什么它没有达到我的预期。它总是落后——我用一个请求点击它，没有任何反应，再次点击它，它打印第一个请求，第三次点击它，它打印第二个请求，等等。为什么会这样？对这段代码的最小更改是什么会导致它在请求进入时立即打印？

import Network
import System.IO
import Network.HTTP.Headers

acceptLoop :: Socket -> IO ()
acceptLoop s = do
  (handle, hostname, _) <- accept s
  putStrLn ("Accepted connection from " ++ hostname)
  text <- hGetContents handle
  let lns = lines text
      hds = tail lns
  print $ parseHeaders hds
  hClose handle
  acceptLoop s


main :: IO ()
main = do
  s <- listenOn (PortNumber 8080)
  acceptLoop s

谢谢， 抢

跟进

所有答案都很有帮助。下面的代码可以工作，但还没有按照建议使用字节串。一个后续问题：ioTakeWhile 是否可以通过使用标准库中的某些函数（可能在 Control.Monad 中）来替换？

ioTakeWhile :: (a -> Bool) -> [IO a] -> IO [a]
ioTakeWhile pred actions = do
  x <- head actions
  if pred x
    then (ioTakeWhile pred (tail actions)) >>= \xs -> return (x:xs)
    else return []

acceptLoop :: Socket -> IO ()
acceptLoop s = do
  (handle, hostname, _) <- accept s
  putStrLn ("Accepted connection from " ++ hostname)
  let lineActions = repeat (hGetLine handle)
  lines <- ioTakeWhile (/= "\r") lineActions
  print lines
  hClose handle

Answer 1

您的问题是使用hGetContents 将获取句柄上的所有内容，直到套接字关闭。您通过尝试解析输入的最后一行来跟踪此调用，直到连接终止才能知道。

解决方案：获取尽可能多的数据（或可用数据），然后终止连接。

已经很晚了，我很累，但这里有一个我知道不是最佳的解决方案（阅读：丑陋的罪恶）：你可以移动到字节串（无论如何都应该这样做）并使用 hGetNonBlocking 或 hGetSome 而不是hGetContents。或者，您可以不断hGetLine（阻塞）直到解析成功让您满意：

import Network
import System.IO
import Network.HTTP.Headers
import Control.Monad
import qualified Data.ByteString.Char8 as B
import Data.ByteString (hGetSome)

acceptLoop :: Socket -> IO ()
acceptLoop s = do
    (handle, hostname, _) <- accept s
    putStrLn ("Accepted connection from " ++ hostname)
    printHeaders handle B.empty
    hClose handle
  where
  printHeaders h s = do
  t <- hGetSome h 4096
  let str  = B.append s t -- inefficient!
      loop = printHeaders h str
  case (parseHeaders . tail . lines) (B.unpack str) of
      Left _   -> loop
      Right x
       | length x < 3 -> loop
       | otherwise    -> print x

main :: IO ()
main = do
  hSetBuffering stdin NoBuffering
  s <- listenOn (PortNumber 8080)
  forever $ acceptLoop s

Answer 2

您可能应该对消息何时完成有一些概念。您需要从 sn-ps 中的输入句柄读取，直到您认识到您已收到完整的消息。然后假设之后的所有内容都是下一条消息。消息可能不会同时出现，也可能成组出现。

例如，消息可能总是固定长度。或者以\n\n 终止（我相信HTTP请求就是这种情况）

[我可能会回来并发布代码以遵循此建议，但如果我不这样做，请尝试调整 TomMD 的代码，这是朝着正确方向迈出的一步]

Answer 3

该方法的简要概述：

惰性程序中的“控制流”与您习惯的不同。事情只有在必须评估时才会被评估，这就是为什么您的程序总是在输出后面的请求。

一般来说，您可以使用“bang”运算符! 和BangPatterns pragma 来进行严格控制。

如果您在这种情况下使用它（通过说!text <- hGetContents handle），您将在请求完成后获得标头的输出。不幸的是，hGetContents 不知道何时在print 语句之前停止等待更多数据，因为handle 没有关闭。

如果您另外重组程序以在let 语句和print 之前添加hClose handle 之前，那么程序的行为就像您想要的那样。

在另一种情况下，不会评估print，因为text 的值永远不会在handle 关闭时“最终确定”。因为它是“懒惰的”，所以print 正在等待hds 和lns，它们又在等待text，它正在等待hClose...这就是为什么你会得到奇怪的行为; hClose 直到下一个请求需要套接字时才被评估，这就是为什么在那之前没有输出的原因。

请注意，简单地设置text 仍然会永远阻塞程序，让它“等待”文件关闭。但是，如果在text 不严格时关闭文件，则它将始终为空，并导致错误。两者一起使用会得到想要的效果。

---

您的程序带有建议的更改：

进行了三处更改：我在text 前面添加了{-# LANGUAGE BangPatterns #-} 杂注、单个字符(!)，并将hClose handle 上移了几行。

{-# LANGUAGE BangPatterns #-}
import Network
import System.IO
import Network.HTTP.Headers

acceptLoop :: Socket -> IO ()
acceptLoop s = do
  (handle, hostname, _) <- accept s
  putStrLn ("Accepted connection from " ++ hostname)
  !text <- hGetContents handle
  hClose handle
  let lns = lines text
      hds = tail lns
  print $ parseHeaders hds
  acceptLoop s

main :: IO ()
main = do
  s <- listenOn (PortNumber 8080)
  acceptLoop s

---

另一种方法：

要完全回避此类问题，您可以尝试使用 System.IO.Strict 模块中的 hGetContents 函数而不是 System.IO。

---

最后一点：

与acceptLoop 中的显式递归相比，我发现以下main 更惯用：

main = do
  s <- listenOn (PortNumber 8080)
  sequence_ $ repeat $ acceptLoop s

这样做，您可以从acceptLoop 中删除递归调用。

TomMD 的解决方案使用来自Contol.Monad 模块的forever，这也很好。