diff options
author | 2011-06-21 17:39:45 -0400 | |
---|---|---|
committer | 2011-06-21 17:52:39 -0400 | |
commit | 40ec8a9726586f24357a5ae2057a092a971c1046 (patch) | |
tree | 3da8a6b99fe58f3405fcfb117050b5821fbc0041 /GitUnionMerge.hs | |
parent | 7e7428f173ba1b72b4de69fd482f44161ee84420 (diff) |
Branch module complete
Refactored some code that it needs into GitRepo.
Diffstat (limited to 'GitUnionMerge.hs')
-rw-r--r-- | GitUnionMerge.hs | 60 |
1 files changed, 21 insertions, 39 deletions
diff --git a/GitUnionMerge.hs b/GitUnionMerge.hs index 8aa04f53a..ba9ea79e4 100644 --- a/GitUnionMerge.hs +++ b/GitUnionMerge.hs @@ -9,10 +9,7 @@ module GitUnionMerge ( unionMerge ) where -import System.FilePath -import System.Directory import System.Cmd.Utils -import Control.Monad (when) import Data.List import Data.Maybe import Data.String.Utils @@ -21,18 +18,24 @@ import qualified GitRepo as Git import Utility {- Performs a union merge. Should be run with a temporary index file - - configured by Git.withIndex. -} -unionMerge :: Git.Repo -> String -> String -> String -> IO () -unionMerge g aref bref newref = do - stage g aref bref + - configured by Git.useIndex. + - + - Use indexpopulated only if the index file already contains exactly the + - contents of aref. + -} +unionMerge :: Git.Repo -> String -> String -> String -> Bool -> IO () +unionMerge g aref bref newref indexpopulated = do + stage g aref bref indexpopulated commit g aref bref newref {- Stages the content of both refs into the index. -} -stage :: Git.Repo -> String -> String -> IO () -stage g aref bref = do - -- Get the contents of aref, as a starting point. - ls <- fromgit - ["ls-tree", "-z", "-r", "--full-tree", aref] +stage :: Git.Repo -> String -> String -> Bool -> IO () +stage g aref bref indexpopulated = do + -- Get the contents of aref, as a starting point, unless + -- the index is already populated with it. + ls <- if indexpopulated + then return [] + else fromgit ["ls-tree", "-z", "-r", "--full-tree", aref] -- Identify files that are different between aref and bref, and -- inject merged versions into git. diff <- fromgit @@ -45,18 +48,12 @@ stage g aref bref = do fromgit l = Git.pipeNullSplit g (map Param l) togit l content = Git.pipeWrite g (map Param l) content >>= forceSuccess - tofromgit l content = do - (h, s) <- Git.pipeWriteRead g (map Param l) content - length s `seq` do - forceSuccess h - Git.reap - return ((), s) pairs [] = [] pairs (_:[]) = error "parse error" pairs (a:b:rest) = (a,b):pairs rest - nullsha = take shaSize $ repeat '0' + nullsha = take Git.shaSize $ repeat '0' ls_tree_line sha file = "100644 blob " ++ sha ++ "\t" ++ file unionmerge = unlines . nub . lines @@ -68,32 +65,17 @@ stage g aref bref = do mergefile' file asha bsha = do let shas = filter (/= nullsha) [asha, bsha] content <- Git.pipeRead g $ map Param ("show":shas) - sha <- getSha "hash-object" $ - tofromgit ["hash-object", "-w", "--stdin"] $ - unionmerge content + sha <- Git.hashObject g $ unionmerge content return $ Just $ ls_tree_line sha file {- Commits the index into the specified branch, as a merge commit. -} commit :: Git.Repo -> String -> String -> String -> IO () commit g aref bref newref = do - tree <- getSha "write-tree" $ + tree <- Git.getSha "write-tree" $ ignorehandle $ pipeFrom "git" ["write-tree"] - sha <- getSha "commit-tree" $ + sha <- Git.getSha "commit-tree" $ ignorehandle $ pipeBoth "git" ["commit-tree", tree, "-p", aref, "-p", bref] "union merge" Git.run g "update-ref" [Param newref, Param sha] - -{- Runs an action that causes a git subcommand to emit a sha, and strips - any trailing newline, returning the sha. -} -getSha :: String -> IO (a, String) -> IO String -getSha subcommand a = do - (_, t) <- a - let t' = if last t == '\n' - then take (length t - 1) t - else t - when (length t' /= shaSize) $ - error $ "failed to read sha from git " ++ subcommand ++ " (" ++ t' ++ ")" - return t' - -shaSize :: Int -shaSize = 40 + where + ignorehandle a = return . snd =<< a |