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

Question

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

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