% 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}