summaryrefslogtreecommitdiff
path: root/Git/Branch.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Git/Branch.hs')
-rw-r--r--Git/Branch.hs20
1 files changed, 13 insertions, 7 deletions
diff --git a/Git/Branch.hs b/Git/Branch.hs
index a2225dc73..ff209d44d 100644
--- a/Git/Branch.hs
+++ b/Git/Branch.hs
@@ -23,7 +23,7 @@ import qualified Git.BuildVersion
- branch is not created yet. So, this also looks at show-ref HEAD
- to double-check.
-}
-current :: Repo -> IO (Maybe Git.Ref)
+current :: Repo -> IO (Maybe Branch)
current r = do
v <- currentUnsafe r
case v of
@@ -35,7 +35,7 @@ current r = do
)
{- The current branch, which may not really exist yet. -}
-currentUnsafe :: Repo -> IO (Maybe Git.Ref)
+currentUnsafe :: Repo -> IO (Maybe Branch)
currentUnsafe r = parse . firstLine
<$> pipeReadStrict [Param "symbolic-ref", Param "-q", Param $ fromRef Git.Ref.headRef] r
where
@@ -144,26 +144,32 @@ commit commitmode allowempty message branch parentrefs repo = do
pipeReadStrict [Param "write-tree"] repo
ifM (cancommit tree)
( do
- sha <- getSha "commit-tree" $
- pipeWriteRead ([Param "commit-tree", Param (fromRef tree)] ++ ps) sendmsg repo
+ sha <- commitTree commitmode message parentrefs tree repo
update branch sha repo
return $ Just sha
, return Nothing
)
where
- ps = applyCommitMode commitmode $
- map Param $ 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
- sendmsg = Just $ flip hPutStr message
commitAlways :: CommitMode -> String -> Branch -> [Ref] -> Repo -> IO Sha
commitAlways commitmode message branch parentrefs repo = fromJust
<$> commit commitmode True message branch parentrefs repo
+commitTree :: CommitMode -> String -> [Ref] -> Ref -> Repo -> IO Sha
+commitTree commitmode message parentrefs tree repo =
+ getSha "commit-tree" $
+ pipeWriteRead ([Param "commit-tree", Param (fromRef tree)] ++ ps)
+ sendmsg repo
+ where
+ ps = applyCommitMode commitmode $
+ map Param $ concatMap (\r -> ["-p", fromRef r]) parentrefs
+ sendmsg = Just $ flip hPutStr message
+
{- A leading + makes git-push force pushing a branch. -}
forcePush :: String -> String
forcePush b = "+" ++ b