diff options
Diffstat (limited to 'Git')
| -rw-r--r-- | Git/Branch.hs | 36 | ||||
| -rw-r--r-- | Git/Ref.hs | 6 |
2 files changed, 34 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 diff --git a/Git/Ref.hs b/Git/Ref.hs index 6ce1b8784..09472930f 100644 --- a/Git/Ref.hs +++ b/Git/Ref.hs @@ -10,6 +10,7 @@ module Git.Ref where import Common import Git import Git.Command +import Git.Sha import Data.Char (chr) @@ -105,6 +106,11 @@ matchingUniq refs repo = nubBy uniqref <$> matching refs repo where uniqref (a, _) (b, _) = a == b +{- Gets the sha of the tree a ref uses. -} +tree :: Ref -> Repo -> IO (Maybe Sha) +tree ref = extractSha <$$> pipeReadStrict + [ Param "rev-parse", Param (show ref ++ ":") ] + {- Checks if a String is a legal git ref name. - - The rules for this are complex; see git-check-ref-format(1) -} |