Haskell懒惰的I/O和关闭文件

Question

我编写了一个小的Haskell程序来打印当前目录中所有文件的MD5校验和(递归搜索).基本上是Haskell版本的md5deep.一切都很好,花花公子,除非当前目录有大量的文件,在这种情况下,我收到如下错误:

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

似乎Haskell的懒惰导致它不会关闭文件,即使在相应的输出行已经完成之后也是如此.

相关代码如下.感兴趣的功能是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

编辑:我有大量的文件不适合RAM,所以我不是在寻找一个解决方案,一次将整个文件读入内存.

Answer 1

您不需要使用任何特殊的方式来执行IO,您只需要更改执行操作的顺序.因此,不是打开所有文件然后处理内容,而是打开一个文件并一次打印一行输出.

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.

Answer 2

懒惰的IO很容易出错.

正如dons建议的那样,你应该使用严格的IO.

您可以使用Iteratee之类的工具来帮助您构建严格的IO代码.我最喜欢的工作是monadic列表.

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实现.

Monadic列出/ ListT来自hackage上的"List"包(变形金刚'和mtl已ListT被破坏,也没有附带有用的函数takeWhile)

Answer 3

注意:我稍微编辑了我的代码,以反映Duncan Coutts答案中的建议.即使在这次编辑之后,他的回答显然比我的好得多,并且似乎没有以同样的方式耗尽内存.

这是我对Iteratee基于版本的快速尝试.当我在一个包含大约2,000个小(30-80K)文件的目录上运行它时,它比你的版本快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.(如果我在这里做了一些可怕的事情,我很抱歉 - 我是这个人的初学者.)