Recursive directory tree printer

Question

I wrote this program that recursively prints all the files and directories starting at the current directory:

import Data.Tree (Tree (..))
import System.Directory (doesDirectoryExist, getCurrentDirectory, getDirectoryContents)

main :: IO ()
main = do
  currentDirectory <- getCurrentDirectory
  tree <- tree currentDirectory "."
  printTree 0 tree

printTree :: Int -> Tree FilePath -> IO ()
printTree indent tree = do
  putStrLn $ (replicate indent ' ' ++ rootLabel tree)
  mapM_ (printTree $ indent + 2) (subForest tree)

treeHelper :: FilePath -> IO [Tree FilePath]
treeHelper path =
  let filter' = filter (`notElem` [".", ".."]) in
  do
    contents <- getDirectoryContents path
    trees <- mapM (tree path) (filter' contents)
    return trees

tree :: FilePath -> FilePath -> IO (Tree FilePath)
tree parent path =
  let fullPath = (parent ++ "/" ++ path) in
  do
    isDirectory <- doesDirectoryExist fullPath
    case isDirectory of
      False -> return $ Node path []
      True -> treeHelper fullPath >>= (return . Node (path ++ "/"))

If you run it, it might print something like this:

./
  dist/
    build/
      autogen/
        cabal_macros.h
        Paths_Tree.hs
      tree/
        tree
        tree-tmp/
          Main.hi
          Main.o
    package.conf.inplace
    setup-config
  Setup.lhs
  tree.cabal
  Tree.hs

I think this is pretty nifty. It's a toy program, so I purposefully left out stuff like error checking and symlink handling and etc. How would you improve this program? Am I duplicating functionality available in a library? Are there places where the code could be tighter? Is my Haskell style not up to snuff?

Answer 1

You can also use unfoldTree (or unfoldTreeM here) to build Data.Tree:

import Control.Monad
import System.Directory
import System.FilePath
import Data.Tree


dirTree :: FilePath -> IO (Tree FilePath)
dirTree root = unfoldTreeM step (root,root)
    where step (f,c) = do
            fs <- getDirectoryContents f
            ds <- filterM doesDirectoryExist fs
            return (c, [(f </> d, d) | d <- ds, d /= "." && d /= ".."])

main :: IO ()
main = do
  t <- dirTree "."
  putStrLn $ drawTree t

Update: As Björn Lindqvist correctly noted in his edit suggestion, my use of doesDirectoryExist doesn't work here (it uses directory names instead of directory paths).

The correct version of dirTree would be:

dirTree :: FilePath -> IO (Tree FilePath)
dirTree root = unfoldTreeM step (root,root)
    where step (p, c) = do
            isDirectory <- doesDirectoryExist p
            fs <- if isDirectory then getDirectoryContents p else return []
            return (c, [(p </> f, f) | f <- fs, f `notElem` [".", ".."]])

Answer 2

Paths should be manipulated with functions from System.FilePath. You can also move let's inside the do's, replace the case on Bool with an if, and squeeze out the helper function with <$>.

import Control.Applicative
import System.FilePath ((</>), addTrailingPathSeparator)

tree :: FilePath -> FilePath -> IO (Tree FilePath)
tree parent path = do
  let fullPath = parent </> path
  isDirectory <- doesDirectoryExist fullPath
  if isDirectory
    then do
      paths <- filter (`notElem` [".", ".."]) <$> getDirectoryContents fullPath
      Node (addTrailingPathSeparator path) <$> mapM (tree fullPath) paths
  else return $ Node path []