From a8c91ce69a332f7756f131da196e0b28bbc4f54f Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 26 Apr 2018 13:17:23 -0400 Subject: [PATCH] add streamDirectoryContents --- Utility/Directory/Stream.hs | 27 ++++++++++++++++++++++----- 1 file changed, 22 insertions(+), 5 deletions(-) diff --git a/Utility/Directory/Stream.hs b/Utility/Directory/Stream.hs index ac62263a8c..e827ef21a2 100644 --- a/Utility/Directory/Stream.hs +++ b/Utility/Directory/Stream.hs @@ -1,17 +1,19 @@ {- streaming directory traversal - - - Copyright 2011-2014 Joey Hess + - Copyright 2011-2018 Joey Hess - - License: BSD-2-clause -} {-# LANGUAGE CPP #-} +{-# LANGUAGE LambdaCase #-} {-# OPTIONS_GHC -fno-warn-tabs #-} module Utility.Directory.Stream where import Control.Monad import System.FilePath +import System.IO.Unsafe (unsafeInterleaveIO) import Control.Concurrent import Data.Maybe import Prelude @@ -66,9 +68,8 @@ closeDirectory (DirectoryHandle isopen h _ alreadyhave) = v <- tryTakeMVar mv when (isJust v) f -{- |Reads the next entry from the handle. Once the end of the directory -is reached, returns Nothing and automatically closes the handle. --} +-- | Reads the next entry from the handle. Once the end of the directory +-- is reached, returns Nothing and automatically closes the handle. readDirectory :: DirectoryHandle -> IO (Maybe FilePath) #ifndef mingw32_HOST_OS readDirectory hdl@(DirectoryHandle _ dirp) = do @@ -99,7 +100,23 @@ readDirectory hdl@(DirectoryHandle _ h fdat mv) = do return (Just filename) #endif --- True only when directory exists and contains nothing. +-- | Like getDirectoryContents, but rather than buffering the whole +-- directory content in memory, lazily streams. +-- +-- This is like lazy readFile in that the handle to the directory remains +-- open until the whole list is consumed, or until the list is garbage +-- collected. So use with caution particularly when traversing directory +-- trees. +streamDirectoryContents :: FilePath -> IO [FilePath] +streamDirectoryContents d = openDirectory d >>= collect + where + collect hdl = readDirectory hdl >>= \case + Nothing -> return [] + Just f -> do + rest <- unsafeInterleaveIO (collect hdl) + return (f:rest) + +-- | True only when directory exists and contains nothing. -- Throws exception if directory does not exist. isDirectoryEmpty :: FilePath -> IO Bool isDirectoryEmpty d = bracket (openDirectory d) closeDirectory check