Question

I writed a Haskell module to list all the contents of a directory by breadth-first order. The below is the source code.

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

It works correct but when performing on a large directory, it will “suspend” for a little while, and spring out all the results.

After a research I find it is the same question with sequence $ map return [1..]::[[Int]] see Why the Haskell sequence function can’t be lazy or why recursive monadic functions can’t be lazy

Answer 1

I modified the older answer that Davorak linked to to use the new pipes library.

It uses StateP to keep a queue of untraversed directories so that it can do a breadth first traversal. It uses MaybeP for exiting from the loop, as a convenience.

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)

This defines a breadth-first lazy producer of files. If you hook it up to a printing stage, it will print out the files as it traverses the tree:

main = runProxy $ evalStateK empty $ runMaybeK $
    traverseTree "/tmp" >-> putStrLnD

Laziness means that if you only demand 3 files, it will only traverse the tree as much as necessary to generate three files, then it will stop:

    main = runProxy $ evalStateK empty $ runMaybeK $
        traverseTree "/tmp" >-> takeB_ 3 >-> putStrLnD

If you want to learn more about the pipes library, then I recommend you read the tutorial.