Haskell ленивый ввод-вывод и закрытие файлов - PullRequest
20 голосов
/ 05 июня 2010

Я написал небольшую программу на Haskell для печати контрольных сумм MD5 для всех файлов в текущем каталоге (рекурсивный поиск).В основном версия Haskell md5deep.Все хорошо, за исключением случаев, когда в текущем каталоге очень большое количество файлов, и в этом случае я получаю сообщение об ошибке:

<program>: <currentFile>: openBinaryFile: resource exhausted (Too many open files)

Кажется, лень Хаскелла заставляет его не закрывать файлы даже послесоответствующая строка вывода завершена.

Соответствующий код приведен ниже.Интересующая функция getList.

import qualified Data.ByteString.Lazy as BS

main :: IO ()
main = putStr . unlines =<< getList "."

getList :: FilePath -> IO [String]
getList p =
    let getFileLine path = liftM (\c -> (hex $ hash $ BS.unpack c) ++ " " ++ path) (BS.readFile path)
    in mapM getFileLine =<< getRecursiveContents p

hex :: [Word8] -> String
hex = concatMap (\x -> printf "%0.2x" (toInteger x))

getRecursiveContents :: FilePath -> IO [FilePath]
-- ^ Just gets the paths to all the files in the given directory.

Есть какие-нибудь идеи о том, как я мог бы решить эту проблему?

Вся программа доступна здесь: http://haskell.pastebin.com/PAZm0Dcb

Редактировать: У меня много файлов, которые не помещаются в ОЗУ, поэтому я не ищу решение, которое считывает весь файл в память сразу.

Ответы [ 7 ]

27 голосов
/ 06 июня 2010

Вам не нужно использовать какой-либо особый способ выполнения ввода-вывода, вам просто нужно изменить порядок, в котором вы делаете вещи. Поэтому вместо того, чтобы открывать все файлы и затем обрабатывать содержимое, вы открываете один файл и печатаете одну строку вывода за раз.

import Data.Digest.Pure.MD5 (md5)
import qualified Data.ByteString.Lazy as BS

main :: IO ()
main = mapM_ (\path -> putStrLn . fileLine path =<< BS.readFile path) 
   =<< getRecursiveContents "."

fileLine :: FilePath -> BS.ByteString -> String
fileLine path c = hash c ++ " " ++ path

hash :: BS.ByteString -> String 
hash = show . md5

Кстати, я использую другую хэш-библиотеку md5, разница не значительна.

Главное, что здесь происходит, это строка:

mapM_ (\path -> putStrLn . fileLine path =<< BS.readFile path)

Он открывает один файл, потребляет все содержимое файла и печатает одну строку вывода. Он закрывает файл, потому что он потребляет все содержимое файла. Ранее вы откладывали, когда файл был использован, что задерживалось, когда файл был закрыт.

Если вы не совсем уверены, используете ли вы все входные данные, но хотите убедиться, что файл все равно закрывается, вы можете использовать функцию withFile из System.IO:

mapM_ (\path -> withFile path ReadMode $ \hnd -> do
                  c <- BS.hGetContents hnd
                  putStrLn (fileLine path c))

Функция withFile открывает файл и передает дескриптор файла в функцию body. Это гарантирует, что файл будет закрыт при возвращении тела. Этот паттерн "withBlah" очень распространен при работе с дорогими ресурсами. Этот шаблон ресурса напрямую поддерживается System.Exception.bracket.

11 голосов
/ 06 июня 2010

Lazy IO очень подвержен ошибкам.

Как и предполагали, вы должны использовать строгий ввод-вывод.

Вы можете использовать такой инструмент, как Iteratee, чтобы помочь вам структурировать строгий код ввода-вывода. Мой любимый инструмент для этой работы - монадические списки.

import Control.Monad.ListT (ListT) -- List
import Control.Monad.IO.Class (liftIO) -- transformers
import Data.Binary (encode) -- binary
import Data.Digest.Pure.MD5 -- pureMD5
import Data.List.Class (repeat, takeWhile, foldlL) -- List
import System.IO (IOMode(ReadMode), openFile, hClose)
import qualified Data.ByteString.Lazy as BS
import Prelude hiding (repeat, takeWhile)

hashFile :: FilePath -> IO BS.ByteString
hashFile =
    fmap (encode . md5Finalize) . foldlL md5Update md5InitialContext . strictReadFileChunks 1024

strictReadFileChunks :: Int -> FilePath -> ListT IO BS.ByteString
strictReadFileChunks chunkSize filename =
    takeWhile (not . BS.null) $ do
        handle <- liftIO $ openFile filename ReadMode
        repeat () -- this makes the lines below loop
        chunk <- liftIO $ BS.hGet handle chunkSize
        when (BS.null chunk) . liftIO $ hClose handle
        return chunk

Я использовал здесь пакет «pureMD5», потому что «Crypto», похоже, не предлагает «потоковую» реализацию md5.

Монадические списки / ListT приходят из пакета "List" при взломе (преобразователи и mtl ListT не работают, а также не имеют полезных функций, таких как takeWhile)

6 голосов
/ 06 июня 2010

ПРИМЕЧАНИЕ: Я немного отредактировал свой код, чтобы отразить совет в Ответ Дункана Коутта . Даже после этого редактирования его ответ, очевидно, намного лучше моего и, похоже, не исчерпывает память таким же образом.


Вот моя быстрая попытка версии на Iteratee. Когда я запускаю его в каталоге, содержащем около 2000 маленьких (30-80 КБ) файлов, это примерно в 30 раз быстрее, чем ваша версия здесь и, кажется, использует немного меньше памяти.

