1 files changed, 99 insertions, 4 deletions

diff --git a/Utility/Directory.hs b/Utility/Directory.hs
index f1bcfad..ade5ef8 100644
--- a/Utility/Directory.hs
+++ b/Utility/Directory.hs
@@ -1,8 +1,8 @@
-{- directory manipulation
+{- directory traversal and manipulation
  -
  - Copyright 2011-2014 Joey Hess <joey@kitenet.net>
  -
- - Licensed under the GNU GPL version 3 or higher.
+ - License: BSD-2-clause
  -}
 
 {-# LANGUAGE CPP #-}
@@ -11,12 +11,20 @@ module Utility.Directory where
 
 import System.IO.Error
 import System.Directory
-import Control.Exception (throw)
+import Control.Exception (throw, bracket)
 import Control.Monad
 import Control.Monad.IfElse
 import System.FilePath
 import Control.Applicative
+import Control.Concurrent
 import System.IO.Unsafe (unsafeInterleaveIO)
+import Data.Maybe
+
+#ifdef mingw32_HOST_OS
+import qualified System.Win32 as Win32
+#else
+import qualified System.Posix as Posix
+#endif
 
 import Utility.PosixFiles
 import Utility.SafeCommand
@@ -43,7 +51,7 @@ dirContents d = map (d </>) . filter (not . dirCruft) <$> getDirectoryContents d
  - When the directory does not exist, no exception is thrown,
  - instead, [] is returned. -}
 dirContentsRecursive :: FilePath -> IO [FilePath]
-dirContentsRecursive topdir = dirContentsRecursiveSkipping (const False) True topdir
+dirContentsRecursive = dirContentsRecursiveSkipping (const False) True
 
 {- Skips directories whose basenames match the skipdir. -}
 dirContentsRecursiveSkipping :: (FilePath -> Bool) -> Bool -> FilePath -> IO [FilePath]
@@ -133,3 +141,90 @@ nukeFile file = void $ tryWhenExists go
 #else
 	go = removeFile file
 #endif
+
+#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
+
+-- 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