% 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, workingRepoDir, allInteractive, fixSubPaths, areFileArgs, listRegisteredFiles, umaskOption, ) import Darcs.Utils ( askUser ) import Darcs.RepoPath ( toFilePath ) import Darcs.Repository ( withRepoLock, ($-), withGutsOf, add_to_pending, applyToWorking, amInRepository, readRecorded, unrecordedChanges ) import Darcs.Patch ( invert, applyToFilepaths, commute ) import Darcs.Witnesses.Ordered ( FL(..), (:>)(..), lengthFL, nullFL, (+>+) ) import Darcs.SelectChanges ( with_selected_last_changes_to_files' ) import Darcs.Patch.TouchesFiles ( choose_touching ) import Darcs.Commands.Unrevert ( writeUnrevert ) import Darcs.Witnesses.Sealed ( unsafeUnseal ) revertDescription :: String revertDescription = "Discard unrecorded changes." revertHelp :: String revertHelp = "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 {commandName = "revert", commandHelp = revertHelp, commandDescription = revertDescription, commandExtraArgs = -1, commandExtraArgHelp = ["[FILE or DIRECTORY]..."], commandCommand = revertCmd, commandPrereq = amInRepository, commandGetArgPossibilities = listRegisteredFiles, commandArgdefaults = nodefaults, commandAdvancedOptions = [ignoretimes, umaskOption], commandBasicOptions = [allInteractive, workingRepoDir]} revertCmd :: [DarcsFlag] -> [String] -> IO () revertCmd opts args = withRepoLock opts $- \repository -> do files <- sort `fmap` fixSubPaths opts args when (areFileArgs files) $ putStrLn $ "Reverting changes in "++unwords (map show files)++"..\n" changes <- unrecordedChanges opts repository files let pre_changed_files = applyToFilepaths (invert changes) (map toFilePath files) rec <- readRecorded 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 Nothing 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 add_to_pending repository $ invert p when (Debug `elem` opts) $ putStrLn "About to write the unrevert file." case commute (norevert:>p) of Just (p':>_) -> writeUnrevert repository p' rec NilFL Nothing -> writeUnrevert 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) putStrLn "Finished reverting." \end{code}