LIB: make deleteDirRecursive more robust
We now try 'deleteDir' first and only start recursive removal if that fails.
This commit is contained in:
parent
4a86b4d2cf
commit
6ec455b515
@ -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.
|
||||||
|
Loading…
Reference in New Issue
Block a user