export the commit function and generalize

This commit is contained in:
Joey Hess 2011-06-21 19:09:20 -04:00
parent 40ec8a9726
commit 5d20ac5800
2 changed files with 14 additions and 11 deletions

View file

@ -6,7 +6,9 @@
-} -}
module GitUnionMerge ( module GitUnionMerge (
unionMerge merge,
stage,
commit
) where ) where
import System.Cmd.Utils import System.Cmd.Utils
@ -23,10 +25,10 @@ import Utility
- Use indexpopulated only if the index file already contains exactly the - Use indexpopulated only if the index file already contains exactly the
- contents of aref. - contents of aref.
-} -}
unionMerge :: Git.Repo -> String -> String -> String -> Bool -> IO () merge :: Git.Repo -> String -> String -> String -> Bool -> IO ()
unionMerge g aref bref newref indexpopulated = do merge g aref bref newref indexpopulated = do
stage g aref bref indexpopulated stage g aref bref indexpopulated
commit g aref bref newref commit g "union merge" newref [aref, bref]
{- Stages the content of both refs into the index. -} {- Stages the content of both refs into the index. -}
stage :: Git.Repo -> String -> String -> Bool -> IO () stage :: Git.Repo -> String -> String -> Bool -> IO ()
@ -68,14 +70,15 @@ stage g aref bref indexpopulated = do
sha <- Git.hashObject g $ unionmerge content sha <- Git.hashObject g $ unionmerge content
return $ Just $ ls_tree_line sha file return $ Just $ ls_tree_line sha file
{- Commits the index into the specified branch, as a merge commit. -} {- Commits the index into the specified branch. If refs are specified,
commit :: Git.Repo -> String -> String -> String -> IO () - commits a merge. -}
commit g aref bref newref = do commit :: Git.Repo -> String -> String -> [String] -> IO ()
commit g message newref mergedrefs = do
tree <- Git.getSha "write-tree" $ ignorehandle $ tree <- Git.getSha "write-tree" $ ignorehandle $
pipeFrom "git" ["write-tree"] pipeFrom "git" ["write-tree"]
sha <- Git.getSha "commit-tree" $ ignorehandle $ sha <- Git.getSha "commit-tree" $ ignorehandle $
pipeBoth "git" ["commit-tree", tree, "-p", aref, "-p", bref] pipeBoth "git" (["commit-tree", tree] ++ ps) message
"union merge"
Git.run g "update-ref" [Param newref, Param sha] Git.run g "update-ref" [Param newref, Param sha]
where where
ignorehandle a = return . snd =<< a ignorehandle a = return . snd =<< a
ps = concatMap (\r -> ["-p", r]) mergedrefs

View file

@ -10,7 +10,7 @@ import System.FilePath
import System.Directory import System.Directory
import Control.Monad (when) import Control.Monad (when)
import GitUnionMerge import qualified GitUnionMerge
import qualified GitRepo as Git import qualified GitRepo as Git
header :: String header :: String
@ -44,5 +44,5 @@ main = do
g <- Git.configRead =<< Git.repoFromCwd g <- Git.configRead =<< Git.repoFromCwd
Git.useIndex (tmpIndex g) Git.useIndex (tmpIndex g)
setup g setup g
unionMerge g aref bref newref False GitUnionMerge.merge g aref bref newref False
cleanup g cleanup g