summaryrefslogtreecommitdiff
path: root/src/Utility/Directory.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Utility/Directory.hs')
-rw-r--r--src/Utility/Directory.hs114
1 files changed, 4 insertions, 110 deletions
diff --git a/src/Utility/Directory.hs b/src/Utility/Directory.hs
index e13191e4..e2c6a946 100644
--- a/src/Utility/Directory.hs
+++ b/src/Utility/Directory.hs
@@ -16,22 +16,18 @@ module Utility.Directory (
import System.IO.Error
import Control.Monad
import System.FilePath
+import System.PosixCompat.Files
import Control.Applicative
-import Control.Concurrent
import System.IO.Unsafe (unsafeInterleaveIO)
import Data.Maybe
import Prelude
-#ifdef mingw32_HOST_OS
-import qualified System.Win32 as Win32
-#else
-import qualified System.Posix as Posix
+#ifndef mingw32_HOST_OS
import Utility.SafeCommand
import Control.Monad.IfElse
#endif
import Utility.SystemDirectory
-import Utility.PosixFiles
import Utility.Tmp
import Utility.Exception
import Utility.Monad
@@ -42,10 +38,6 @@ dirCruft "." = True
dirCruft ".." = True
dirCruft _ = False
-fsCruft :: FilePath -> Bool
-fsCruft "lost+found" = True
-fsCruft d = dirCruft d
-
{- Lists the contents of a directory.
- Unlike getDirectoryContents, paths are not relative to the directory. -}
dirContents :: FilePath -> IO [FilePath]
@@ -100,10 +92,10 @@ dirTreeRecursiveSkipping skipdir topdir = go [] [topdir]
go c (dir:dirs)
| skipdir (takeFileName dir) = go c dirs
| otherwise = unsafeInterleaveIO $ do
- subdirs <- go c
+ subdirs <- go []
=<< filterM (isDirectory <$$> getSymbolicLinkStatus)
=<< catchDefaultIO [] (dirContents dir)
- go (subdirs++[dir]) dirs
+ go (subdirs++dir:c) dirs
{- Moves one filename to another.
- First tries a rename, but falls back to moving across devices if needed. -}
@@ -162,101 +154,3 @@ 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 = testDirectory d dirCruft
-
--- | True if the directory does not exist or contains nothing.
--- Ignores "lost+found" which can exist in an empty filesystem.
-isUnpopulated :: FilePath -> IO Bool
-isUnpopulated d = catchDefaultIO True $ testDirectory d fsCruft
-
--- | Run test on entries found in directory, return False as soon as the
--- test returns False, else return True. Throws exception if directory does
--- not exist.
-testDirectory :: FilePath -> (FilePath -> Bool) -> IO Bool
-testDirectory d test = bracket (openDirectory d) closeDirectory check
- where
- check h = do
- v <- readDirectory h
- case v of
- Nothing -> return True
- Just f
- | not (test f) -> return False
- | otherwise -> check h