src/Darcs/Commands/Revert.lhs

   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 \subsection{darcs 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 )
  35 import Darcs.Repository ( withRepoLock, ($-), withGutsOf,
  36                     get_unrecorded, get_unrecorded_unsorted,
  37                     add_to_pending, sync_repo,
  38                     applyToWorking,
  39                     amInRepository, slurp_recorded_and_unrecorded,
  40                   )
  41 import Darcs.Patch ( invert, apply_to_filepaths, commute )
  42 import Darcs.Ordered ( FL(..), (:>)(..), lengthFL, nullFL, (+>+) )
  43 import Darcs.SelectChanges ( with_selected_last_changes_to_files' )
  44 import Darcs.Patch.TouchesFiles ( choose_touching )
  45 import Darcs.Commands.Unrevert ( write_unrevert )
  46 import Darcs.Sealed ( unsafeUnseal )
  47 \end{code}
  48 \begin{code}
  49 revert_description :: String
  50 revert_description =
  51  "Revert to the recorded version (not always reversible)."
  52 \end{code}
  53
  54 \options{revert}
  55
  56 \haskell{revert_help} The actions of a revert may be reversed using the
  57 unrevert command (see subsection~\ref{unrevert}).  However, if you've made
  58 changes since the revert your mileage may vary, so please be careful.
  59
  60 \begin{code}
  61 revert_help :: String
  62 revert_help =
  63  "Revert is used to undo changes made to the working copy which have\n"++
  64  "not yet been recorded.  You will be prompted for which changes you\n"++
  65  "wish to undo. The last revert can be undone safely using the unrevert\n"++
  66  "command if the working copy was not modified in the meantime.\n"
  67 \end{code}
  68 \begin{code}
  69 revert :: DarcsCommand
  70 revert = DarcsCommand {command_name = "revert",
  71                        command_help = revert_help,
  72                        command_description = revert_description,
  73                        command_extra_args = -1,
  74                        command_extra_arg_help = ["[FILE or DIRECTORY]..."],
  75                        command_command = revert_cmd,
  76                        command_prereq = amInRepository,
  77                        command_get_arg_possibilities = list_registered_files,
  78                        command_argdefaults = nodefaults,
  79                        command_advanced_options = [ignoretimes, umask_option],
  80                        command_basic_options = [all_interactive,
  81                                                working_repo_dir]}
  82 \end{code}
  83 You can give revert optional arguments indicating files or directories.  If
  84 you do so it will only prompt you to revert changes in those files or in
  85 files in those directories.
  86 \begin{code}
  87 revert_cmd :: [DarcsFlag] -> [String] -> IO ()
  88 revert_cmd opts args = withRepoLock opts $- \repository -> do
  89   files <- sort `fmap` fixSubPaths opts args
  90   when (areFileArgs files) $
  91        putStrLn $ "Reverting changes in "++unwords (map show files)++"..\n"
  92   changes <- if All `elem` opts
  93                    then get_unrecorded_unsorted repository
  94                    else get_unrecorded repository
  95   let pre_changed_files = apply_to_filepaths (invert changes) (map toFilePath files)
  96   (rec, working_dir) <- slurp_recorded_and_unrecorded repository
  97   case unsafeUnseal $ choose_touching pre_changed_files changes of
  98     NilFL -> putStrLn "There are no changes to revert!"
  99     _ -> with_selected_last_changes_to_files' "revert" opts working_dir
 100                pre_changed_files changes $ \ (norevert:>p) ->
 101         if nullFL p
 102         then putStrLn $ "If you don't want to revert after all," ++
 103                         " that's fine with me!"
 104         else do
 105              let theseChanges = englishNum (lengthFL p) . This . Noun $ "change"
 106              yorn <- if All `elem` opts
 107                      then return "y"
 108                      else askUser $ "Do you really want to revert " ++ theseChanges "? "
 109              case yorn of ('y':_) -> return ()
 110                           _ -> exitWith $ ExitSuccess
 111              withGutsOf repository $ do
 112                  add_to_pending repository $ invert p
 113                  when (Debug `elem` opts) $ putStrLn "About to write the unrevert file."
 114                  case commute (norevert:>p) of
 115                    Just (p':>_) -> write_unrevert repository p' rec NilFL
 116                    Nothing -> write_unrevert repository (norevert+>+p) rec NilFL
 117                  when (Debug `elem` opts) $ putStrLn "About to apply to the working directory."
 118                  applyToWorking repository opts (invert p) `catch` \e ->
 119                      fail ("Unable to apply inverse patch!" ++ show e)
 120   sync_repo repository
 121   putStrLn "Finished reverting."
 122 \end{code}
 123