export the commit function and generalize
This commit is contained in:
parent
40ec8a9726
commit
5d20ac5800
2 changed files with 14 additions and 11 deletions
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue