-- Copyright (C) 2002-2005 David Roundy---- 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.{-# LANGUAGE CPP #-}moduleDarcs.Commands.Unrecord(unrecord,unpull,obliterate,getLastPatches)whereimportControl.Monad(when)importSystem.Exit(exitWith,ExitCode(ExitSuccess))importData.Maybe(isJust)importPrinter(text,putDoc)importEnglish(presentParticiple)importDarcs.Patch.PatchInfoAnd(hopefully,patchDesc)importDarcs.Commands(DarcsCommand(..),nodefaults,commandAlias,putVerbose)importDarcs.Arguments(DarcsFlag,output,outputAutoName,getOutput,workingRepoDir,nocompress,setEnvDarcsPatches,matchSeveralOrLast,depsSel,ignoretimes,allInteractive,umaskOption,summary,dryRun,printDryRunMessageAndExit,changesReverse)importDarcs.Flags(doReverse,UseIndex(..),ScanKnown(..),compression)importDarcs.Match(firstMatch,matchFirstPatchset,matchAPatchread)importDarcs.Repository(PatchInfoAnd,withGutsOf,withRepoLock,RepoJob(..),tentativelyRemovePatches,finalizeRepositoryChanges,tentativelyAddToPending,applyToWorking,readRepo,amInHashedRepository,invalidateIndex,unrecordedChanges)importDarcs.Patch(RepoPatch,invert,commute,effect)importDarcs.Patch.Apply(ApplyState)importDarcs.Patch.Set(PatchSet(..),Tagged(..),appendPSFL)#ifdef GADT_WITNESSESimportDarcs.Patch.Set(Origin)#endifimportDarcs.Witnesses.Ordered(RL(..),(:>)(..),(+<+),mapFL_FL,nullFL,reverseRL,mapRL,FL(..))importDarcs.Patch.Depends(findCommonWithThem)importDarcs.SelectChanges(selectChanges,WhichChanges(..),selectionContext,runSelection)importDarcs.Patch.Bundle(makeBundleN,patchFilename,contextPatches)importProgress(debugMessage)importDarcs.Witnesses.Sealed(Sealed(..))importDarcs.RepoPath(useAbsoluteOrStd)importDarcs.Lock(writeDocBinFile)importStorage.Hashed.Tree(Tree)#include "gadts.h"unrecordDescription::StringunrecordDescription="Remove recorded patches without changing the working copy."unrecordHelp::StringunrecordHelp="Unrecord does the opposite of record in that it makes the changes from\n"++"patches active changes again which you may record or revert later. The\n"++"working copy itself will not change.\n"++"Beware that you should not use this command if you are going to\n"++"re-record the changes in any way and there is a possibility that\n"++"another user may have already pulled the patch.\n"unrecord::DarcsCommandunrecord=DarcsCommand{commandProgramName="darcs",commandName="unrecord",commandHelp=unrecordHelp,commandDescription=unrecordDescription,commandExtraArgs=0,commandExtraArgHelp=[],commandCommand=unrecordCmd,commandPrereq=amInHashedRepository,commandGetArgPossibilities=return[],commandArgdefaults=nodefaults,commandAdvancedOptions=[nocompress,umaskOption,changesReverse],commandBasicOptions=[matchSeveralOrLast,depsSel,allInteractive,workingRepoDir]}unrecordCmd::[DarcsFlag]->[String]->IO()unrecordCmdopts_=withRepoLockopts$RepoJob$\repository->doallpatches<-readReporepository(_:>patches)<-return$iffirstMatchoptsthengetLastPatchesoptsallpatcheselsematchingHeadoptsallpatchesletcontext=selectionContext"unrecord"optsNothingNothingselector=ifdoReverseoptsthenselectChangesLastelseselectChangesLastReversed(_:>to_unrecord)<-runSelection(selectorpatches)contextwhen(nullFLto_unrecord)$doputStrLn"No patches selected!"exitWithExitSuccessputVerboseopts$text"About to write out (potentially) modified patches..."setEnvDarcsPatchesto_unrecordinvalidateIndexrepository-- Warning: A do-notation statement discarded a result of type Darcs.Repository.InternalTypes.Repository p r u z.withGutsOfrepository$do_<-tentativelyRemovePatchesrepository(compressionopts)to_unrecordfinalizeRepositoryChangesrepositoryputStrLn"Finished unrecording."getLastPatches::RepoPatchp=>[DarcsFlag]->PatchSetpC(Originr)->((PatchSetp):>(FL(PatchInfoAndp)))C(Originr)getLastPatchesoptsps=casematchFirstPatchsetoptspsofSealedp1s->findCommonWithThempsp1sunpullDescription::StringunpullDescription="Opposite of pull; unsafe if patch is not in remote repository."unpullHelp::StringunpullHelp="Unpull completely removes recorded patches from your local repository.\n"++"The changes will be undone in your working copy and the patches will not be\n"++"shown in your changes list anymore.\n"++"Beware that if the patches are not still present in another repository you\n"++"will lose precious code by unpulling!\n"unpull::DarcsCommandunpull=(commandAlias"unpull"Nothingobliterate){commandHelp=unpullHelp,commandDescription=unpullDescription,commandCommand=unpullCmd}unpullCmd::[DarcsFlag]->[String]->IO()unpullCmd=genericObliterateCmd"unpull"obliterateDescription::StringobliterateDescription="Delete selected patches from the repository. (UNSAFE!)"obliterateHelp::StringobliterateHelp="Obliterate completely removes recorded patches from your local repository.\n"++"The changes will be undone in your working copy and the patches will not be\n"++"shown in your changes list anymore.\n"++"Beware that you can lose precious code by obliterating!\n"obliterate::DarcsCommandobliterate=DarcsCommand{commandProgramName="darcs",commandName="obliterate",commandHelp=obliterateHelp,commandDescription=obliterateDescription,commandExtraArgs=0,commandExtraArgHelp=[],commandCommand=obliterateCmd,commandPrereq=amInHashedRepository,commandGetArgPossibilities=return[],commandArgdefaults=nodefaults,commandAdvancedOptions=[nocompress,ignoretimes,umaskOption,changesReverse],commandBasicOptions=[matchSeveralOrLast,depsSel,allInteractive,workingRepoDir,summary,output,outputAutoName]++dryRun}obliterateCmd::[DarcsFlag]->[String]->IO()obliterateCmd=genericObliterateCmd"obliterate"-- | genericObliterateCmd is the function that executes the "obliterate" and-- "unpull" commands.genericObliterateCmd::String-- ^ The name under which the command is invoked (@unpull@ or @obliterate@)->[DarcsFlag]-- ^ The flags given on the command line->[String]-- ^ Files given on the command line (unused)->IO()genericObliterateCmdcmdnameopts_=withRepoLockopts$RepoJob$\repository->do-- FIXME we may need to honour --ignore-times here, although this command-- does not take that option (yet)pend<-unrecordedChanges(UseIndex,ScanKnown)repositoryNothingallpatches<-readReporepository(auto_kept:>removal_candidates)<-return$iffirstMatchoptsthengetLastPatchesoptsallpatcheselsematchingHeadoptsallpatchesletcontext=selectionContextcmdnameoptsNothingNothingselector=ifdoReverseoptsthenselectChangesLastelseselectChangesLastReversed(kept:>removed)<-runSelection(selectorremoval_candidates)contextwhen(nullFLremoved)$doputStrLn"No patches selected!"exitWithExitSuccesscasecommute(effectremoved:>pend)ofNothing->fail$"Can't "++cmdname++" patch without reverting some unrecorded change."Just(_:>p_after_pending)->doprintDryRunMessageAndExit"obliterate"optsremovedsetEnvDarcsPatchesremovedwhen(isJust$getOutputopts"")$savetoBundleopts(auto_kept`appendPSFL`kept)removedinvalidateIndexrepositorywithGutsOfrepository$-- Warning: A do-notation statement discarded a result of type Darcs.Repository.InternalTypes.Repository p r u z.do_<-tentativelyRemovePatchesrepository(compressionopts)removedtentativelyAddToPendingrepositoryopts$invert$effectremovedfinalizeRepositoryChangesrepositorydebugMessage"Applying patches to working directory..."_<-applyToWorkingrepositoryopts(invertp_after_pending)`catch`\e->fail("Couldn't undo patch in working dir.\n"++showe)return()putStrLn$"Finished "++presentParticiplecmdname++"."-- | matchingHead returns the repository up to some tag. The tag t is-- the last tag such that there is a patch after t that is matched by-- the user's query.matchingHead::forallpC(r).RepoPatchp=>[DarcsFlag]->PatchSetpC(Originr)->(PatchSetp:>FL(PatchInfoAndp))C(Originr)matchingHeadoptsset=casemhsetof(start:>patches)->(start:>reverseRLpatches)wheremh::FORALL(x)PatchSetpC(Originx)->(PatchSetp:>RL(PatchInfoAndp))C(Originx)mhs@(PatchSetx_)|or(mapRL(matchAPatchreadopts)x)=contextPatchessmh(PatchSetx(Taggedt_ps:<:ts))=casemh(PatchSet(t:<:ps)ts)of(start:>patches)->(start:>x+<+patches)mhps=(ps:>NilRL)savetoBundle::(RepoPatchp,ApplyStatep~Tree)=>[DarcsFlag]->PatchSetpC(Originz)->FL(PatchInfoAndp)C(zt)->IO()savetoBundleoptskeptremoved@(x:>:_)=dobundle<-makeBundleNNothingkept(mapFL_FLhopefullyremoved)letfilename=patchFilename$patchDescxJustoutname=getOutputoptsfilenameuseAbsoluteOrStdwriteDocBinFileputDocoutname$bundlesavetoBundle__NilFL=return()