1-- Copyright (C) 2002-2004,2007-2008 David Roundy 2-- Copyright (C) 2005 Juliusz Chroboczek 3-- Copyright (C) 2009 Petr Rockai 4-- 5-- This program is free software; you can redistribute it and/or modify 6-- it under the terms of the GNU General Public License as published by 7-- the Free Software Foundation; either version 2, or (at your option) 8-- any later version. 9-- 10-- This program is distributed in the hope that it will be useful, 11-- but WITHOUT ANY WARRANTY; without even the implied warranty of 12-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13-- GNU General Public License for more details. 14-- 15-- You should have received a copy of the GNU General Public License 16-- along with this program; see the file COPYING. If not, write to 17-- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 18-- Boston, MA 02110-1301, USA. 19 20 21module Darcs.Repository.Merge 22 ( tentativelyMergePatches 23 , considerMergeToWorking 24 ) where 25 26import Darcs.Prelude 27 28import Control.Monad ( when, unless ) 29import System.Exit ( exitSuccess ) 30import System.IO.Error 31 ( catchIOError 32 , ioeGetErrorType 33 , isIllegalOperationErrorType 34 ) 35 36import Darcs.Util.Tree( Tree ) 37import Darcs.Util.External ( backupByCopying ) 38 39import Darcs.Patch 40 ( RepoPatch, IsRepoType, PrimOf, merge 41 , effect 42 , listConflictedFiles ) 43import Darcs.Patch.Apply ( ApplyState ) 44import Darcs.Patch.Ident ( merge2FL ) 45import Darcs.Patch.Named ( patchcontents, anonymous ) 46import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, n2pia, hopefully ) 47import Darcs.Patch.Progress( progressFL ) 48import Darcs.Patch.Set ( PatchSet, Origin, patchSet2RL ) 49import Darcs.Patch.Witnesses.Ordered 50 ( FL(..), RL(..), Fork(..), (:\/:)(..), (:/\:)(..), (+>+), (+<<+) 51 , mapFL_FL, concatFL, reverseFL ) 52import Darcs.Patch.Witnesses.Sealed ( Sealed(Sealed), seal ) 53 54import Darcs.Repository.Flags 55 ( UseIndex 56 , ScanKnown 57 , AllowConflicts (..) 58 , Reorder (..) 59 , UpdatePending (..) 60 , ExternalMerge (..) 61 , Verbosity (..) 62 , Compression (..) 63 , WantGuiPause (..) 64 , DiffAlgorithm (..) 65 , LookForMoves(..) 66 , LookForReplaces(..) 67 ) 68import Darcs.Repository.Hashed 69 ( tentativelyAddPatches_ 70 , tentativelyRemovePatches_ 71 , UpdatePristine(..) 72 ) 73import Darcs.Repository.Pristine 74 ( applyToTentativePristine 75 , ApplyDir(..) 76 ) 77import Darcs.Repository.InternalTypes ( Repository, repoLocation ) 78import Darcs.Repository.Pending ( setTentativePending ) 79import Darcs.Repository.Resolution 80 ( externalResolution 81 , standardResolution 82 , StandardResolution(..) 83 , announceConflicts 84 ) 85import Darcs.Repository.State ( unrecordedChanges, readUnrecorded ) 86 87import Darcs.Util.Prompt ( promptYorn ) 88import Darcs.Util.Path ( anchorPath, displayPath ) 89import Darcs.Util.Progress( debugMessage ) 90import Darcs.Util.Printer.Color ( ePutDocLn ) 91import Darcs.Util.Printer ( redText, vcat ) 92 93data MakeChanges = MakeChanges | DontMakeChanges deriving ( Eq ) 94 95{- 'tentativelyMergePatches' is not easy to understand by just staring at 96the code. So here is an in-depth explanation. 97 98We start out at the state X at which our repo and the their repo deviate, 99assuming any patches common to both repos have first been commuted to the 100common part before X. So X is the intermediate state that is existentially 101hiddden inside the Fork we get passed as argument. R is our recorded state 102and Y is the recorded state of their repo. 103 104 Y R 105 \ / 106 them us 107 \ / 108 X 109 | 110 common 111 | 112 O 113 114We will elide the common part from now on. It doesn't change and we only 115pass it unmodified to standardResolution, see below. 116 117The easy part is to merge the local patches (us) with the remote ones 118(them), giving us them' and us'. 119 120 T 121 / \ 122 us' them' 123 / \ 124 Y R 125 \ / 126 them us 127 \ / 128 X 129 130 131We can ignore us' and just add them' on top of us (which are already in our 132repo), unless --reorder-patches is in effect, in which case we remove us and 133then first add them and afterwards us'. The new state on top is T which 134stands for the new /tentative/ state i.e. what will become the recorded 135state after we finalize our changes. 136 137But we're not done yet: we must also adapt the pending patch and the working 138tree. Note that changing the working tree is not done in this procedure, we 139merely return a list of prims to apply to working. Let us add the difference 140between pristine and working, which we call pw, to the picture. 141 142 T U 143 / \ / 144 us' them' pw 145 / \ / 146 Y R 147 \ / 148 them us 149 \ / 150 X 151 152It is easy to see now that we must merge pw with them', as both start at the 153(old) recorded state. This gives us pw' and them''. 154 155 U' 156 / \ 157 pw' them'' 158 / \ 159 T U 160 / \ / 161 us' them' pw 162 / \ / 163 Y R 164 \ / 165 them us 166 \ / 167 X 168 169Since U is our unrecorded state, them'' leads us from our old unrecorded 170state to the new one, so this is what we will return (if there are no 171conflicts; if there are, see below). 172 173What about the pending patch? It starts at R and goes half-way toward U 174since it is a prefix of pw. The new pending should start at T and go 175half-way toward the new working state U'. Instead of adapting the old 176pending patch, we set the new pending patch to pw', ignoring the old one. 177This relies on sifting to commute out and drop the parts that need not be in 178the pending patch, which is done when we finalize the tentative changes. 179 180Up to now we did not consider conflicts. Any new conflicts arising from the 181merges we made so far must be "resolved", that is, marked for manual 182resolution, if possible, or at least reported o the user. We made two 183merges, one with us and one with pw. It is important now to realize that our 184existing repo, and in particular the sequence us, could already be 185conflicted. Our job is to resolve only /new/ conflicts and not any 186unresolved conflicts that were already in our repo. So, from the rightmost 187branch of our double merge us+>+pw+>+them'', we should /not/ resolve us. And 188since the original pw cannot be conflicted (it consists of prim patches 189only) we can disregard it. This leaves only them'' which is what we pass to 190standardResolution to generate the markup, along with its full context, 191consisting of (common +>+ us +>+ pw). 192 193The resulting "resolution" goes on top, leading to our final unrecorded 194state U'': 195 196 U'' 197 | 198 res 199 | 200 U' 201 / \ 202 pw' them'' 203 / \ 204 T U 205 / \ / 206 us' them' pw 207 / \ / 208 Y R 209 \ / 210 them us 211 \ / 212 X 213 214In case the patches we pull are in conflict with local /unrecorded/ changes 215(i.e. pw), we want to warn the user about that and allow them to cancel the 216operation. The reason is that it is hard to reconstruct the original 217unrecorded changes when they are messed up with conflict resolution markup. 218To see if this is the case we check whether pw' has conflicts. As an extra 219precaution we backup any conflicted files, so the user can refer to them to 220restore things or compare in a diff viewer. 221 222The patches we return are what we need to update U to U'' i.e. them''+>+res. 223The new pending patch starts out at the new tentative state, so as explained 224above, we set it to pw'+>+res, and again rely on sifting to commute out and 225drop anything we don't need. 226 227TODO: We should return a properly coerced @Repository rt p wR wU wT@. 228-} 229 230tentativelyMergePatches_ :: (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) 231 => MakeChanges 232 -> Repository rt p wR wU wR -> String 233 -> AllowConflicts 234 -> ExternalMerge -> WantGuiPause 235 -> Compression -> Verbosity -> Reorder 236 -> ( UseIndex, ScanKnown, DiffAlgorithm ) 237 -> Fork (PatchSet rt p) 238 (FL (PatchInfoAnd rt p)) 239 (FL (PatchInfoAnd rt p)) Origin wR wY 240 -> IO (Sealed (FL (PrimOf p) wU)) 241tentativelyMergePatches_ mc _repo cmd allowConflicts externalMerge wantGuiPause 242 compression verbosity reorder diffingOpts@(useidx, _, dflag) (Fork context us them) = do 243 (them' :/\: us') 244 <- return $ merge2FL (progressFL "Merging us" us) 245 (progressFL "Merging them" them) 246 pw <- unrecordedChanges diffingOpts NoLookForMoves NoLookForReplaces _repo Nothing 247 -- Note: we use anonymous here to wrap the unrecorded changes. 248 -- This is benign because we only retain the effect of the results 249 -- of the merge (pw' and them''). 250 anonpw <- n2pia `fmap` anonymous pw 251 pw' :/\: them'' <- return $ merge (them' :\/: anonpw :>: NilFL) 252 let them''content = concatFL $ progressFL "Examining patches for conflicts" $ 253 mapFL_FL (patchcontents . hopefully) them'' 254 let conflicts = 255 standardResolution 256 (patchSet2RL context +<<+ us :<: anonpw) 257 (reverseFL them'') 258 let standard_resolution = mangled conflicts 259 260 debugMessage "Checking for conflicts..." 261 when (allowConflicts == YesAllowConflictsAndMark) $ 262 mapM_ backupByCopying $ 263 map (anchorPath (repoLocation _repo)) $ 264 conflictedPaths conflicts 265 266 debugMessage "Announcing conflicts..." 267 have_conflicts <- 268 announceConflicts cmd allowConflicts externalMerge conflicts 269 270 debugMessage "Checking for unrecorded conflicts..." 271 let pw'content = concatFL $ progressFL "Examining patches for conflicts" $ 272 mapFL_FL (patchcontents . hopefully) pw' 273 case listConflictedFiles pw'content of 274 [] -> return () 275 fs -> do 276 ePutDocLn $ vcat $ map redText $ 277 "You have conflicting unrecorded changes to:" : map displayPath fs 278 -- we catch "hIsTerminalDevice: illegal operation (handle is closed)" 279 -- which can be thrown when we apply patches remotely (i.e. during push) 280 confirmed <- promptYorn "Proceed?" `catchIOError` (\e -> 281 if isIllegalOperationErrorType (ioeGetErrorType e) 282 then return True 283 else ioError e) 284 unless confirmed $ do 285 putStrLn "Cancelled." 286 exitSuccess 287 288 debugMessage "Reading working tree..." 289 working <- readUnrecorded _repo useidx Nothing 290 291 debugMessage "Working out conflict markup..." 292 Sealed resolution <- 293 case (externalMerge , have_conflicts) of 294 (NoExternalMerge, _) -> return $ if allowConflicts == YesAllowConflicts 295 then seal NilFL 296 else standard_resolution 297 (_, False) -> return $ standard_resolution 298 (YesExternalMerge c, True) -> externalResolution dflag working c wantGuiPause 299 (effect us +>+ pw) (effect them) them''content 300 301 debugMessage "Adding patches to the inventory and writing new pending..." 302 when (mc == MakeChanges) $ do 303 applyToTentativePristine _repo ApplyNormal verbosity them' 304 -- these two cases result in the same trees (that's the idea of 305 -- merging), so we only operate on the set of patches and do the 306 -- adaption of pristine and pending in the common code below 307 _repo <- case reorder of 308 NoReorder -> do 309 tentativelyAddPatches_ DontUpdatePristine _repo 310 compression verbosity NoUpdatePending them' 311 Reorder -> do 312 -- we do not actually remove any effect in the end, so 313 -- it would be wrong to update the unrevert bundle or 314 -- the working tree or pending 315 r1 <- tentativelyRemovePatches_ DontUpdatePristineNorRevert _repo 316 compression NoUpdatePending us 317 r2 <- tentativelyAddPatches_ DontUpdatePristine r1 318 compression verbosity NoUpdatePending them 319 tentativelyAddPatches_ DontUpdatePristine r2 320 compression verbosity NoUpdatePending us' 321 setTentativePending _repo (effect pw' +>+ resolution) 322 return $ seal (effect them''content +>+ resolution) 323 324tentativelyMergePatches :: (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) 325 => Repository rt p wR wU wR -> String 326 -> AllowConflicts 327 -> ExternalMerge -> WantGuiPause 328 -> Compression -> Verbosity -> Reorder 329 -> ( UseIndex, ScanKnown, DiffAlgorithm ) 330 -> Fork (PatchSet rt p) 331 (FL (PatchInfoAnd rt p)) 332 (FL (PatchInfoAnd rt p)) Origin wR wY 333 -> IO (Sealed (FL (PrimOf p) wU)) 334tentativelyMergePatches = tentativelyMergePatches_ MakeChanges 335 336 337considerMergeToWorking :: (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) 338 => Repository rt p wR wU wR -> String 339 -> AllowConflicts 340 -> ExternalMerge -> WantGuiPause 341 -> Compression -> Verbosity -> Reorder 342 -> ( UseIndex, ScanKnown, DiffAlgorithm ) 343 -> Fork (PatchSet rt p) 344 (FL (PatchInfoAnd rt p)) 345 (FL (PatchInfoAnd rt p)) Origin wR wY 346 -> IO (Sealed (FL (PrimOf p) wU)) 347considerMergeToWorking = tentativelyMergePatches_ DontMakeChanges 348