目录树的广度优先遍历并不懒惰

我尝试遍历目录树。简单的深度优先遍历似乎不会以惰性方式生成数据，并且会耗尽内存。接下来，我尝试了广度优先方法，该方法显示了相同的问题 - 它使用了所有可用内存，然后崩溃。

我的代码是：

getFilePathBreadtFirst :: FilePath -> IO [FilePath]
getFilePathBreadtFirst fp = do
  fileinfo <- getInfo fp 
  res :: [FilePath]  <- if isReadableDirectory fileinfo
          then do
                children  <- getChildren fp 
                lower    <-  mapM getFilePathBreadtFirst children  
                return (children ++  concat lower)
           else return [fp]        -- should only return the files? 
  return res 

getChildren :: FilePath -> IO [FilePath]
getChildren path = do 
          names <- getUsefulContents path
          let namesfull = map (path </>) names
          return namesfull

testBF fn = do  -- crashes for /home/frank, does not go to swap 
  fps <- getFilePathBreadtFirst fn
  putStrLn $ unlines fps

我认为所有代码要么是线性的，要么是尾递归的，我希望文件名列表立即开始，但事实上并非如此。我的代码和思路哪里出了问题？我在哪里失去了懒惰的评估？

我将使用三个单独的技巧来解决你的问题。

• Trick 1： 使用pipes用于在遍历树的同时流式传输文件名的库。
• Trick 2： 使用StateT (Seq FilePath)Transformer 来实现广度优先遍历。
• Trick 3： 使用MaybeT变压器以避免在编写循环和退出时手动递归。

以下代码将这三种技巧组合在一个 monad 转换器堆栈中。

import Control.Monad
import Control.Monad.Trans
import Control.Monad.Trans.Maybe
import Control.Monad.State.Lazy
import Control.Pipe
import Data.Sequence
import System.FilePath.Posix
import System.Directory

loop :: (Monad m) => MaybeT m a -> m ()
loop = liftM (maybe () id) . runMaybeT . forever

quit :: (Monad m) => MaybeT m a
quit = mzero

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

permissible :: FilePath -> IO Bool
permissible file
  = fmap (\p -> readable p && searchable p) $ getPermissions file

traverseTree :: FilePath -> Producer FilePath IO ()
traverseTree path = (`evalStateT` empty) $ loop $ do
    -- All code past this point uses the following monad transformer stack:
    -- MaybeT (StateT (Seq FilePath) (Producer FilePath IO)) ()
    let liftState = lift
        liftPipe  = lift . lift
        liftIO    = lift . lift . lift
    liftState $ modify (|> path)
    forever $ do
        x <- liftState $ gets viewl
        case x of
            EmptyL    -> quit
            file :< s -> do
                liftState $ put s
                liftPipe $ yield file
                p <- liftIO $ doesDirectoryExist file
                when p $ do
                    names <- liftIO $ getUsefulContents file
                    -- allowedNames <- filterM permissible names
                    let namesfull = map (path </>) names
                    liftState $ forM_ namesfull $ \name -> modify (|> name)

这将创建一个广度优先文件名生成器，可以与树遍历同时使用。您可以使用以下方式使用这些值：

printer :: (Show a) => Consumer a IO r
printer = forever $ do
    a <- await
    lift $ print a

>>> runPipe $ printer <+< traverseTree path
<Prints file names as it traverses the tree>

您甚至可以选择不要求所有值：

-- Demand only 'n' elements
take' :: (Monad m) => Int -> Pipe a a m ()
take' n = replicateM_ n $ do
    a <- await
    yield a

>> runPipe $ printer <+< take' 3 <+< traverseTree path
<Prints only three files>

更重要的是，最后一个示例将仅遍历树以生成三个文件所需的次数，然后它将停止。当您想要的只是 3 个结果时，这可以防止浪费地遍历整个树！

要了解更多有关pipes图书馆技巧，请参阅管道教程 http://hackage.haskell.org/packages/archive/pipes/2.3.0/doc/html/Control-Pipe-Tutorial.html at Control.Pipes.Tutorial.

要了解有关循环技巧的更多信息，请阅读此内容博客文章 http://www.haskellforall.com/2012/07/breaking-from-loop.html.

我找不到广度优先遍历的队列技巧的好链接，但我知道它就在那里。如果其他人知道这方面的好链接，只需编辑我的答案即可添加它。