Идиоматический обход каталога io-streams

Я обсуждал код на Reddit, и мне стало любопытно о том, как это будет реализовано в io-streams. Рассмотрим следующий код, который проходит через структуру каталогов и выводит все имена файлов:

import           Control.Exception         (bracket)
import qualified Data.Foldable             as F
import           Data.Streaming.Filesystem (closeDirStream, openDirStream,
                                            readDirStream)
import           System.Environment        (getArgs)
import           System.FilePath           ((</>))

printFiles :: FilePath -> IO ()
printFiles dir = bracket
    (openDirStream dir)
    closeDirStream
    loop
  where
    loop ds = do
        mfp <- readDirStream ds
        F.forM_ mfp $ \fp' -> do
            let fp = dir </> fp'
            ftype <- getFileType fp
            case ftype of
                FTFile -> putStrLn fp
                FTFileSym -> putStrLn fp
                FTDirectory -> printFiles fp
                _ -> return ()
            loop ds

main :: IO ()
main = getArgs >>= mapM_ printFiles

Вместо того, чтобы просто печатать файлы, предположим, что мы хотим создать какое-то потоковое представление пути к файлу. Я знаю, как это будет работать в счетчике, канале и каналах. Однако, поскольку промежуточные шаги требуют приобретения дефицитного ресурса (DirStream), я не уверен, какой будет реализация для потоков ввода-вывода. Может ли кто-нибудь привести пример того, как это будет сделано?

Для сравнения вот реализация канала, что стало возможным благодаря bracketP и MonadResource. А вот как можно использовать код канала для реализации той же программы печати файлов, что и выше:

import           Control.Monad.IO.Class       (liftIO)
import           Control.Monad.Trans.Resource (runResourceT)
import           Data.Conduit                 (($$))
import           Data.Conduit.Filesystem      (sourceDirectoryDeep)
import qualified Data.Conduit.List            as CL
import           System.Environment           (getArgs)

main :: IO ()
main =
    getArgs >>= runResourceT . mapM_ eachRoot
  where
    -- False means don't traverse dir symlinks
    eachRoot root = sourceDirectoryDeep False root
                 $$ CL.mapM_ (liftIO . putStrLn)