% 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 021101301, USA.
\subsection{darcs amendrecord}
\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{amendrecord}
\haskell{amendrecord_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" ++
"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}