-- 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. -- | -- Copyright : 2004, 2007 David Roundy -- License : GPL -- Maintainer : darcs-devel@darcs.net -- Stability : experimental -- Portability : portable module Darcs.UI.Commands.Amend ( amend , amendrecord ) where import Prelude () import Darcs.Prelude import Data.Maybe ( isNothing, isJust ) import Control.Monad ( when ) import Darcs.UI.Commands ( DarcsCommand(..), withStdOpts , commandAlias , nodefaults , setEnvDarcsFiles , setEnvDarcsPatches , amInHashedRepository ) import Darcs.UI.Commands.Util ( announceFiles, testTentativeAndMaybeExit ) import Darcs.UI.Completion ( modifiedFileArgs, knownFileArgs ) import Darcs.UI.Flags ( DarcsFlag, diffOpts, fixSubPaths ) import Darcs.UI.Options ( DarcsOption, (^), oparse, odesc, ocheck, defaultFlags, (?) ) import qualified Darcs.UI.Options.All as O import Darcs.UI.PatchHeader ( updatePatchHeader, AskAboutDeps(..) , HijackOptions(..) , runHijackT ) import Darcs.Repository.Flags ( UpdateWorking(..), DryRun(NoDryRun) ) import Darcs.Patch ( IsRepoType, RepoPatch, description, PrimOf , effect, invert, invertFL ) import Darcs.Patch.Apply ( ApplyState ) import Darcs.Patch.Info ( isTag ) import Darcs.Patch.Split ( primSplitter ) import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, info, patchDesc ) import Darcs.Patch.Rebase.Fixup ( RebaseFixup(..) ) import Darcs.Patch.Rebase.Name ( RebaseName(..) ) import Darcs.Util.Path ( toFilePath, SubPath(), AbsolutePath ) import Darcs.Repository ( Repository , withRepoLock , RepoJob(..) , RebaseJobFlags(..) , tentativelyRemovePatches , tentativelyAddPatch , withManualRebaseUpdate , finalizeRepositoryChanges , invalidateIndex , unrecordedChanges , readRecorded ) import Darcs.Repository.Prefs ( globalPrefsDirDoc ) import Darcs.UI.SelectChanges ( WhichChanges(..) , selectionContextPrim , runSelection , withSelectedPatchFromRepo ) import qualified Darcs.UI.SelectChanges as S ( PatchSelectionOptions(..) ) import Darcs.Util.Exception ( clarifyErrors ) import Darcs.Patch.Witnesses.Ordered ( FL(..), (:>)(..), (+>+), nullFL, reverseRL, mapFL_FL ) import Darcs.Util.Printer ( putDocLn ) import Darcs.Util.Tree( Tree ) import Darcs.Repository.Pending ( tentativelyRemoveFromPending ) amendDescription :: String amendDescription = "Improve a patch before it leaves your repository." amendHelp :: String amendHelp = "Amend updates a \"draft\" patch with additions or improvements,\n" ++ "resulting in a single \"finished\" patch.\n" ++ "\n" ++ "By default `amend` proposes you to record additional changes.\n" ++ "If instead you want to remove changes, use the flag `--unrecord`.\n" ++ "\n" ++ "When recording a draft patch, it is a good idea to start the name with\n" ++ "`DRAFT:`. When done, remove it with `darcs amend --edit-long-comment`.\n" ++ "Alternatively, to change the patch name without starting an editor, \n" ++ "use the `--name`/`-m` flag:\n" ++ "\n" ++ " darcs amend --match 'name \"DRAFT: foo\"' --name 'foo2'\n" ++ "\n" ++ "Like `darcs record`, if you call amend 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 --match 'touch foo.c' bar.c\n" ++ "\n" ++ "It is usually a bad idea to amend another developer's patch. To make\n" ++ "amend only ask about your own patches by default, you can add\n" ++ "something like `amend match David Roundy` to `" ++ globalPrefsDirDoc ++ "defaults`, \n" ++ "where `David Roundy` is your name.\n" amendBasicOpts :: DarcsOption a (Bool -> [O.MatchFlag] -> O.TestChanges -> Maybe Bool -> Maybe String -> Bool -> Maybe String -> Bool -> Maybe O.AskLongComment -> Bool -> O.LookFor -> Maybe String -> O.WithContext -> O.DiffAlgorithm -> a) amendBasicOpts = O.amendUnrecord ^ O.matchOneNontag ^ O.testChanges ^ O.interactive --True ^ O.author ^ O.selectAuthor ^ O.patchname ^ O.askDeps ^ O.askLongComment ^ O.keepDate ^ O.lookfor ^ O.repoDir ^ O.withContext ^ O.diffAlgorithm amendAdvancedOpts :: DarcsOption a (O.Compression -> O.UseIndex -> O.UMask -> O.SetScriptsExecutable -> a) amendAdvancedOpts = O.compress ^ O.useIndex ^ O.umask ^ O.setScriptsExecutable amendOpts :: DarcsOption a (Bool -> [O.MatchFlag] -> O.TestChanges -> Maybe Bool -> Maybe String -> Bool -> Maybe String -> Bool -> Maybe O.AskLongComment -> Bool -> O.LookFor -> Maybe String -> O.WithContext -> O.DiffAlgorithm -> Maybe O.StdCmdAction -> Bool -> Bool -> O.Verbosity -> Bool -> O.Compression -> O.UseIndex -> O.UMask -> O.SetScriptsExecutable -> O.UseCache -> O.HooksConfig -> a) amendOpts = withStdOpts amendBasicOpts amendAdvancedOpts data AmendConfig = AmendConfig { amendUnrecord :: Bool , matchFlags :: [O.MatchFlag] , testChanges :: O.TestChanges , interactive :: Maybe Bool , author :: Maybe String , selectAuthor :: Bool , patchname :: Maybe String , askDeps :: Bool , askLongComment :: Maybe O.AskLongComment , keepDate :: Bool , lookfor :: O.LookFor , _workingRepoDir :: Maybe String , withContext :: O.WithContext , diffAlgorithm :: O.DiffAlgorithm , verbosity :: O.Verbosity , compress :: O.Compression , useIndex :: O.UseIndex , umask :: O.UMask , sse :: O.SetScriptsExecutable , useCache :: O.UseCache } amendConfig :: [DarcsFlag] -> AmendConfig amendConfig = oparse (amendBasicOpts ^ O.verbosity ^ amendAdvancedOpts ^ O.useCache) AmendConfig amend :: DarcsCommand AmendConfig amend = DarcsCommand { commandProgramName = "darcs" , commandName = "amend" , commandHelp = amendHelp , commandDescription = amendDescription , commandExtraArgs = -1 , commandExtraArgHelp = ["[FILE or DIRECTORY]..."] , commandCommand = amendCmd , commandPrereq = amInHashedRepository , commandCompleteArgs = amendFileArgs , commandArgdefaults = nodefaults , commandAdvancedOptions = odesc amendAdvancedOpts , commandBasicOptions = odesc amendBasicOpts , commandDefaults = defaultFlags amendOpts , commandCheckOptions = ocheck amendOpts , commandParseOptions = amendConfig } where amendFileArgs fps flags args = if (O.amendUnrecord ? flags) then knownFileArgs fps flags args else modifiedFileArgs fps flags args amendrecord :: DarcsCommand AmendConfig amendrecord = commandAlias "amend-record" Nothing amend amendCmd :: (AbsolutePath, AbsolutePath) -> AmendConfig -> [String] -> IO () amendCmd _ cfg [] = doAmend cfg Nothing amendCmd fps cfg args = do files <- fixSubPaths fps args if null files then fail "No valid arguments were given, nothing to do." else doAmend cfg $ Just files doAmend :: AmendConfig -> Maybe [SubPath] -> IO () doAmend cfg files = let rebaseJobFlags = RebaseJobFlags (compress cfg) (verbosity cfg) YesUpdateWorking in withRepoLock NoDryRun (useCache cfg) YesUpdateWorking (umask cfg) $ RebaseAwareJob rebaseJobFlags $ \(repository :: Repository rt p wR wU wR) -> withSelectedPatchFromRepo "amend" repository (patchSelOpts cfg) $ \ (_ :> oldp) -> do announceFiles (verbosity cfg) files "Amending changes in" -- auxiliary function needed because the witness types differ for the isTag case pristine <- readRecorded repository let go :: forall wU1 . FL (PrimOf p) wR wU1 -> IO () go NilFL | not (hasEditMetadata cfg) = putStrLn "No changes!" go ch = do let context = selectionContextPrim First "record" (patchSelOpts cfg) --([All,Unified] `intersect` opts) (Just (primSplitter (diffAlgorithm cfg))) (map toFilePath <$> files) (Just pristine) (chosenPatches :> _) <- runSelection ch context addChangesToPatch cfg repository oldp chosenPatches if not (isTag (info oldp)) -- amending a normal patch then if amendUnrecord cfg then do let context = selectionContextPrim Last "unrecord" (patchSelOpts cfg) -- ([All,Unified] `intersect` opts) (Just (primSplitter (diffAlgorithm cfg))) (map toFilePath <$> files) (Just pristine) (_ :> chosenPrims) <- runSelection (effect oldp) context let invPrims = reverseRL (invertFL chosenPrims) addChangesToPatch cfg repository oldp invPrims else go =<< unrecordedChanges (diffingOpts cfg) (O.moves (lookfor cfg)) (O.replaces (lookfor cfg)) repository files -- amending a tag else if hasEditMetadata cfg && isNothing files -- the user is not trying to add new changes to the tag so there is -- no reason to warn. then go NilFL -- the user is trying to add new changes to a tag. else do if hasEditMetadata cfg -- the user already knows that it is possible to edit tag metadata, -- note that s/he is providing editing options! then putStrLn "You cannot add new changes to a tag." -- the user may not be aware that s/he can edit tag metadata. else putStrLn "You cannot add new changes to a tag, but you are allowed to edit tag's metadata (see darcs help amend)." go NilFL addChangesToPatch :: forall rt p wR wU wT wX wY . (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) => AmendConfig -> Repository rt p wR wU wT -> PatchInfoAnd rt p wX wT -> FL (PrimOf p) wT wY -> IO () addChangesToPatch cfg repository oldp chs = let rebaseJobFlags = RebaseJobFlags (compress cfg) (verbosity cfg) YesUpdateWorking in if nullFL chs && not (hasEditMetadata cfg) then putStrLn "You don't want to record anything!" else do invalidateIndex repository -- If a rebase is in progress, we want to manually update the rebase state, using -- the amendments directly as rebase fixups. This is necessary because otherwise -- the normal commute rules for the rebase state will first remove the original -- patch then add the amended patch, and this can lead to more conflicts than using -- the amendment as a fixup directly. For example, if a rename operation is amended in, -- the rename can be propagated to any edits to the file in the rebase state, whereas -- a delete then add would just cause a conflict. -- -- We can also signal that any explicit dependencies of the old patch should be rewritten -- for the new patch using a 'NameFixup'. (repository''', (mlogf, newp)) <- withManualRebaseUpdate rebaseJobFlags repository $ \repository' -> do repository'' <- tentativelyRemovePatches repository' (compress cfg) YesUpdateWorking (oldp :>: NilFL) (mlogf, newp) <- runHijackT AlwaysRequestHijackPermission $ updatePatchHeader "amend" (if askDeps cfg then AskAboutDeps repository'' else NoAskAboutDeps) (patchSelOpts cfg) (diffAlgorithm cfg) (keepDate cfg) (selectAuthor cfg) (author cfg) (patchname cfg) (askLongComment cfg) oldp chs let fixups = mapFL_FL PrimFixup (invert chs) +>+ NameFixup (Rename (info newp) (info oldp)) :>: NilFL setEnvDarcsFiles newp repository''' <- tentativelyAddPatch repository'' (compress cfg) (verbosity cfg) YesUpdateWorking newp return (repository''', fixups, (mlogf, newp)) let failmsg = maybe "" (\lf -> "\nLogfile left in "++lf++".") mlogf testTentativeAndMaybeExit repository''' (verbosity cfg) (testChanges cfg) (sse cfg) (isInteractive cfg) ("you have a bad patch: '" ++ patchDesc newp ++ "'") "amend it" (Just failmsg) when (O.moves (lookfor cfg) == O.YesLookForMoves || O.replaces (lookfor cfg) == O.YesLookForReplaces) $ tentativelyRemoveFromPending repository''' YesUpdateWorking oldp finalizeRepositoryChanges repository''' YesUpdateWorking (compress cfg) `clarifyErrors` failmsg putStrLn "Finished amending patch:" putDocLn $ description newp setEnvDarcsPatches (newp :>: NilFL) hasEditMetadata :: AmendConfig -> Bool hasEditMetadata cfg = isJust (author cfg) || selectAuthor cfg || isJust (patchname cfg) || askLongComment cfg == Just O.YesEditLongComment || askLongComment cfg == Just O.PromptLongComment || askDeps cfg -- hasEditMetadata [] = False -- hasEditMetadata (Author _:_) = True -- hasEditMetadata (SelectAuthor:_) = True -- hasEditMetadata (LogFile _:_) = True -- ??? not listed as an option for amend -- hasEditMetadata (PatchName _:_) = True -- hasEditMetadata (EditLongComment:_) = True -- hasEditMetadata (PromptLongComment:_) = True -- hasEditMetadata (AskDeps:_) = True -- hasEditMetadata (_:fs) = hasEditMetadata fs patchSelOpts :: AmendConfig -> S.PatchSelectionOptions patchSelOpts cfg = S.PatchSelectionOptions { S.verbosity = verbosity cfg , S.matchFlags = matchFlags cfg , S.interactive = isInteractive cfg , S.selectDeps = O.PromptDeps -- option not supported, use default , S.summary = O.NoSummary -- option not supported, use default , S.withContext = withContext cfg } diffingOpts :: AmendConfig -> (O.UseIndex, O.ScanKnown, O.DiffAlgorithm) diffingOpts cfg = diffOpts (useIndex cfg) (O.adds (lookfor cfg)) O.NoIncludeBoring (diffAlgorithm cfg) isInteractive :: AmendConfig -> Bool isInteractive = maybe True id . interactive