added annex.commitmessage

Added annex.commitmessage config that can specify a commit message for the
git-annex branch instead of the usual "update".

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-2017 Joey Hess <id@joeyh.name>
+ - Copyright 2011-2018 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -19,6 +19,7 @@ module Annex.Branch (
 	getHistorical,
 	change,
 	maybeChange,
+	commitMessage,
 	commit,
 	forceCommit,
 	getBranch,
@@ -51,7 +52,7 @@ import qualified Git.Tree
 import Git.LsTree (lsTreeParams)
 import qualified Git.HashObject
 import Annex.HashObject
-import Git.Types
+import Git.Types (Ref(..), fromRef, RefDate, TreeItemType(..))
 import Git.FilePath
 import Annex.CatFile
 import Annex.Perms
@@ -177,9 +178,9 @@ updateTo' pairs = do
 	go branchref dirty tomerge jl = withIndex $ do
 		let (refs, branches) = unzip tomerge
 		cleanjournal <- if dirty then stageJournal jl else return noop
-		let merge_desc = if null tomerge
-			then "update"
-			else "merging " ++
+		merge_desc <- if null tomerge
+			then commitMessage
+			else return $ "merging " ++
 				unwords (map Git.Ref.describe branches) ++ 
 				" into " ++ fromRef name
 		localtransitions <- parseTransitionsStrictly "local"
@@ -259,6 +260,11 @@ maybeChange file f = lockJournal $ \jl -> do
 set :: JournalLocked -> FilePath -> String -> Annex ()
 set = setJournalFile
 
+{- Commit message used when making a commit of whatever data has changed
+ - to the git-annex brach. -}
+commitMessage :: Annex String
+commitMessage = fromMaybe "update" . annexCommitMessage <$> Annex.getGitConfig
+
 {- Stages the journal, and commits staged changes to the branch. -}
 commit :: String -> Annex ()
 commit = whenM journalDirty . forceCommit

Annex/Content.hs

@@ -975,7 +975,7 @@ saveState nocommit = doSideAction $ do
 	Annex.Queue.flush
 	unless nocommit $
 		whenM (annexAlwaysCommit <$> Annex.getGitConfig) $
-			Annex.Branch.commit "update"
+			Annex.Branch.commit =<< Annex.Branch.commitMessage
 
 {- Downloads content from any of a list of urls. -}
 downloadUrl :: Key -> MeterUpdate -> [Url.URLString] -> FilePath -> Annex Bool

Annex/MakeRepo.hs

@@ -82,7 +82,7 @@ initRepo' desc mgroup = unlessM isInitialized $ do
 	maybe noop (defaultStandardGroup u) mgroup
 	{- Ensure branch gets committed right away so it is
 	 - available for merging immediately. -}
-	Annex.Branch.commit "update"
+	Annex.Branch.commit =<< Annex.Branch.commitMessage
 
 {- Checks if a git repo exists at a location. -}
 probeRepoExists :: FilePath -> IO Bool

Assistant/Sync.hs

@@ -124,7 +124,7 @@ pushToRemotes remotes = do
 pushToRemotes' :: UTCTime -> [Remote] -> Assistant [Remote]
 pushToRemotes' now remotes = do
 	(g, branch, u) <- liftAnnex $ do
-		Annex.Branch.commit "update"
+		Annex.Branch.commit =<< Annex.Branch.commitMessage
 		(,,)
 			<$> gitRepo
 			<*> join Command.Sync.getCurrBranch

Assistant/WebApp/Configurators/Fsck.hs

@@ -138,7 +138,7 @@ postConfigFsckR = page "Consistency checks" (Just Configuration) $ do
 changeSchedule :: Handler () -> Handler Html
 changeSchedule a = do
 	a
-	liftAnnex $ Annex.Branch.commit "update"
+	liftAnnex $ Annex.Branch.commit =<< Annex.Branch.commitMessage
 	redirect ConfigFsckR
 
 getRemoveActivityR :: UUID -> ScheduledActivity -> Handler Html

CHANGELOG

@@ -6,6 +6,8 @@ git-annex (6.20180720) UNRELEASED; urgency=medium
   * Added remote.name.annex-speculate-present config that can be used to
     make cache remotes.
   * Added --accessedwithin matching option.
+  * Added annex.commitmessage config that can specify a commit message
+    for the git-annex branch instead of the usual "update".
 
  -- Joey Hess <id@joeyh.name>  Tue, 31 Jul 2018 12:14:11 -0400
 

Command/Commit.hs

@@ -21,7 +21,7 @@ seek = withNothing start
 
 start :: CommandStart
 start = next $ next $ do
-	Annex.Branch.commit "update"
+	Annex.Branch.commit =<< Annex.Branch.commitMessage
 	_ <- runhook <=< inRepo $ Git.hookPath "annex-content"
 	return True
   where

Command/Merge.hs

@@ -27,7 +27,7 @@ mergeBranch = do
 	next $ do
 		Annex.Branch.update
 		-- commit explicitly, in case no remote branches were merged
-		Annex.Branch.commit "update"
+		Annex.Branch.commit =<< Annex.Branch.commitMessage
 		next $ return True
 
 mergeSynced :: CommandStart

Command/Sync.hs

@@ -301,7 +301,7 @@ commit :: SyncOptions -> CommandStart
 commit o = stopUnless shouldcommit $ next $ next $ do
 	commitmessage <- maybe commitMsg return (messageOption o)
 	showStart' "commit" Nothing
-	Annex.Branch.commit "update"
+	Annex.Branch.commit =<< Annex.Branch.commitMessage
 	ifM isDirect
 		( do
 			void stageDirect
@@ -544,7 +544,7 @@ pushBranch remote branch g = directpush `after` annexpush `after` syncpush
 
 commitAnnex :: CommandStart
 commitAnnex = do
-	Annex.Branch.commit "update"
+	Annex.Branch.commit =<< Annex.Branch.commitMessage
 	stop
 
 mergeAnnex :: CommandStart

Logs/Web.hs

@@ -78,7 +78,7 @@ knownUrls = do
 	 - any journaled changes are reflected in it, since we're going
 	 - to query its index directly. -}
 	Annex.Branch.update
-	Annex.Branch.commit "update"
+	Annex.Branch.commit =<< Annex.Branch.commitMessage
 	Annex.Branch.withIndex $ do
 		top <- fromRepo Git.repoPath
 		(l, cleanup) <- inRepo $ Git.LsFiles.stagedDetails [top]

Remote/Git.hs

@@ -728,7 +728,7 @@ commitOnCleanup repo r a = go `after` a
 	cleanup
 		| not $ Git.repoIsUrl repo = onLocalFast repo r $
 			doQuietSideAction $
-				Annex.Branch.commit "update"
+				Annex.Branch.commit =<< Annex.Branch.commitMessage
 		| otherwise = void $ do
 			Just (shellcmd, shellparams) <-
 				Ssh.git_annex_shell NoConsumeStdin

Types/GitConfig.hs

@@ -62,6 +62,7 @@ data GitConfig = GitConfig
 	, annexBloomAccuracy :: Maybe Int
 	, annexSshCaching :: Maybe Bool
 	, annexAlwaysCommit :: Bool
+	, annexCommitMessage :: Maybe String
 	, annexMergeAnnexBranches :: Bool
 	, annexDelayAdd :: Maybe Int
 	, annexHttpHeaders :: [String]
@@ -123,6 +124,7 @@ extractGitConfig r = GitConfig
 	, annexBloomAccuracy = getmayberead (annex "bloomaccuracy")
 	, annexSshCaching = getmaybebool (annex "sshcaching")
 	, annexAlwaysCommit = getbool (annex "alwayscommit") True
+	, annexCommitMessage = getmaybe (annex "commitmessage")
 	, annexMergeAnnexBranches = getbool (annex "merge-annex-branches") True
 	, annexDelayAdd = getmayberead (annex "delayadd")
 	, annexHttpHeaders = getlist (annex "http-headers")

doc/git-annex.mdwn

@@ -974,6 +974,17 @@ Here are all the supported configuration settings.
   since it could garbage collect objects that are staged in git-annex's
   index but not yet committed.
 
+* `annex.commitmessage`
+
+  When git-annex updates the git-annex branch, it usually makes up
+  its own commit message ("update"), since users rarely look at or
+  care about changes to that branch. If you do care, you can
+  specify this setting by running commands with
+  `-c annex.commitmessage=whatever`
+
+  This works well in combination with annex.alwayscommit=false,
+  to gather up a set of changes and commit them with a message you specify.
+
 * `annex.merge-annex-branches`
 
   By default, git-annex branches that have been pulled from remotes

doc/todo/be_able_to_specify_custom_commit_message_for_git-annex_branch_commit.mdwn

@@ -1,3 +1,5 @@
 ATM many commit messages in git-annex branch are just an "update".  But I wondered if it could be relatively simple to implement to be able to provide a custom commit message, e.g. by defining some environment variable (e.g. GIT_ANNEX_UPDATE_MESSAGE) during whatever process is initiating the actual commit?  sure thing there could be cases whenever multiple processes "contributed" to the changes which are finally "flushed" by committing, but imho it could provide a good way to annotate changes within git-annex branch at least to some degree.  E.g. I could use "update: added URLs to the files for datalad-archives remote" ;)
 
 [[!meta author=yoh]]
+
+> [[done]] as annex.commitmessage config. --[[Joey]]