export tree: avoid confusing output about renaming files

When a file in the export is renamed, and the remote's renameExport
returned Nothing, renaming to the temp file would first say it was
renaming, and appear to succeed, but actually what it did was delete the
file. Then renaming from the temp file would not do anything, since the
temp file is not present on the remote. This appeared as if a file got
renamed to a temp file and left there.

Note that exporttree=yes importree=yes remotes have their usual
renameExport replaced with one that returns Nothing. (For reasons
explained in Remote.Helper.ExportImport.) So this happened
even with remotes that support renameExport.

Fix by letting renameExport = Nothing when it's not supported at all.
This avoids displaying the rename.

Sponsored-by: Graham Spencer on Patreon

Command/Export.hs

@@ -406,9 +406,10 @@ startRecoverIncomplete r db sha oldf
 	oldloc = mkExportLocation $ getTopFilePath oldf
 
 startMoveToTempName :: Remote -> ExportHandle -> TopFilePath -> Key -> CommandStart
-startMoveToTempName r db f ek = 
+startMoveToTempName r db f ek = case renameExport (exportActions r) of
-	starting ("rename " ++ name r) ai si $
+	Just _ -> starting ("rename " ++ name r) ai si $
 		performRename r db ek loc tmploc
+	Nothing -> stop
   where
 	loc = mkExportLocation f'
 	f' = getTopFilePath f
@@ -418,27 +419,29 @@ startMoveToTempName r db f ek =
 	si = SeekInput []
 
 startMoveFromTempName :: Remote -> ExportHandle -> Key -> TopFilePath -> CommandStart
-startMoveFromTempName r db ek f = do
+startMoveFromTempName r db ek f = case renameExport (exportActions r) of
-	let tmploc = exportTempName ek
+	Just _ -> stopUnless (liftIO $ elem tmploc <$> getExportedLocation db ek) $
-	let ai = ActionItemOther $ Just $
-		QuotedPath (fromExportLocation tmploc) <> " -> " <> QuotedPath f'
-	stopUnless (liftIO $ elem tmploc <$> getExportedLocation db ek) $
 		starting ("rename " ++ name r) ai si $
 			performRename r db ek tmploc loc
+	Nothing -> stop
   where
 	loc = mkExportLocation f'
 	f' = getTopFilePath f
+	tmploc = exportTempName ek
+	ai = ActionItemOther $ Just $
+		QuotedPath (fromExportLocation tmploc) <> " -> " <> QuotedPath f'
 	si = SeekInput []
 
 performRename :: Remote -> ExportHandle -> Key -> ExportLocation -> ExportLocation -> CommandPerform
-performRename r db ek src dest =
+performRename r db ek src dest = case renameExport (exportActions r) of
-	tryNonAsync (renameExport (exportActions r) ek src dest) >>= \case
+	Just renameaction -> tryNonAsync (renameaction ek src dest) >>= \case
 		Right (Just ()) -> next $ cleanupRename r db ek src dest
 		Left err -> do
 			warning $ UnquotedString $ "rename failed (" ++ show err ++ "); deleting instead"
 			fallbackdelete
-		-- remote does not support renaming
 		Right Nothing -> fallbackdelete
+	-- remote does not support renaming
+	Nothing -> fallbackdelete
   where
 	fallbackdelete = performUnexport r db [ek] src
 

Remote/Adb.hs

@@ -94,7 +94,7 @@ gen r u rc gc rs = do
 			, versionedExport = False
 			, checkPresentExport = checkPresentExportM serial adir
 			, removeExportDirectory = Just $ removeExportDirectoryM serial adir
-			, renameExport = renameExportM serial adir
+			, renameExport = Just $ renameExportM serial adir
 			}
 		, importActions = ImportActions
 			{ listImportableContents = listImportableContentsM serial adir c

Remote/Directory.hs

@@ -112,7 +112,7 @@ gen r u rc gc rs = do
 				-- Not needed because removeExportLocation
 				-- auto-removes empty directories.
 				, removeExportDirectory = Nothing
-				, renameExport = renameExportM dir
+				, renameExport = Just $ renameExportM dir
 				}
 			, importActions = ImportActions
 				{ listImportableContents = listImportableContentsM ii dir

Remote/External.hs

@@ -98,7 +98,7 @@ gen r u rc gc rs
 				, versionedExport = False
 				, checkPresentExport = checkPresentExportM external
 				, removeExportDirectory = Just $ removeExportDirectoryM external
-				, renameExport = renameExportM external
+				, renameExport = Just $ renameExportM external
 				}
 			else exportUnsupported
 		-- Cheap exportSupported that replaces the expensive