По какой-то причине у него все еще не хватает памяти для очень больших файлов - я не совсем понимаю Iteratee достаточно хорошо, чтобы понять, почему легко.

module Main where

import Control.Monad.State
import Data.Digest.Pure.MD5
import Data.List (sort)
import Data.Word (Word8) 
import System.Directory 
import System.FilePath ((</>))
import qualified Data.ByteString.Lazy as BS

import qualified Data.Iteratee as I
import qualified Data.Iteratee.WrappedByteString as IW

evalIteratee path = evalStateT (I.fileDriver iteratee path) md5InitialContext

iteratee :: I.IterateeG IW.WrappedByteString Word8 (StateT MD5Context IO) MD5Digest
iteratee = I.IterateeG chunk
  where
    chunk s@(I.EOF Nothing) =
      get >>= \ctx -> return $ I.Done (md5Finalize ctx) s
    chunk (I.Chunk c) = do
      modify $ \ctx -> md5Update ctx $ BS.fromChunks $ (:[]) $ IW.unWrap c
      return $ I.Cont (I.IterateeG chunk) Nothing

fileLine :: FilePath -> MD5Digest -> String
fileLine path c = show c ++ " " ++ path

main = mapM_ (\path -> putStrLn . fileLine path =<< evalIteratee path) 
   =<< getRecursiveContents "."

getRecursiveContents :: FilePath -> IO [FilePath]
getRecursiveContents topdir = do
  names <- getDirectoryContents topdir

  let properNames = filter (`notElem` [".", ".."]) names

  paths <- concatForM properNames $ \name -> do
    let path = topdir </> name

    isDirectory <- doesDirectoryExist path
    if isDirectory
      then getRecursiveContents path
      else do
        isFile <- doesFileExist path
        if isFile
          then return [path]
          else return []

  return (sort paths)

concatForM :: (Monad m) => [a1] -> (a1 -> m [a]) -> m [a]
concatForM xs f = liftM concat (forM xs f)

Обратите внимание, что вам понадобится пакет iteratee и TomMD pureMD5. (И мои извинения, если я сделал здесь что-то ужасное - я новичок в этом деле.)

3 голосов
/ 05 июня 2010

Редактировать: я предполагал, что пользователь открывает тысячи очень маленьких файлов, оказывается, они очень большие. Лень будет иметь важное значение.

Ну, вам нужно использовать другой механизм ввода-вывода. Или:

  • Строгий ввод-вывод (обработка файлов с помощью Data.ByteString или System.IO.Strict
  • или, Iteratee IO (только для экспертов).

Я бы также настоятельно рекомендовал не использовать 'unpack', так как это уничтожает преимущество использования строк байтов.

Например, вы можете заменить ваш ленивый ввод-вывод на System.IO.Strict, получив:

import qualified System.IO.Strict as S

getList :: FilePath -> IO [String]
getList p = mapM getFileLine =<< getRecursiveContents p
    where
        getFileLine path = liftM (\c -> (hex (hash c)) ++ " " ++ path)
                                 (S.readFile path)
2 голосов
/ 06 июня 2010

Проблема в том, что mapM не так ленив, как вы думаете, - в результате получается полный список с одним элементом на путь к файлу. И файл ввода-вывода, который вы используете , является ленивым, поэтому вы получаете список с одним открытым файлом на путь к файлу.

Самым простым решением в этом случае является принудительное вычисление хэша для каждого пути к файлу. Один из способов сделать это - Control.Exception.evaluate:

getFileLine path = do
  theHash <- liftM (\c -> (hex $ hash $ BS.unpack c) ++ " " ++ path) (BS.readFile path)
  evaluate theHash

Как уже отмечали другие, мы работаем над заменой нынешнего подхода к отложенному вводу-выводу, который является более общим, но все же простым.

0 голосов
/ 06 июня 2010

unsafeInterleaveIO?

Еще одно решение, которое приходит на ум, - это использование unsafeInterleaveIO из System.IO.Unsafe.См. Ответ Томаша Зелонки в этой теме в Haskell Cafe.

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

Теперь, я считаю, mapM getFileLine открывает все файлы, но не начинает читать из них, покаputStr . unlines.Таким образом, множество проблем с обработчиками открытых файлов плавают вокруг, это проблема.(Пожалуйста, исправьте меня, если я ошибаюсь).

Пример

A модифицированный пример с unsafeInterleaveIO работает с каталогом 100 ГБ в течение нескольких минут, впостоянное пространство.

getList :: FilePath -> IO [String]
getList p =
  let getFileLine path =
        liftM (\c -> (show . md5 $ c) ++ " " ++ path)
        (unsafeInterleaveIO $ BS.readFile path)
  in mapM getFileLine =<< getRecursiveContents p 

(я изменил для реализации хэша в pureMD5)

PS Я не уверен, что это хороший стиль.Я считаю, что решения с итератами и строгим вводом-выводом лучше, но этот сделать быстрее.Я использую его в небольших сценариях, но боюсь полагаться на него в более крупной программе.

0 голосов
/ 06 июня 2010

РЕДАКТИРОВАТЬ: извините, думал, что проблема была с файлами, а не чтение / обход диалектории. Игнорировать это.

Нет проблем, просто откройте файл (openFile), прочитайте его содержимое (Data.ByteString.Lazy.hGetContents), выполните хэш md5 (пусть! H = содержимое md5) и явно закройте файл (hClose).

...