diff --git a/Remote/Directory.hs b/Remote/Directory.hs index cb7553fe25..b107c18e90 100644 --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -160,9 +160,15 @@ remove d k = liftIO $ do - before it can delete them. -} void $ tryIO $ mapM_ allowWrite =<< dirContents dir #endif - catchBoolIO $ do + ok <- catchBoolIO $ do removeDirectoryRecursive dir return True + {- Removing the subdirectory will fail if it doesn't exist. + - But, we want to succeed in that case, as long as the directory + - remote's top-level directory does exist. -} + if ok + then return ok + else doesDirectoryExist d <&&> (not <$> doesDirectoryExist dir) where dir = storeDir d k diff --git a/Types/Remote.hs b/Types/Remote.hs index 584f3d044c..9c2a69effd 100644 --- a/Types/Remote.hs +++ b/Types/Remote.hs @@ -64,7 +64,7 @@ data RemoteA a = Remote { retrieveKeyFile :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> a Bool, -- retrieves a key's contents to a tmp file, if it can be done cheaply retrieveKeyFileCheap :: Key -> FilePath -> a Bool, - -- removes a key's contents + -- removes a key's contents (succeeds if the contents are not present) removeKey :: Key -> a Bool, -- Checks if a key is present in the remote; if the remote -- cannot be accessed returns a Left error message.