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
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
|
{- git-annex automatic merge conflict resolution
-
- Copyright 2012-2014 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Annex.AutoMerge (autoMergeFrom) where
import Common.Annex
import qualified Annex.Queue
import Annex.Direct
import Annex.CatFile
import Annex.Link
import qualified Git.Command
import qualified Git.LsFiles as LsFiles
import qualified Git.UpdateIndex as UpdateIndex
import qualified Git.Merge
import qualified Git.Ref
import qualified Git
import Git.Types (BlobType(..))
import Config
import Annex.ReplaceFile
import Git.FileMode
import Annex.VariantFile
import qualified Data.Set as S
{- Merges from a branch into the current branch
- (which may not exist yet),
- with automatic merge conflict resolution. -}
autoMergeFrom :: Git.Ref -> (Maybe Git.Ref) -> Annex Bool
autoMergeFrom branch currbranch = do
showOutput
case currbranch of
Nothing -> go Nothing
Just b -> go =<< inRepo (Git.Ref.sha b)
where
go old = ifM isDirect
( mergeDirect currbranch old branch (resolveMerge old branch)
, inRepo (Git.Merge.mergeNonInteractive branch)
<||> resolveMerge old branch
)
{- Resolves a conflicted merge. It's important that any conflicts be
- resolved in a way that itself avoids later merge conflicts, since
- multiple repositories may be doing this concurrently.
-
- Only merge conflicts where at least one side is an annexed file
- is resolved.
-
- This uses the Keys pointed to by the files to construct new
- filenames. So when both sides modified annexed file foo,
- it will be deleted, and replaced with files foo.variant-A and
- foo.variant-B.
-
- On the other hand, when one side deleted foo, and the other modified it,
- it will be deleted, and the modified version stored as file
- foo.variant-A (or B).
-
- It's also possible that one side has foo as an annexed file, and
- the other as a directory or non-annexed file. The annexed file
- is renamed to resolve the merge, and the other object is preserved as-is.
-
- In indirect mode, the merge is resolved in the work tree and files
- staged, to clean up from a conflicted merge that was run in the work
- tree. The resolution is committed.
-
- In direct mode, the work tree is not touched here, and no commit is made;
- files are staged to the index, and written to the gitAnnexMergeDir, and
- later mergeDirectCleanup handles updating the work tree.
-}
resolveMerge :: Maybe Git.Ref -> Git.Ref -> Annex Bool
resolveMerge us them = do
top <- fromRepo Git.repoPath
(fs, cleanup) <- inRepo (LsFiles.unmerged [top])
mergedfs <- catMaybes <$> mapM (resolveMerge' us them) fs
let merged = not (null mergedfs)
void $ liftIO cleanup
unlessM isDirect $ do
(deleted, cleanup2) <- inRepo (LsFiles.deleted [top])
unless (null deleted) $
Annex.Queue.addCommand "rm" [Params "--quiet -f --"] deleted
void $ liftIO cleanup2
when merged $ do
unlessM isDirect $
cleanConflictCruft mergedfs top
Annex.Queue.flush
unlessM isDirect $ do
void $ inRepo $ Git.Command.runBool
[ Param "commit"
, Param "--no-verify"
, Param "-m"
, Param "git-annex automatic merge conflict fix"
]
showLongNote "Merge conflict was automatically resolved; you may want to examine the result."
return merged
resolveMerge' :: Maybe Git.Ref -> Git.Ref -> LsFiles.Unmerged -> Annex (Maybe FilePath)
resolveMerge' Nothing _ _ = return Nothing
resolveMerge' (Just us) them u = do
kus <- getkey LsFiles.valUs LsFiles.valUs
kthem <- getkey LsFiles.valThem LsFiles.valThem
case (kus, kthem) of
-- Both sides of conflict are annexed files
(Just keyUs, Just keyThem)
| keyUs /= keyThem -> resolveby $ do
makelink keyUs
makelink keyThem
| otherwise -> resolveby $
makelink keyUs
-- Our side is annexed file, other side is not.
(Just keyUs, Nothing) -> resolveby $ do
graftin them file
makelink keyUs
-- Our side is not annexed file, other side is.
(Nothing, Just keyThem) -> resolveby $ do
graftin us file
makelink keyThem
-- Neither side is annexed file; cannot resolve.
(Nothing, Nothing) -> return Nothing
where
file = LsFiles.unmergedFile u
getkey select select'
| select (LsFiles.unmergedBlobType u) == Just SymlinkBlob =
case select' (LsFiles.unmergedSha u) of
Nothing -> return Nothing
Just sha -> catKey sha symLinkMode
| otherwise = return Nothing
makelink key = do
let dest = variantFile file key
l <- inRepo $ gitAnnexLink dest key
ifM isDirect
( do
d <- fromRepo gitAnnexMergeDir
replaceFile (d </> dest) $ makeAnnexLink l
, replaceFile dest $ makeAnnexLink l
)
stageSymlink dest =<< hashSymlink l
{- stage a graft of a directory or file from a branch -}
graftin b item = Annex.Queue.addUpdateIndex
=<< fromRepo (UpdateIndex.lsSubTree b item)
resolveby a = do
{- Remove conflicted file from index so merge can be resolved. -}
Annex.Queue.addCommand "rm" [Params "--quiet -f --cached --"] [file]
void a
return (Just file)
{- git-merge moves conflicting files away to files
- named something like f~HEAD or f~branch, but the
- exact name chosen can vary. Once the conflict is resolved,
- this cruft can be deleted. To avoid deleting legitimate
- files that look like this, only delete files that are
- A) not staged in git and B) look like git-annex symlinks.
-}
cleanConflictCruft :: [FilePath] -> FilePath -> Annex ()
cleanConflictCruft resolvedfs top = do
(fs, cleanup) <- inRepo $ LsFiles.notInRepo False [top]
mapM_ clean fs
void $ liftIO cleanup
where
clean f
| matchesresolved f = whenM (isJust <$> isAnnexLink f) $
liftIO $ nukeFile f
| otherwise = noop
s = S.fromList resolvedfs
matchesresolved f = S.member (base f) s
base f = reverse $ drop 1 $ dropWhile (/= '~') $ reverse f
|
