AmendRecord.lhs

%  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 ( Test, NoTest, 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, list_registered_files,
                        get_easy_author, set_scripts_executable
                      )
import Darcs.Utils ( askUser )
import Printer ( putDocLn )
\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 = 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]}
\end{code}
\begin{code}
amendrecord_cmd :: [DarcsFlag] -> [String] -> IO ()
amendrecord_cmd origopts args =
    let opts = if NoTest `elem` origopts then origopts else Test:origopts
        edit_metadata = has_edit_metadata opts in
    withRepoLock 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
\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. If the
\verb!--set-scripts-executable! flag is passed to amend-record, darcs will set
scripts executable in the temporary test directory before running the test. 

\begin{code}
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}