Haskell лень - как я могу заставить IO случиться раньше?

Я только начал изучать 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

спасибо, Rob

Followup

Все ответы были полезными. Приведенный ниже код работает, но пока не использует bytestrings, как это было предложено. Следующий вопрос: можно ли заменить 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

Ответы

Ответ 1

Ваша проблема в использовании hGetContents получит все содержимое на ручке до закрытия сокета. Вы следуете этому вызову, пытаясь проанализировать последнюю строку ввода, которая не будет известна до тех пор, пока соединение не завершится.

Решение: получите столько данных, сколько вам нужно (или доступно), а затем завершите соединение.

Поздно, и я устал, но здесь решение, которое я знаю, неоптимально (читай: уродливый как грех): вы можете перейти к bytestrings (должен делать это в любом случае) и использовать 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

Ответ 2

Краткий обзор подхода:

"Контроль потока" в ленивых программах отличается от того, к которому вы привыкли. Вещи не будут оцениваться до тех пор, пока у них не будет, поэтому ваша программа всегда запрашивает результат с выходом.

В общем, вы можете сделать что-то строгое, используя оператор "bang" ! и прагма BangPatterns.

Если вы используете его в этом случае (говоря !text <- hGetContents handle), вы получите результат заголовков после завершения запроса. К сожалению, hGetContents не знает, когда прекратить ждать дополнительных данных перед оператором print, потому что handle не закрыт.

Если вы дополнительно реструктурируете программу, чтобы иметь hClose handle перед оператором let и print, тогда программа ведет себя так, как вы хотите.

В другом случае print не оценивается, потому что значение text никогда не завершается закрытием handle. Поскольку он "ленив", print затем ожидает hds и lns, которые в очереди ждут на text, который ждет на hClose... вот почему вы получали странное поведение; hClose не оценивался до тех пор, пока сокет не был нужен для следующего запроса, поэтому до этого не было вывода.

Обратите внимание, что просто создание text strict будет по-прежнему блокировать программу навсегда, оставив "ожидание" для закрытия файла. Тем не менее, если файл закрыт, когда text является нестрогим, он всегда будет пустым и вызовет ошибку. Использование обоих вместе даст желаемый эффект.

Ваша программа с предлагаемыми изменениями:

Были сделаны три изменения: я добавил прагму {-# LANGUAGE BangPatterns #-}, один символ (!) перед text и переместил 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

Альтернативный подход:

Чтобы обойти такие проблемы, вы можете попробовать использовать функцию hGetContents из System.IO.Strict вместо System.IO.

Последнее примечание:

Вместо явной рекурсии в acceptLoop я нахожу следующее main более идиоматичным:

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

Выполняя это, вы можете удалить рекурсивный вызов из acceptLoop.

Решение TomMD использует forever из модуля Contol.Monad, что тоже хорошо.

Ответ 3

Вероятно, у вас должно быть некоторое представление о завершении сообщения. Вы должны прочитать из дескриптора ввода в фрагментах, пока не узнаете, что у вас есть полное сообщение. Затем предположим, что все это будет следующим сообщением. Сообщения могут не появляться сразу или могут появляться в группах.

Сообщения могут всегда быть фиксированной длиной, например. Или завершено с помощью \n\n (я считаю, что это относится к HTTP-запросам)

[Я могу вернуться и отправить код, чтобы пойти с этим советом, но если я этого не сделаю, просто попробуйте и скопируйте TomMD-код, который является шагом в правильном направлении]