Remote/Helper/ExportImport.hs

@@ -41,7 +41,7 @@ instance HasExportUnsupported (ExportActions Annex) where
 		, removeExport = nope
 		, versionedExport = False
 		, removeExportDirectory = nope
-		, renameExport = \_ _ _ -> return Nothing
+		, renameExport = Nothing
 		}
 	 where
 	 	nope = giveup "export not supported"
@@ -257,7 +257,7 @@ adjustExportImport' isexport isimport r rs = do
 		-- renameExport is optional, and the remote's
 		-- implementation may lose modifications to the file
 		-- (by eg copying and then deleting) so don't use it
-		, renameExport = \_ _ _ -> return Nothing
+		, renameExport = Nothing
 		, checkPresentExport = checkPresentImport ciddbv
 		}
 	

Remote/Helper/ReadOnly.hs

@@ -34,7 +34,7 @@ adjustReadOnly r
 			{ storeExport = readonlyStoreExport
 			, removeExport = readonlyRemoveExport
 			, removeExportDirectory = Just readonlyRemoveExportDirectory
-			, renameExport = readonlyRenameExport
+			, renameExport = Nothing
 			}
 		, importActions = (importActions r)
 			{ storeExportWithContentIdentifier = readonlyStoreExportWithContentIdentifier
@@ -62,9 +62,6 @@ readonlyRemoveExport _ _ = readonlyFail
 readonlyRemoveExportDirectory :: ExportDirectory -> Annex ()
 readonlyRemoveExportDirectory _ = readonlyFail
 
-readonlyRenameExport :: Key -> ExportLocation -> ExportLocation -> Annex (Maybe ())
-readonlyRenameExport _ _ _ = return Nothing
-
 readonlyStoreExportWithContentIdentifier :: FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex ContentIdentifier
 readonlyStoreExportWithContentIdentifier _ _ _ _ _ = readonlyFail
 

Remote/Rsync.hs

@@ -106,7 +106,7 @@ gen r u rc gc rs = do
 				, versionedExport = False
 				, checkPresentExport = checkPresentExportM o
 				, removeExportDirectory = Just (removeExportDirectoryM o)
-				, renameExport = renameExportM o
+				, renameExport = Just $ renameExportM o
 				}
 			, importActions = importUnsupported
 			, whereisKey = Nothing

Remote/S3.hs

@@ -228,7 +228,7 @@ gen r u rc gc rs = do
 				, checkPresentExport = checkPresentExportS3 hdl this info
 				-- S3 does not have directories.
 				, removeExportDirectory = Nothing
-				, renameExport = renameExportS3 hdl this rs info
+				, renameExport = Just $ renameExportS3 hdl this rs info
 				}
 			, importActions = ImportActions
                                 { listImportableContents = listImportableContentsS3 hdl this info c

Remote/WebDAV.hs

@@ -104,7 +104,7 @@ gen r u rc gc rs = do
 				, versionedExport = False
 				, removeExportDirectory = Just $
 					removeExportDirectoryDav hdl
-				, renameExport = renameExportDav hdl
+				, renameExport = Just $ renameExportDav hdl
 				}
 			, importActions = importUnsupported
 			, whereisKey = Nothing

Types/Remote.hs

@@ -302,7 +302,7 @@ data ExportActions a = ExportActions
 	--
 	-- Throws an exception if the remote cannot be accessed, or
 	-- the file doesn't exist or cannot be renamed.
-	, renameExport :: Key -> ExportLocation -> ExportLocation -> a (Maybe ())
+	, renameExport :: Maybe (Key -> ExportLocation -> ExportLocation -> a (Maybe ()))
 	}
 
 data ImportActions a = ImportActions