diff options
Diffstat (limited to 'Git')
| -rw-r--r-- | Git/Branch.hs | 36 | ||||
| -rw-r--r-- | Git/Fsck.hs | 9 | ||||
| -rw-r--r-- | Git/Ref.hs | 6 |
3 files changed, 38 insertions, 13 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 diff --git a/Git/Fsck.hs b/Git/Fsck.hs index 8555aa0..8d5b75b 100644 --- a/Git/Fsck.hs +++ b/Git/Fsck.hs @@ -37,17 +37,16 @@ data FsckResults = FsckFoundMissing MissingObjects | FsckFailed -} findBroken :: Bool -> Repo -> IO FsckResults findBroken batchmode r = do + let (command, params) = ("git", fsckParams r) + (command', params') <- if batchmode + then toBatchCommand (command, params) + else return (command, params) (output, fsckok) <- processTranscript command' (toCommand params') Nothing let objs = findShas output badobjs <- findMissing objs r if S.null badobjs && not fsckok then return FsckFailed else return $ FsckFoundMissing badobjs - where - (command, params) = ("git", fsckParams r) - (command', params') - | batchmode = toBatchCommand (command, params) - | otherwise = (command, params) foundBroken :: FsckResults -> Bool foundBroken FsckFailed = True @@ -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) -} |