From 3328fb83373adad786e57d4ed47e1d801e14260f Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 30 Dec 2018 15:08:55 -0400 Subject: Merged Utility changes from git-annex Last done in May 2017.. --- src/Utility/Directory/Stream.hs | 130 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 130 insertions(+) create mode 100644 src/Utility/Directory/Stream.hs (limited to 'src/Utility/Directory/Stream.hs') diff --git a/src/Utility/Directory/Stream.hs b/src/Utility/Directory/Stream.hs new file mode 100644 index 00000000..e827ef21 --- /dev/null +++ b/src/Utility/Directory/Stream.hs @@ -0,0 +1,130 @@ +{- streaming directory traversal + - + - 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 + +#ifdef mingw32_HOST_OS +import qualified System.Win32 as Win32 +#else +import qualified System.Posix as Posix +#endif + +import Utility.Directory +import Utility.Exception + +#ifndef mingw32_HOST_OS +data DirectoryHandle = DirectoryHandle IsOpen Posix.DirStream +#else +data DirectoryHandle = DirectoryHandle IsOpen Win32.HANDLE Win32.FindData (MVar ()) +#endif + +type IsOpen = MVar () -- full when the handle is open + +openDirectory :: FilePath -> IO DirectoryHandle +openDirectory path = do +#ifndef mingw32_HOST_OS + dirp <- Posix.openDirStream path + isopen <- newMVar () + return (DirectoryHandle isopen dirp) +#else + (h, fdat) <- Win32.findFirstFile (path "*") + -- Indicate that the fdat contains a filename that readDirectory + -- has not yet returned, by making the MVar be full. + -- (There's always at least a "." entry.) + alreadyhave <- newMVar () + isopen <- newMVar () + return (DirectoryHandle isopen h fdat alreadyhave) +#endif + +closeDirectory :: DirectoryHandle -> IO () +#ifndef mingw32_HOST_OS +closeDirectory (DirectoryHandle isopen dirp) = + whenOpen isopen $ + Posix.closeDirStream dirp +#else +closeDirectory (DirectoryHandle isopen h _ alreadyhave) = + whenOpen isopen $ do + _ <- tryTakeMVar alreadyhave + Win32.findClose h +#endif + where + whenOpen :: IsOpen -> IO () -> IO () + whenOpen mv f = do + 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. +readDirectory :: DirectoryHandle -> IO (Maybe FilePath) +#ifndef mingw32_HOST_OS +readDirectory hdl@(DirectoryHandle _ dirp) = do + e <- Posix.readDirStream dirp + if null e + then do + closeDirectory hdl + return Nothing + else return (Just e) +#else +readDirectory hdl@(DirectoryHandle _ h fdat mv) = do + -- If the MVar is full, then the filename in fdat has + -- not yet been returned. Otherwise, need to find the next + -- file. + r <- tryTakeMVar mv + case r of + Just () -> getfn + Nothing -> do + more <- Win32.findNextFile h fdat + if more + then getfn + else do + closeDirectory hdl + return Nothing + where + getfn = do + filename <- Win32.getFindDataFileName fdat + return (Just filename) +#endif + +-- | 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 + where + check h = do + v <- readDirectory h + case v of + Nothing -> return True + Just f + | not (dirCruft f) -> return False + | otherwise -> check h -- cgit v1.2.3