按广度优先顺序列出目录的所有内容会导致效率低下

Tor*_*nny 4 io performance haskell loops lazy-evaluation

我写了一个Haskell模块,按宽度优先顺序列出目录的所有内容.以下是源代码.

module DirElements (dirElem) where

import System.Directory (getDirectoryContents, doesDirectoryExist)
import System.FilePath ((</>))

dirElem :: FilePath -> IO [[FilePath]]
dirElem dirPath = iterateM (not.null) (concatMapM getDirectoryContents') [dirPath] >>= return.tail

getDirectoryContents' :: FilePath -> IO [FilePath]
getDirectoryContents' dirPath = do
  isDir <- do doesDirectoryExist dirPath
  if isDir then dirContent else return [] where
    dirContent = do
      contents <- getDirectoryContents dirPath
      return.(map (dirPath</>)).tail.tail $ contents

iterateM :: (Monad m) => (a -> Bool) -> (a -> m a) -> a -> m [a]
iterateM fb f x = do --Notice: Due to the the implementation of >>=, iterateM can't be writen like iterate which gives a infinite list and have type of iterateM :: (Monad m) => (a -> Bool) -> (a -> m a) -> a -> m [a]
  if fb x
    then do
      tail <- do {fx <- f x; iterateM fb f fx}
      return (x:tail)
    else return []

concatMapM :: Monad m => (a -> m[b]) -> [a] -> m[b]
concatMapM f list = mapM f list >>= return.concat
Run Code Online (Sandbox Code Playgroud)

它工作正常,但在大型目录上执行时,它会"暂停"一段时间,并弹出所有结果.

经过研究后我发现它是同一个问题,sequence $ map return [1..]::[[Int]]看看为什么Haskell序列函数不能延迟或为什么递归monadic函数不能懒惰

Dav*_*rak 12

这偶尔出现,答案最终是使用像库这样的iteratee.最近经常建议的是代理库.

我以前见过Conduit解决方案和一些优雅的monadic解决方案,但我现在还没有找到它们.


ert*_*tes 9

首先,这与严格性无关.像许多monad一样,IO在其monadic操作中实际上是非常规的.这与懒惰与急切的I/O有关.

问题是您首先执行目录遍历,然后处理结果.您可以通过使用协程来交错它们来改善它.一种简单的方法是使目录遍历将回调作为参数:

getDirectoryContents' :: (MonadIO m) => (FilePath -> m a) -> FilePath -> m ()
getDirectoryContents' k fp = {- ... -}
Run Code Online (Sandbox Code Playgroud)

这是最简单,最不灵活的解决方案.更灵活的解决方案是实际执行协同程序.您可以通过推出自己的协同程序单子免费,单子,协程操作,或者您可以使用许多流抽象,如一个管道,枚举管道与最后一个是我的简单的情况下,像这样的个人recommentation.


Gab*_*lez 6

我修改了Davorak链接到的旧答案以使用新pipes库.

它用于StateP保留未遍历目录的队列,以便它可以进行广度优先遍历.MaybeP为方便起见,它用于退出循环.

import Control.Monad
import Control.Proxy
import Control.Proxy.Trans.Maybe
import Control.Proxy.Trans.State as S
import Data.Sequence hiding (filter)
import System.FilePath.Posix
import System.Directory

getUsefulContents :: FilePath -> IO [FilePath]
getUsefulContents path
  = fmap (filter (`notElem` [".", ".."])) $ getDirectoryContents path

traverseTree
    :: (Proxy p)
    => FilePath
    -> () -> Producer (MaybeP (StateP (Seq FilePath) p)) FilePath IO r
traverseTree path () = do
    liftP $ S.modify (|> path)
    forever $ do
        x <- liftP $ S.gets viewl
        case x of
            EmptyL    -> mzero
            file :< s -> do
                liftP $ S.put s
                respond file
                p <- lift $ doesDirectoryExist file
                when p $ do
                    names <- lift $ getUsefulContents file
                    let namesfull = map (file </>) names
                    liftP $ forM_ namesfull $ \name ->
                        S.modify (|> name)
Run Code Online (Sandbox Code Playgroud)

这定义了一个广度优先的懒惰文件生成器.如果将它连接到打印阶段,它将在遍历树时打印出文件:

main = runProxy $ evalStateK empty $ runMaybeK $
    traverseTree "/tmp" >-> putStrLnD
Run Code Online (Sandbox Code Playgroud)

懒惰意味着如果你只需要3个文件,它只会根据需要遍历树来生成三个文件,然后它会停止:

    main = runProxy $ evalStateK empty $ runMaybeK $
        traverseTree "/tmp" >-> takeB_ 3 >-> putStrLnD
Run Code Online (Sandbox Code Playgroud)

如果您想了解有关该pipes库的更多信息,那么我建议您阅读本教程.