aboutsummaryrefslogtreecommitdiff
path: root/Git/Branch.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2013-12-01 13:59:39 -0400
committerGravatar Joey Hess <joey@kitenet.net>2013-12-01 13:59:45 -0400
commit91bf77fae4e0645d466db01a9a45f6a380c933f7 (patch)
treea2e57e048dfb9c40edd6ae74d293ec92beb23eb1 /Git/Branch.hs
parent05224f307e37aa51b8daa11ce2d2657e4b41bed3 (diff)
Avoid using git commit in direct mode, since in some situations it will read the full contents of files in the tree.
The assistant's commit code also always avoids git commit, for simplicity. Indirect mode sync still does a git commit -a to catch unstaged changes. Note that this means that direct mode sync no longer runs the pre-commit hook or any other hooks git commit might call. The git annex pre-commit hook action for direct mode is however explicitly run. (The assistant already ran git commit with hooks disabled, so no change there.)
Diffstat (limited to 'Git/Branch.hs')
-rw-r--r--Git/Branch.hs36
1 files changed, 28 insertions, 8 deletions
diff --git a/Git/Branch.hs b/Git/Branch.hs
index 7b3297d74..405fa108f 100644
--- a/Git/Branch.hs
+++ b/Git/Branch.hs
@@ -89,18 +89,38 @@ fastForward branch (first:rest) repo =
(False, False) -> findbest c rs -- same
{- Commits the index into the specified branch (or other ref),
- - with the specified parent refs, and returns the committed sha -}
-commit :: String -> Branch -> [Ref] -> Repo -> IO Sha
-commit message branch parentrefs repo = do
+ - with the specified parent refs, and returns the committed sha.
+ -
+ - Without allowempy set, avoids making a commit if there is exactly
+ - one parent, and it has the same tree that would be committed.
+ -
+ - Unlike git-commit, does not run any hooks, or examine the work tree
+ - in any way.
+ -}
+commit :: Bool -> String -> Branch -> [Ref] -> Repo -> IO (Maybe Sha)
+commit allowempty message branch parentrefs repo = do
tree <- getSha "write-tree" $
pipeReadStrict [Param "write-tree"] repo
- sha <- getSha "commit-tree" $ pipeWriteRead
- (map Param $ ["commit-tree", show tree] ++ ps)
- (Just $ flip hPutStr message) repo
- update branch sha repo
- return sha
+ ifM (cancommit tree)
+ ( do
+ sha <- getSha "commit-tree" $ pipeWriteRead
+ (map Param $ ["commit-tree", show tree] ++ ps)
+ (Just $ flip hPutStr message) repo
+ update branch sha repo
+ return $ Just sha
+ , return Nothing
+ )
where
ps = concatMap (\r -> ["-p", show r]) parentrefs
+ cancommit tree
+ | allowempty = return True
+ | otherwise = case parentrefs of
+ [p] -> maybe False (tree /=) <$> Git.Ref.tree p repo
+ _ -> return True
+
+commitAlways :: String -> Branch -> [Ref] -> Repo -> IO Sha
+commitAlways message branch parentrefs repo = fromJust
+ <$> commit True message branch parentrefs repo
{- A leading + makes git-push force pushing a branch. -}
forcePush :: String -> String