implement export.log and resolve export conflicts

Incremental export updates work now too.

This commit was sponsored by Anthony DeRobertis on Patreon.

1 files changed, 49 insertions, 35 deletions

diff --git a/Command/Export.hs b/Command/Export.hs
index aba8a1877..1310244ac 100644
--- a/Command/Export.hs
+++ b/Command/Export.hs
@@ -11,14 +11,16 @@ import Command
 import qualified Git
 import qualified Git.DiffTree
 import qualified Git.LsTree
+import qualified Git.Ref
 import Git.Types
-import Git.Sha
 import Git.FilePath
+import Git.Sha
 import Types.Key
 import Types.Remote
 import Annex.Content
 import Annex.CatFile
 import Logs.Location
+import Logs.Export
 import Messages.Progress
 import Utility.Tmp
 
@@ -67,45 +69,46 @@ exportKey sha = mk <$> catKey sha
 seek :: ExportOptions -> CommandSeek
 seek o = do
 	r <- getParsed (exportRemote o)
-	let oldtreeish = emptyTree -- XXX temporary
-
-	-- First, diff the old and new trees and update all changed
-	-- files in the export.
-	(diff, cleanup) <- inRepo $
-		Git.DiffTree.diffTreeRecursive oldtreeish (exportTreeish o)
-	seekActions $ pure $ map (startDiff r) diff
-	void $ liftIO cleanup
-
-	-- In case a previous export was incomplete, make a pass
-	-- over the whole tree and export anything that is not
-	-- yet exported.
-	(l, cleanup') <- inRepo $ Git.LsTree.lsTree (exportTreeish o)
-	seekActions $ pure $ map (start r) l
-	void $ liftIO cleanup'
+	new <- fromMaybe (error "unknown tree") <$>
+		inRepo (Git.Ref.sha (exportTreeish o))
+	old <- getExport (uuid r)
+
+	when (length old > 1) $
+		warning "Export conflict detected. Different trees have been exported to the same special remote. Resolving.."
+	
+	-- First, diff the old and new trees and delete all changed
+	-- files in the export. Every file that remains in the export will
+	-- have the content from the new treeish.
+	-- 
+	-- (Also, when there was an export conflict, this resolves it.)
+	forM_ old $ \oldtreesha -> do
+		(diff, cleanup) <- inRepo $
+			Git.DiffTree.diffTreeRecursive oldtreesha new
+		seekActions $ pure $ map (startUnexport r) diff
+		void $ liftIO cleanup
+
+	-- Waiting until now to record the export guarantees that,
+	-- if this export is interrupted, there are no files left over
+	-- from a previous export, that are not part of this export.
+	recordExport (uuid r) $ ExportChange
+		{ oldTreeish = old
+		, newTreeish = new
+		}
 
-startDiff :: Remote -> Git.DiffTree.DiffTreeItem -> CommandStart
-startDiff r diff
-	| Git.DiffTree.dstsha diff == nullSha = do
-		showStart "unexport" f
-		oldk <- exportKey (Git.DiffTree.srcsha diff)
-		next $ performUnexport r oldk loc
-	| otherwise = do
-		showStart "export" f
-		k <- exportKey (Git.DiffTree.dstsha diff)
-		next $ performExport r k (Git.DiffTree.dstsha diff) loc
-  where
-	loc = ExportLocation $ toInternalGitPath $ 
-		getTopFilePath $ Git.DiffTree.file diff
-	f = getTopFilePath $ Git.DiffTree.file diff
+	-- Export everything that is not yet exported.
+	(l, cleanup') <- inRepo $ Git.LsTree.lsTree new
+	seekActions $ pure $ map (startExport r) l
+	void $ liftIO cleanup'
 
-start :: Remote -> Git.LsTree.TreeItem -> CommandStart
-start r ti = do
+startExport :: Remote -> Git.LsTree.TreeItem -> CommandStart
+startExport r ti = do
 	ek <- exportKey (Git.LsTree.sha ti)
-	stopUnless (elem (uuid r) <$> loggedLocations (asKey ek)) $
+	stopUnless (notElem (uuid r) <$> loggedLocations (asKey ek)) $ do
+		showStart "export" f
 		next $ performExport r ek (Git.LsTree.sha ti) loc
   where
-	loc = ExportLocation $ toInternalGitPath $
-		getTopFilePath $ Git.LsTree.file ti
+	loc = ExportLocation $ toInternalGitPath f
+	f = getTopFilePath $ Git.LsTree.file ti
 
 performExport :: Remote -> ExportKey -> Sha -> ExportLocation -> CommandPerform
 performExport r ek contentsha loc = case storeExport r of
@@ -137,6 +140,17 @@ cleanupExport r ek = do
 	logChange (asKey ek) (uuid r) InfoPresent
 	return True
 
+startUnexport :: Remote -> Git.DiffTree.DiffTreeItem -> CommandStart
+startUnexport r diff
+	| Git.DiffTree.srcsha diff /= nullSha = do
+		showStart "unexport" f
+		oldk <- exportKey (Git.DiffTree.srcsha diff)
+		next $ performUnexport r oldk loc
+	| otherwise = stop
+  where
+	loc = ExportLocation $ toInternalGitPath f
+	f = getTopFilePath $ Git.DiffTree.file diff
+
 performUnexport :: Remote -> ExportKey -> ExportLocation -> CommandPerform
 performUnexport r ek loc = case removeExport r of
 	Nothing -> error "remote does not support removing exported files"