% Copyright (C) 2002-2004,2007 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. \subsection{darcs rollback} \begin{code} {-# OPTIONS_GHC -cpp #-} {-# LANGUAGE CPP #-} module Darcs.Commands.Rollback ( rollback ) where import Control.Monad ( when, filterM ) import System.Exit ( exitWith, ExitCode(..) ) import Data.List ( sort ) import Data.Maybe ( isJust ) import System.Directory ( removeFile ) import Darcs.Commands ( DarcsCommand(..), nodefaults, loggers ) import Darcs.Arguments ( DarcsFlag(MarkConflicts), fixSubPaths, get_author, definePatches, working_repo_dir, nocompress, author, patchname_option, ask_long_comment, leave_test_dir, notest, list_registered_files, match_several_or_last, all_interactive, umask_option ) import Darcs.RepoPath ( toFilePath ) import Darcs.Repository ( amInRepository, withRepoLock, ($-), applyToWorking, slurp_recorded_and_unrecorded, read_repo, slurp_recorded, tentativelyMergePatches, withGutsOf, finalizeRepositoryChanges, sync_repo ) import Darcs.Patch ( summary, invert, namepatch, effect, fromPrims, sort_coalesceFL ) import Darcs.Ordered import Darcs.Hopefully ( n2pia ) import Darcs.Lock ( world_readable_temp ) import Darcs.SlurpDirectory ( empty_slurpy, wait_a_moment ) import Darcs.Match ( first_match ) import Darcs.SelectChanges ( with_selected_last_changes_to_files_reversed, with_selected_last_changes_to_files' ) import Darcs.Commands.Record ( file_exists, get_log ) import Darcs.Commands.Unrecord ( get_last_patches ) import Darcs.Utils ( clarify_errors ) import Darcs.Progress ( debugMessage ) import Darcs.Sealed ( Sealed(..), FlippedSeal(..) ) import IsoDate ( getIsoDateTime ) #include "impossible.h" \end{code} \begin{code} rollback_description :: String rollback_description = "Record a new patch reversing some recorded changes." \end{code} \options{rollback} \haskell{rollback_help} If you decide you didn't want to roll back a patch after all, you can reverse its effect by obliterating the rolled-back patch. Rollback can actually allow you to roll back a subset of the changes made by the selected patch or patches. Many of the options available in rollback behave similarly to the options for unrecord~\ref{unrecord} and record~\ref{record}. \begin{code} rollback_help :: String rollback_help = "Rollback is used to undo the effects of one or more patches without actually\n"++ "deleting them. Instead, it creates a new patch reversing selected portions.\n"++ "of those changes. Unlike obliterate and unrecord (which accomplish a similar\n"++ "goal) rollback is perfectly safe, since it leaves in the repository a record\n"++ "of its changes.\n" \end{code} \begin{code} rollback :: DarcsCommand rollback = DarcsCommand {command_name = "rollback", command_help = rollback_help, command_description = rollback_description, command_extra_args = -1, command_extra_arg_help = ["[FILE or DIRECTORY]..."], command_command = rollback_cmd, command_prereq = amInRepository, command_get_arg_possibilities = list_registered_files, command_argdefaults = nodefaults, command_advanced_options = [nocompress,umask_option], command_basic_options = [match_several_or_last, all_interactive, author, patchname_option, ask_long_comment, notest, leave_test_dir, working_repo_dir]} \end{code} \begin{code} rollback_cmd :: [DarcsFlag] -> [String] -> IO () rollback_cmd opts args = withRepoLock opts $- \repository -> do let (logMessage,_,_) = loggers opts rec <- if null args then return empty_slurpy else slurp_recorded repository files <- sort `fmap` fixSubPaths opts args existing_files <- map toFilePath `fmap` filterM (file_exists rec) files non_existent_files <- map toFilePath `fmap` filterM (fmap not . file_exists rec) files when (not $ null existing_files) $ logMessage $ "Recording changes in "++unwords existing_files++":\n" when (not $ null non_existent_files) $ logMessage $ "Non existent files or directories: "++unwords non_existent_files++"\n" when ((not $ null non_existent_files) && null existing_files) $ fail "None of the files you specified exist!" (recorded, working_dir) <- slurp_recorded_and_unrecorded repository allpatches <- read_repo repository FlippedSeal patches <- return $ if first_match opts then get_last_patches opts allpatches else FlippedSeal $ concatRL allpatches with_selected_last_changes_to_files_reversed "rollback" opts recorded existing_files (reverseRL patches) $ \ (_ :> ps) -> do when (nullFL ps) $ do logMessage "No patches selected!" exitWith ExitSuccess definePatches ps with_selected_last_changes_to_files' "rollback" opts working_dir existing_files (sort_coalesceFL $ effect ps) $ \ (_:>ps'') -> do when (nullFL ps'') $ do logMessage "No changes selected!" exitWith ExitSuccess let make_log = world_readable_temp "darcs-rollback" newlog = Just ("", "":"rolling back:":"":lines (show $ summary ps )) --tentativelyRemovePatches repository opts (mapFL_FL hopefully ps) (name, my_log, logf) <- get_log opts newlog make_log $ invert ps'' date <- getIsoDateTime my_author <- get_author opts rbp <- n2pia `fmap` namepatch date name my_author my_log (fromPrims $ invert ps'') debugMessage "Adding rollback patch to repository." Sealed pw <- tentativelyMergePatches repository "rollback" (MarkConflicts : opts) NilFL (rbp :>: NilFL) debugMessage "Finalizing rollback changes..." withGutsOf repository $ do finalizeRepositoryChanges repository debugMessage "About to apply rolled-back changes to working directory." -- so work will be more recent than rec: revertable $ do wait_a_moment applyToWorking repository opts pw when (isJust logf) $ removeFile (fromJust logf) sync_repo repository logMessage $ "Finished rolling back." where revertable x = x `clarify_errors` unlines ["Error applying patch to the working directory.","", "This may have left your working directory an inconsistent", "but recoverable state. If you had no un-recorded changes", "by using 'darcs revert' you should be able to make your", "working directory consistent again."] \end{code}