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.

Command/Export.hs

@@ -25,6 +25,7 @@ import Annex.CatFile
 import Logs.Location
 import Logs.Export
 import Database.Export
+import Remote.Helper.Export
 import Messages.Progress
 import Utility.Tmp
 
@@ -252,24 +253,24 @@ startUnexport' r ea db f ek = do
 performUnexport :: Remote -> ExportActions Annex -> ExportHandle -> [ExportKey] -> ExportLocation -> CommandPerform
 performUnexport r ea db eks loc = do
 	ifM (allM (\ek -> removeExport ea (asKey ek) loc) eks)
-		( next $ cleanupUnexport r db eks loc
+		( next $ cleanupUnexport r ea db eks loc
 		, stop
 		)
 
-cleanupUnexport :: Remote -> ExportHandle -> [ExportKey] -> ExportLocation -> CommandCleanup
+cleanupUnexport :: Remote -> ExportActions Annex -> ExportHandle -> [ExportKey] -> ExportLocation -> CommandCleanup
-cleanupUnexport r db eks loc = do
+cleanupUnexport r ea db eks loc = do
 	liftIO $ do
 		forM_ eks $ \ek ->
 			removeExportLocation db (asKey ek) loc
-		-- Flush so that getExportLocation sees this and any
-		-- other removals of the key.
 		flushDbQueue db
+
 	remaininglocs <- liftIO $ 
 		concat <$> forM eks (\ek -> getExportLocation db (asKey ek))
 	when (null remaininglocs) $
 		forM_ eks $ \ek ->
 			logChange (asKey ek) (uuid r) InfoMissing
-	return True
+	
+	removeEmptyDirectories ea db loc (map asKey eks)
 
 startRecoverIncomplete :: Remote -> ExportActions Annex -> ExportHandle -> Git.Sha -> TopFilePath -> CommandStart
 startRecoverIncomplete r ea db sha oldf
@@ -306,7 +307,7 @@ startMoveFromTempName r ea db ek f = do
 performRename :: Remote -> ExportActions Annex -> ExportHandle -> ExportKey -> ExportLocation -> ExportLocation -> CommandPerform
 performRename r ea db ek src dest = do
 	ifM (renameExport ea (asKey ek) src dest)
-		( next $ cleanupRename db ek src dest
+		( next $ cleanupRename ea db ek src dest
 		-- In case the special remote does not support renaming,
 		-- unexport the src instead.
 		, do
@@ -314,11 +315,10 @@ performRename r ea db ek src dest = do
 			performUnexport r ea db [ek] src
 		)
 
-cleanupRename :: ExportHandle -> ExportKey -> ExportLocation -> ExportLocation -> CommandCleanup
+cleanupRename :: ExportActions Annex -> ExportHandle -> ExportKey -> ExportLocation -> ExportLocation -> CommandCleanup
-cleanupRename db ek src dest = do
+cleanupRename ea db ek src dest = do
 	liftIO $ do
 		removeExportLocation db (asKey ek) src
 		addExportLocation db (asKey ek) dest
-		-- Flush so that getExportLocation sees this.
 		flushDbQueue db
-	return True
+	removeEmptyDirectories ea db src [asKey ek]

Database/Export.hs

@@ -28,11 +28,10 @@ import qualified Database.Queue as H
 import Database.Init
 import Annex.Locations
 import Annex.Common hiding (delete)
-import Types.Remote (ExportLocation(..), ExportDirectory(..))
+import Types.Remote (ExportLocation(..), ExportDirectory(..), exportedDirectories)
 
 import Database.Persist.TH
 import Database.Esqueleto hiding (Key)
-import qualified System.FilePath.Posix as Posix
 
 newtype ExportHandle = ExportHandle H.DbQueue
 
@@ -114,12 +113,3 @@ isExportDirectoryEmpty (ExportHandle h) (ExportDirectory d) = H.queryDbQueue h $
 	return $ null l
   where
 	ed = toSFilePath d
-
-exportedDirectories :: ExportLocation -> [ExportDirectory]
-exportedDirectories (ExportLocation f) =
-	map (ExportDirectory . Posix.joinPath . reverse) $ 
-		subs [] $ map Posix.dropTrailingPathSeparator $
-			Posix.splitPath $ Posix.takeDirectory f
-  where
-	subs _ [] = []
-	subs ps (d:ds) = (d:ps) : subs (d:ps) ds

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
+				oks <- forM locs $ \loc ->
-					ok <- removeExport ea k loc
+					ifM (removeExport ea k loc)
-					when ok $
+						( do
-						liftIO $ removeExportLocation db k loc
+							liftIO $ do
-					return ok
+								removeExportLocation db k loc
-				liftIO $ flushDbQueue db
+								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
+			)

Types/Remote.hs

@@ -22,11 +22,13 @@ module Types.Remote
 	, ExportDirectory(..)
 	, isExportSupported
 	, ExportActions(..)
+	, exportedDirectories
 	)
 	where
 
-import Data.Map as M
+import qualified Data.Map as M
 import Data.Ord
+import qualified System.FilePath.Posix as Posix
 
 import qualified Git
 import Types.Key
@@ -198,3 +200,14 @@ data ExportActions a = ExportActions
 	-- support renames.
 	, renameExport :: Key -> ExportLocation -> ExportLocation -> a Bool
 	}
+
+-- | All directories down to the ExportLocation, with the deepest ones
+-- last.
+exportedDirectories :: ExportLocation -> [ExportDirectory]
+exportedDirectories (ExportLocation f) =
+	map (ExportDirectory . Posix.joinPath . reverse) $ 
+		subs [] $ map Posix.dropTrailingPathSeparator $
+			Posix.splitPath $ Posix.takeDirectory f
+  where
+	subs _ [] = []
+	subs ps (d:ds) = (d:ps) : subs (d:ps) ds