3

我正在编写一个程序，该程序创建一个 shell 脚本，其中包含一个用于目录中每个图像文件的命令。目录中有 667,944 张图片，所以我需要妥善处理严格/懒惰的问题。

这是一个简单的例子，它给了我Stack space overflow。如果我给它更多空间使用它确实有效+RTS -Ksize -RTS，但它应该能够以很少的内存运行，立即产生输出。因此，我一直在阅读 Haskell wiki 和有关 Haskell 的 wikibook 中有关严格性的内容，试图找出解决问题的方法，我认为这是让我感到悲伤的 mapM 命令之一，但我仍然没有对严格性的理解不够，无法对问题进行排序。

我在 SO 上发现了一些其他似乎相关的问题（Haskell 中的 mapM 是否严格？为什么这个程序会出现堆栈溢出？以及Haskell 的 mapM 不懒惰吗？），但启蒙仍然让我望而却步。

import System.Environment (getArgs)
import System.Directory (getDirectoryContents)

genCommand :: FilePath -> FilePath -> FilePath -> IO String
genCommand indir outdir file = do
  let infile = indir ++ '/':file
  let angle = 0 -- have to actually read the file to calculate this for real
  let outfile = outdir ++ '/':file
  return $! "convert " ++ infile ++ " -rotate " ++ show angle ++ 
    " -crop 143x143+140+140 " ++ outfile

main :: IO ()
main = do
  putStrLn "#!/bin/sh"
  (indir:outdir:_) <- getArgs
  files <- getDirectoryContents indir
  let imageFiles = filter (`notElem` [".", ".."]) files
  commands <- mapM (genCommand indir outdir) imageFiles
  mapM_ putStrLn commands

编辑：测试#1

这是示例的最新版本。

import System.Environment (getArgs)
import System.Directory (getDirectoryContents)
import Control.Monad ((>=>))

genCommand :: FilePath -> FilePath -> FilePath -> IO String
genCommand indir outdir file = do
  let infile = indir ++ '/':file
  let angle = 0 -- have to actually read the file to calculate this for real
  let outfile = outdir ++ '/':file
  return $! "convert " ++ infile ++ " -rotate " ++ show angle ++ 
    " -crop 143x143+140+140 " ++ outfile

main :: IO ()
main = do
  putStrLn "TEST 1"
  (indir:outdir:_) <- getArgs
  files <- getDirectoryContents indir
  putStrLn $ show (length files)
  let imageFiles = filter (`notElem` [".", ".."]) files
  -- mapM_ (genCommand indir outdir >=> putStrLn) imageFiles
  mapM_ (\filename -> genCommand indir outdir filename >>= putStrLn) imageFiles

我用命令编译它ghc --make -O2 amy2.hs -rtsopts。如果我用命令运行它./amy2 ~/nosync/GalaxyZoo/table2/images/ wombat，我会得到

