diff options
author | Joey Hess <joey@kitenet.net> | 2011-06-21 14:09:06 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2011-06-21 14:09:06 -0400 |
commit | e735d459b531246798622994718eaccfcf0086ab (patch) | |
tree | 4c63e9142a51e4c176f7379c4a41ed5b6fcf9cd2 /git-union-merge.hs | |
parent | 9f9e17aa0f4898063a58c88661bca01465b126a9 (diff) |
moved to library
Diffstat (limited to 'git-union-merge.hs')
-rw-r--r-- | git-union-merge.hs | 107 |
1 files changed, 5 insertions, 102 deletions
diff --git a/git-union-merge.hs b/git-union-merge.hs index e11f93701..62a79a4c2 100644 --- a/git-union-merge.hs +++ b/git-union-merge.hs @@ -6,17 +6,9 @@ -} import System.Environment -import System.FilePath -import System.Directory -import System.Cmd.Utils -import System.Posix.Env (setEnv) -import Control.Monad (when) -import Data.List -import Data.Maybe -import Data.String.Utils +import GitUnionMerge import qualified GitRepo as Git -import Utility header :: String header = "Usage: git-union-merge ref ref newref" @@ -24,14 +16,6 @@ header = "Usage: git-union-merge ref ref newref" usage :: IO a usage = error $ "bad parameters\n\n" ++ header -main :: IO () -main = do - [aref, bref, newref] <- parseArgs - g <- setup - stage g aref bref - commit g aref bref newref - cleanup g - parseArgs :: IO [String] parseArgs = do args <- getArgs @@ -39,89 +23,8 @@ parseArgs = do then usage else return args -tmpIndex :: Git.Repo -> FilePath -tmpIndex g = Git.workTree g </> Git.gitDir g </> "index.git-union-merge" - -{- Configures git to use a temporary index file. -} -setup :: IO Git.Repo -setup = do +main :: IO () +main = do + [aref, bref, newref] <- parseArgs g <- Git.configRead =<< Git.repoFromCwd - cleanup g -- idempotency - setEnv "GIT_INDEX_FILE" (tmpIndex g) True - return g - -cleanup :: Git.Repo -> IO () -cleanup g = do - e' <- doesFileExist (tmpIndex g) - when e' $ removeFile (tmpIndex g) - -{- 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] - -- Identify files that are different between aref and bref, and - -- inject merged versions into git. - diff <- fromgit - ["diff-tree", "--raw", "-z", "-r", "--no-renames", "-l0", aref, bref] - ls' <- mapM mergefile (pairs diff) - -- Populate the index file. Later lines override earlier ones. - togit ["update-index", "-z", "--index-info"] - (join "\0" $ ls++catMaybes ls') - where - 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' - ls_tree_line sha file = "100644 blob " ++ sha ++ "\t" ++ file - unionmerge = unlines . nub . lines - - mergefile (info, file) = do - let [_colonamode, _bmode, asha, bsha, _status] = words info - if bsha == nullsha - then return Nothing -- already staged from aref - else mergefile' file asha bsha - 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 - return $ Just $ ls_tree_line sha file - -{- Commits the index into the specified branch. -} -commit :: Git.Repo -> String -> String -> String -> IO () -commit g aref bref newref = do - tree <- getSha "write-tree" $ - pipeFrom "git" ["write-tree"] - sha <- getSha "commit-tree" $ - 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 + unionMerge g aref bref newref |