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 \darcsCommand{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, sp2fn )
   30 import Darcs.Hopefully ( PatchInfoAnd, n2pia, hopefully, info )
   31 import Darcs.Repository ( withRepoLock, ($-), withGutsOf,
   32                     get_unrecorded_in_files, get_unrecorded_in_files_unsorted,
   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 ( 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, testByDefault, list_registered_files,
   57                         get_easy_author, set_scripts_executable
   58                       )
   59 import Darcs.Utils ( askUser )
   60 import Printer ( putDocLn )
   61 import Darcs.Gorsvet( invalidateIndex )
   62 
   63 amendrecord_description :: String
   64 amendrecord_description =
   65  "Improve a patch before it leaves your repository."
   66 
   67 amendrecord_help :: String
   68 amendrecord_help =
   69  "Amend-record updates a `draft' patch with additions or improvements,\n" ++
   70  "resulting in a single `finished' patch.  This is better than recording\n" ++
   71  "the additions and improvements as separate patches, because then\n" ++
   72  "whenever the `draft' patch is copied between repositories, you would\n" ++
   73  "need to make sure all the extra patches are copied, too.\n" ++
   74  "\n" ++
   75  "Do not copy draft patches between repositories, because a finished\n" ++
   76  "patch cannot be copied into a repository that contains a draft of the\n" ++
   77  "same patch.  If this has already happened, `darcs obliterate' can be\n" ++
   78  "used to remove the draft patch.\n" ++
   79  "\n" ++
   80  -- FIXME: is the following still true in Darcs 2.1? --twb
   81  "Do not run amend-record in repository that other developers can pull\n" ++
   82  "from, because if they pull while an amend-record is in progress, their\n" ++
   83  "repository may be corrupted.\n" ++
   84  "\n" ++
   85  "When recording a draft patch, it is a good idea to start the name with\n" ++
   86  "`DRAFT:' so that other developers know it is not finished.  When\n" ++
   87  "finished, remove it with `darcs amend-record --edit-long-comment'.\n" ++
   88  "To change the patch name without starting an editor, use --patch-name.\n" ++
   89  "\n" ++
   90  "Like `darcs record', if you call amend-record with files as arguments,\n" ++
   91  "you will only be asked about changes to those files.  So to amend a\n" ++
   92  "patch to foo.c with improvements in bar.c, you would run:\n" ++
   93  "\n" ++
   94  "    darcs amend-record --match 'touch foo.c' bar.c\n" ++
   95  "\n" ++
   96  "It is usually a bad idea to amend another developer's patch.  To make\n" ++
   97  "amend-record only ask about your own patches by default, you can add\n" ++
   98  "something like `amend-record match David Roundy' to ~/.darcs/defaults, \n" ++
   99  "where `David Roundy' is your name. " ++ 
  100  "On Windows use C:/Documents And Settings/user/Application Data/darcs/defaults\n"
  101 
  102 amendrecord :: DarcsCommand
  103 amendrecord = DarcsCommand {command_name = "amend-record",
  104                             command_help = amendrecord_help,
  105                             command_description = amendrecord_description,
  106                             command_extra_args = -1,
  107                             command_extra_arg_help = ["[FILE or DIRECTORY]..."],
  108                             command_command = amendrecord_cmd,
  109                             command_prereq = amInRepository,
  110                             command_get_arg_possibilities = list_registered_files,
  111                             command_argdefaults = nodefaults,
  112                             command_advanced_options = [nocompress, ignoretimes, umask_option,
  113                                                         set_scripts_executable],
  114                             command_basic_options = [match_one_nontag,
  115                                                      notest,
  116                                                     leave_test_dir,
  117                                                     all_interactive,
  118                                                     author, patchname_option, ask_long_comment,
  119                                                     lookforadds,
  120                                                     working_repo_dir]}
  121 
  122 amendrecord_cmd :: [DarcsFlag] -> [String] -> IO ()
  123 amendrecord_cmd opts args =
  124     let edit_metadata = has_edit_metadata opts in
  125     withRepoLock (testByDefault opts) $- \repository -> do
  126     files  <- sort `fmap` fixSubPaths opts args
  127     when (areFileArgs files) $
  128          putStrLn $ "Amending changes in "++unwords (map show files)++":\n"
  129     with_selected_patch_from_repo "amend" repository opts $ \ (_ :> oldp) -> do
  130         ch <- if All `elem` opts 
  131               then get_unrecorded_in_files_unsorted repository (map sp2fn files)
  132               else get_unrecorded_in_files repository (map sp2fn files)
  133         case ch of
  134           NilFL | not edit_metadata -> putStrLn "No changes!"
  135           _ -> do
  136               date <- get_date opts
  137               with_selected_changes_to_files' "add" (filter (==All) opts)
  138                 (map toFilePath files) ch $ \ (chs:>_) ->
  139                   if (nullFL chs && not edit_metadata)
  140                   then putStrLn "You don't want to record anything!"
  141                   else do
  142                        let old_pinf = info oldp
  143                            prior    = (pi_name old_pinf, pi_log old_pinf)
  144                            make_log = world_readable_temp "darcs-amend-record"
  145                            old_author = pi_author old_pinf
  146                        author_here <- get_easy_author
  147                        case author_here of
  148                          Nothing -> return ()
  149                          Just ah -> let edit_author = isJust (get_author opts)
  150                                     in if (edit_author || ah == old_author)
  151                                        then return ()
  152                                        else do yorn <- askUser $ "You're not "++old_author
  153                                                                  ++"! Amend anyway? "
  154                                                case yorn of ('y':_) -> return ()
  155                                                             _ -> exitWith $ ExitSuccess
  156                        (new_name, new_log, _) <- get_log opts (Just prior) make_log chs
  157                        let new_author = case get_author opts of
  158                                         Just a  -> a
  159                                         Nothing -> pi_author old_pinf
  160                            maybe_invert = if is_inverted old_pinf then invert_name else id
  161                        new_pinf <- maybe_invert `fmap` patchinfo date new_name
  162                                                                  new_author new_log
  163                        let newp = fixp oldp chs new_pinf
  164                        defineChanges newp
  165                        invalidateIndex repository
  166                        withGutsOf repository $ do
  167                          tentativelyRemovePatches repository opts (hopefully oldp :>: NilFL)
  168                          tentativelyAddPatch repository opts newp
  169                          finalizeRepositoryChanges repository
  170                        sync_repo repository
  171                        putStrLn "Finished amending patch:"
  172                        putDocLn $ description newp
  173 
  174 has_edit_metadata :: [DarcsFlag] -> Bool
  175 has_edit_metadata (Author _:_) = True
  176 has_edit_metadata (LogFile _:_) = True
  177 has_edit_metadata (PatchName _:_) = True
  178 has_edit_metadata (EditLongComment:_) = True
  179 has_edit_metadata (PromptLongComment:_) = True
  180 has_edit_metadata (_:fs) = has_edit_metadata fs
  181 has_edit_metadata [] = False
  182 
  183 get_author :: [DarcsFlag] -> Maybe String
  184 get_author (Author a:_) = Just a
  185 get_author (_:as) = get_author as
  186 get_author []     = Nothing
  187 
  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 $ concatFL $ mapFL_FL canonize
  194            $ sort_coalesceFL $ concatFL $ mapFL_FL canonize $ oldchs +>+ chs
  195 \end{code}