make merge commit on export that preserves the import history

Annex/Import.hs

@@ -31,6 +31,7 @@ import Annex.Link
 import Annex.LockFile
 import Annex.Content
 import Annex.Export
+import Annex.RemoteTrackingBranch
 import Command
 import Backend
 import Config
@@ -188,12 +189,9 @@ buildImportCommit' importcommitconfig mtrackingcommit imported@(History ti _) =
 		-- history as exported, and git merge will understand that
 		-- the history is connected.
 		| otherwise = do
-			ci <- mkcommits imported
-			let parents = 
-				[ trackingcommit
-				, ci
-				]
-			Just <$> mkcommit parents ti
+			importedcommit <- mkcommits imported
+			Just <$> makeRemoteTrackingBranchMergeCommit'
+				trackingcommit importedcommit ti
 	  where
 		h'@(History t s) = mapHistory historyCommitTree h
 

Annex/RemoteTrackingBranch.hs

@@ -10,12 +10,15 @@ module Annex.RemoteTrackingBranch
 	, mkRemoteTrackingBranch
 	, fromRemoteTrackingBranch
 	, setRemoteTrackingBranch
+	, makeRemoteTrackingBranchMergeCommit
+	, makeRemoteTrackingBranchMergeCommit'
 	) where
 
 import Annex.Common
 import Git.Types
 import qualified Git.Ref
 import qualified Git.Branch
+import qualified Git.History
 import qualified Types.Remote as Remote
 
 newtype RemoteTrackingBranch = RemoteTrackingBranch
@@ -32,3 +35,40 @@ mkRemoteTrackingBranch remote ref = RemoteTrackingBranch $
 setRemoteTrackingBranch :: RemoteTrackingBranch -> Sha -> Annex ()
 setRemoteTrackingBranch tb commit = 
 	inRepo $ Git.Branch.update' (fromRemoteTrackingBranch tb) commit
+
+{- Makes a merge commit that preserves the import history of the
+ - RemoteTrackingBranch, while grafting new git history into it.
+ -
+ - The second parent of the merge commit is the past history of the
+ - RemoteTrackingBranch as imported from a remote. When importing a
+ - history of trees from a remote, commits can be sythesized from
+ - them, but such commits won't have the same sha due to eg date differing.
+ - But since we know that the second parent consists entirely of such
+ - import commits, they can be reused when updating the
+ - RemoteTrackingBranch.
+ -
+ - The commitsha should have the treesha as its tree.
+ -}
+makeRemoteTrackingBranchMergeCommit :: RemoteTrackingBranch -> Sha -> Sha -> Annex Sha
+makeRemoteTrackingBranchMergeCommit tb commitsha treesha =
+	-- Check if the tracking branch exists.
+	inRepo (Git.Ref.sha (fromRemoteTrackingBranch tb)) >>= \case
+		Nothing -> return commitsha
+		Just _ -> inRepo (Git.History.getHistoryToDepth 1 (fromRemoteTrackingBranch tb)) >>= \case
+			Nothing -> return commitsha
+			Just (Git.History.History hc _) -> case Git.History.historyCommitParents hc of
+				[_, importhistory] ->
+					makeRemoteTrackingBranchMergeCommit' commitsha importhistory treesha
+				-- Earlier versions of git-annex did not
+				-- make the merge commit, or perhaps
+				-- something else changed where the
+				-- tracking branch pointed.
+				_ -> return commitsha
+
+makeRemoteTrackingBranchMergeCommit' :: Sha -> Sha -> Sha -> Annex Sha
+makeRemoteTrackingBranchMergeCommit' commitsha importedhistory treesha = 
+	inRepo $ Git.Branch.commitTree
+			Git.Branch.AutomaticCommit
+			"remote tracking branch"
+			[commitsha, importedhistory]
+			treesha

Command/Export.hs

@@ -235,7 +235,8 @@ fillExport r db newtree mtbcommitsha = do
 		Nothing -> noop
 		Just (tb, commitsha) ->
 			whenM (liftIO $ fromAllFilled <$> takeMVar allfilledvar) $
-				setRemoteTrackingBranch tb commitsha
+				makeRemoteTrackingBranchMergeCommit tb commitsha newtree
+					>>= setRemoteTrackingBranch tb
 	
 	liftIO $ fromFileUploaded <$> takeMVar cvar
 

Command/Import.hs

@@ -266,7 +266,7 @@ seekRemote remote branch msubdir = do
 					Nothing -> giveup $ "Unable to find base tree for branch " ++ fromRef branch
 	
 	trackingcommit <- fromtrackingbranch Git.Ref.sha
-	let importcommitconfig = ImportCommitConfig trackingcommit ManualCommit importmessage
+	let importcommitconfig = ImportCommitConfig trackingcommit AutomaticCommit importmessage
 	let commitimport = commitRemote remote branch tb trackingcommit importtreeconfig importcommitconfig
 
 	importabletvar <- liftIO $ newTVarIO Nothing