-- Copyright (C) 2002-2004,2007-2008 David Roundy-- Copyright (C) 2005 Juliusz Chroboczek-- Copyright (C) 2009 Petr Rockai---- This program is free software; you can redistribute it and/or modify-- it under the terms of the GNU General Public License as published by-- the Free Software Foundation; either version 2, or (at your option)-- any later version.---- This program is distributed in the hope that it will be useful,-- but WITHOUT ANY WARRANTY; without even the implied warranty of-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the-- GNU General Public License for more details.---- You should have received a copy of the GNU General Public License-- along with this program; see the file COPYING. If not, write to-- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,-- Boston, MA 02110-1301, USA.#include "gadts.h"moduleDarcs.Repository.Merge(tentativelyMergePatches,considerMergeToWorking)whereimportDarcs.Resolution(standardResolution,externalResolution)importDarcs.External(backupByCopying)importControl.Monad(when,unless)importDarcs.Patch.PatchInfoAnd(PatchInfoAnd,n2pia,hopefully)importDarcs.Flags(DarcsFlag(AllowConflicts,NoAllowConflicts),wantExternalMerge,diffingOpts,compression)importDarcs.Witnesses.Ordered(FL(..),(:\/:)(..),(:/\:)(..),(+>+),mapFL_FL)importDarcs.Patch(RepoPatch,PrimOf,merge,joinPatches,listTouchedFiles,patchcontents,anonymous,fromPrims,effect)importDarcs.Patch.Apply(ApplyState)importDarcs.Patch.Depends(merge2FL)importProgress(debugMessage)importDarcs.ProgressPatches(progressFL)importDarcs.Witnesses.Sealed(Sealed(Sealed),seal)importDarcs.Repository.InternalTypes(Repository(..))importDarcs.Repository.State(unrecordedChanges,readUnrecorded)importDarcs.Repository.Internal(announceMergeConflicts,checkUnrecordedConflicts,MakeChanges(..),setTentativePending,tentativelyAddPatch_,applyToTentativePristine,UpdatePristine(..))importStorage.Hashed.Tree(Tree)tentativelyMergePatches_::forallpC(rutyx).(RepoPatchp,ApplyStatep~Tree)=>MakeChanges->RepositorypC(rut)->String->[DarcsFlag]->FL(PatchInfoAndp)C(xt)->FL(PatchInfoAndp)C(xy)->IO(Sealed(FL(PrimOfp)C(u)))tentativelyMergePatches_mcrcmdoptsusithemi=doletus=mapFL_FLhopefullyusithem=mapFL_FLhopefullythemiSealedpc<-return$merge2FL(progressFL"Merging us"usi)(progressFL"Merging them"themi)pend<-unrecordedChanges(diffingOptsopts)rNothinganonpend<-n2pia`fmap`anonymous(fromPrimspend)pend':/\:pw<-return$merge(pc:\/:anonpend:>:NilFL)letpwprim=joinPatches$progressFL"Examining patches for conflicts"$mapFL_FL(patchcontents.hopefully)pwSealedstandard_resolved_pw<-return$standardResolutionpwprimdebugMessage"Checking for conflicts..."unless(AllowConflicts`elem`opts||NoAllowConflicts`elem`opts)$mapM_backupByCopying$listTouchedFilesstandard_resolved_pwdebugMessage"Announcing conflicts..."have_conflicts<-announceMergeConflictscmdoptsstandard_resolved_pwdebugMessage"Checking for unrecorded conflicts..."have_unrecorded_conflicts<-checkUnrecordedConflictsopts$mapFL_FLhopefullypcdebugMessage"Reading working directory..."working<-readUnrecordedrNothingdebugMessage"Working out conflicts in actual working directory..."Sealedpw_resolution<-case(wantExternalMergeopts,have_conflicts||have_unrecorded_conflicts)of(Nothing,_)->return$ifAllowConflicts`elem`optsthensealNilFLelsesealstandard_resolved_pw(_,False)->return$sealstandard_resolved_pw(Justc,True)->externalResolutionworkingcopts(effectus+>+pend)(effectthem)pwprimdebugMessage"Applying patches to the local directories..."when(mc==MakeChanges)$doletdoChanges::FL(PatchInfoAndp)C(xt)->IO()doChangesNilFL=applypsrthemidoChanges_=applypsrpcdoChangesusisetTentativePendingr(effectpend'+>+pw_resolution)return$seal(effectpwprim+>+pw_resolution)wheremapAdd::RepositorypC(mli)->FL(PatchInfoAndp)C(ij)->IO(RepositorypC(mlj))mapAddrepoNilFL=returnrepomapAddrepo(a:>:as)=dorepo'<-tentativelyAddPatch_DontUpdatePristinerepo(compressionopts)amapAddrepo'asapplyps::RepositorypC(mli)->FL(PatchInfoAndp)C(ij)->IO()applypsrepops=dodebugMessage"Adding patches to inventory..."-- Warning: A do-notation statement discarded a result of type Repository p m l j._<-mapAddrepopsdebugMessage"Applying patches to pristine..."applyToTentativePristinerepopstentativelyMergePatches::(RepoPatchp,ApplyStatep~Tree)=>RepositorypC(rut)->String->[DarcsFlag]->FL(PatchInfoAndp)C(xt)->FL(PatchInfoAndp)C(xy)->IO(Sealed(FL(PrimOfp)C(u)))tentativelyMergePatches=tentativelyMergePatches_MakeChangesconsiderMergeToWorking::(RepoPatchp,ApplyStatep~Tree)=>RepositorypC(rut)->String->[DarcsFlag]->FL(PatchInfoAndp)C(xt)->FL(PatchInfoAndp)C(xy)->IO(Sealed(FL(PrimOfp)C(u)))considerMergeToWorking=tentativelyMergePatches_DontMakeChanges