% Copyright (C) 2002-2005 David Roundy % % This program is free software; you can redistribute it and/or modify % it under the terms of the GNU General Public License as published by % the Free Software Foundation; either version 2, or (at your option) % any later version. % % This program is distributed in the hope that it will be useful, % but WITHOUT ANY WARRANTY; without even the implied warranty of % MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the % GNU General Public License for more details. % % You should have received a copy of the GNU General Public License % along with this program; see the file COPYING. If not, write to % the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, % Boston, MA 02110-1301, USA. \subsection{darcs unrecord} \begin{code} module Unrecord ( unrecord, unpull, obliterate, rempatch ) where import Monad ( when ) import System ( exitWith, ExitCode( ExitSuccess ) ) import Data.Maybe ( fromJust ) import SignalHandler ( withSignalsBlocked ) import DarcsCommands ( DarcsCommand(..), nodefaults, loggers ) import DarcsArguments ( DarcsFlag( Verbose ), working_repo_dir, nocompress, verbose, match_several_or_last, ignoretimes, all_gui_interactive, umask_option, ) import Match ( first_match, match_first_patchset, ) import Repository ( PatchSet, withRepoLock, slurp_recorded, applyToWorking, get_unrecorded, read_pending, with_new_pending, sync_repo, ) import DarcsRepo ( read_repo, write_inventory, write_patch, remove_from_checkpoint_inventory, am_in_repo, ) import Pristine ( identifyPristine, applyPristine ) import Patch ( Patch, invert, patch2patchinfo, join_patches, commute, flatten, null_patch, ) import PatchInfo ( PatchInfo ) import Depends ( deep_optimize_patchset, commute_to_end, get_common_and_uncommon ) import Unrevert ( remove_from_unrevert_context ) import SelectChanges ( with_selected_last_changes_reversed ) #include "impossible.h" \end{code} \begin{code} unrecord_description :: String unrecord_description = "Remove recorded patches without changing the working copy." \end{code} \options{unrecord} \haskell{unrecord_help} Unrecord can be thought of as undo-record. If a record is followed by an unrecord, everything looks like before the record; all the previously unrecorded changes are back, and can be recorded again in a new patch. The unrecorded patch however is actually removed from your repository, so there is no way to record it again to get it back.\footnote{The patch file itself is not actually deleted, but its context is lost, so it cannot be reliably read---your only choice would be to go in by hand and read its contents.}. If you want to remove the changes from the working copy too (where they otherwise will show up as unrecorded changes again), you'll also need to \verb!darcs revert!. To do unrecord and revert in one go, you can use \verb!darcs unpull!. If you don't revert after unrecording, then the changes made by the unrecorded patches are left in your working tree. If these patches are actually from another repository, interaction (either pushes or pulls) with that repository may be massively slowed down, as darcs tries to cope with the fact that you appear to have made a large number of changes that conflict with those present in the other repository. So if you really want to undo the result of a \emph{pull} operation, use unpull! Unrecord is primarily intended for when you record a patch, realize it needs just one more change, but would rather not have a separate patch for just that one change. \newcommand{\pullwarning}[1]{ \textbf{WARNING:} #1 should not be run when there is a possibility that another user may be pulling from the same repository. Attempting to do so may cause repository corruption.} \pullwarning{Unrecord} \begin{options} --from-match, --from-patch, --from-tag, --last \end{options} Usually you only want to unrecord the latest changes, and almost never would you want to unrecord changes before a tag---you would have to have unrecorded the tag as well to do that. Therefore, and for efficiency, darcs only prompts you for the latest patches, after some optimal tag. If you do want to unrecord more patches in one go, there are the \verb!--from! and \verb!--last! options to set the earliest patch selectable to unrecord. \begin{options} --matches, --patches, --tags \end{options} With these options you can specify what patch or patches to be prompted for by unrecord. This is especially useful when you want to unrecord patches with dependencies, since all the dependent patches (but no others) will be included in the choices. These options can be slow if the list of patches to match is long, which can happen if \verb!--from! or \verb!--last! is used. The latter options can of course be used to \emph{shorten} the list too, if it is long by default. \begin{code} unrecord_help :: String unrecord_help = "Unrecord does the opposite of record in that it makes the changes from\n"++ "patches active changes again which you may record or revert later. The\n"++ "working copy itself will not change.\n" \end{code} \begin{code} unrecord :: DarcsCommand unrecord = DarcsCommand {command_name = "unrecord", command_help = unrecord_help, command_description = unrecord_description, command_extra_args = 0, command_extra_arg_help = [], command_command = unrecord_cmd, command_prereq = am_in_repo, command_get_arg_possibilities = return [], command_argdefaults = nodefaults, command_darcsoptions = [match_several_or_last, verbose,nocompress, all_gui_interactive, working_repo_dir, umask_option]} \end{code} \begin{code} unrecord_cmd :: [DarcsFlag] -> [String] -> IO () unrecord_cmd opts _ = withRepoLock opts $ \repository -> do let (logMessage,_,_) = loggers opts recorded <- slurp_recorded repository pend <- do aack <- read_pending repository return $ case aack of Nothing -> [] Just p -> flatten p allpatches <- read_repo "." let patches = if first_match opts then get_last_patches opts allpatches else head allpatches patches' = map (fromJust . snd) $ reverse patches with_selected_last_changes_reversed "unrecord" opts recorded patches' (Just $ length patches') $ \ (to_unrecord, _) -> do when (null to_unrecord) $ do logMessage "No patches selected!" exitWith ExitSuccess remove_from_unrevert_context to_unrecord let newpend = join_patches (to_unrecord ++ pend) withSignalsBlocked $ with_new_pending repository newpend $ do when (Verbose `elem` opts) $ logMessage "About to write out (potentially) modified patches..." let (_, skipped) = commute_to_end to_unrecord allpatches sequence_ $ map (write_patch opts) skipped repo_patches <- read_repo "." when (Verbose `elem` opts) $ logMessage "About to write inventory..." write_inventory "." $ foldl (flip rempatch) repo_patches (reverse to_unrecord) when (Verbose `elem` opts) $ logMessage "About to write checkpoint inventory..." remove_from_checkpoint_inventory to_unrecord when (Verbose `elem` opts) $ logMessage "Updating pristine tree..." pris <- identifyPristine applyPristine pris (invert $ join_patches to_unrecord) `catch` \e -> fail ("Unable to apply inverse patch!\n" ++ show e) sync_repo repository logMessage "Finished unrecording." get_last_patches :: [DarcsFlag] -> PatchSet -> [(PatchInfo, Maybe Patch)] get_last_patches opts ps = case get_common_and_uncommon (ps,p1s) of (_,us,_) -> concat us where p1s = match_first_patchset opts ps rempatch :: Patch -> PatchSet -> PatchSet rempatch p (pps:ppss) = case patch2patchinfo p of Nothing -> bug "Weird problem in unrecord or unpull - in rempatch." Just pinfo -> if pinfo `elem` simple_infos then (filter ((/= pinfo).fst) pps) : ppss else deep_optimize_patchset $ map (filter ((/= pinfo).fst)) (pps:ppss) where simple_infos = init $ map fst pps rempatch _ [] = impossible \end{code} \subsection{darcs unpull} \begin{code} unpull_description :: String unpull_description = "Opposite of pull; unsafe if patch is not in remote repository." \end{code} \begin{code} unpull_help :: String unpull_help = "Unpull completely removes recorded patches from your local repository.\n"++ "The changes will be undone in your working copy and the patches will not be\n"++ "shown in your changes list anymore.\n"++ "Beware that if the patches are not still present in another repository you\n"++ "will lose precious code by unpulling!\n" \end{code} \options{unpull} \haskell{unpull_help} Unlike unrecord, unpull does not just delete the patch from the repository, it actually applies an inverse patch to the repository. This makes unpull a particularly dangerous command, as it not only deletes the patch from the repository, but also removes the changes from the working directory. It is equivalent to an unrecord followed by a revert, except that revert can be unreverted. \pullwarning{Unpull} Contrary to what its name suggests, there is nothing in unpull that requires that the ``unpulled'' patch originate from a different repository. The name was chosen simply to suggest a situation in which it is ``safe'' to use unpull. If the patch was originally from another repository, then unpulling is safe, because you can always pull the patch again if you decide you want it after all. If you unpull a locally recorded patch, all record of that change is lost, which is what makes this a ``dangerous'' command, and thus deserving of an obscure name which is more suggestive of when it is safe to use than precisely what it does. \begin{options} --from-match, --from-patch, --from-tag, --last \end{options} For efficiency, darcs only prompts you for the latest patches, after some optimal tag. If you do want to unpull more patches in one go, there are the \verb!--from! and \verb!--last! options to set the earliest patch selectable to unpull. \begin{options} --matches, --patches, --tags \end{options} With these options you can specify what patch or patches to be prompted for by unpull. This is especially useful when you want to unpull patches with dependencies, since all the dependent patches (but no others) will be included in the choices. In the case of tags, what you are unpulling is the tag itself, not any other patches. These options can be slow if the list of patches to match with is long, which can happen if \verb!--from! or \verb!--last! is used. The latter options can of course be used to \emph{shorten} the list too, if it is long by default. \begin{code} unpull :: DarcsCommand unpull = DarcsCommand {command_name = "unpull", command_help = unpull_help, command_description = unpull_description, command_extra_args = 0, command_extra_arg_help = [], command_command = unpull_cmd, command_prereq = am_in_repo, command_get_arg_possibilities = return [], command_argdefaults = nodefaults, command_darcsoptions = [match_several_or_last, verbose,nocompress, ignoretimes, all_gui_interactive, working_repo_dir, umask_option]} unpull_cmd :: [DarcsFlag] -> [String] -> IO () unpull_cmd = generic_unpull_cmd "unpull" \end{code} \subsection{darcs obliterate} \begin{code} obliterate_description :: String obliterate_description = "Delete selected patches from the repository. (UNSAFE!)" \end{code} \begin{code} obliterate_help :: String obliterate_help = "Obliterate completely removes recorded patches from your local repository.\n"++ "The changes will be undone in your working copy and the patches will not be\n"++ "shown in your changes list anymore.\n"++ "Beware that you can lose precious code by obliterating!\n" \end{code} \options{obliterate} \haskell{obliterate_help} Obliterate deletes a patch from the repository \emph{and} removes those changes from the working directory. It is therefore a \emph{very dangerous} command. When there are no local changes, obliterate is equivalent to an unrecord followed by a revert, except that revert can be unreverted. In the case of tags, obliterate removes the tag itself, not any other patches. Note that obliterate is currently an alias for unpull. \pullwarning{Obliterate} \begin{options} --from-match, --from-patch, --from-tag, --last \end{options} For efficiency, darcs only prompts you for the latest patches, after some optimal tag. If you do want to unpull more patches in one go, there are the \verb!--from! and \verb!--last! options to set the earliest patch selectable to unpull. \begin{options} --matches, --patches, --tags \end{options} With these options you can specify what patch or patches to be prompted for by unpull. This is especially useful when you want to unpull patches with dependencies, since all the dependent patches (but no others) will be included in the choices. \begin{code} obliterate :: DarcsCommand obliterate = DarcsCommand {command_name = "obliterate", command_help = obliterate_help, command_description = obliterate_description, command_extra_args = 0, command_extra_arg_help = [], command_command = obliterate_cmd, command_prereq = am_in_repo, command_get_arg_possibilities = return [], command_argdefaults = nodefaults, command_darcsoptions = [match_several_or_last, verbose,nocompress, ignoretimes, all_gui_interactive, working_repo_dir, umask_option]} obliterate_cmd :: [DarcsFlag] -> [String] -> IO () obliterate_cmd = generic_unpull_cmd "obliterate" \end{code} \begin{code} generic_unpull_cmd :: String -> [DarcsFlag] -> [String] -> IO () generic_unpull_cmd cmdname opts _ = withRepoLock opts $ \repository -> do let (logMessage,_,_) = loggers opts recorded <- slurp_recorded repository mpend <- get_unrecorded repository opts let pend = case mpend of Nothing -> null_patch Just p -> p allpatches <- read_repo "." let patches = if first_match opts then get_last_patches opts allpatches else head allpatches patches' = map (fromJust . snd) $ reverse patches with_selected_last_changes_reversed cmdname opts recorded patches' (Just $ length patches') $ \ (ps, _) -> case commute (pend, join_patches ps) of Nothing -> fail $ "Can't "++ cmdname ++ " patch without reverting some unrecorded change." Just (p_after_pending, pend') -> do when (null ps) $ do logMessage "No patches selected!" exitWith ExitSuccess remove_from_unrevert_context ps withSignalsBlocked $ with_new_pending repository pend' $ do let (_, skipped) = commute_to_end ps allpatches sequence_ $ map (write_patch opts) skipped repo_patches <- read_repo "." write_inventory "." $ foldl (flip rempatch) repo_patches (reverse ps) remove_from_checkpoint_inventory ps pris <- identifyPristine applyPristine pris (invert $ join_patches ps) `catch` \e -> fail ("Unable to apply inverse patch!\n" ++ show e) applyToWorking repository opts (invert p_after_pending) `catch` \e -> fail ("Couldn't undo patch in working dir.\n" ++ show e) sync_repo repository logMessage $ "Finished " ++ present_participle cmdname ++ "." present_participle :: String -> String present_participle v | last v == 'e' = init v ++ "ing" | otherwise = v ++ "ing" \end{code}