merge from git-annex

Fixes 2 bugs, one a data loss bug. It is possible to get those fixes
without merging all the other changes, if a backport is wanted.

1 files changed, 15 insertions, 2 deletions

diff --git a/Git/Branch.hs b/Git/Branch.hs
index fcae905..54af101 100644
--- a/Git/Branch.hs
+++ b/Git/Branch.hs
@@ -1,6 +1,6 @@
 {- git branch stuff
  -
- - Copyright 2011 Joey Hess <id@joeyh.name>
+ - Copyright 2011-2021 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -166,7 +166,7 @@ commitCommand' runner commitmode ps = runner $
  -}
 commit :: CommitMode -> Bool -> String -> Branch -> [Ref] -> Repo -> IO (Maybe Sha)
 commit commitmode allowempty message branch parentrefs repo = do
-	tree <- getSha "write-tree" $ pipeReadStrict [Param "write-tree"] repo
+	tree <- writeTree repo
 	ifM (cancommit tree)
 		( do
 			sha <- commitTree commitmode message parentrefs tree repo
@@ -185,6 +185,19 @@ commitAlways :: CommitMode -> String -> Branch -> [Ref] -> Repo -> IO Sha
 commitAlways commitmode message branch parentrefs repo = fromJust
 	<$> commit commitmode True message branch parentrefs repo
 
+-- Throws exception if the index is locked, with an error message output by
+-- git on stderr.
+writeTree :: Repo -> IO Sha
+writeTree repo = getSha "write-tree" $
+	pipeReadStrict [Param "write-tree"] repo
+
+-- Avoids error output if the command fails due to eg, the index being locked.
+writeTreeQuiet :: Repo -> IO (Maybe Sha)
+writeTreeQuiet repo = extractSha <$> withNullHandle go
+  where
+	go nullh = pipeReadStrict' (\p -> p { std_err = UseHandle nullh }) 
+		[Param "write-tree"] repo
+
 commitTree :: CommitMode -> String -> [Ref] -> Ref -> Repo -> IO Sha
 commitTree commitmode message parentrefs tree repo =
 	getSha "commit-tree" $