% Copyright (C) 2004 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 amend-record} \begin{code} module AmendRecord ( amendrecord ) where import List ( sort ) import System.Exit ( ExitCode(..), exitWith ) import Monad ( when, liftM ) import SignalHandler ( withSignalsBlocked ) import Repository ( PatchSet, withRepoLock, get_unrecorded, slurp_recorded, with_new_pending, sync_repo, ) import DarcsRepo ( read_repo, add_to_inventory, write_patch, am_in_repo, write_inventory, ) import Pristine ( identifyPristine, applyPristine ) import Depends ( deep_optimize_patchset ) import Patch ( Patch, patch2patchinfo, join_patches, flatten, infopatch, getdeps, adddeps, flatten_to_primitives, canonize, merger_equivalent, null_patch, ) import PatchInfo ( human_friendly, set_pi_date, ) import SelectChanges ( with_selected_changes_to_files, with_selected_patch_from_repo, ) import DarcsCommands ( DarcsCommand(..), nodefaults ) import Record ( get_date ) import DarcsArguments ( DarcsFlag ( NoTest, All, AnyOrder ), all_interactive, ignoretimes, leave_test_dir, nocompress, lookforadds, fix_filepaths_wrt, working_repo_dir, match_one_nontag, umask_option, verbose, notest, list_registered_files, ) import Unrevert ( remove_from_unrevert_context ) import Test ( test_patch ) import Printer ( putDocLn ) #include "impossible.h" \end{code} \begin{code} amendrecord_description :: String amendrecord_description = "Replace a patch with a better version before it leaves your repository." \end{code} \options{amend-record} \haskell{amend-record_help} If you provide one or more files or directories as additional arguments to amend-record, you will only be prompted to changes in those files or directories. The old version of the patch is lost and the new patch will include both the old and the new changes. This is mostly the same as unrecording the old patch, fixing the changes and recording a new patch with the same name and description. \verb!amend-record! will modify the date of the recorded patch. \begin{code} amendrecord_help :: String amendrecord_help = "Amend-record is used to replace a patch with a newer version with additional\n"++ "changes.\n\n"++ "WARNINGS: You should ONLY use amend-record on patches which only exist in a\n"++ "single repository! Also, running amend-record while another user is pulling\n"++ "from the same repository may cause repository corruption.\n" \end{code} \begin{code} amendrecord :: DarcsCommand amendrecord = DarcsCommand {command_name = "amend-record", command_help = amendrecord_help, command_description = amendrecord_description, command_extra_args = -1, command_extra_arg_help = ["[FILE or DIRECTORY]..."], command_command = amendrecord_cmd, command_prereq = am_in_repo, command_get_arg_possibilities = list_registered_files, command_argdefaults = nodefaults, command_darcsoptions = [match_one_nontag, verbose, notest, leave_test_dir, nocompress, all_interactive, ignoretimes, lookforadds, working_repo_dir, umask_option]} \end{code} \begin{code} amendrecord_cmd :: [DarcsFlag] -> [String] -> IO () amendrecord_cmd opts args = withRepoLock opts $ \repository -> do files <- sort `liftM` fix_filepaths_wrt "." opts args when (concat files /= "") $ putStrLn $ "Amending changes in "++unwords (map show files)++":\n" with_selected_patch_from_repo "amend" opts True $ \ (oldp, skipped) -> do changes <- if All `elem` opts then get_unrecorded repository (AnyOrder:opts) else get_unrecorded repository opts case changes of Nothing -> putStrLn "No changes!" Just ch -> do date <- get_date opts s <- slurp_recorded repository with_selected_changes_to_files "add" (filter (==All) opts) s files (flatten ch) Nothing $ \ (unrec,chs) -> if null chs then putStrLn "You don't want to record anything!" else do let newp = fixp oldp chs date when (want_to_do_test opts) $ do testproblem <- test_patch opts (join_patches chs) when (testproblem /= ExitSuccess) $ exitWith $ ExitFailure 1 write_patch opts $ newp remove_from_unrevert_context [oldp] withSignalsBlocked $ with_new_pending repository (join_patches unrec) $ do pris <- identifyPristine applyPristine pris (join_patches chs) `catch` \e -> fail ("Bizarre error in amend-recording:\n" ++ show e) sequence_ $ map (write_patch opts) skipped patches' <- read_repo "." write_inventory "." $ rempatch oldp patches' add_to_inventory "." [(fromJust $ patch2patchinfo newp)] sync_repo repository putStrLn "Finished amending patch:" putDocLn $ human_friendly $ fromJust $ patch2patchinfo newp \end{code} If you configure darcs to run a test suite, darcs will run this test on the amended repository to make sure it is valid. Darcs first creates a pristine copy of the source tree (in a temporary directory), then it runs the test, using its return value to decide if the amended change is valid. \begin{code} want_to_do_test :: [DarcsFlag] -> Bool want_to_do_test (NoTest:_) = False want_to_do_test (_:flags) = want_to_do_test flags want_to_do_test [] = True \end{code} \begin{code} fixp :: Patch -> [Patch] -> String -> Patch fixp oldp chs d = let pinf = fromJust $ patch2patchinfo oldp pdeps = getdeps oldp oldchs = flatten_to_primitives $ merger_equivalent oldp really_canonize p = case canonize p of Nothing -> null_patch Just p' -> p' infodepspatch pinfo deps p = adddeps (infopatch pinfo p) deps in infodepspatch (set_pi_date d pinf) pdeps $ really_canonize $ join_patches $ oldchs ++ chs rempatch :: Patch -> PatchSet -> PatchSet rempatch p (pps:ppss) = case patch2patchinfo p of Nothing -> impossible 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}