Haskell 惰性 I/O 和关闭文件

Question

我编写了一个小型 Haskell 程序来打印当前目录中所有文件的 MD5 校验和（递归搜索）。基本上是 md5deep 的 Haskell 版本。一切都很好，除非当前目录有大量文件，在这种情况下，我会收到如下错误：

<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)

它打开一个文件，消耗文件的全部内容并打印一行输出。它关闭文件，因为它正在消耗文件的全部内容。以前你在文件被消耗时延迟，而在文件关闭时延迟。

如果您不太确定是否正在使用所有输入，但又想确保文件被关闭，那么您可以使用System.IO 中的withFile 函数：

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

withFile 函数打开文件并将文件句柄传递给正文函数。它保证当正文返回时文件被关闭。这种“withBlah”模式在处理昂贵的资源时非常常见。 System.Exception.bracket 直接支持此资源模式。

Answer 2

延迟 IO 非常容易出错。

按照dons的建议，你应该使用严格的IO。

您可以使用 Iteratee 等工具来帮助您构建严格的 IO 代码。我最喜欢的工具是一元列表。

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 lists/ListT 来自 hackage 上的 "List" 包（transformers' 和 mtl 的 ListT 已损坏，也没有像 takeWhile 这样的有用功能）

Answer 3

注意：我稍微编辑了我的代码以反映Duncan Coutts's answer 中的建议。即使在此编辑之后，他的答案显然比我的要好得多，而且似乎并没有以同样的方式耗尽内存。

---

这是我对基于Iteratee 的版本的快速尝试。当我在包含大约 2,000 个小 (30-80K) 文件的目录上运行它时，它比 your version here 快大约 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。 （如果我在这里做了一些可怕的事情，我深表歉意——我是这个东西的初学者。）

Answer 4

编辑：我的假设是用户打开了数千个非常小的文件，结果它们非常大。懒惰是必不可少的。

嗯，您需要使用不同的 IO 机制。要么：

• 严格 IO（使用 Data.ByteString 或 System.IO.Strict 处理文件
• 或者，Iteratee IO（目前仅供专家使用）。

我也强烈建议不要使用“解包”，因为这会破坏使用字节串的好处。

例如，您可以将惰性 IO 替换为 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)

Answer 5

问题在于 mapM 并不像你想象的那么懒惰——它会产生一个完整的列表，每个文件路径都有一个元素。而且您使用的文件 IO 是惰性的，因此您会得到一个列表，其中每个文件路径都有一个打开的文件。

在这种情况下，最简单的解决方案是强制评估每个文件路径的哈希值。一种方法是使用Control.Exception.evaluate：

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

正如其他人所指出的，我们正在努力替代当前的惰性 IO 方法，该方法更通用但仍然简单。

Answer 6

编辑：抱歉，我认为问题出在文件上，而不是字典读取/遍历。忽略这个。

没问题，只需显式打开文件（openFile），读取内容（Data.ByteString.Lazy.hGetContents），执行 md5 哈希（让 !h = md5 内容），然后显式关闭文件（hClose）。

Answer 7

unsafeInterleaveIO?

想到的另一个解决方案是使用来自System.IO.Unsafe 的unsafeInterleaveIO。请参阅 Haskell 咖啡馆 this thread Tomasz Zielonka 的回复。

它将输入-输出操作（打开文件）推迟到实际需要时。因此可以避免一次打开所有文件，而是按顺序读取和处理它们（懒惰地打开它们）。

现在，我相信mapM getFileLine 打开所有文件，但直到putStr . unlines 才开始读取它们。因此，许多带有打开文件处理程序的 thunk 都会四处飘荡，这就是问题所在。 （如果我错了，请纠正我）。

一个例子

现在，modified example with unsafeInterleaveIO 在恒定空间中针对 100 GB 目录运行了几分钟。

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实现散列）

附：我不确定这是否是好的风格。我相信具有迭代和严格 IO 的解决方案更好，但这个解决方案更快。我在小脚本中使用它，但我害怕在更大的程序中依赖它。