remove empty directories when removing from export

The subtle part of this is what happens when the remote fails to remove
an empty directory. The removal from the export needs to fail in that
case, so the removal will be tried again later. However, removeExportLocation
has already been run and changed the export db, so if the next run
checks getExportLocation, it might decide nothing remains to be done,
leaving the empty directory.

Dealt with that by making removeEmptyDirectories, handle a failure
by calling addExportLocation, reverting the database changes so the next
run will be guaranteed to try deleting the empty directory again.

This commit was sponsored by Thomas Hochstein on Patreon.

1 files changed, 32 insertions, 6 deletions

diff --git a/Remote/Helper/Export.hs b/Remote/Helper/Export.hs
index 44fa47ca5..101124cef 100644
--- a/Remote/Helper/Export.hs
+++ b/Remote/Helper/Export.hs
@@ -120,12 +120,15 @@ adjustExportable r = case M.lookup "exporttree" (config r) of
 			, removeKey = \k -> do
 				locs <- liftIO $ getExportLocation db k
 				ea <- exportActions r
-				oks <- forM locs $ \loc -> do
-					ok <- removeExport ea k loc
-					when ok $
-						liftIO $ removeExportLocation db k loc
-					return ok
-				liftIO $ flushDbQueue db
+				oks <- forM locs $ \loc ->
+					ifM (removeExport ea k loc)
+						( do
+							liftIO $ do
+								removeExportLocation db k loc
+								flushDbQueue db
+							removeEmptyDirectories ea db loc [k]
+						, return False
+						)
 				return (and oks)
 			-- Can't lock content on exports, since they're
 			-- not key/value stores, and someone else could
@@ -143,3 +146,26 @@ adjustExportable r = case M.lookup "exporttree" (config r) of
 				is <- getInfo r
 				return (is++[("export", "yes")])
 			}
+
+-- | Remove empty directories from the export. Call after removing an
+-- exported file, and after calling removeExportLocation and flushing the
+-- database.
+removeEmptyDirectories :: ExportActions Annex -> ExportHandle -> ExportLocation -> [Key] -> Annex Bool
+removeEmptyDirectories ea db loc ks = case removeExportDirectory ea of
+	Nothing -> return True
+	Just removeexportdirectory -> do
+		ok <- allM (go removeexportdirectory) 
+			(reverse (exportedDirectories loc))
+		unless ok $ liftIO $ do
+			-- Add back to export database, so this is
+			-- tried again next time.
+			forM_ ks $ \k ->
+				addExportLocation db k loc
+			flushDbQueue db
+		return ok
+  where
+	go removeexportdirectory d = 
+		ifM (liftIO $ isExportDirectoryEmpty db d)
+			( removeexportdirectory d
+			, return True
+			)