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