% Copyright (C) 2004,2007 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 Darcs.Commands.AmendRecord ( amendrecord ) where import Data.List ( sort ) import Data.Maybe ( isJust ) import System.Exit ( ExitCode(..), exitWith ) import Control.Monad ( when ) import Darcs.Flags ( DarcsFlag(Author, LogFile, PatchName, EditLongComment, PromptLongComment) ) import Darcs.Lock ( world_readable_temp ) import Darcs.RepoPath ( toFilePath ) import Darcs.Hopefully ( PatchInfoAnd, n2pia, hopefully, info ) import Darcs.Repository ( withRepoLock, ($-), withGutsOf, get_unrecorded, get_unrecorded_unsorted, slurp_recorded, tentativelyRemovePatches, tentativelyAddPatch, finalizeRepositoryChanges, sync_repo, amInRepository, ) import Darcs.Patch ( RepoPatch, description, Prim, fromPrims, infopatch, getdeps, adddeps, effect, sort_coalesceFL, canonize ) import Darcs.Patch.Info ( pi_author, pi_name, pi_log, PatchInfo, patchinfo, is_inverted, invert_name, ) import Darcs.Ordered ( FL(..), (:>)(..), (+>+), nullFL, mapFL_FL, concatFL ) import Darcs.SelectChanges ( with_selected_changes_to_files', with_selected_patch_from_repo ) import Darcs.Commands ( DarcsCommand(..), nodefaults ) import Darcs.Commands.Record ( get_date, get_log ) import Darcs.Arguments ( DarcsFlag ( All ), areFileArgs, fixSubPaths, defineChanges, all_interactive, ignoretimes, ask_long_comment, author, patchname_option, leave_test_dir, nocompress, lookforadds, working_repo_dir, match_one_nontag, umask_option, notest, testByDefault, list_registered_files, get_easy_author, set_scripts_executable ) import Darcs.Utils ( askUser ) import Printer ( putDocLn ) 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} \begin{code} amendrecord_help :: String amendrecord_help = "Amend-record updates a `draft' patch with additions or improvements,\n" ++ "resulting in a single `finished' patch. This is better than recording\n" ++ "the additions and improvements as separate patches, because then\n" ++ "whenever the `draft' patch is copied between repositories, you would\n" ++ "need to make sure all the extra patches are copied, too.\n" ++ "\n" ++ "Do not copy draft patches between repositories, because a finished\n" ++ "patch cannot be copied into a repository that contains a draft of the\n" ++ "same patch. If this has already happened, `darcs obliterate' can be\n" ++ "used to remove the draft patch.\n" ++ "\n" ++ -- FIXME: is the following still true in Darcs 2.1? --twb "Do not run amend-record in repository that other developers can pull\n" ++ "from, because if they pull while an amend-record is in progress, their\n" ++ "repository may be corrupted.\n" ++ "\n" ++ "When recording a draft patch, it is a good idea to start the name with\n" ++ "`DRAFT:' so that other developers know it is not finished. When\n" ++ "finished, remove it with `darcs amend-record --edit-description'.\n" ++ "\n" ++ "Like `darcs record', if you call amend-record with files as arguments,\n" ++ "you will only be asked about changes to those files. So to amend a\n" ++ "patch to foo.c with improvements in bar.c, you would run:\n" ++ "\n" ++ " darcs amend-record --match 'touch foo.c' bar.c\n" ++ "\n" ++ "It is usually a bad idea to amend another developer's patch. To make\n" ++ "amend-record only ask about your own patches by default, you can add\n" ++ "something like `amend-record match David Roundy' to ~/.darcs/defaults,\n" ++ "where `David Roundy' is your name.\n" 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 = amInRepository, command_get_arg_possibilities = list_registered_files, command_argdefaults = nodefaults, command_advanced_options = [nocompress, ignoretimes, umask_option, set_scripts_executable], command_basic_options = [match_one_nontag, notest, leave_test_dir, all_interactive, author, patchname_option, ask_long_comment, lookforadds, working_repo_dir]} amendrecord_cmd :: [DarcsFlag] -> [String] -> IO () amendrecord_cmd opts args = let edit_metadata = has_edit_metadata opts in withRepoLock (testByDefault opts) $- \repository -> do files <- sort `fmap` fixSubPaths opts args when (areFileArgs files) $ putStrLn $ "Amending changes in "++unwords (map show files)++":\n" with_selected_patch_from_repo "amend" repository opts $ \ (_ :> oldp) -> do ch <- if All `elem` opts then get_unrecorded_unsorted repository else get_unrecorded repository case ch of NilFL | not edit_metadata -> putStrLn "No changes!" _ -> do date <- get_date opts s <- slurp_recorded repository with_selected_changes_to_files' "add" (filter (==All) opts) s (map toFilePath files) ch $ \ (chs:>_) -> if (nullFL chs && not edit_metadata) then putStrLn "You don't want to record anything!" else do let old_pinf = info oldp prior = (pi_name old_pinf, pi_log old_pinf) make_log = world_readable_temp "darcs-amend-record" old_author = pi_author old_pinf author_here <- get_easy_author case author_here of Nothing -> return () Just ah -> let edit_author = isJust (get_author opts) in if (edit_author || ah == old_author) then return () else do yorn <- askUser $ "You're not "++old_author ++"! Amend anyway? " case yorn of ('y':_) -> return () _ -> exitWith $ ExitSuccess (new_name, new_log, _) <- get_log opts (Just prior) make_log chs let new_author = case get_author opts of Just a -> a Nothing -> pi_author old_pinf maybe_invert = if is_inverted old_pinf then invert_name else id new_pinf <- maybe_invert `fmap` patchinfo date new_name new_author new_log let newp = fixp oldp chs new_pinf defineChanges newp withGutsOf repository $ do tentativelyRemovePatches repository opts (hopefully oldp :>: NilFL) tentativelyAddPatch repository opts newp finalizeRepositoryChanges repository sync_repo repository putStrLn "Finished amending patch:" putDocLn $ description newp has_edit_metadata :: [DarcsFlag] -> Bool has_edit_metadata (Author _:_) = True has_edit_metadata (LogFile _:_) = True has_edit_metadata (PatchName _:_) = True has_edit_metadata (EditLongComment:_) = True has_edit_metadata (PromptLongComment:_) = True has_edit_metadata (_:fs) = has_edit_metadata fs has_edit_metadata [] = False get_author :: [DarcsFlag] -> Maybe String get_author (Author a:_) = Just a get_author (_:as) = get_author as get_author [] = Nothing fixp :: RepoPatch p => PatchInfoAnd p -> FL Prim -> PatchInfo -> PatchInfoAnd p fixp oldp chs new_pinf = let pdeps = getdeps $ hopefully oldp oldchs = effect oldp infodepspatch pinfo deps p = adddeps (infopatch pinfo p) deps in n2pia $ infodepspatch new_pinf pdeps $ fromPrims $ concatFL $ mapFL_FL canonize $ sort_coalesceFL $ concatFL $ mapFL_FL canonize $ oldchs +>+ chs \end{code}