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/TestDirectory.hs | 40 ++++++++++++++++++++++++++++++++++ 1 file changed, 40 insertions(+) create mode 100644 src/Utility/Directory/TestDirectory.hs (limited to 'src/Utility/Directory/TestDirectory.hs') diff --git a/src/Utility/Directory/TestDirectory.hs b/src/Utility/Directory/TestDirectory.hs new file mode 100644 index 00000000..e1f961b9 --- /dev/null +++ b/src/Utility/Directory/TestDirectory.hs @@ -0,0 +1,40 @@ +{- testing properties of directories + - + - Copyright 2011-2018 Joey Hess + - + - License: BSD-2-clause + -} + +module Utility.Directory.TestDirectory where + +import Utility.Directory +import Utility.Directory.Stream +import Utility.Exception + +-- | 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 + +fsCruft :: FilePath -> Bool +fsCruft "lost+found" = True +fsCruft d = dirCruft d + +-- | 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 -- cgit v1.2.3