src/Darcs/Commands/AmendRecord.lhs

   1 %  Copyright (C) 2004,2007 David Roundy
   2 %
   3 %  This program is free software; you can redistribute it and/or modify
   4 %  it under the terms of the GNU General Public License as published by
   5 %  the Free Software Foundation; either version 2, or (at your option)
   6 %  any later version.
   7 %
   8 %  This program is distributed in the hope that it will be useful,
   9 %  but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 %  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 %  GNU General Public License for more details.
  12 %
  13 %  You should have received a copy of the GNU General Public License
  14 %  along with this program; see the file COPYING.  If not, write to
  15 %  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  16 %  Boston, MA 02110-1301, USA.
  17
  18 \subsection{darcs amend-record}
  19 \begin{code}
  20 module Darcs.Commands.AmendRecord ( amendrecord ) where
  21 import Data.List ( sort )
  22 import Data.Maybe ( isJust )
  23 import System.Exit ( ExitCode(..), exitWith )
  24 import Control.Monad ( when )
  25
  26 import Darcs.Flags ( DarcsFlag(Author, LogFile, PatchName,
  27                                EditLongComment, PromptLongComment) )
  28 import Darcs.Lock ( world_readable_temp )
  29 import Darcs.RepoPath ( toFilePath )
  30 import Darcs.Hopefully ( PatchInfoAnd, n2pia, hopefully, info )
  31 import Darcs.Repository ( withRepoLock, ($-), withGutsOf,
  32                     get_unrecorded, get_unrecorded_unsorted, slurp_recorded,
  33                     tentativelyRemovePatches, tentativelyAddPatch, finalizeRepositoryChanges,
  34                     sync_repo, amInRepository,
  35                   )
  36 import Darcs.Patch ( RepoPatch, description, Prim, fromPrims,
  37                      infopatch, getdeps, adddeps, effect,
  38                      sort_coalesceFL,
  39                      canonize )
  40 import Darcs.Patch.Info ( pi_author, pi_name, pi_log,
  41                           PatchInfo, patchinfo, is_inverted, invert_name,
  42                         )
  43 import Darcs.Ordered ( FL(..), (:>)(..), (+>+),
  44                              nullFL, mapFL_FL, concatFL )
  45 import Darcs.SelectChanges ( with_selected_changes_to_files',
  46                              with_selected_patch_from_repo )
  47 import Darcs.Commands ( DarcsCommand(..), nodefaults )
  48 import Darcs.Commands.Record ( get_date, get_log )
  49 import Darcs.Arguments ( DarcsFlag ( Test, NoTest, All ),
  50                          areFileArgs, fixSubPaths, defineChanges,
  51                         all_interactive, ignoretimes,
  52                         ask_long_comment, author, patchname_option,
  53                         leave_test_dir, nocompress, lookforadds,
  54                          working_repo_dir,
  55                         match_one_nontag, umask_option,
  56                         notest, list_registered_files,
  57                         get_easy_author, set_scripts_executable
  58                       )
  59 import Darcs.Utils ( askUser )
  60 import Printer ( putDocLn )
  61 \end{code}
  62 \begin{code}
  63 amendrecord_description :: String
  64 amendrecord_description =
  65  "Replace a patch with a better version before it leaves your repository."
  66 \end{code}
  67
  68 \options{amend-record}
  69
  70 \haskell{amend-record_help}
  71 If you provide one or more files or directories as additional arguments to
  72 amend-record, you will only be prompted to changes in those files or
  73 directories.
  74
  75 The old version of the patch is lost and the new patch will include both the
  76 old and the new changes.  This is mostly the same as unrecording the old patch,
  77 fixing the changes and recording a new patch with the same name and
  78 description.
  79
  80 \verb!amend-record! will modify the date of the recorded patch.
  81 \begin{code}
  82 amendrecord_help :: String
  83 amendrecord_help =
  84  "Amend-record is used to replace a patch with a newer version with additional\n"++
  85  "changes.\n\n"++
  86  "WARNINGS: You should ONLY use amend-record on patches which only exist in a\n"++
  87  "single repository! Also, running amend-record while another user is pulling\n"++
  88  "from the same repository may cause repository corruption.\n"
  89 \end{code}
  90 \begin{code}
  91 amendrecord :: DarcsCommand
  92 amendrecord = DarcsCommand {command_name = "amend-record",
  93                             command_help = amendrecord_help,
  94                             command_description = amendrecord_description,
  95                             command_extra_args = -1,
  96                             command_extra_arg_help = ["[FILE or DIRECTORY]..."],
  97                             command_command = amendrecord_cmd,
  98                             command_prereq = amInRepository,
  99                             command_get_arg_possibilities = list_registered_files,
 100                             command_argdefaults = nodefaults,
 101                             command_advanced_options = [nocompress, ignoretimes, umask_option,
 102                                                         set_scripts_executable],
 103                             command_basic_options = [match_one_nontag,
 104                                                      notest,
 105                                                     leave_test_dir,
 106                                                     all_interactive,
 107                                                     author, patchname_option, ask_long_comment,
 108                                                     lookforadds,
 109                                                     working_repo_dir]}
 110 \end{code}
 111 \begin{code}
 112 amendrecord_cmd :: [DarcsFlag] -> [String] -> IO ()
 113 amendrecord_cmd origopts args =
 114     let opts = if NoTest `elem` origopts then origopts else Test:origopts
 115         edit_metadata = has_edit_metadata opts in
 116     withRepoLock opts $- \repository -> do
 117     files  <- sort `fmap` fixSubPaths opts args
 118     when (areFileArgs files) $
 119          putStrLn $ "Amending changes in "++unwords (map show files)++":\n"
 120     with_selected_patch_from_repo "amend" repository opts $ \ (_ :> oldp) -> do
 121         ch <- if All `elem` opts
 122               then get_unrecorded_unsorted repository
 123               else get_unrecorded repository
 124         case ch of
 125           NilFL | not edit_metadata -> putStrLn "No changes!"
 126           _ -> do
 127               date <- get_date opts
 128               s <- slurp_recorded repository
 129               with_selected_changes_to_files' "add" (filter (==All) opts)
 130                 s (map toFilePath files) ch $ \ (chs:>_) ->
 131                   if (nullFL chs && not edit_metadata)
 132                   then putStrLn "You don't want to record anything!"
 133                   else do
 134                        let old_pinf = info oldp
 135                            prior    = (pi_name old_pinf, pi_log old_pinf)
 136                            make_log = world_readable_temp "darcs-amend-record"
 137                            old_author = pi_author old_pinf
 138                        author_here <- get_easy_author
 139                        case author_here of
 140                          Nothing -> return ()
 141                          Just ah -> let edit_author = isJust (get_author opts)
 142                                     in if (edit_author || ah == old_author)
 143                                        then return ()
 144                                        else do yorn <- askUser $ "You're not "++old_author
 145                                                                  ++"! Amend anyway? "
 146                                                case yorn of ('y':_) -> return ()
 147                                                             _ -> exitWith $ ExitSuccess
 148                        (new_name, new_log, _) <- get_log opts (Just prior) make_log chs
 149                        let new_author = case get_author opts of
 150                                         Just a  -> a
 151                                         Nothing -> pi_author old_pinf
 152                            maybe_invert = if is_inverted old_pinf then invert_name else id
 153                        new_pinf <- maybe_invert `fmap` patchinfo date new_name
 154                                                                  new_author new_log
 155                        let newp = fixp oldp chs new_pinf
 156                        defineChanges newp
 157                        withGutsOf repository $ do
 158                          tentativelyRemovePatches repository opts (hopefully oldp :>: NilFL)
 159                          tentativelyAddPatch repository opts newp
 160                          finalizeRepositoryChanges repository
 161                        sync_repo repository
 162                        putStrLn "Finished amending patch:"
 163                        putDocLn $ description newp
 164
 165 has_edit_metadata :: [DarcsFlag] -> Bool
 166 has_edit_metadata (Author _:_) = True
 167 has_edit_metadata (LogFile _:_) = True
 168 has_edit_metadata (PatchName _:_) = True
 169 has_edit_metadata (EditLongComment:_) = True
 170 has_edit_metadata (PromptLongComment:_) = True
 171 has_edit_metadata (_:fs) = has_edit_metadata fs
 172 has_edit_metadata [] = False
 173
 174 get_author :: [DarcsFlag] -> Maybe String
 175 get_author (Author a:_) = Just a
 176 get_author (_:as) = get_author as
 177 get_author []     = Nothing
 178 \end{code}
 179
 180 If you configure darcs to run a test suite, darcs will run this test on the
 181 amended repository to make sure it is valid.  Darcs first creates a pristine
 182 copy of the source tree (in a temporary directory), then it runs the test,
 183 using its return value to decide if the amended change is valid. If the
 184 \verb!--set-scripts-executable! flag is passed to amend-record, darcs will set
 185 scripts executable in the temporary test directory before running the test.
 186
 187 \begin{code}
 188 fixp :: RepoPatch p => PatchInfoAnd p -> FL Prim -> PatchInfo -> PatchInfoAnd p
 189 fixp oldp chs new_pinf =
 190     let pdeps = getdeps $ hopefully oldp
 191         oldchs = effect oldp
 192         infodepspatch pinfo deps p = adddeps (infopatch pinfo p) deps
 193     in n2pia $ infodepspatch new_pinf pdeps $ fromPrims $ sort_coalesceFL $
 194        concatFL $
 195        mapFL_FL canonize $ oldchs +>+ chs
 196 \end{code}