Question

我正在编写一个程序，该程序为目录中的每个图像文件创建一个包含一个命令的shell脚本。目录中有667,944个图像，因此我需要正确处理严格/懒惰问题。

这是一个给我Stack space overflow的简单示例。如果我使用+RTS -Ksize -RTS为它提供更多空间，它确实有效，但它应该能够以很少的内存运行，立即产生输出。所以我一直在阅读有关Haskell wiki中的严格性和Haskell上的wikibook的内容，试图弄清楚如何解决问题，我认为它是给我的mapM命令之一悲伤，但我仍然不太了解严格来解决这个问题。

我在SO上发现了一些似乎相关的其他问题（Is mapM in Haskell strict? Why does this program get a stack overflow?和Is Haskell's mapM not lazy?），但启蒙仍然没有找到我。

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.

如果我用命令./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

......等等。

Answer 1

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

在这种情况下，简单的解决方法是在同一genCommand内同时运行putStrLn和mapM_。请注意，mapM_不会遇到同样的问题，因为它没有构建中间列表。

mapM_ (genCommand indir outdir >=> putStrLn) imageFiles

以上使用来自Control.Monad的“kleisli组合运算符”>=>，它与函数组合运算符.类似，但monadic函数除外。您还可以使用普通绑定和lambda。

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

对于希望在小型monadic流处理器之间实现更好的可组合性的更复杂的I / O应用程序，您应该使用conduit或pipes等库。

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

（*）确切地说，也是严格性问题，因为除了在内存中构建一个大的中间列表之外，懒惰导致mapM构建不必要的thunks并使用堆栈。

编辑：所以似乎主要罪魁祸首可能是getDirectoryContents。查看函数的source code，它基本上在内部执行与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之类的功能组合功能的能力。 $=运算符在链中向前传输内容，$$将流连接到使用者。

不太好的事情是现实世界很复杂，编写高效而强大的代码需要我们通过资源管理来跳过一些环节。这就是为什么所有操作都在ResourceT monad变换器中工作，它跟踪例如打开文件处理并在不再需要它们时立即和确定地清理它们，或者例如如果计算被异常中止（这与使用惰性I / O并依赖垃圾收集器最终释放任何稀缺资源相反）。

但是，这意味着我们 a）需要使用runResourceT和 b）运行最终生成的管道操作，我们需要明确提升I / O使用liftIO对变换后的monad进行操作，而不是直接写入例如L.mapM_ putStrLn。

堆栈空间溢出（可能与mapM有关）

1 个答案: