%  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; 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 AmendRecord ( amendrecord ) where
import List ( sort )
import System.Exit ( ExitCode(..), exitWith )
import Monad ( when, liftM )

import SignalHandler ( withSignalsBlocked )
import Repository ( PatchSet,
                    withRepoLock, get_unrecorded, slurp_recorded,
                    with_new_pending, sync_repo,
                  )
import DarcsRepo ( read_repo,
                   add_to_inventory, write_patch,
                   am_in_repo, write_inventory,
                 )
import Pristine ( identifyPristine, applyPristine )
import Depends ( deep_optimize_patchset )
import Patch ( Patch, patch2patchinfo, join_patches, flatten,
               infopatch, getdeps, adddeps, flatten_to_primitives,
               canonize, merger_equivalent, null_patch,
             )
import PatchInfo ( human_friendly, set_pi_date, )
import SelectChanges ( with_selected_changes_to_files,
                       with_selected_patch_from_repo,
                     )
import DarcsCommands ( DarcsCommand(..), nodefaults )
import Record ( get_date )
import DarcsArguments ( DarcsFlag ( NoTest, All, AnyOrder ),
                        all_interactive, ignoretimes,
                        leave_test_dir, nocompress, lookforadds,
                        fix_filepaths_wrt, working_repo_dir,
                        match_one_nontag, umask_option,
                        verbose, notest, list_registered_files,
                      )
import Unrevert ( remove_from_unrevert_context )
import Test ( test_patch )
import Printer ( putDocLn )
#include "impossible.h"
\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 = 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,
                                                    umask_option]}
\end{code}
\begin{code}
amendrecord_cmd :: [DarcsFlag] -> [String] -> IO ()
amendrecord_cmd opts args =
    withRepoLock opts $ \repository -> do
    files  <- sort `liftM` fix_filepaths_wrt "." opts args
    when (concat files /= "") $
         putStrLn $ "Amending changes in "++unwords (map show files)++":\n"
    with_selected_patch_from_repo "amend" opts True $ \ (oldp, skipped) -> do
        changes <- if All `elem` opts 
                   then get_unrecorded repository (AnyOrder:opts)
                   else get_unrecorded repository opts
        case changes of
          Nothing -> putStrLn "No changes!"
          Just ch ->
           do date <- get_date opts
              s <- slurp_recorded repository
              with_selected_changes_to_files "add" (filter (==All) opts)
                s files (flatten ch) Nothing $ \ (unrec,chs) ->
                  if null chs
                  then putStrLn "You don't want to record anything!"
                  else do
                       let newp = fixp oldp chs date
                       when (want_to_do_test opts) $
                            do testproblem <- test_patch opts (join_patches chs)
                               when (testproblem /= ExitSuccess) $
                                    exitWith $ ExitFailure 1
                       write_patch opts $ newp
                       remove_from_unrevert_context [oldp]
                       withSignalsBlocked $
                         with_new_pending repository (join_patches unrec) $ do
                         pris <- identifyPristine
                         applyPristine pris (join_patches chs) `catch`
                             \e -> fail ("Bizarre error in amend-recording:\n" ++ show e)
                         sequence_ $ map (write_patch opts) skipped
                         patches' <- read_repo "."
                         write_inventory "." $ rempatch oldp patches'
                         add_to_inventory "."
                                         [(fromJust $ patch2patchinfo newp)]
                       sync_repo repository
                       putStrLn "Finished amending patch:"
                       putDocLn $ human_friendly $ fromJust
                                    $ patch2patchinfo newp
\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.

\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
        pdeps = getdeps oldp
        oldchs = flatten_to_primitives $ merger_equivalent oldp
        really_canonize p = case canonize p of Nothing -> null_patch
                                               Just p' -> p'
        infodepspatch pinfo deps p = adddeps (infopatch pinfo p) deps
    in
    infodepspatch (set_pi_date d pinf) pdeps $
              really_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 = init $ map fst pps
rempatch _ [] = impossible
\end{code}
