1 % Copyright (C) 2002-2004,2007 David Roundy 2 % 3 % This program is free software; you can redistribute it and/or modify 4 % it under the terms of the GNU General Public License as published by 5 % the Free Software Foundation; either version 2, or (at your option) 6 % any later version. 7 % 8 % This program is distributed in the hope that it will be useful, 9 % but WITHOUT ANY WARRANTY; without even the implied warranty of 10 % MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 % GNU General Public License for more details. 12 % 13 % You should have received a copy of the GNU General Public License 14 % along with this program; see the file COPYING. If not, write to 15 % the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 16 % Boston, MA 02110-1301, USA. 17 18 \darcsCommand{rollback} 19 \begin{code} 20 {-# OPTIONS_GHC -cpp #-} 21 {-# LANGUAGE CPP #-} 22 23 module Darcs.Commands.Rollback ( rollback ) where 24 25 import Control.Monad ( when, filterM ) 26 import System.Exit ( exitWith, ExitCode(..) ) 27 import Data.List ( sort ) 28 import Data.Maybe ( isJust ) 29 import System.Directory ( removeFile ) 30 31 import Darcs.Commands ( DarcsCommand(..), nodefaults, loggers ) 32 import Darcs.Arguments ( DarcsFlag(MarkConflicts), fixSubPaths, get_author, 33 definePatches, 34 working_repo_dir, nocompress, 35 author, patchname_option, ask_long_comment, 36 leave_test_dir, notest, list_registered_files, 37 match_several_or_last, all_interactive, umask_option 38 ) 39 import Darcs.RepoPath ( toFilePath ) 40 import Darcs.Repository ( amInRepository, withRepoLock, ($-), applyToWorking, 41 read_repo, slurp_recorded, 42 tentativelyMergePatches, withGutsOf, 43 finalizeRepositoryChanges, sync_repo ) 44 import Darcs.Patch ( summary, invert, namepatch, effect, fromPrims, 45 sort_coalesceFL, canonize ) 46 import Darcs.Ordered 47 import Darcs.Hopefully ( n2pia ) 48 import Darcs.Lock ( world_readable_temp ) 49 import Darcs.SlurpDirectory ( empty_slurpy, wait_a_moment ) 50 import Darcs.Match ( first_match ) 51 import Darcs.SelectChanges ( with_selected_last_changes_to_files_reversed, 52 with_selected_last_changes_to_files' ) 53 import Darcs.Commands.Record ( file_exists, get_log ) 54 import Darcs.Commands.Unrecord ( get_last_patches ) 55 import Darcs.Utils ( clarify_errors ) 56 import Printer ( renderString ) 57 import Progress ( debugMessage ) 58 import Darcs.Sealed ( Sealed(..), FlippedSeal(..) ) 59 import IsoDate ( getIsoDateTime ) 60 import Darcs.Gorsvet( invalidateIndex ) 61 #include "impossible.h" 62 63 rollback_description :: String 64 rollback_description = 65 "Record a new patch reversing some recorded changes." 66 \end{code} 67 68 If you decide you didn't want to roll back a patch 69 after all, you can reverse its effect by obliterating the rolled-back patch. 70 71 Rollback can actually allow you to roll back a subset of the changes made 72 by the selected patch or patches. Many of the options available in 73 rollback behave similarly to the options for unrecord~\ref{unrecord} and 74 record~\ref{record}. 75 76 \begin{code} 77 rollback_help :: String 78 rollback_help = 79 "Rollback is used to undo the effects of one or more patches without actually\n"++ 80 "deleting them. Instead, it creates a new patch reversing selected portions.\n"++ 81 "of those changes. Unlike obliterate and unrecord (which accomplish a similar\n"++ 82 "goal) rollback is perfectly safe, since it leaves in the repository a record\n"++ 83 "of its changes.\n" 84 85 rollback :: DarcsCommand 86 rollback = DarcsCommand {command_name = "rollback", 87 command_help = rollback_help, 88 command_description = rollback_description, 89 command_extra_args = -1, 90 command_extra_arg_help = ["[FILE or DIRECTORY]..."], 91 command_command = rollback_cmd, 92 command_prereq = amInRepository, 93 command_get_arg_possibilities = list_registered_files, 94 command_argdefaults = nodefaults, 95 command_advanced_options = [nocompress,umask_option], 96 command_basic_options = [match_several_or_last, 97 all_interactive, 98 author, patchname_option, ask_long_comment, 99 notest, leave_test_dir, 100 working_repo_dir]} 101 102 rollback_cmd :: [DarcsFlag] -> [String] -> IO () 103 rollback_cmd opts args = withRepoLock opts $- \repository -> do 104 let (logMessage,_,_) = loggers opts 105 rec <- if null args then return empty_slurpy 106 else slurp_recorded repository 107 files <- sort `fmap` fixSubPaths opts args 108 existing_files <- map toFilePath `fmap` filterM (file_exists rec) files 109 non_existent_files <- map toFilePath `fmap` filterM (fmap not . file_exists rec) files 110 when (not $ null existing_files) $ 111 logMessage $ "Recording changes in "++unwords existing_files++":\n" 112 when (not $ null non_existent_files) $ 113 logMessage $ "Non existent files or directories: "++unwords non_existent_files++"\n" 114 when ((not $ null non_existent_files) && null existing_files) $ 115 fail "None of the files you specified exist!" 116 allpatches <- read_repo repository 117 FlippedSeal patches <- return $ if first_match opts 118 then get_last_patches opts allpatches 119 else FlippedSeal $ concatRL allpatches 120 with_selected_last_changes_to_files_reversed "rollback" opts existing_files 121 (reverseRL patches) $ 122 \ (_ :> ps) -> 123 do when (nullFL ps) $ do logMessage "No patches selected!" 124 exitWith ExitSuccess 125 definePatches ps 126 with_selected_last_changes_to_files' "rollback" opts 127 existing_files (concatFL $ mapFL_FL canonize $ 128 sort_coalesceFL $ effect ps) $ \ (_:>ps'') -> 129 do when (nullFL ps'') $ do logMessage "No changes selected!" 130 exitWith ExitSuccess 131 let make_log = world_readable_temp "darcs-rollback" 132 newlog = Just ("", "":"rolling back:":"":lines (renderString $ summary ps )) 133 --tentativelyRemovePatches repository opts (mapFL_FL hopefully ps) 134 (name, my_log, logf) <- get_log opts newlog make_log $ invert ps'' 135 date <- getIsoDateTime 136 my_author <- get_author opts 137 rbp <- n2pia `fmap` namepatch date name my_author my_log 138 (fromPrims $ invert ps'') 139 debugMessage "Adding rollback patch to repository." 140 Sealed pw <- tentativelyMergePatches repository "rollback" (MarkConflicts : opts) 141 NilFL (rbp :>: NilFL) 142 debugMessage "Finalizing rollback changes..." 143 invalidateIndex repository 144 withGutsOf repository $ do 145 finalizeRepositoryChanges repository 146 debugMessage "About to apply rolled-back changes to working directory." 147 -- so work will be more recent than rec: 148 revertable $ do wait_a_moment 149 applyToWorking repository opts pw 150 when (isJust logf) $ removeFile (fromJust logf) 151 sync_repo repository 152 logMessage $ "Finished rolling back." 153 where revertable x = x `clarify_errors` unlines 154 ["Error applying patch to the working directory.","", 155 "This may have left your working directory an inconsistent", 156 "but recoverable state. If you had no un-recorded changes", 157 "by using 'darcs revert' you should be able to make your", 158 "working directory consistent again."] 159 \end{code} 160