1 %  Copyright (C) 2002-2005 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{revert}
   19 \begin{code}
   20 module Darcs.Commands.Revert ( revert ) where
   21 import System.Exit ( ExitCode(..), exitWith )
   22 import Control.Monad ( when )
   23 import Data.List ( sort )
   24 
   25 import English (englishNum, This(..), Noun(..))
   26 import Darcs.Commands ( DarcsCommand(..), nodefaults )
   27 import Darcs.Arguments ( DarcsFlag( All, Debug ),
   28                         ignoretimes, working_repo_dir,
   29                         all_interactive,
   30                         fixSubPaths, areFileArgs,
   31                         list_registered_files, umask_option,
   32                       )
   33 import Darcs.Utils ( askUser )
   34 import Darcs.RepoPath ( toFilePath, sp2fn )
   35 import Darcs.Repository ( withRepoLock, ($-), withGutsOf,
   36                     get_unrecorded_in_files,
   37                     get_unrecorded_in_files_unsorted,
   38                     add_to_pending, sync_repo,
   39                     applyToWorking,
   40                     amInRepository, slurp_recorded,
   41                   )
   42 import Darcs.Patch ( invert, apply_to_filepaths, commute )
   43 import Darcs.Ordered ( FL(..), (:>)(..), lengthFL, nullFL, (+>+) )
   44 import Darcs.SelectChanges ( with_selected_last_changes_to_files' )
   45 import Darcs.Patch.TouchesFiles ( choose_touching )
   46 import Darcs.Commands.Unrevert ( write_unrevert )
   47 import Darcs.Sealed ( unsafeUnseal )
   48 import Darcs.Gorsvet( invalidateIndex )
   49 
   50 revert_description :: String
   51 revert_description = "Discard unrecorded changes."
   52 
   53 revert_help :: String
   54 revert_help =
   55  "The `darcs revert' command discards unrecorded changes the working\n" ++
   56  "tree.  As with `darcs record', you will be asked which hunks (changes)\n" ++
   57  "to revert.  The --all switch can be used to avoid such prompting. If\n" ++
   58  "files or directories are specified, other parts of the working tree\n" ++
   59  "are not reverted.\n" ++
   60  "\n" ++
   61  "In you accidentally reverted something you wanted to keep (for\n" ++
   62  "example, typing `darcs rev -a' instead of `darcs rec -a'), you can\n" ++
   63  "immediately run `darcs unrevert' to restore it.  This is only\n" ++
   64  "guaranteed to work if the repository has not changed since `darcs\n" ++
   65  "revert' ran.\n"
   66 
   67 revert :: DarcsCommand
   68 revert = DarcsCommand {command_name = "revert",
   69                        command_help = revert_help,
   70                        command_description = revert_description,
   71                        command_extra_args = -1,
   72                        command_extra_arg_help = ["[FILE or DIRECTORY]..."],
   73                        command_command = revert_cmd,
   74                        command_prereq = amInRepository,
   75                        command_get_arg_possibilities = list_registered_files,
   76                        command_argdefaults = nodefaults,
   77                        command_advanced_options = [ignoretimes, umask_option],
   78                        command_basic_options = [all_interactive,
   79                                                working_repo_dir]}
   80 
   81 revert_cmd :: [DarcsFlag] -> [String] -> IO ()
   82 revert_cmd opts args = withRepoLock opts $- \repository -> do
   83   files <- sort `fmap` fixSubPaths opts args
   84   let files_fn = map sp2fn files
   85   when (areFileArgs files) $
   86        putStrLn $ "Reverting changes in "++unwords (map show files)++"..\n"
   87   changes <- if All `elem` opts
   88                    then get_unrecorded_in_files_unsorted repository files_fn
   89                    else get_unrecorded_in_files repository files_fn
   90   let pre_changed_files = apply_to_filepaths (invert changes) (map toFilePath files)
   91   rec <- slurp_recorded repository
   92   case unsafeUnseal $ choose_touching pre_changed_files changes of
   93     NilFL -> putStrLn "There are no changes to revert!"
   94     _ -> with_selected_last_changes_to_files' "revert" opts
   95                pre_changed_files changes $ \ (norevert:>p) ->
   96         if nullFL p
   97         then putStrLn $ "If you don't want to revert after all," ++
   98                         " that's fine with me!"
   99         else do
  100              let theseChanges = englishNum (lengthFL p) . This . Noun $ "change"
  101              yorn <- if All `elem` opts
  102                      then return "y"
  103                      else askUser $ "Do you really want to revert " ++ theseChanges "? "
  104              case yorn of ('y':_) -> return ()
  105                           _ -> exitWith $ ExitSuccess
  106              withGutsOf repository $ do
  107                  invalidateIndex repository
  108                  add_to_pending repository $ invert p
  109                  when (Debug `elem` opts) $ putStrLn "About to write the unrevert file."
  110                  case commute (norevert:>p) of
  111                    Just (p':>_) -> write_unrevert repository p' rec NilFL
  112                    Nothing -> write_unrevert repository (norevert+>+p) rec NilFL
  113                  when (Debug `elem` opts) $ putStrLn "About to apply to the working directory."
  114                  applyToWorking repository opts (invert p) `catch` \e ->
  115                      fail ("Unable to apply inverse patch!" ++ show e)
  116   sync_repo repository
  117   putStrLn "Finished reverting."
  118 \end{code}
  119