fix compaction of export.log

It was not getting old lines removed, because the tree graft confused
the updater, so it union merged from the previous git-annex branch,
which still contained the old lines. Fixed by carefully using setIndexSha.

This commit was supported by the NSF-funded DataLad project.

Annex/Branch.hs

@@ -1,6 +1,6 @@
 {- management of the git-annex branch
  -
- - Copyright 2011-2016 Joey Hess <id@joeyh.name>
+ - Copyright 2011-2017 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -23,8 +23,9 @@ module Annex.Branch (
 	forceCommit,
 	getBranch,
 	files,
-	withIndex,
+	graftTreeish,
 	performTransitions,
+	withIndex,
 ) where
 
 import qualified Data.ByteString.Lazy as L
@@ -46,6 +47,7 @@ import qualified Git.Sha
 import qualified Git.Branch
 import qualified Git.UnionMerge
 import qualified Git.UpdateIndex
+import qualified Git.Tree
 import Git.LsTree (lsTreeParams)
 import qualified Git.HashObject
 import Annex.HashObject
@@ -614,3 +616,25 @@ getMergedRefs' = do
 	parse l = 
 		let (s, b) = separate (== '\t') l
 		in (Ref s, Ref b)
+
+{- Grafts a treeish into the branch at the specified location,
+ - and then removes it. This ensures that the treeish won't get garbage
+ - collected, and will always be available as long as the git-annex branch
+ - is available. -}
+graftTreeish :: Git.Ref -> TopFilePath -> Annex ()
+graftTreeish treeish graftpoint = lockJournal $ \jl -> do
+	branchref <- getBranch
+	updateIndex jl branchref
+	Git.Tree.Tree t <- inRepo $ Git.Tree.getTree branchref
+	t' <- inRepo $ Git.Tree.recordTree $ Git.Tree.Tree $
+		Git.Tree.RecordedSubTree graftpoint treeish [] : t
+	c <- inRepo $ Git.Branch.commitTree Git.Branch.AutomaticCommit
+		"graft" [branchref] t'
+	origtree <- inRepo $ Git.Tree.recordTree (Git.Tree.Tree t)
+	c' <- inRepo $ Git.Branch.commitTree Git.Branch.AutomaticCommit
+		"graft cleanup" [c] origtree
+	inRepo $ Git.Branch.update' fullname c'
+	-- The tree in c' is the same as the tree in branchref,
+	-- and the index was updated to that above, so it's safe to
+	-- say that the index contains c'.
+	setIndexSha c'

Logs/Export.hs

@@ -11,6 +11,7 @@ import qualified Data.Map as M
 
 import Annex.Common
 import qualified Annex.Branch
+import Annex.Journal
 import qualified Git
 import qualified Git.Branch
 import Git.Tree
@@ -97,7 +98,7 @@ recordExportBeginning remoteuuid newtree = do
 		showExportLog 
 			. changeMapLog c ep new
 			. parseExportLog
-	graftTreeish newtree
+	Annex.Branch.graftTreeish newtree (asTopFilePath "export.tree")
 
 parseExportLog :: String -> MapLog ExportParticipants Exported
 parseExportLog = parseMapLog parseExportParticipants parseExported
@@ -125,20 +126,3 @@ parseExported :: String -> Maybe Exported
 parseExported s = case words s of
 	(et:it) -> Just $ Exported (Git.Ref et) (map Git.Ref it)
 	_ -> Nothing
-
--- To prevent git-annex branch merge conflicts, the treeish is
--- first grafted in and then removed in a subsequent commit.
-graftTreeish :: Git.Ref -> Annex ()
-graftTreeish treeish = do
-	branchref <- Annex.Branch.getBranch
-	Tree t <- inRepo $ getTree branchref
-	t' <- inRepo $ recordTree $ Tree $
-		RecordedSubTree (asTopFilePath graftpoint) treeish [] : t
-	commit <- inRepo $ Git.Branch.commitTree Git.Branch.AutomaticCommit
-		"export tree" [branchref] t'
-	origtree <- inRepo $ recordTree (Tree t)
-	commit' <- inRepo $ Git.Branch.commitTree Git.Branch.AutomaticCommit
-		"export tree cleanup" [commit] origtree
-	inRepo $ Git.Branch.update' Annex.Branch.fullname commit'
-  where
-	graftpoint = "export.tree"

doc/todo/export.mdwn

@@ -17,7 +17,6 @@ there need to be a new interface in supported remotes?
 
 Work is in progress. Todo list:
 
-* Compact the export.log to remove old entries.
 * `git annex get --from export` works in the repo that exported to it,
   but in another repo, the export db won't be populated, so it won't work.
   Maybe just show a useful error message in this case?  
@@ -25,7 +24,6 @@ Work is in progress. Todo list:
   export from another repository also doesn't work right, because the
   export database is not populated. So, seems that the export database needs
   to get populated based on the export log in these cases.
-* Support export to aditional special remotes (webdav etc)
 * Support export in the assistant (when eg setting up a S3 special remote).
   Would need git-annex sync to export to the master tree?
   This is similar to the little-used preferreddir= preferred content