% 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; if not, write to the Free Software Foundation, % Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. \section{darcs rerecord} \begin{code} module Rerecord ( rerecord ) where import Directory ( setCurrentDirectory ) import Workaround ( getCurrentDirectory ) import Control.Exception ( block ) import List ( sort ) import System import Monad ( when, ) import Lock ( withLock ) import Repository ( read_repo, slurp_recorded, get_unrecorded, add_to_inventory, write_patch, sift_for_pending, write_pending, am_in_repo, sync_repo, write_inventory, PatchSet, ) import Depends ( deep_optimize_patchset ) import Patch ( Patch, patch2patchinfo, join_patches, flatten, infopatch, flatten_to_primitives, apply_to_slurpy, canonize, ) import PatchInfo ( human_friendly, set_pi_date, ) import SelectChanges ( with_selected_changes_to_files, with_selected_patch_from_repo, ) import SlurpDirectory ( slurp_write_dirty, ) import DarcsCommands ( DarcsCommand(..), nodefaults ) import Record ( get_date ) import DarcsArguments ( DarcsFlag ( NoTest, All, AnyOrder ), all_interactive, ignoretimes, leave_test_dir, nocompress, lookforadds, fix_filepath, working_repo_dir, match_one_nontag, verbose, notest, list_registered_files, ) import Unrevert ( remove_from_unrevert_context ) import Test ( test_slurpy ) #include "impossible.h" \end{code} \begin{code} rerecord_description :: String rerecord_description = "Add some changes to an already recorded patch." \end{code} \options{rerecord} \haskell{rerecord_help} If you provide one or more files or directories as additional arguments to rerecord, you will only be prompted to changes in those files or directories. Rerecord will modify the date of the recorded patch. WARNING: You should ONLY rerecord patches which only exist in a single repository! \begin{code} rerecord_help :: String rerecord_help = "Rerecord is used to add additional changes to a patch which has already\n"++ "been recorded. Despite its name, rerecord is NOT the opposite of unrecord.\n" \end{code} \begin{code} rerecord :: DarcsCommand rerecord = DarcsCommand {command_name = "rerecord", command_help = rerecord_help, command_description = rerecord_description, command_extra_args = -1, command_extra_arg_help = ["[FILE or DIRECTORY]..."], command_command = rerecord_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]} \end{code} \begin{code} rerecord_cmd :: [DarcsFlag] -> [String] -> IO () rerecord_cmd opts args = let files = sort $ map (fix_filepath opts) args in withLock "./_darcs/lock" $ do when (concat files /= "") $ putStr $ "Rerecording changes in "++unwords (map show files)++":\n\n" with_selected_patch_from_repo "rerecord" opts True $ \ (oldp, skipped) -> do changes <- if All `elem` opts then get_unrecorded (AnyOrder:opts) else get_unrecorded opts case changes of Nothing -> putStr "No changes!\n" Just ch -> do date <- get_date opts s <- slurp_recorded "." with_selected_changes_to_files "rerecord" (filter (==All) opts) s files (flatten ch) $ \ (unrec,chs) -> if null chs then putStr "You don't want to record anything!\n" else do let newp = fixp oldp chs date recorded <- slurp_recorded "." recorded' <- slurp_recorded "." case apply_to_slurpy (join_patches chs) recorded of Nothing -> fail "Unable to apply patch!" Just rec' -> do when (want_to_do_test opts) $ do testproblem <- test_slurpy opts rec' when (testproblem /= ExitSuccess) $ exitWith $ ExitFailure 1 write_patch opts $ newp former_dir <- getCurrentDirectory remove_from_unrevert_context oldp setCurrentDirectory "_darcs/current" block $ do case apply_to_slurpy (join_patches chs) recorded' of Just s' -> slurp_write_dirty s' Nothing -> fail "Bizarre error in rerecording..." setCurrentDirectory former_dir sequence_ $ map (write_patch opts) skipped patches' <- read_repo "." write_inventory "." $ rempatch oldp patches' add_to_inventory "." (fromJust $ patch2patchinfo newp) write_pending $ sift_for_pending $ join_patches unrec sync_repo putStr "Finished rerecording patch:\n" putStr $ human_friendly $ fromJust $ patch2patchinfo newp \end{code} If you configure darcs to run a test suite, darcs will run this test on the rerecorded repo to make sure it is valid. Darcs first creates a pristine copy of the source tree (in \verb!/tmp!), then it runs the test, using its return value to decide if the rerecord 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 oldchs = flatten_to_primitives oldp in infopatch (set_pi_date d pinf) $ fromJust $ 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 = tail $ reverse $ map fst pps rempatch _ [] = impossible \end{code}