treeコマンドを実装してみました

ファイルの階層構造を見易く表示するtreeコマンドを実装してみました。関数tree、traverseDirectory、traverseDirectory'あたりにリファクタリングの余地がありそうですが、この辺でやめておきます。ディレクトリをトラバースする処理と表示する処理を分けた方が再利用性があがるような気がします(RubyでいうところのFindモジュールみたいな感じで分離した方がよさそう)。
ファイル: tree.hs

import System
import System.Directory
import Control.Monad
import Data.List

main :: IO ()
main = do args <- getArgs
          tree $ if null args then "." else head args

tree :: String -> IO ()
tree path =
    do let prefix = ""
           isLast = True
       isDir <- doesDirectoryExist path
       unless isDir $ error $ "path is not directory. " ++ path
       putStrLn $ item prefix isLast ++ path
       traverseDirectory (line prefix isLast) path
    where
      traverseDirectory :: String -> String -> IO ()
      traverseDirectory prefix dir =
          do paths <- getDirectoryContents dir
             traverseDirectory' prefix $ collectAbsolutePaths dir paths

      collectAbsolutePaths :: String -> [String] -> [String]
      collectAbsolutePaths dir =
          map (\p -> dir ++ "/" ++ p) . filter (\p -> p /= "." && p /= "..")

      traverseDirectory' :: String -> [String] -> IO ()
      traverseDirectory' _ [] = return ()
      traverseDirectory' prefix (path:paths) =
          do let isLast = null paths
             isDir <- doesDirectoryExist path
             putStrLn $ item prefix isLast ++ basename path
             when isDir $ traverseDirectory (line prefix isLast) path
             traverseDirectory' prefix paths

      item :: String -> Bool -> String
      item prefix isLast = prefix ++ (if isLast then "`- " else "+- ")
                           
      line :: String -> Bool -> String
      line prefix isLast = prefix ++ (if isLast then "    " else "|   ")

basename :: String -> String
basename path = let rpath = reverse path
                in case (findIndex (\c-> c == '/') rpath ) of
                     Just index -> reverse $ take index rpath
                     Nothing -> path

以下、実行例です。

$ ./tree.exe
`- .
    +- Makefile
    +- test
    |   +- a.txt
    |   +- b.txt
    |   +- c.txt
    |   `- hoge
    |       `- foo.txt
    +- test2
    |   +- a.txt
    |   +- b.txt
    |   +- c.txt
    |   `- hoge
    |       `- foo.txt
    +- tree.exe
    +- tree.hi
    +- tree.hs
    `- tree.o

いやHaskellでプログラミングは楽しいな。なぜだかわかりませんが(ただ実装するだけだったらどう考えてもRubyの方がお気楽なんだもの)。まだ関数合成とか部分適用とか型クラスとかモナドとかいろいろ分かってないことが多いです。勉強要です。