diff options
author | Joey Hess <joeyh@debian.org> | 2013-12-03 15:02:21 -0400 |
---|---|---|
committer | Joey Hess <joeyh@debian.org> | 2013-12-03 15:02:21 -0400 |
commit | b1ed0aee347a88507d1530f61006cd658b57e54c (patch) | |
tree | eb2a975663782f83e6b20d6d239447d7222de81b /Git/Branch.hs | |
parent | 7e592e1d6ed5e0b25b37215da7558c6324688d6f (diff) | |
parent | a4f3e112954e1b785c84c339bcbd83597a89335e (diff) | |
download | git-repair-b1ed0aee347a88507d1530f61006cd658b57e54c.tar.gz |
Record git-repair (1.20131203) in archive suite sid
Diffstat (limited to 'Git/Branch.hs')
-rw-r--r-- | Git/Branch.hs | 36 |
1 files changed, 28 insertions, 8 deletions
diff --git a/Git/Branch.hs b/Git/Branch.hs index 7b3297d..405fa10 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 |