Improve robustness of removePathForcibly

Fixes haskell#60.

System/Directory.hs

@@ -570,15 +570,22 @@ removeContentsRecursive path =
     mapM_ removePathRecursive [path </> x | x <- cont]
     removeDirectory path
 
--- | @'removePathForcibly@ removes a file or directory at /path/ together with
--- its contents and subdirectories. Symbolic links are removed without
--- affecting their the targets. If the path does not exist, nothing happens.
+-- | Removes a file or directory at /path/ together with its contents and
+-- subdirectories. Symbolic links are removed without affecting their the
+-- targets. If the path does not exist, nothing happens.
 --
 -- Unlike other removal functions, this function will also attempt to delete
 -- files marked as read-only or otherwise made unremovable due to permissions.
 -- As a result, if the removal is incomplete, the permissions or attributes on
 -- the remaining files may be altered.
 --
+-- If an entry within the directory vanishes while @removePathForcibly@ is
+-- running, it is silently ignored.
+--
+-- If an exception occurs while removing an entry, @removePathForcibly@ will
+-- still try to remove as many entries as it can before failing with an
+-- exception.  The first exception that it encountered is re-thrown.
+--
 -- @since 1.2.7.0
 removePathForcibly :: FilePath -> IO ()
 removePathForcibly path =
@@ -587,18 +594,32 @@ removePathForcibly path =
     dirType <- tryIOErrorType isDoesNotExistError (getDirectoryType path)
     case dirType of
       Left _              -> return ()
-      Right NotDirectory  -> removeFile path
-      Right DirectoryLink -> removeDirectory path
+      Right NotDirectory  -> ignoreDoesNotExistError (removeFile path)
+      Right DirectoryLink -> ignoreDoesNotExistError (removeDirectory path)
       Right Directory     -> do
-        mapM_ (removePathForcibly . (path </>)) =<< listDirectory path
-        removeDirectory path
+        ps <- listDirectory path
+        sequenceWithIOErrors_ $
+          [ removePathForcibly (path </> p) | p <- ps ] ++
+          [ ignoreDoesNotExistError (removeDirectory path) ]
   where
+    ignoreDoesNotExistError action = do
+      _ <- tryIOErrorType isDoesNotExistError action
+      return ()
     makeRemovable p = do
       perms <- getPermissions p
       setPermissions path perms{ readable = True
                                , searchable = True
                                , writable = True }
 
+sequenceWithIOErrors_ :: [IO ()] -> IO ()
+sequenceWithIOErrors_ actions = go (Right ()) actions
+  where
+    go (Left e)   []       = ioError e
+    go (Right ()) []       = return ()
+    go s          (m : ms) = s `seq` do
+      r <- tryIOError m
+      go (s >> r) ms
+
 {- |'removeFile' /file/ removes the directory entry for an existing file
 /file/, where /file/ is not itself a directory. The
 implementation may specify additional constraints which must be

changelog.md

@@ -1,6 +1,12 @@
 Changelog for the [`directory`][1] package
 ==========================================
 
+## 1.2.7.1 (Oct 2016)
+
+  * Don't abort `removePathForcibly` if files or directories go missing.
+    In addition, keep going even if an exception occurs.
+    ([#60](https://github.com/haskell/directory/issues/60))
+
 ## 1.2.7.0 (August 2016)
 
   * Remove deprecated C bits.  This means `HsDirectory.h` and its functions

directory.cabal

@@ -1,5 +1,5 @@
 name:           directory
-version:        1.2.7.0
+version:        1.2.7.1
 -- NOTE: Don't forget to update ./changelog.md
 license:        BSD3
 license-file:   LICENSE