TEST 1
Stack space overflow: current size 8388608 bytes.
Use `+RTS -Ksize -RTS' to increase it.

如果我改为使用 command 运行它./amy2 ~/nosync/GalaxyZoo/table2/images/ wombat +RTS -K20M，我会得到正确的输出......最终：

TEST 1
667946
convert /home/amy/nosync/GalaxyZoo/table2/images//587736546846572812.jpeg -rotate 0 -crop 143x143+140+140 wombat/587736546846572812.jpeg
convert /home/amy/nosync/GalaxyZoo/table2/images//587736542558617814.jpeg -rotate 0 -crop 143x143+140+140 wombat/587736542558617814.jpeg

...等等。

4

1 回答 1

6

这实际上不是严格性问题（*），而是评估顺序问题。与惰性求值的纯值不同，一元效应必须以确定的顺序发生。mapM执行给定列表中的每个操作并收集结果，但在执行整个操作列表之前它无法返回，因此您不会获得与纯列表函数相同的流式处理行为。

在这种情况下，最简单的解决方法是在同genCommand一个. 请注意，它不会遇到同样的问题，因为它没有构建中间列表。putStrLnmapM_mapM_

mapM_ (genCommand indir outdir >=> putStrLn) imageFiles

上面使用了“kleisli 组合算子” >=>，除了一元函数外，Control.Monad它类似于函数组合算子.。您还可以使用普通绑定和 lambda。

mapM_ (\filename -> genCommand indir outdir filename >>= putStrLn) imageFiles

对于更复杂的 I/O 应用程序，您希望在小型单子流处理器之间具有更好的可组合性，您应该使用诸如conduit或之类的库pipes。

另外，请确保您使用-O或进行编译-O2。

(*) 确切地说，这也是一个严格性问题，因为除了在内存中构建一个大的中间列表之外，惰性还会导致mapM构建不必要的 thunk 并用完堆栈。

编辑：所以看来罪魁祸首可能是getDirectoryContents。查看函数的源代码，它本质上与mapM.

为了进行流式目录列表，我们需要使用System.Posix.Directory不幸的是使程序与非 POSIX 系统（如 Windows）不兼容。您可以通过例如使用延续传递样式流式传输目录内容

import System.Environment (getArgs)
import Control.Monad ((>=>))

import System.Posix.Directory (openDirStream, readDirStream, closeDirStream)
import Control.Exception (bracket)

genCommand :: FilePath -> FilePath -> FilePath -> IO String
genCommand indir outdir file = do
  let infile = indir ++ '/':file
  let angle = 0 -- have to actually read the file to calculate this for real
  let outfile = outdir ++ '/':file
  return $! "convert " ++ infile ++ " -rotate " ++ show angle ++
    " -crop 143x143+140+140 " ++ outfile

streamingDirContents :: FilePath -> (FilePath -> IO ()) -> IO ()
streamingDirContents root cont = do
    let loop stream = do
            fp <- readDirStream stream
            case fp of
                [] -> return ()
                _   | fp `notElem` [".", ".."] -> cont fp >> loop stream
                    | otherwise -> loop stream
    bracket (openDirStream root) loop closeDirStream


main :: IO ()
main = do
  putStrLn "TEST 1"
  (indir:outdir:_) <- getArgs
  streamingDirContents indir (genCommand indir outdir >=> putStrLn)

以下是您可以使用以下方法执行相同操作的方法conduit：

import System.Environment (getArgs)

import System.Posix.Directory (openDirStream, readDirStream, closeDirStream)

import Data.Conduit
import qualified  Data.Conduit.List as L
import Control.Monad.IO.Class (liftIO, MonadIO)

genCommand :: FilePath -> FilePath -> FilePath -> IO String
genCommand indir outdir file = do
  let infile = indir ++ '/':file
  let angle = 0 -- have to actually read the file to calculate this for real
  let outfile = outdir ++ '/':file
  return $! "convert " ++ infile ++ " -rotate " ++ show angle ++
    " -crop 143x143+140+140 " ++ outfile

dirSource :: (MonadResource m, MonadIO m) => FilePath -> Source m FilePath
dirSource root = do
    bracketP (openDirStream root) closeDirStream $ \stream -> do
        let loop = do
                fp <- liftIO $ readDirStream stream
                case fp of
                    [] -> return ()
                    _  -> yield fp >> loop
        loop

main :: IO ()
main = do
    putStrLn "TEST 1"
    (indir:outdir:_) <- getArgs
    let files    = dirSource indir $= L.filter (`notElem` [".", ".."])
        commands = files $= L.mapM (liftIO . genCommand indir outdir)

    runResourceT $ commands $$ L.mapM_ (liftIO . putStrLn)

这样做的好处conduit是，您重新获得了使用诸如管道版本filter和mapM. 操作员在$=链中向前传输内容$$并将流连接到消费者。

不太好的事情是现实世界很复杂，编写高效且健壮的代码需要我们在资源管理方面跳过一些障碍。这就是为什么所有操作都在ResourceTmonad 转换器中工作的原因，它跟踪例如打开的文件句柄，并在不再需要它们时迅速和确定地清理它们，或者例如，如果计算被异常中止（这与使用惰性 I /O 并依靠垃圾收集器最终释放任何稀缺资源）。

然而，这意味着我们a)需要运行最终生成的管道操作，runResourceT并且b)我们需要显式地将 I/O 操作提升到转换后的 monad，liftIO而不是能够直接编写 eg L.mapM_ putStrLn。

于 2013-04-18T15:32:00.430 回答