1{- adjusted branch merging
2 -
3 - Copyright 2016-2020 Joey Hess <id@joeyh.name>
4 -
5 - Licensed under the GNU AGPL version 3 or higher.
6 -}
7
8{-# LANGUAGE BangPatterns, OverloadedStrings #-}
9
10module Annex.AdjustedBranch.Merge (
11	mergeToAdjustedBranch,
12) where
13
14import Annex.Common
15import Annex.AdjustedBranch
16import qualified Annex
17import Git
18import Git.Types
19import qualified Git.Branch
20import qualified Git.Ref
21import qualified Git.Command
22import qualified Git.Merge
23import Git.Sha
24import Annex.CatFile
25import Annex.AutoMerge
26import Annex.Tmp
27import Annex.GitOverlay
28import Utility.Tmp.Dir
29import Utility.CopyFile
30import Utility.Directory.Create
31
32import qualified Data.ByteString as S
33import qualified System.FilePath.ByteString as P
34
35{- Update the currently checked out adjusted branch, merging the provided
36 - branch into it. Note that the provided branch should be a non-adjusted
37 - branch. -}
38mergeToAdjustedBranch :: Branch -> (OrigBranch, Adjustment) -> [Git.Merge.MergeConfig] -> Bool -> Git.Branch.CommitMode -> Annex Bool
39mergeToAdjustedBranch tomerge (origbranch, adj) mergeconfig canresolvemerge commitmode = catchBoolIO $
40	join $ preventCommits go
41  where
42	adjbranch@(AdjBranch currbranch) = originalToAdjusted origbranch adj
43	basis = basisBranch adjbranch
44
45	go commitsprevented =
46		ifM (inRepo $ Git.Branch.changed currbranch tomerge)
47			( do
48				(updatedorig, _) <- propigateAdjustedCommits'
49					origbranch adj commitsprevented
50				changestomerge updatedorig
51			, nochangestomerge
52			)
53
54	nochangestomerge = return $ return True
55
56	{- Since the adjusted branch changes files, merging tomerge
57	 - directly into it would likely result in unncessary merge
58	 - conflicts. To avoid those conflicts, instead merge tomerge into
59	 - updatedorig. The result of the merge can the be
60	 - adjusted to yield the final adjusted branch.
61	 -
62	 - In order to do a merge into a ref that is not checked out,
63	 - set the work tree to a temp directory, and set GIT_DIR
64	 - to another temp directory, in which HEAD contains the
65	 - updatedorig sha. GIT_COMMON_DIR is set to point to the real
66	 - git directory, and so git can read and write objects from there,
67	 - but will use GIT_DIR for HEAD and index.
68	 -
69	 - (Doing the merge this way also lets it run even though the main
70	 - index file is currently locked.)
71	 -}
72	changestomerge (Just updatedorig) = withOtherTmp $ \othertmpdir -> do
73		git_dir <- fromRepo Git.localGitDir
74		let git_dir' = fromRawFilePath git_dir
75		tmpwt <- fromRepo gitAnnexMergeDir
76		withTmpDirIn (fromRawFilePath othertmpdir) "git" $ \tmpgit -> withWorkTreeRelated tmpgit $
77			withemptydir git_dir tmpwt $ withWorkTree tmpwt $ do
78				liftIO $ writeFile (tmpgit </> "HEAD") (fromRef updatedorig)
79				-- Copy in refs and packed-refs, to work
80				-- around bug in git 2.13.0, which
81				-- causes it not to look in GIT_DIR for refs.
82				refs <- liftIO $ dirContentsRecursive $
83					git_dir' </> "refs"
84				let refs' = (git_dir' </> "packed-refs") : refs
85				liftIO $ forM_ refs' $ \src ->
86					whenM (doesFileExist src) $ do
87						dest <- relPathDirToFile git_dir
88							(toRawFilePath src)
89						let dest' = toRawFilePath tmpgit P.</> dest
90						createDirectoryUnder git_dir
91							(P.takeDirectory dest')
92						void $ createLinkOrCopy src
93							(fromRawFilePath dest')
94				-- This reset makes git merge not care
95				-- that the work tree is empty; otherwise
96				-- it will think that all the files have
97				-- been staged for deletion, and sometimes
98				-- the merge includes these deletions
99				-- (for an unknown reason).
100				-- http://thread.gmane.org/gmane.comp.version-control.git/297237
101				inRepo $ Git.Command.run [Param "reset", Param "HEAD", Param "--quiet"]
102				showAction $ "Merging into " ++ fromRef (Git.Ref.base origbranch)
103				merged <- autoMergeFrom' tomerge Nothing mergeconfig commitmode True
104					(const $ resolveMerge (Just updatedorig) tomerge True)
105				if merged
106					then do
107						!mergecommit <- liftIO $ extractSha
108							<$> S.readFile (tmpgit </> "HEAD")
109						-- This is run after the commit lock is dropped.
110						return $ postmerge mergecommit
111					else return $ return False
112	changestomerge Nothing = return $ return False
113
114	withemptydir git_dir d a = bracketIO setup cleanup (const a)
115	  where
116		setup = do
117			whenM (doesDirectoryExist d) $
118				removeDirectoryRecursive d
119			createDirectoryUnder git_dir (toRawFilePath d)
120		cleanup _ = removeDirectoryRecursive d
121
122	{- A merge commit has been made between the basisbranch and
123	 - tomerge. Update the basisbranch and origbranch to point
124	 - to that commit, adjust it to get the new adjusted branch,
125	 - and check it out.
126	 -
127	 - But, there may be unstaged work tree changes that conflict,
128	 - so the check out is done by making a normal merge of
129	 - the new adjusted branch.
130	 -}
131	postmerge (Just mergecommit) = do
132		setBasisBranch basis mergecommit
133		inRepo $ Git.Branch.update' origbranch mergecommit
134		adjtree <- adjustTree adj (BasisBranch mergecommit)
135		adjmergecommit <- commitAdjustedTree adjtree (BasisBranch mergecommit)
136		-- Make currbranch be the parent, so that merging
137		-- this commit will be a fast-forward.
138		adjmergecommitff <- commitAdjustedTree' adjtree (BasisBranch mergecommit) [currbranch]
139		showAction "Merging into adjusted branch"
140		ifM (autoMergeFrom adjmergecommitff (Just currbranch) mergeconfig commitmode canresolvemerge)
141			( reparent adjtree adjmergecommit =<< getcurrentcommit
142			, return False
143			)
144	postmerge Nothing = return False
145
146	-- Now that the merge into the adjusted branch is complete,
147	-- take the tree from that merge, and attach it on top of the
148	-- adjmergecommit, if it's different.
149	reparent adjtree adjmergecommit (Just currentcommit) = do
150		if (commitTree currentcommit /= adjtree)
151			then do
152				cmode <- annexCommitMode <$> Annex.getGitConfig
153				c <- inRepo $ Git.Branch.commitTree cmode
154					("Merged " ++ fromRef tomerge) [adjmergecommit]
155					(commitTree currentcommit)
156				inRepo $ Git.Branch.update "updating adjusted branch" currbranch c
157				propigateAdjustedCommits origbranch adj
158			else inRepo $ Git.Branch.update "updating adjusted branch" currbranch adjmergecommit
159		return True
160	reparent _ _ Nothing = return False
161
162	getcurrentcommit = inRepo Git.Branch.currentUnsafe >>= \case
163		Nothing -> return Nothing
164		Just c -> catCommit c
165