1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
|
{- git-union-merge program
-
- Copyright 2011 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
import System.Environment
import System.FilePath
import System.Directory
import System.Cmd
import System.Cmd.Utils
import System.Posix.Env (setEnv)
import System.Posix.Directory (changeWorkingDirectory)
import Control.Monad (when, unless)
import Data.List
import qualified GitRepo as Git
import Utility
header :: String
header = "Usage: git-union-merge branch ref ref"
usage :: IO a
usage = error $ "bad parameters\n\n" ++ header
main :: IO ()
main = do
[branch, aref, bref] <- parseArgs
g <- setup
stage g aref bref
commit g branch aref bref
cleanup g
parseArgs :: IO [String]
parseArgs = do
args <- getArgs
if (length args /= 3)
then usage
else return args
tmpDir :: Git.Repo -> FilePath
tmpDir g = Git.workTree g </> Git.gitDir g </> "tmp" </> "git-union-merge"
tmpIndex :: Git.Repo -> FilePath
tmpIndex g = Git.workTree g </> Git.gitDir g </> "tmp" </> "git-union-merge.index"
{- Moves to a temporary directory, and configures git to use it as its
- working tree, and to use a temporary index file as well. -}
setup :: IO Git.Repo
setup = do
g <- Git.configRead =<< Git.repoFromCwd
cleanup g -- idempotency
let tmp = tmpDir g
createDirectoryIfMissing True tmp
changeWorkingDirectory tmp
-- Note that due to these variables being set, Git.run and
-- similar helpers cannot be used, as they override the work tree.
-- It is only safe to use Git.run etc when doing things that do
-- not operate on the work tree.
setEnv "GIT_WORK_TREE" tmp True
setEnv "GIT_INDEX_FILE" (tmpIndex g) True
return g
cleanup :: Git.Repo -> IO ()
cleanup g = do
e <- doesDirectoryExist (tmpDir g)
when e $ removeDirectoryRecursive (tmpDir g)
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
-- populate index with the contents of aref, as a starting point
_ <- system $ "git ls-tree -r --full-name --full-tree " ++ aref ++
" | git update-index --index-info"
-- identify files that are different in bref, and stage merged files
diff <- Git.pipeNullSplit g $ map Param
["diff-tree", "--raw", "-z", "--no-renames", "-l0", aref, bref]
mapM_ genfile (pairs diff)
_ <- system "git add ."
return ()
where
pairs [] = []
pairs (_:[]) = error "parse error"
pairs (a:b:rest) = (a,b):pairs rest
nullsha = take 40 $ repeat '0'
genfile (info, file) = do
let [_colonamode, _bmode, asha, bsha, _status] = words info
let shas =
if bsha == nullsha
then [] -- staged from aref
else
if asha == nullsha
then [bsha]
else [asha, bsha]
unless (null shas) $ do
content <- Git.pipeRead g $ map Param ("show":shas)
writeFile file $ unlines $ nub $ lines content
{- Commits the index into the specified branch. -}
commit :: Git.Repo -> String -> String -> String -> IO ()
commit g branch aref bref = do
tree <- getsha $
pipeFrom "git" ["write-tree"]
sha <- getsha $
pipeBoth "git" ["commit-tree", tree, "-p", aref, "-p", bref]
"union merge"
Git.run g "update-ref" [Param $ "refs/heads/" ++ branch, Param sha]
where
getsha a = do
(_, t) <- a
let t' = if last t == '\n'
then take (length t - 1) t
else t
when (null t') $ error "failed to read sha from git"
return t'
|
