src/Darcs/Commands/Rollback.lhs

   1 %  Copyright (C) 2002-2004,2007 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 rollback}
  19 \begin{code}
  20 {-# OPTIONS_GHC -cpp #-}
  21 {-# LANGUAGE CPP #-}
  22
  23 module Darcs.Commands.Rollback ( rollback ) where
  24
  25 import Control.Monad ( when, filterM )
  26 import System.Exit ( exitWith, ExitCode(..) )
  27 import Data.List ( sort )
  28 import Data.Maybe ( isJust )
  29 import System.Directory ( removeFile )
  30
  31 import Darcs.Commands ( DarcsCommand(..), nodefaults, loggers )
  32 import Darcs.Arguments ( DarcsFlag(MarkConflicts), fixSubPaths, get_author,
  33                          definePatches,
  34                          working_repo_dir, nocompress,
  35                          author, patchname_option, ask_long_comment,
  36                          leave_test_dir, notest, list_registered_files,
  37                          match_several_or_last, all_interactive, umask_option
  38                        )
  39 import Darcs.RepoPath ( toFilePath )
  40 import Darcs.Repository ( amInRepository, withRepoLock, ($-), applyToWorking,
  41                           slurp_recorded_and_unrecorded, read_repo, slurp_recorded,
  42                           tentativelyMergePatches, withGutsOf,
  43                           finalizeRepositoryChanges, sync_repo )
  44 import Darcs.Patch ( summary, invert, namepatch, effect, fromPrims, sort_coalesceFL )
  45 import Darcs.Ordered
  46 import Darcs.Hopefully ( n2pia )
  47 import Darcs.Lock ( world_readable_temp )
  48 import Darcs.SlurpDirectory ( empty_slurpy, wait_a_moment )
  49 import Darcs.Match ( first_match )
  50 import Darcs.SelectChanges ( with_selected_last_changes_to_files_reversed,
  51                              with_selected_last_changes_to_files' )
  52 import Darcs.Commands.Record ( file_exists, get_log )
  53 import Darcs.Commands.Unrecord ( get_last_patches )
  54 import Darcs.Utils ( clarify_errors )
  55 import Darcs.Progress ( debugMessage )
  56 import Darcs.Sealed ( Sealed(..), unsafeUnflippedseal )
  57 import IsoDate ( getIsoDateTime )
  58 #include "impossible.h"
  59 \end{code}
  60
  61 \begin{code}
  62 rollback_description :: String
  63 rollback_description =
  64  "Record a new patch reversing some recorded changes."
  65 \end{code}
  66
  67 \options{rollback}
  68
  69 \haskell{rollback_help} If you decide you didn't want to roll back a patch
  70 after all, you can reverse its effect by obliterating the rolled-back patch.
  71
  72 Rollback can actually allow you to roll back a subset of the changes made
  73 by the selected patch or patches.  Many of the options available in
  74 rollback behave similarly to the options for unrecord~\ref{unrecord} and
  75 record~\ref{record}.
  76
  77 \begin{code}
  78 rollback_help :: String
  79 rollback_help =
  80  "Rollback is used to undo the effects of one or more patches without actually\n"++
  81  "deleting them.  Instead, it creates a new patch reversing selected portions.\n"++
  82  "of those changes. Unlike obliterate and unrecord (which accomplish a similar\n"++
  83  "goal) rollback is perfectly safe, since it leaves in the repository a record\n"++
  84  "of its changes.\n"
  85 \end{code}
  86 \begin{code}
  87 rollback :: DarcsCommand
  88 rollback = DarcsCommand {command_name = "rollback",
  89                          command_help = rollback_help,
  90                          command_description = rollback_description,
  91                          command_extra_args = -1,
  92                          command_extra_arg_help = ["[FILE or DIRECTORY]..."],
  93                          command_command = rollback_cmd,
  94                          command_prereq = amInRepository,
  95                          command_get_arg_possibilities = list_registered_files,
  96                          command_argdefaults = nodefaults,
  97                          command_advanced_options = [nocompress,umask_option],
  98                          command_basic_options = [match_several_or_last,
  99                                                   all_interactive,
 100                                                   author, patchname_option, ask_long_comment,
 101                                                   notest, leave_test_dir,
 102                                                   working_repo_dir]}
 103 \end{code}
 104 \begin{code}
 105 rollback_cmd :: [DarcsFlag] -> [String] -> IO ()
 106 rollback_cmd opts args = withRepoLock opts $- \repository -> do
 107   let (logMessage,_,_) = loggers opts
 108   rec <- if null args then return empty_slurpy
 109          else slurp_recorded repository
 110   files <- sort `fmap` fixSubPaths opts args
 111   existing_files <- map toFilePath `fmap` filterM (file_exists rec) files
 112   non_existent_files <- map toFilePath `fmap` filterM (fmap not . file_exists rec) files
 113   when (not $ null existing_files) $
 114        logMessage $ "Recording changes in "++unwords existing_files++":\n"
 115   when (not $ null non_existent_files) $
 116        logMessage $ "Non existent files or directories: "++unwords non_existent_files++"\n"
 117   when ((not $ null non_existent_files) && null existing_files) $
 118        fail "None of the files you specified exist!"
 119   (recorded, working_dir) <- slurp_recorded_and_unrecorded repository
 120   allpatches <- read_repo repository
 121   let patches = if first_match opts then get_last_patches opts allpatches
 122                                     else unsafeUnflippedseal $ headRL allpatches
 123   with_selected_last_changes_to_files_reversed "rollback" opts recorded existing_files
 124       (reverseRL patches) $
 125     \ (_ :> ps) ->
 126     do when (nullFL ps) $ do logMessage "No patches selected!"
 127                              exitWith ExitSuccess
 128        definePatches ps
 129        with_selected_last_changes_to_files' "rollback" opts working_dir
 130                existing_files (sort_coalesceFL $ effect ps) $ \ (_:>ps'') ->
 131          do when (nullFL ps'') $ do logMessage "No changes selected!"
 132                                     exitWith ExitSuccess
 133             let make_log = world_readable_temp "darcs-rollback"
 134                 newlog = Just ("", "":"rolling back:":"":lines (show $ summary ps ))
 135             --tentativelyRemovePatches repository opts (mapFL_FL hopefully ps)
 136             (name, my_log, logf) <- get_log opts newlog make_log $ invert ps''
 137             date <- getIsoDateTime
 138             my_author <- get_author opts
 139             rbp <- n2pia `fmap` namepatch date name my_author my_log
 140                                           (fromPrims $ invert ps'')
 141             debugMessage "Adding rollback patch to repository."
 142             Sealed pw <- tentativelyMergePatches repository "rollback" (MarkConflicts : opts)
 143                          NilFL (rbp :>: NilFL)
 144             debugMessage "Finalizing rollback changes..."
 145             withGutsOf repository $ do
 146               finalizeRepositoryChanges repository
 147               debugMessage "About to apply rolled-back changes to working directory."
 148               -- so work will be more recent than rec:
 149               revertable $ do wait_a_moment
 150                               applyToWorking repository opts pw
 151             when (isJust logf) $ removeFile (fromJust logf)
 152             sync_repo repository
 153             logMessage $ "Finished rolling back."
 154           where revertable x = x `clarify_errors` unlines
 155                   ["Error applying patch to the working directory.","",
 156                    "This may have left your working directory an inconsistent",
 157                    "but recoverable state. If you had no un-recorded changes",
 158                    "by using 'darcs revert' you should be able to make your",
 159                    "working directory consistent again."]
 160 \end{code}
 161