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 []