% 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.
\darcsCommand{amend-record}
\begin{code}
module Darcs.Commands.AmendRecord ( amendrecord ) where
import Data.List ( sort )
import Data.Maybe ( isJust )
import System.Directory ( removeFile )
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 ( Repository, withRepoLock, ($-), withGutsOf,
tentativelyRemovePatches, tentativelyAddPatch, finalizeRepositoryChanges,
amInRepository
, invalidateIndex, unrecordedChanges
)
import Darcs.Patch ( RepoPatch, description, Prim, fromPrims,
infopatch, getdeps, adddeps, effect,
)
import Darcs.Patch.Prim ( canonizeFL )
import Darcs.Patch.Info ( pi_author, pi_name, pi_log,
PatchInfo, patchinfo, is_inverted, invert_name,
)
import Darcs.Patch.Split ( primSplitter )
import Darcs.Witnesses.Ordered ( FL(..), (:>)(..), (+>+), nullFL )
import Darcs.SelectChanges ( with_selected_changes_to_files',
with_selected_patch_from_repo )
import Darcs.Commands ( DarcsCommand(..), nodefaults )
import Darcs.Commands.Record ( getDate, getLog )
import Darcs.Arguments ( DarcsFlag ( All ),
areFileArgs, fixSubPaths, defineChanges,
allInteractive, ignoretimes,
askLongComment, author, patchnameOption,
leaveTestDir, nocompress, lookforadds,
workingRepoDir,
matchOneNontag, umaskOption,
notest, testByDefault, listRegisteredFiles,
getEasyAuthor, setScriptsExecutableOption
)
import Darcs.Utils ( askUser, clarifyErrors )
import Printer ( putDocLn )
amendrecordDescription :: String
amendrecordDescription =
"Improve a patch before it leaves your repository."
amendrecordHelp :: String
amendrecordHelp =
"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-long-comment'.\n" ++
"To change the patch name without starting an editor, use --patch-name.\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. " ++
"On Windows use C:/Documents And Settings/user/Application Data/darcs/defaults\n"
amendrecord :: DarcsCommand
amendrecord = DarcsCommand {commandName = "amend-record",
commandHelp = amendrecordHelp,
commandDescription = amendrecordDescription,
commandExtraArgs = 1,
commandExtraArgHelp = ["[FILE or DIRECTORY]..."],
commandCommand = amendrecordCmd,
commandPrereq = amInRepository,
commandGetArgPossibilities = listRegisteredFiles,
commandArgdefaults = nodefaults,
commandAdvancedOptions = [nocompress, ignoretimes, umaskOption,
setScriptsExecutableOption],
commandBasicOptions = [matchOneNontag,
notest,
leaveTestDir,
allInteractive,
author, patchnameOption, askLongComment,
lookforadds,
workingRepoDir]}
amendrecordCmd :: [DarcsFlag] -> [String] -> IO ()
amendrecordCmd opts args =
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 <- unrecordedChanges opts repository files
case ch of
NilFL | not (hasEditMetadata opts) -> putStrLn "No changes!"
_ ->
with_selected_changes_to_files' "add" (filter (==All) opts) (Just primSplitter)
(map toFilePath files) ch $ addChangesToPatch opts repository oldp
addChangesToPatch :: forall t p . (RepoPatch p) => [DarcsFlag] -> Repository p -> PatchInfoAnd p
-> (FL Prim :> t) -> IO ()
addChangesToPatch opts repository oldp (chs:>_) =
if (nullFL chs && not (hasEditMetadata opts))
then putStrLn "You don't want to record anything!"
else do
(mlogf, newp) <- updatePatchHeader opts oldp chs
defineChanges newp
invalidateIndex repository
withGutsOf repository $ do
tentativelyRemovePatches repository opts (hopefully oldp :>: NilFL)
tentativelyAddPatch repository opts newp
let failmsg = maybe "" (\lf -> "\nLogfile left in "++lf++".") mlogf
finalizeRepositoryChanges repository `clarifyErrors` failmsg
maybe (return ()) removeFile mlogf
putStrLn "Finished amending patch:"
putDocLn $ description newp
updatePatchHeader :: forall p. (RepoPatch p) => [DarcsFlag] -> PatchInfoAnd p -> FL Prim
-> IO (Maybe String, PatchInfoAnd p)
updatePatchHeader opts oldp chs = 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
date <- getDate opts
warnIfHijacking opts old_author
(new_name, new_log, mlogf) <- getLog opts (Just prior) make_log chs
let new_author = case getAuthor 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
return $ (mlogf, fixp oldp chs new_pinf)
warnIfHijacking :: [DarcsFlag] -> String -> IO ()
warnIfHijacking opts old_author = do
author_here <- getEasyAuthor
case author_here of
Nothing -> return ()
Just ah -> let edit_author = isJust (getAuthor 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
hasEditMetadata :: [DarcsFlag] -> Bool
hasEditMetadata (Author _:_) = True
hasEditMetadata (LogFile _:_) = True
hasEditMetadata (PatchName _:_) = True
hasEditMetadata (EditLongComment:_) = True
hasEditMetadata (PromptLongComment:_) = True
hasEditMetadata (_:fs) = hasEditMetadata fs
hasEditMetadata [] = False
getAuthor :: [DarcsFlag] -> Maybe String
getAuthor (Author a:_) = Just a
getAuthor (_:as) = getAuthor as
getAuthor [] = 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 $ canonizeFL
$ oldchs +>+ chs
\end{code}