ファイルを探す処理をconduitで書く

find.hs

{-# LANGUAGE RankNTypes #-}
import Data.Conduit
import qualified Data.Conduit.List as CL(consume, filter)
import Data.Conduit.Filesystem
import qualified Filesystem.Path as FP (FilePath, filename)
import Control.Monad.IO.Class(MonadIO)

pickup :: (Monad m) => FP.FilePath -> Consumer FP.FilePath m (Maybe FP.FilePath)
pickup target = await >>= pickup'
  where
    pickup' Nothing = return Nothing
    pickup' (Just path) | isTarget path = return (Just path)
                        | otherwise     = await >>= pickup'
    isTarget filePath = FP.filename filePath == target

findFiles :: (MonadIO m) => FP.FilePath -> FP.FilePath -> m [FP.FilePath]
findFiles root target = (traverse False root $$+ pickup target) >>= findContinue
  where
    findContinue (_,  Nothing)  = return []
    findContinue (src0, Just x) = (src0 $$++ pickup target) >>= findContinue >>= \xs -> return (x:xs)

find :: (MonadIO m) => FP.FilePath -> FP.FilePath -> m [FP.FilePath]
find root target = (traverse False root) $= CL.filter (\x -> FP.filename x == target) $$ CL.consume