LIB: make deleteDirRecursive more robust

We now try 'deleteDir' first and only start recursive removal
if that fails.
This commit is contained in:
Julian Ospald 2016-05-03 11:54:25 +02:00
parent 4a86b4d2cf
commit 6ec455b515
No known key found for this signature in database
GPG Key ID: 511B62C09D50CD28

View File

@ -71,8 +71,10 @@ import Data.Word
) )
import Foreign.C.Error import Foreign.C.Error
( (
eINVAL eEXIST
, eINVAL
, eNOSYS , eNOSYS
, eNOTEMPTY
, eXDEV , eXDEV
) )
import Foreign.C.Types import Foreign.C.Types
@ -416,17 +418,20 @@ deleteDir p = P.withAbsPath p removeDirectory
-- * not atomic -- * not atomic
-- * examines filetypes explicitly -- * examines filetypes explicitly
deleteDirRecursive :: Path Abs -> IO () deleteDirRecursive :: Path Abs -> IO ()
deleteDirRecursive p = do deleteDirRecursive p =
files <- getDirsFiles p catchErrno [eNOTEMPTY, eEXIST]
for_ files $ \file -> do (deleteDir p)
ftype <- getFileType file $ do
case ftype of files <- getDirsFiles p
SymbolicLink -> deleteFile file for_ files $ \file -> do
Directory -> deleteDirRecursive file ftype <- getFileType file
RegularFile -> deleteFile file case ftype of
_ -> ioError $ userError $ "No idea what to do with the" ++ SymbolicLink -> deleteFile file
"given filetype: " ++ show ftype Directory -> deleteDirRecursive file
removeDirectory . P.toFilePath $ p RegularFile -> deleteFile file
_ -> ioError $ userError $ "No idea what to do with the" ++
"given filetype: " ++ show ftype
removeDirectory . P.toFilePath $ p
-- |Deletes a file, directory or symlink, whatever it may be. -- |Deletes a file, directory or symlink, whatever it may be.