ディレクトリ走査関数と遅延I/O

Find.hs

module Find where
import Control.Applicative
import Control.Exception (bracket)
import Data.List (isInfixOf)
import Prelude hiding (catch)
import System.Directory (getDirectoryContents, doesDirectoryExist, getPermissions, searchable)
import System.FilePath ((</>))
import System.Posix (openDirStream, closeDirStream, readDirStream)
import UnfoldrM

getValidContents :: FilePath -> IO [String]
getValidContents path =
  filter (`notElem` [".", "..", ".git", ".svn"]) <$> getDirectoryContents path

isSearchableDir :: FilePath -> IO Bool
isSearchableDir dir =
  (&&) <$> doesDirectoryExist dir
       <*> (searchable <$> getPermissions dir)

data DEntry = File FilePath | Dir (IO [DEntry])

getRecursiveContents :: FilePath -> IO [DEntry]
getRecursiveContents dir = map (dir </>) <$> getValidContents dir >>= mapM toDEntry
  where toDEntry :: FilePath -> IO DEntry
        toDEntry path = do
          isDir <- isSearchableDir path
          if isDir
            then return $ Dir $ getRecursiveContents path
            else File <$> pure path

grep :: String -> [DEntry] -> IO ()
grep pattern = mapM_ go
  where go (File f)
          | pattern `isInfixOf` f = putStrLn f
          | otherwise             = return ()
        go (Dir mdentries)        = mdentries >>= grep pattern

find :: FilePath -> String -> IO ()
find dir pattern = getRecursiveContents dir >>= grep pattern

unsafeGetDirectoryContents :: FilePath -> IO [FilePath]
unsafeGetDirectoryContents path = openDirStream path >>= unsafeUnfoldrIO phi
  where phi dirp = do
          e <- readDirStream dirp
          if null e
            then return Nothing
            else return $ Just (e, dirp)

unsafeGetDirectoryContents' :: FilePath -> IO [FilePath]
unsafeGetDirectoryContents' path =
  bracket (openDirStream path) closeDirStream (unsafeUnfoldrIO phi)
  where phi dirp = do
          e <- readDirStream dirp
          if null e
            then return Nothing
            else return $ Just (e, dirp)