src/Darcs/Commands/Unrecord.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 unrecord}
  19 \label{unrecord}
  20 \begin{code}
  21 {-# OPTIONS_GHC -cpp #-}
  22 {-# LANGUAGE CPP #-}
  23
  24 module Darcs.Commands.Unrecord ( unrecord, unpull, obliterate, rempatch, get_last_patches ) where
  25 import Control.Monad ( when )
  26 import System.Exit ( exitWith, ExitCode( ExitSuccess ) )
  27
  28 import Darcs.SlurpDirectory ( wait_a_moment )
  29 import Darcs.Hopefully ( hopefully, info )
  30 import Darcs.Commands ( DarcsCommand(..), nodefaults, loggers, command_alias )
  31 import Darcs.Arguments ( DarcsFlag( Verbose ),
  32                          working_repo_dir, nocompress, definePatches,
  33                         match_several_or_last, deps_sel,
  34                         ignoretimes,
  35                         all_interactive, umask_option,
  36                       )
  37 import Darcs.Match ( first_match, match_first_patchset, match_a_patchread )
  38 import Darcs.Repository ( PatchSet, PatchInfoAnd, withGutsOf,
  39                           withRepoLock, ($-), slurp_recorded,
  40                     tentativelyRemovePatches, finalizeRepositoryChanges,
  41                     tentativelyAddToPending,
  42                     applyToWorking,
  43                     get_unrecorded, read_repo, amInRepository,
  44                     sync_repo,
  45                   )
  46 import Darcs.Patch ( Patchy, RepoPatch, Named, invert, patch2patchinfo, commutex, effect )
  47 import Darcs.Ordered ( RL(..), (:<)(..), (:>)(..), (:\/:)(..), (+<+),
  48                              unsafeRL, unsafeUnRL, mapFL_FL, nullFL,
  49                              concatRL, reverseRL, mapRL, mapRL_RL )
  50 import Darcs.Patch.Depends ( deep_optimize_patchset, get_common_and_uncommon )
  51 import Darcs.SelectChanges ( with_selected_last_changes_reversed )
  52 import Darcs.Progress ( debugMessage )
  53 import Darcs.Sealed ( Sealed(..) )
  54 #include "impossible.h"
  55 \end{code}
  56 \begin{code}
  57 unrecord_description :: String
  58 unrecord_description =
  59  "Remove recorded patches without changing the working copy."
  60 \end{code}
  61
  62 \options{unrecord}
  63
  64 \haskell{unrecord_help}
  65
  66 Unrecord can be thought of as undo-record.
  67 If a record is followed by an unrecord, everything looks like before
  68 the record; all the previously unrecorded changes are back, and can be
  69 recorded again in a new patch. The unrecorded patch however is actually
  70 removed from your repository, so there is no way to record it again to get
  71 it back.\footnote{The patch file itself is not actually deleted, but its
  72 context is lost, so it cannot be reliably read---your only choice would be
  73 to go in by hand and read its contents.}.
  74
  75 If you want to remove
  76 the changes from the working copy too (where they otherwise will show
  77 up as unrecorded changes again), you'll also need to \verb!darcs revert!.
  78 To do unrecord and revert in one go, you can use \verb!darcs obliterate!.
  79
  80 If you don't revert after unrecording, then the changes made by the
  81 unrecorded patches are left in your working tree.  If these patches are
  82 actually from another repository, interaction (either pushes or pulls) with
  83 that repository may be massively slowed down, as darcs tries to cope with
  84 the fact that you appear to have made a large number of changes that
  85 conflict with those present in the other repository.  So if you really want
  86 to undo the result of a \emph{pull} operation, use obliterate! Unrecord is
  87 primarily intended for when you record a patch, realize it needs just one
  88 more change, but would rather not have a separate patch for just that one
  89 change.
  90
  91 \newcommand{\pullwarning}[1]{
  92 \textbf{WARNING:} #1 should not be run when there is a possibility
  93 that another user may be pulling from the same repository.  Attempting to do so
  94 may cause repository corruption.}
  95
  96 \pullwarning{Unrecord}
  97
  98 \begin{options}
  99 --from-match, --from-patch, --from-tag, --last
 100 \end{options}
 101
 102 Usually you only want to unrecord the latest changes,
 103 and almost never would you want to unrecord changes before a tag---you
 104 would have to have unrecorded the tag as well to do that.
 105 Therefore, and for efficiency, darcs only prompts you for the latest patches,
 106 after some optimal tag.
 107
 108 If you do want to unrecord more patches in one go,
 109 there are the \verb!--from! and \verb!--last! options
 110 to set the earliest patch selectable to unrecord.
 111
 112 \begin{options}
 113 --matches, --patches, --tags, --no-deps
 114 \end{options}
 115
 116 The \verb!--patches!, \verb!--matches!, \verb!--tags!, and \verb!--no-deps!
 117 options can be used to select which patches to unrecord, as described in
 118 subsection~\ref{selecting}.
 119
 120 With these options you can specify
 121 what patch or patches to be prompted for by unrecord.
 122 This is especially useful when you want to unrecord patches with dependencies,
 123 since all the dependent patches (but no others) will be included in the choices.
 124 Or if you use \verb!--no-deps! you won't be asked about patches that can't be
 125 unrecorded due to depending patches.
 126
 127 Selecting patches can be slow, so darcs cuts the search at the last
 128 optimized tag. Use the \verb!--from! or \verb!--last! options to search
 129 more or fewer patches.
 130
 131 \begin{code}
 132 unrecord_help :: String
 133 unrecord_help =
 134  "Unrecord does the opposite of record in that it makes the changes from\n"++
 135  "patches active changes again which you may record or revert later.  The\n"++
 136  "working copy itself will not change.\n"++
 137  "Beware that you should not use this command if you are going to\n"++
 138  "re-record the changes in any way and there is a possibility that\n"++
 139  "another user may have already pulled the patch.\n"
 140 \end{code}
 141 \begin{code}
 142 unrecord :: DarcsCommand
 143 unrecord = DarcsCommand {command_name = "unrecord",
 144                          command_help = unrecord_help,
 145                          command_description = unrecord_description,
 146                          command_extra_args = 0,
 147                          command_extra_arg_help = [],
 148                          command_command = unrecord_cmd,
 149                          command_prereq = amInRepository,
 150                          command_get_arg_possibilities = return [],
 151                          command_argdefaults = nodefaults,
 152                          command_advanced_options = [nocompress,umask_option],
 153                          command_basic_options = [match_several_or_last,
 154                                                  deps_sel,
 155                                                  all_interactive,
 156                                                  working_repo_dir]}
 157 \end{code}
 158 \begin{code}
 159 unrecord_cmd :: [DarcsFlag] -> [String] -> IO ()
 160 unrecord_cmd opts _ = withRepoLock opts $- \repository -> do
 161   let (logMessage,_,_) = loggers opts
 162   recorded <- slurp_recorded repository
 163   allpatches <- read_repo repository
 164   let patches = if first_match opts then get_last_patches opts allpatches
 165                                     else matchingHead opts allpatches
 166   with_selected_last_changes_reversed "unrecord" opts recorded
 167       (reverseRL patches) $
 168     \ (_ :> to_unrecord) -> do
 169        when (nullFL to_unrecord) $ do logMessage "No patches selected!"
 170                                       exitWith ExitSuccess
 171        when (Verbose `elem` opts) $
 172             logMessage "About to write out (potentially) modified patches..."
 173        definePatches to_unrecord
 174        withGutsOf repository $ do tentativelyRemovePatches repository opts $
 175                                                            mapFL_FL hopefully to_unrecord
 176                                   finalizeRepositoryChanges repository
 177        sync_repo repository
 178        logMessage "Finished unrecording."
 179
 180 get_last_patches :: RepoPatch p => [DarcsFlag] -> PatchSet p -> RL (PatchInfoAnd p)
 181 get_last_patches opts ps =
 182   case get_common_and_uncommon (ps,p1s) of
 183   (_,us :\/: _) -> concatRL us
 184   where (Sealed p1s) = match_first_patchset opts ps
 185
 186 rempatch :: RepoPatch p => Named p -> PatchSet p -> PatchSet p
 187 rempatch p (pps:<:ppss) =
 188     case patch2patchinfo p of
 189     pinfo -> if pinfo `elem` simple_infos
 190                   -- The following ugly hack is only safe because we don't use
 191                   -- the actual patches!
 192                   then (unsafeRL $ filter ((/= pinfo).info) $ unsafeUnRL pps) :<: ppss
 193                   else deep_optimize_patchset $
 194                        mapRL_RL (unsafeRL . filter ((/= pinfo).info) . unsafeUnRL) (pps:<:ppss)
 195     where simple_infos = init $ mapRL info pps
 196 rempatch _ NilRL = impossible
 197 \end{code}
 198
 199 \begin{code}
 200 unpull_description :: String
 201 unpull_description =
 202  "Opposite of pull; unsafe if patch is not in remote repository."
 203 \end{code}
 204
 205 \begin{code}
 206 unpull_help :: String
 207 unpull_help =
 208  "Unpull completely removes recorded patches from your local repository.\n"++
 209  "The changes will be undone in your working copy and the patches will not be\n"++
 210  "shown in your changes list anymore.\n"++
 211  "Beware that if the patches are not still present in another repository you\n"++
 212  "will lose precious code by unpulling!\n"
 213 \end{code}
 214
 215 \begin{code}
 216 unpull :: DarcsCommand
 217 unpull = (command_alias "unpull" obliterate)
 218                       {command_help = unpull_help,
 219                        command_description = unpull_description,
 220                        command_command = unpull_cmd}
 221
 222 unpull_cmd :: [DarcsFlag] -> [String] -> IO ()
 223 unpull_cmd = generic_obliterate_cmd "unpull"
 224 \end{code}
 225
 226
 227
 228 \subsection{darcs obliterate}
 229
 230 \begin{code}
 231 obliterate_description :: String
 232 obliterate_description =
 233  "Delete selected patches from the repository. (UNSAFE!)"
 234 \end{code}
 235
 236 \begin{code}
 237 obliterate_help :: String
 238 obliterate_help =
 239  "Obliterate completely removes recorded patches from your local repository.\n"++
 240  "The changes will be undone in your working copy and the patches will not be\n"++
 241  "shown in your changes list anymore.\n"++
 242  "Beware that you can lose precious code by obliterating!\n"
 243 \end{code}
 244
 245 \options{obliterate}
 246
 247 \haskell{obliterate_help}
 248
 249 Obliterate deletes a patch from the repository \emph{and} removes those
 250 changes from the working directory.  It is therefore a \emph{very
 251 dangerous} command.  When there are no local changes, obliterate is
 252 equivalent to an unrecord followed by a revert, except that revert can be
 253 unreverted.  In the case of tags, obliterate removes the tag itself, not
 254 any other patches.
 255
 256 Note that unpull was the old name for obliterate. Unpull is still an
 257 hidden alias for obliterate.
 258
 259 \pullwarning{Obliterate}
 260
 261 \begin{options}
 262 --from-match, --from-patch, --from-tag, --last
 263 \end{options}
 264
 265 Usually you only want to obliterate the latest changes, and almost never would
 266 you want to obliterate changes before a tag---you would have to have obliterated
 267 the tag as well to do that. Therefore, and for efficiency, darcs only
 268 prompts you for the latest patches, after some optimal tag.
 269
 270 If you do want to obliterate more patches in one go, there are the
 271 \verb!--from! and \verb!--last! options to set the earliest patch
 272 selectable to obliterate.
 273
 274 \begin{options}
 275 --matches, --patches, --tags, --no-deps
 276 \end{options}
 277
 278 The \verb!--patches!, \verb!--matches!, \verb!--tags!, and \verb!--no-deps!
 279 options can be used to select which patches to obliterate, as described in
 280 subsection~\ref{selecting}.
 281
 282 With these options you can specify what patch or patches to be prompted for
 283 by obliterate. This is especially useful when you want to obliterate patches with
 284 dependencies, since all the dependent patches (but no others) will be
 285 included in the choices. Or if you use \verb!--no-deps! you won't be asked
 286 about patches that can't be obliterated due to depending patches.
 287
 288 Selecting patches can be slow, so darcs cuts the search at the last
 289 optimized tag. Use the \verb!--from! or \verb!--last! options to search
 290 more or fewer patches.
 291
 292 \begin{code}
 293 obliterate :: DarcsCommand
 294 obliterate = DarcsCommand {command_name = "obliterate",
 295                            command_help = obliterate_help,
 296                            command_description = obliterate_description,
 297                            command_extra_args = 0,
 298                            command_extra_arg_help = [],
 299                            command_command = obliterate_cmd,
 300                            command_prereq = amInRepository,
 301                            command_get_arg_possibilities = return [],
 302                            command_argdefaults = nodefaults,
 303                            command_advanced_options = [nocompress,ignoretimes,umask_option],
 304                            command_basic_options = [match_several_or_last,
 305                                                    deps_sel,
 306                                                    all_interactive,
 307                                                    working_repo_dir]}
 308 obliterate_cmd :: [DarcsFlag] -> [String] -> IO ()
 309 obliterate_cmd = generic_obliterate_cmd "obliterate"
 310 \end{code}
 311
 312 \begin{code}
 313 generic_obliterate_cmd :: String -> [DarcsFlag] -> [String] -> IO ()
 314 generic_obliterate_cmd cmdname opts _ = withRepoLock opts $- \repository -> do
 315   let (logMessage,_,_) = loggers opts
 316   recorded <- slurp_recorded repository
 317   pend <- get_unrecorded repository
 318   allpatches <- read_repo repository
 319   let patches = if first_match opts then get_last_patches opts allpatches
 320                                     else matchingHead opts allpatches
 321   with_selected_last_changes_reversed cmdname opts recorded
 322       (reverseRL patches) $
 323     \ (_ :> ps) ->
 324     case commutex (pend :< effect ps) of
 325     Nothing -> fail $ "Can't "++ cmdname ++
 326                " patch without reverting some unrecorded change."
 327     Just (p_after_pending:<_) -> do
 328         when (nullFL ps) $ do logMessage "No patches selected!"
 329                               exitWith ExitSuccess
 330         definePatches ps
 331         withGutsOf repository $
 332                              do tentativelyRemovePatches repository opts (mapFL_FL hopefully ps)
 333                                 tentativelyAddToPending repository opts $ invert $ effect ps
 334                                 finalizeRepositoryChanges repository
 335                                 debugMessage "Waiting a bit for timestamps to differ..."
 336                                 wait_a_moment
 337                                 debugMessage "Applying patches to working directory..."
 338                                 applyToWorking repository opts (invert p_after_pending) `catch` \e ->
 339                                     fail ("Couldn't undo patch in working dir.\n" ++ show e)
 340         sync_repo repository
 341         logMessage $ "Finished " ++ present_participle cmdname ++ "."
 342
 343 matchingHead :: Patchy p => [DarcsFlag] -> RL (RL (PatchInfoAnd p)) -> RL (PatchInfoAnd p)
 344 matchingHead opts (x:<:_) | or (mapRL (match_a_patchread opts) x) = x
 345 matchingHead opts (x:<:xs) = x +<+ matchingHead opts xs
 346 matchingHead _ NilRL = NilRL
 347
 348 present_participle :: String -> String
 349 present_participle v | last v == 'e' = init v ++ "ing"
 350                      | otherwise = v ++ "ing"
 351 \end{code}
 352