% 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. \darcsCommand{revert} \begin{code} module Darcs.Commands.Revert ( revert ) where import System.Exit ( ExitCode(..), exitWith ) import Control.Monad ( when ) import Data.List ( sort ) import English (englishNum, This(..), Noun(..)) import Darcs.Commands ( DarcsCommand(..), nodefaults ) import Darcs.Arguments ( DarcsFlag( All, Debug ), ignoretimes, working_repo_dir, all_interactive, fixSubPaths, areFileArgs, list_registered_files, umask_option, ) import Darcs.Utils ( askUser ) import Darcs.RepoPath ( toFilePath, sp2fn ) import Darcs.Repository ( withRepoLock, ($-), withGutsOf, get_unrecorded_in_files, get_unrecorded_in_files_unsorted, add_to_pending, sync_repo, applyToWorking, amInRepository, slurp_recorded, ) import Darcs.Patch ( invert, apply_to_filepaths, commute ) import Darcs.Ordered ( FL(..), (:>)(..), lengthFL, nullFL, (+>+) ) import Darcs.SelectChanges ( with_selected_last_changes_to_files' ) import Darcs.Patch.TouchesFiles ( choose_touching ) import Darcs.Commands.Unrevert ( write_unrevert ) import Darcs.Sealed ( unsafeUnseal ) import Darcs.Gorsvet( invalidateIndex ) revert_description :: String revert_description = "Discard unrecorded changes." revert_help :: String revert_help = "The `darcs revert' command discards unrecorded changes the working\n" ++ "tree. As with `darcs record', you will be asked which hunks (changes)\n" ++ "to revert. The --all switch can be used to avoid such prompting. If\n" ++ "files or directories are specified, other parts of the working tree\n" ++ "are not reverted.\n" ++ "\n" ++ "In you accidentally reverted something you wanted to keep (for\n" ++ "example, typing `darcs rev -a' instead of `darcs rec -a'), you can\n" ++ "immediately run `darcs unrevert' to restore it. This is only\n" ++ "guaranteed to work if the repository has not changed since `darcs\n" ++ "revert' ran.\n" revert :: DarcsCommand revert = DarcsCommand {command_name = "revert", command_help = revert_help, command_description = revert_description, command_extra_args = -1, command_extra_arg_help = ["[FILE or DIRECTORY]..."], command_command = revert_cmd, command_prereq = amInRepository, command_get_arg_possibilities = list_registered_files, command_argdefaults = nodefaults, command_advanced_options = [ignoretimes, umask_option], command_basic_options = [all_interactive, working_repo_dir]} revert_cmd :: [DarcsFlag] -> [String] -> IO () revert_cmd opts args = withRepoLock opts $- \repository -> do files <- sort `fmap` fixSubPaths opts args let files_fn = map sp2fn files when (areFileArgs files) $ putStrLn $ "Reverting changes in "++unwords (map show files)++"..\n" changes <- if All `elem` opts then get_unrecorded_in_files_unsorted repository files_fn else get_unrecorded_in_files repository files_fn let pre_changed_files = apply_to_filepaths (invert changes) (map toFilePath files) rec <- slurp_recorded repository case unsafeUnseal $ choose_touching pre_changed_files changes of NilFL -> putStrLn "There are no changes to revert!" _ -> with_selected_last_changes_to_files' "revert" opts pre_changed_files changes $ \ (norevert:>p) -> if nullFL p then putStrLn $ "If you don't want to revert after all," ++ " that's fine with me!" else do let theseChanges = englishNum (lengthFL p) . This . Noun $ "change" yorn <- if All `elem` opts then return "y" else askUser $ "Do you really want to revert " ++ theseChanges "? " case yorn of ('y':_) -> return () _ -> exitWith $ ExitSuccess withGutsOf repository $ do invalidateIndex repository add_to_pending repository $ invert p when (Debug `elem` opts) $ putStrLn "About to write the unrevert file." case commute (norevert:>p) of Just (p':>_) -> write_unrevert repository p' rec NilFL Nothing -> write_unrevert repository (norevert+>+p) rec NilFL when (Debug `elem` opts) $ putStrLn "About to apply to the working directory." applyToWorking repository opts (invert p) `catch` \e -> fail ("Unable to apply inverse patch!" ++ show e) sync_repo repository putStrLn "Finished reverting." \end{code}