diff options
Diffstat (limited to 'Git/Branch.hs')
| -rw-r--r-- | Git/Branch.hs | 36 |
1 files changed, 30 insertions, 6 deletions
diff --git a/Git/Branch.hs b/Git/Branch.hs index 7c7e44d75..98838ef15 100644 --- a/Git/Branch.hs +++ b/Git/Branch.hs @@ -103,6 +103,28 @@ fastForward branch (first:rest) repo = (False, True) -> findbest c rs -- worse (False, False) -> findbest c rs -- same +{- The user may have set commit.gpgsign, indending all their manual + - commits to be signed. But signing automatic/background commits could + - easily lead to unwanted gpg prompts or failures. + -} +data CommitMode = ManualCommit | AutomaticCommit + deriving (Eq) + +{- Commit via the usual git command. -} +commitCommand :: CommitMode -> [CommandParam] -> Repo -> IO Bool +commitCommand = commitCommand' runBool + +{- Commit will fail when the tree is clean. This suppresses that error. -} +commitQuiet :: CommitMode -> [CommandParam] -> Repo -> IO () +commitQuiet commitmode ps = void . tryIO . commitCommand' runQuiet commitmode ps + +commitCommand' :: ([CommandParam] -> Repo -> IO a) -> CommitMode -> [CommandParam] -> Repo -> IO a +commitCommand' runner commitmode ps = runner (Param "commit" : ps') + where + ps' + | commitmode == AutomaticCommit = Param "--no-gpg-sign" : ps + | otherwise = ps + {- Commits the index into the specified branch (or other ref), - with the specified parent refs, and returns the committed sha. - @@ -112,8 +134,8 @@ fastForward branch (first:rest) repo = - 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 +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 ifM (cancommit tree) @@ -126,16 +148,18 @@ commit allowempty message branch parentrefs repo = do , return Nothing ) where - ps = concatMap (\r -> ["-p", fromRef r]) parentrefs + ps = + (if commitmode == AutomaticCommit then ["--no-gpg-sign"] else []) + ++ concatMap (\r -> ["-p", fromRef 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 +commitAlways :: CommitMode -> String -> Branch -> [Ref] -> Repo -> IO Sha +commitAlways commitmode message branch parentrefs repo = fromJust + <$> commit commitmode True message branch parentrefs repo {- A leading + makes git-push force pushing a branch. -} forcePush :: String -> String |