% 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" ++
     -- FIXME: is the following still true in Darcs 2.1? --twb
     "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}