{- testing properties of directories
 -
 - Copyright 2011-2018 Joey Hess <id@joeyh.name>
 -
 - 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 :: FilePath -> IO Bool
isDirectoryEmpty FilePath
d = FilePath -> (FilePath -> Bool) -> IO Bool
testDirectory FilePath
d FilePath -> Bool
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 :: FilePath -> IO Bool
isUnpopulated FilePath
d = forall (m :: * -> *) a. MonadCatch m => a -> m a -> m a
catchDefaultIO Bool
True forall a b. (a -> b) -> a -> b
$ FilePath -> (FilePath -> Bool) -> IO Bool
testDirectory FilePath
d FilePath -> Bool
fsCruft

fsCruft :: FilePath -> Bool
fsCruft :: FilePath -> Bool
fsCruft FilePath
"lost+found" = Bool
True
fsCruft FilePath
d = FilePath -> Bool
dirCruft FilePath
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 :: FilePath -> (FilePath -> Bool) -> IO Bool
testDirectory FilePath
d FilePath -> Bool
test = forall (m :: * -> *) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket (FilePath -> IO DirectoryHandle
openDirectory FilePath
d) DirectoryHandle -> IO ()
closeDirectory DirectoryHandle -> IO Bool
check
  where
	check :: DirectoryHandle -> IO Bool
check DirectoryHandle
h = do
		Maybe FilePath
v <- DirectoryHandle -> IO (Maybe FilePath)
readDirectory DirectoryHandle
h
		case Maybe FilePath
v of
			Maybe FilePath
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
			Just FilePath
f
				| Bool -> Bool
not (FilePath -> Bool
test FilePath
f) -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
				| Bool
otherwise -> DirectoryHandle -> IO Bool
check DirectoryHandle
h