Haskell лень - как заставить IO произойти раньше? - PullRequest
Новая
       31

Haskell лень - как заставить IO произойти раньше?

14 голосов
/ 21 марта 2011

Я только начал изучать Haskell. Ниже приведен код, написанный в императивном стиле, который реализует простой сервер - он печатает заголовки HTTP-запроса. Помимо того, что мне нужно переосмыслить это в Haskell, работать с отложенными списками и функциями более высокого порядка, я бы хотел ясно видеть, почему он не выполняет то, что я задумал. Он всегда один позади - я нажимаю на него с запросом, ничего не происходит, нажимаю на него снова, он печатает первый запрос, нажимает на него 3 раза, печатает 2-й запрос и т. Д. Почему? И каково минимальное изменение в этом коде, которое заставило бы его печатать правильно, когда пришел запрос? 

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

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

Ответы [ 3 ]

10 голосов
/ 21 марта 2011

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

Решение: получить столько данных, сколько вам нужно (или доступно), затем завершитьСоединение или 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
6 голосов
/ 21 марта 2011

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

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

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

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

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

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

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

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

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

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

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

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

...