improve alwayscommit=false mode

Now changes are staged into the branch's index, but not committed,
which avoids growing a large journal. And sync and merge always
explicitly commit, ensuring that even when they do nothing else,
they commit the staged changes.

Added a flag file to indicate that the branch's journal contains
uncommitted changes. (Could use git ls-files, but don't want to run
that every time.)

In the future, this ability to have uncommitted changes staged in the
journal might be used on remotes after a series of oneshot commands.

Annex/Branch.hs

@@ -18,6 +18,7 @@ module Annex.Branch (
 	get,
 	change,
 	commit,
+	stage,
 	files,
 ) where
 
@@ -114,7 +115,7 @@ updateTo pairs = do
 	-- ensure branch exists, and get its current ref
 	branchref <- getBranch
 	-- check what needs updating before taking the lock
-	dirty <- journalDirty
+	dirty <- unCommitted
 	(refs, branches) <- unzip <$> filterM isnewer pairs
 	if not dirty && null refs
 		then updateIndex branchref
@@ -182,11 +183,17 @@ set file content = do
 
 {- Stages the journal, and commits staged changes to the branch. -}
 commit :: String -> Annex ()
-commit message = whenM journalDirty $ lockJournal $ do
+commit message = whenM unCommitted $ lockJournal $ do
 	stageJournal
 	ref <- getBranch
 	withIndex $ commitBranch ref message [fullname]
 
+{- Stages the journal, not making a commit to the branch. -}
+stage :: Annex ()
+stage = whenM journalDirty $ lockJournal $ do
+	stageJournal
+	setUnCommitted
+
 {- Commits the staged changes in the index to the branch.
  - 
  - Ensures that the branch's index file is first updated to the state
@@ -213,6 +220,7 @@ commitBranch branchref message parents = do
 	parentrefs <- commitparents <$> catObject committedref
 	when (racedetected branchref parentrefs) $
 		fixrace committedref parentrefs
+	setCommitted
 	where
 		-- look for "parent ref" lines and return the refs
 		commitparents = map (Git.Ref . snd) . filter isparent .
@@ -301,6 +309,25 @@ setIndexSha ref = do
         lock <- fromRepo gitAnnexIndexLock
 	liftIO $ writeFile lock $ show ref ++ "\n"
 
+{- Checks if there are uncommitted changes in the branch's index or journal. -}
+unCommitted :: Annex Bool
+unCommitted = do
+	d <- liftIO . doesFileExist =<< fromRepo gitAnnexIndexDirty
+	if d
+		then return d
+		else journalDirty
+
+setUnCommitted :: Annex ()
+setUnCommitted = do
+	file <- fromRepo gitAnnexIndexDirty
+	liftIO $ writeFile file "1"
+
+setCommitted :: Annex ()
+setCommitted = do
+	file <- fromRepo gitAnnexIndexDirty
+	_ <- liftIO $ tryIO $ removeFile file
+	return ()
+
 {- Stages the journal into the index. -}
 stageJournal :: Annex ()
 stageJournal = do

Annex/Content.hs

@@ -312,9 +312,11 @@ getKeysPresent' dir = do
 saveState :: Bool -> Annex ()
 saveState oneshot = do
 	Annex.Queue.flush False
+	unless oneshot $ do
 		alwayscommit <- Git.configTrue <$> fromRepo (Git.Config.get "annex.alwayscommit" "true")
-	unless (oneshot || not alwayscommit) $ do
+		if alwayscommit
-		Annex.Branch.commit "update"
+			then Annex.Branch.commit "update"
+			else Annex.Branch.stage
 
 {- Downloads content from any of a list of urls. -}
 downloadUrl :: [Url.URLString] -> FilePath -> Annex Bool

Command/Merge.hs

@@ -26,4 +26,6 @@ start = do
 perform :: CommandPerform
 perform = do
 	Annex.Branch.update
+	-- commit explicitly, in case no remote branches were merged
+	Annex.Branch.commit "update"
 	next $ return True

Command/Sync.hs

@@ -75,6 +75,7 @@ commit = do
 	showStart "commit" ""
 	next $ next $ do
 		showOutput
+		Annex.Branch.commit "update"
 		-- Commit will fail when the tree is clean, so ignore failure.
 		_ <- inRepo $ Git.Command.runBool "commit"
 			[Param "-a", Param "-m", Param "git-annex automatic sync"]

Locations.hs

@@ -22,6 +22,7 @@ module Locations (
 	gitAnnexJournalLock,
 	gitAnnexIndex,
 	gitAnnexIndexLock,
+	gitAnnexIndexDirty,
 	gitAnnexSshDir,
 	isLinkToAnnex,
 	annexHashes,
@@ -143,6 +144,10 @@ gitAnnexIndex r = gitAnnexDir r </> "index"
 gitAnnexIndexLock :: Git.Repo -> FilePath
 gitAnnexIndexLock r = gitAnnexDir r </> "index.lck"
 
+{- Flag file for .git/annex/index. -}
+gitAnnexIndexDirty :: Git.Repo -> FilePath
+gitAnnexIndexDirty r = gitAnnexDir r </> "index.dirty"
+
 {- .git/annex/ssh/ is used for ssh connection caching -}
 gitAnnexSshDir :: Git.Repo -> FilePath
 gitAnnexSshDir r = addTrailingPathSeparator $ gitAnnexDir r </> "ssh"