{-# LANGUAGE OverloadedStrings #-}
module Darcs.UI.Commands.Amend
(
amend
, amendrecord
) where
import Darcs.Prelude
import Control.Monad ( unless )
import Data.Maybe ( isNothing, isJust )
import Darcs.UI.Commands
( DarcsCommand(..), withStdOpts
, commandAlias
, nodefaults
, setEnvDarcsFiles
, setEnvDarcsPatches
, amInHashedRepository
)
import Darcs.UI.Commands.Util
( announceFiles
, historyEditHelp
, testTentativeAndMaybeExit
)
import Darcs.UI.Completion ( modifiedFileArgs, knownFileArgs )
import Darcs.UI.Flags ( diffOpts, pathSetFromArgs )
import Darcs.UI.Options ( (^), oparse, odesc, ocheck, defaultFlags, (?) )
import qualified Darcs.UI.Options.All as O
import Darcs.UI.PatchHeader ( updatePatchHeader, AskAboutDeps(..)
, HijackOptions(..)
, runHijackT )
import Darcs.Repository.Flags ( UpdatePending(..), DryRun(NoDryRun) )
import Darcs.Patch ( IsRepoType, RepoPatch, description, PrimOf
, effect, invert, invertFL, sortCoalesceFL
)
import Darcs.Patch.Apply ( ApplyState )
import Darcs.Patch.Depends ( patchSetUnion, findCommonWithThem )
import Darcs.Patch.Info ( isTag )
import Darcs.Patch.Named ( fmapFL_Named )
import Darcs.Patch.PatchInfoAnd ( hopefully )
import Darcs.Patch.Set ( Origin, PatchSet, patchSet2RL )
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 ( AnchoredPath )
import Darcs.Repository
( Repository
, withRepoLock
, RepoJob(..)
, identifyRepositoryFor
, ReadingOrWriting(Reading)
, tentativelyRemovePatches
, tentativelyAddPatch
, withManualRebaseUpdate
, finalizeRepositoryChanges
, invalidateIndex
, readPendingAndWorking
, readRecorded
, readRepo
)
import Darcs.Repository.Pending ( tentativelyRemoveFromPW )
import Darcs.Repository.Prefs ( getDefaultRepo )
import Darcs.UI.SelectChanges
( WhichChanges(..)
, selectionConfigPrim
, runInvertibleSelection
, withSelectedPatchFromList
)
import qualified Darcs.UI.SelectChanges as S
( PatchSelectionOptions(..)
)
import Darcs.Util.Exception ( clarifyErrors )
import Darcs.Patch.Witnesses.Ordered
( FL(..), RL, (:>)(..), (+>+)
, nullFL, reverseRL, reverseFL, mapFL_FL
)
import Darcs.Patch.Witnesses.Sealed ( Sealed(..), FlippedSeal(..) )
import Darcs.Util.English ( anyOfClause, itemizeVertical )
import Darcs.Util.Printer ( Doc, formatWords, putDocLn, text, (<+>), ($$), ($+$) )
import Darcs.Util.Printer.Color ( ePutDocLn )
import Darcs.Util.Tree( Tree )
amendDescription :: String
amendDescription :: String
amendDescription = String
"Improve a patch before it leaves your repository."
amendHelp :: Doc
amendHelp :: Doc
amendHelp =
[String] -> Doc
formatWords
[ String
"Amend updates a \"draft\" patch with additions or improvements,"
, String
"resulting in a single \"finished\" patch."
]
Doc -> Doc -> Doc
$+$ [String] -> Doc
formatWords
[ String
"By default `amend` proposes you to record additional changes."
, String
"If instead you want to remove changes, use the flag `--unrecord`."
]
Doc -> Doc -> Doc
$+$ [String] -> Doc
formatWords
[ String
"When recording a draft patch, it is a good idea to start the name with"
, String
"`DRAFT:`. When done, remove it with `darcs amend --edit-long-comment`."
, String
"Alternatively, to change the patch name without starting an editor, "
, String
"use the `--name`/`-m` flag:"
]
Doc -> Doc -> Doc
$+$ String -> Doc
text
String
" darcs amend --match 'name \"DRAFT: foo\"' --name 'foo2'"
Doc -> Doc -> Doc
$+$ [String] -> Doc
formatWords
[ String
"Like `darcs record`, if you call amend with files as arguments,"
, String
"you will only be asked about changes to those files. So to amend a"
, String
"patch to foo.c with improvements in bar.c, you would run:"
]
Doc -> Doc -> Doc
$+$ String -> Doc
text
String
" darcs amend --match 'touch foo.c' bar.c"
Doc -> Doc -> Doc
$+$ Doc
historyEditHelp
data AmendConfig = AmendConfig
{ AmendConfig -> Bool
amendUnrecord :: Bool
, AmendConfig -> [NotInRemote]
notInRemote :: [O.NotInRemote]
, AmendConfig -> [MatchFlag]
matchFlags :: [O.MatchFlag]
, AmendConfig -> TestChanges
testChanges :: O.TestChanges
, AmendConfig -> Maybe Bool
interactive :: Maybe Bool
, AmendConfig -> Maybe String
author :: Maybe String
, AmendConfig -> Bool
selectAuthor :: Bool
, AmendConfig -> Maybe String
patchname :: Maybe String
, AmendConfig -> Bool
askDeps :: Bool
, :: Maybe O.AskLongComment
, AmendConfig -> Bool
keepDate :: Bool
, AmendConfig -> LookFor
lookfor :: O.LookFor
, AmendConfig -> Maybe String
_workingRepoDir :: Maybe String
, AmendConfig -> WithContext
withContext :: O.WithContext
, AmendConfig -> DiffAlgorithm
diffAlgorithm :: O.DiffAlgorithm
, AmendConfig -> Verbosity
verbosity :: O.Verbosity
, AmendConfig -> Compression
compress :: O.Compression
, AmendConfig -> UseIndex
useIndex :: O.UseIndex
, AmendConfig -> UMask
umask :: O.UMask
, AmendConfig -> SetScriptsExecutable
sse :: O.SetScriptsExecutable
, AmendConfig -> UseCache
useCache :: O.UseCache
}
amend :: DarcsCommand
amend :: DarcsCommand
amend = DarcsCommand
{
commandProgramName :: String
commandProgramName = String
"darcs"
, commandName :: String
commandName = String
"amend"
, commandHelp :: Doc
commandHelp = Doc
amendHelp
, commandDescription :: String
commandDescription = String
amendDescription
, commandExtraArgs :: Int
commandExtraArgs = -Int
1
, commandExtraArgHelp :: [String]
commandExtraArgHelp = [String
"[FILE or DIRECTORY]..."]
, commandCommand :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
commandCommand = (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
amendCmd
, commandPrereq :: [DarcsFlag] -> IO (Either String ())
commandPrereq = [DarcsFlag] -> IO (Either String ())
amInHashedRepository
, commandCompleteArgs :: (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
commandCompleteArgs = (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
fileArgs
, commandArgdefaults :: [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
commandArgdefaults = [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
nodefaults
, commandAdvancedOptions :: [DarcsOptDescr DarcsFlag]
commandAdvancedOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc forall {a}.
OptSpec
DarcsOptDescr
DarcsFlag
a
(Compression -> UseIndex -> UMask -> SetScriptsExecutable -> a)
advancedOpts
, commandBasicOptions :: [DarcsOptDescr DarcsFlag]
commandBasicOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc forall {a}.
OptSpec
DarcsOptDescr
DarcsFlag
a
(Bool
-> [NotInRemote]
-> [MatchFlag]
-> TestChanges
-> Maybe Bool
-> Maybe String
-> Bool
-> Maybe String
-> Bool
-> Maybe AskLongComment
-> Bool
-> LookFor
-> Maybe String
-> WithContext
-> DiffAlgorithm
-> a)
basicOpts
, commandDefaults :: [DarcsFlag]
commandDefaults = forall (d :: * -> *) f b. OptSpec d f [f] b -> [f]
defaultFlags forall {a}.
DarcsOption
a
(Bool
-> [NotInRemote]
-> [MatchFlag]
-> TestChanges
-> Maybe Bool
-> Maybe String
-> Bool
-> Maybe String
-> Bool
-> Maybe AskLongComment
-> Bool
-> LookFor
-> Maybe String
-> WithContext
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Verbosity
-> Compression
-> UseIndex
-> UMask
-> SetScriptsExecutable
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
allOpts
, commandCheckOptions :: [DarcsFlag] -> [String]
commandCheckOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [f] -> [String]
ocheck forall {a}.
DarcsOption
a
(Bool
-> [NotInRemote]
-> [MatchFlag]
-> TestChanges
-> Maybe Bool
-> Maybe String
-> Bool
-> Maybe String
-> Bool
-> Maybe AskLongComment
-> Bool
-> LookFor
-> Maybe String
-> WithContext
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Verbosity
-> Compression
-> UseIndex
-> UMask
-> SetScriptsExecutable
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
allOpts
}
where
fileArgs :: (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
fileArgs (AbsolutePath, AbsolutePath)
fps [DarcsFlag]
flags [String]
args =
if (PrimDarcsOption Bool
O.amendUnrecord forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
flags)
then (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
knownFileArgs (AbsolutePath, AbsolutePath)
fps [DarcsFlag]
flags [String]
args
else (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
modifiedFileArgs (AbsolutePath, AbsolutePath)
fps [DarcsFlag]
flags [String]
args
basicOpts :: OptSpec
DarcsOptDescr
DarcsFlag
a
(Bool
-> [NotInRemote]
-> [MatchFlag]
-> TestChanges
-> Maybe Bool
-> Maybe String
-> Bool
-> Maybe String
-> Bool
-> Maybe AskLongComment
-> Bool
-> LookFor
-> Maybe String
-> WithContext
-> DiffAlgorithm
-> a)
basicOpts
= PrimDarcsOption Bool
O.amendUnrecord
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption [NotInRemote]
O.notInRemote
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ MatchOption
O.matchOneNontag
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption TestChanges
O.testChanges
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption (Maybe Bool)
O.interactive
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption (Maybe String)
O.author
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption Bool
O.selectAuthor
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption (Maybe String)
O.patchname
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption Bool
O.askDeps
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption (Maybe AskLongComment)
O.askLongComment
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption Bool
O.keepDate
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption LookFor
O.lookfor
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption (Maybe String)
O.repoDir
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption WithContext
O.withContext
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption DiffAlgorithm
O.diffAlgorithm
advancedOpts :: OptSpec
DarcsOptDescr
DarcsFlag
a
(Compression -> UseIndex -> UMask -> SetScriptsExecutable -> a)
advancedOpts
= PrimDarcsOption Compression
O.compress
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption UseIndex
O.useIndex
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption UMask
O.umask
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption SetScriptsExecutable
O.setScriptsExecutable
allOpts :: DarcsOption
a
(Bool
-> [NotInRemote]
-> [MatchFlag]
-> TestChanges
-> Maybe Bool
-> Maybe String
-> Bool
-> Maybe String
-> Bool
-> Maybe AskLongComment
-> Bool
-> LookFor
-> Maybe String
-> WithContext
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Verbosity
-> Compression
-> UseIndex
-> UMask
-> SetScriptsExecutable
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
allOpts = forall b c a.
DarcsOption (Maybe StdCmdAction -> Verbosity -> b) c
-> DarcsOption
(UseCache -> HooksConfig -> Bool -> Bool -> Bool -> a) b
-> DarcsOption a c
withStdOpts forall {a}.
OptSpec
DarcsOptDescr
DarcsFlag
a
(Bool
-> [NotInRemote]
-> [MatchFlag]
-> TestChanges
-> Maybe Bool
-> Maybe String
-> Bool
-> Maybe String
-> Bool
-> Maybe AskLongComment
-> Bool
-> LookFor
-> Maybe String
-> WithContext
-> DiffAlgorithm
-> a)
basicOpts forall {a}.
OptSpec
DarcsOptDescr
DarcsFlag
a
(Compression -> UseIndex -> UMask -> SetScriptsExecutable -> a)
advancedOpts
config :: [DarcsFlag] -> AmendConfig
config = forall (d :: * -> *) f a b. OptSpec d f a b -> b -> [f] -> a
oparse (forall {a}.
OptSpec
DarcsOptDescr
DarcsFlag
a
(Bool
-> [NotInRemote]
-> [MatchFlag]
-> TestChanges
-> Maybe Bool
-> Maybe String
-> Bool
-> Maybe String
-> Bool
-> Maybe AskLongComment
-> Bool
-> LookFor
-> Maybe String
-> WithContext
-> DiffAlgorithm
-> a)
basicOpts forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption Verbosity
O.verbosity forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ forall {a}.
OptSpec
DarcsOptDescr
DarcsFlag
a
(Compression -> UseIndex -> UMask -> SetScriptsExecutable -> a)
advancedOpts forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption UseCache
O.useCache) Bool
-> [NotInRemote]
-> [MatchFlag]
-> TestChanges
-> Maybe Bool
-> Maybe String
-> Bool
-> Maybe String
-> Bool
-> Maybe AskLongComment
-> Bool
-> LookFor
-> Maybe String
-> WithContext
-> DiffAlgorithm
-> Verbosity
-> Compression
-> UseIndex
-> UMask
-> SetScriptsExecutable
-> UseCache
-> AmendConfig
AmendConfig
amendCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
amendCmd (AbsolutePath, AbsolutePath)
fps [DarcsFlag]
flags [String]
args = (AbsolutePath, AbsolutePath)
-> [String] -> IO (Maybe [AnchoredPath])
pathSetFromArgs (AbsolutePath, AbsolutePath)
fps [String]
args forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= AmendConfig -> Maybe [AnchoredPath] -> IO ()
doAmend ([DarcsFlag] -> AmendConfig
config [DarcsFlag]
flags)
amendrecord :: DarcsCommand
amendrecord :: DarcsCommand
amendrecord = String -> Maybe DarcsCommand -> DarcsCommand -> DarcsCommand
commandAlias String
"amend-record" forall a. Maybe a
Nothing DarcsCommand
amend
doAmend :: AmendConfig -> Maybe [AnchoredPath] -> IO ()
doAmend :: AmendConfig -> Maybe [AnchoredPath] -> IO ()
doAmend AmendConfig
cfg Maybe [AnchoredPath]
files =
forall a.
DryRun -> UseCache -> UpdatePending -> UMask -> RepoJob a -> IO a
withRepoLock DryRun
NoDryRun (AmendConfig -> UseCache
useCache AmendConfig
cfg) UpdatePending
YesUpdatePending (AmendConfig -> UMask
umask AmendConfig
cfg) forall a b. (a -> b) -> a -> b
$
forall a.
(forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wR -> IO a)
-> RepoJob a
RebaseAwareJob forall a b. (a -> b) -> a -> b
$ \(Repository rt p wR wU wR
repository :: Repository rt p wR wU wR) -> do
PatchSet rt p Origin wR
patchSet <- forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
Repository rt p wR wU wT -> IO (PatchSet rt p Origin wR)
readRepo Repository rt p wR wU wR
repository
FlippedSeal RL (PatchInfoAnd rt p) wX wR
patches <- forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
AmendConfig
-> Repository rt p wR wU wT
-> PatchSet rt p Origin wR
-> IO (FlippedSeal (RL (PatchInfoAnd rt p)) wR)
filterNotInRemote AmendConfig
cfg Repository rt p wR wU wR
repository PatchSet rt p Origin wR
patchSet
forall (p :: * -> * -> *) wO wR.
(Commute p, Matchable p, ShowPatch p, ShowContextPatch p,
ApplyState p ~ Tree) =>
String
-> RL p wO wR
-> PatchSelectionOptions
-> (forall wA. (:>) (FL p) p wA wR -> IO ())
-> IO ()
withSelectedPatchFromList String
"amend" RL (PatchInfoAnd rt p) wX wR
patches (AmendConfig -> PatchSelectionOptions
patchSelOpts AmendConfig
cfg) forall a b. (a -> b) -> a -> b
$ \ (FL (PatchInfoAnd rt p) wA wZ
_ :> PatchInfoAnd rt p wZ wR
oldp) -> do
Verbosity -> Maybe [AnchoredPath] -> String -> IO ()
announceFiles (AmendConfig -> Verbosity
verbosity AmendConfig
cfg) Maybe [AnchoredPath]
files String
"Amending changes in"
Tree IO
pristine <- forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> IO (Tree IO)
readRecorded Repository rt p wR wU wR
repository
FL (PrimOf p) wR wZ
pending :> FL (PrimOf p) wZ wU
working <-
forall (p :: * -> * -> *) (rt :: RepoType) wR wU.
(RepoPatch p, ApplyState p ~ Tree) =>
(UseIndex, ScanKnown, DiffAlgorithm)
-> LookForMoves
-> LookForReplaces
-> Repository rt p wR wU wR
-> Maybe [AnchoredPath]
-> IO ((:>) (FL (PrimOf p)) (FL (PrimOf p)) wR wU)
readPendingAndWorking
(AmendConfig -> (UseIndex, ScanKnown, DiffAlgorithm)
diffingOpts AmendConfig
cfg)
(LookFor -> LookForMoves
O.moves (AmendConfig -> LookFor
lookfor AmendConfig
cfg))
(LookFor -> LookForReplaces
O.replaces (AmendConfig -> LookFor
lookfor AmendConfig
cfg))
Repository rt p wR wU wR
repository
Maybe [AnchoredPath]
files
let go :: forall wU1 . FL (PrimOf p) wR wU1 -> IO ()
go :: forall wU1. FL (PrimOf p) wR wU1 -> IO ()
go FL (PrimOf p) wR wU1
NilFL | Bool -> Bool
not (AmendConfig -> Bool
hasEditMetadata AmendConfig
cfg) =
AmendConfig -> Doc -> IO ()
putInfo AmendConfig
cfg Doc
"No changes!"
go FL (PrimOf p) wR wU1
ch =
do let selection_config :: SelectionConfig (PrimOf p)
selection_config =
forall (prim :: * -> * -> *).
WhichChanges
-> String
-> PatchSelectionOptions
-> Maybe (Splitter prim)
-> Maybe [AnchoredPath]
-> Maybe (Tree IO)
-> SelectionConfig prim
selectionConfigPrim WhichChanges
First String
"record"
(AmendConfig -> PatchSelectionOptions
patchSelOpts AmendConfig
cfg)
(forall a. a -> Maybe a
Just (forall (p :: * -> * -> *).
PrimPatch p =>
DiffAlgorithm -> Splitter p
primSplitter (AmendConfig -> DiffAlgorithm
diffAlgorithm AmendConfig
cfg)))
Maybe [AnchoredPath]
files
(forall a. a -> Maybe a
Just Tree IO
pristine)
(FL (PrimOf p) wR wZ
chosenPatches :> FL (PrimOf p) wZ wU1
_) <- forall (p :: * -> * -> *) wX wY.
(Invert p, MatchableRP p, ShowPatch p, ShowContextPatch p,
ApplyState p ~ Tree) =>
FL p wX wY -> SelectionConfig p -> IO ((:>) (FL p) (FL p) wX wY)
runInvertibleSelection FL (PrimOf p) wR wU1
ch SelectionConfig (PrimOf p)
selection_config
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wX wY wP.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
AmendConfig
-> Repository rt p wR wU wT
-> PatchInfoAnd rt p wX wT
-> FL (PrimOf p) wT wY
-> FL (PrimOf p) wT wP
-> FL (PrimOf p) wP wU
-> IO ()
addChangesToPatch AmendConfig
cfg Repository rt p wR wU wR
repository PatchInfoAnd rt p wZ wR
oldp FL (PrimOf p) wR wZ
chosenPatches FL (PrimOf p) wR wZ
pending FL (PrimOf p) wZ wU
working
if Bool -> Bool
not (PatchInfo -> Bool
isTag (forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> PatchInfo
info PatchInfoAnd rt p wZ wR
oldp))
then if AmendConfig -> Bool
amendUnrecord AmendConfig
cfg
then do let selection_config :: SelectionConfig (PrimOf p)
selection_config =
forall (prim :: * -> * -> *).
WhichChanges
-> String
-> PatchSelectionOptions
-> Maybe (Splitter prim)
-> Maybe [AnchoredPath]
-> Maybe (Tree IO)
-> SelectionConfig prim
selectionConfigPrim WhichChanges
Last String
"unrecord"
(AmendConfig -> PatchSelectionOptions
patchSelOpts AmendConfig
cfg)
(forall a. a -> Maybe a
Just (forall (p :: * -> * -> *).
PrimPatch p =>
DiffAlgorithm -> Splitter p
primSplitter (AmendConfig -> DiffAlgorithm
diffAlgorithm AmendConfig
cfg)))
Maybe [AnchoredPath]
files
(forall a. a -> Maybe a
Just Tree IO
pristine)
(FL (PrimOf p) wZ wZ
_ :> FL (PrimOf p) wZ wR
chosenPrims) <- forall (p :: * -> * -> *) wX wY.
(Invert p, MatchableRP p, ShowPatch p, ShowContextPatch p,
ApplyState p ~ Tree) =>
FL p wX wY -> SelectionConfig p -> IO ((:>) (FL p) (FL p) wX wY)
runInvertibleSelection (forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect PatchInfoAnd rt p wZ wR
oldp) SelectionConfig (PrimOf p)
selection_config
let invPrims :: FL (PrimOf p) wR wZ
invPrims = forall (a :: * -> * -> *) wX wZ. RL a wX wZ -> FL a wX wZ
reverseRL (forall (p :: * -> * -> *) wX wY.
Invert p =>
FL p wX wY -> RL p wY wX
invertFL FL (PrimOf p) wZ wR
chosenPrims)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wX wY wP.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
AmendConfig
-> Repository rt p wR wU wT
-> PatchInfoAnd rt p wX wT
-> FL (PrimOf p) wT wY
-> FL (PrimOf p) wT wP
-> FL (PrimOf p) wP wU
-> IO ()
addChangesToPatch AmendConfig
cfg Repository rt p wR wU wR
repository PatchInfoAnd rt p wZ wR
oldp FL (PrimOf p) wR wZ
invPrims FL (PrimOf p) wR wZ
pending FL (PrimOf p) wZ wU
working
else forall wU1. FL (PrimOf p) wR wU1 -> IO ()
go (forall (prim :: * -> * -> *) wX wY.
PrimCanonize prim =>
FL prim wX wY -> FL prim wX wY
sortCoalesceFL (FL (PrimOf p) wR wZ
pending forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ FL (PrimOf p) wZ wU
working))
else if AmendConfig -> Bool
hasEditMetadata AmendConfig
cfg Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isNothing Maybe [AnchoredPath]
files
then forall wU1. FL (PrimOf p) wR wU1 -> IO ()
go forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
else do if AmendConfig -> Bool
hasEditMetadata AmendConfig
cfg
then Doc -> IO ()
ePutDocLn Doc
"You cannot add new changes to a tag."
else Doc -> IO ()
ePutDocLn Doc
"You cannot add new changes to a tag, but you are allowed to edit tag's metadata (see darcs help amend)."
forall wU1. FL (PrimOf p) wR wU1 -> IO ()
go forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
addChangesToPatch :: forall rt p wR wU wT wX wY wP
. (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree)
=> AmendConfig
-> Repository rt p wR wU wT
-> PatchInfoAnd rt p wX wT
-> FL (PrimOf p) wT wY
-> FL (PrimOf p) wT wP
-> FL (PrimOf p) wP wU
-> IO ()
addChangesToPatch :: forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wX wY wP.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
AmendConfig
-> Repository rt p wR wU wT
-> PatchInfoAnd rt p wX wT
-> FL (PrimOf p) wT wY
-> FL (PrimOf p) wT wP
-> FL (PrimOf p) wP wU
-> IO ()
addChangesToPatch AmendConfig
cfg Repository rt p wR wU wT
_repository PatchInfoAnd rt p wX wT
oldp FL (PrimOf p) wT wY
chs FL (PrimOf p) wT wP
pending FL (PrimOf p) wP wU
working =
if forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Bool
nullFL FL (PrimOf p) wT wY
chs Bool -> Bool -> Bool
&& Bool -> Bool
not (AmendConfig -> Bool
hasEditMetadata AmendConfig
cfg)
then AmendConfig -> Doc -> IO ()
putInfo AmendConfig
cfg Doc
"You don't want to record anything!"
else do
forall t. t -> IO ()
invalidateIndex Repository rt p wR wU wT
_repository
(Repository rt p wR wU wY
_repository, (Maybe String
mlogf, PatchInfoAnd rt p wX wY
newp)) <-
forall (rt :: RepoType) (p :: * -> * -> *) x wR wU wT1 wT2.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT1
-> (Repository rt p wR wU wT1
-> IO
(Repository rt p wR wU wT2, FL (RebaseFixup (PrimOf p)) wT2 wT1,
x))
-> IO (Repository rt p wR wU wT2, x)
withManualRebaseUpdate Repository rt p wR wU wT
_repository forall a b. (a -> b) -> a -> b
$ \Repository rt p wR wU wT
_repository -> do
Repository rt p wR wU wX
_repository <-
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wX.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT
-> Compression
-> UpdatePending
-> FL (PatchInfoAnd rt p) wX wT
-> IO (Repository rt p wR wU wX)
tentativelyRemovePatches
Repository rt p wR wU wT
_repository
(AmendConfig -> Compression
compress AmendConfig
cfg)
UpdatePending
NoUpdatePending
(PatchInfoAnd rt p wX wT
oldp forall (a :: * -> * -> *) wX wX wZ.
a wX wX -> FL a wX wZ -> FL a wX wZ
:>: forall (a :: * -> * -> *) wX. FL a wX wX
NilFL)
(Maybe String
mlogf, PatchInfoAnd rt p wX wY
newp) <-
forall (m :: * -> *) a.
Monad m =>
HijackOptions -> HijackT m a -> m a
runHijackT HijackOptions
AlwaysRequestHijackPermission forall a b. (a -> b) -> a -> b
$
forall (rt :: RepoType) (p :: * -> * -> *) wX wY wR wU wT.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
String
-> AskAboutDeps rt p wR wU wT
-> PatchSelectionOptions
-> DiffAlgorithm
-> Bool
-> Bool
-> Maybe String
-> Maybe String
-> Maybe AskLongComment
-> Named (PrimOf p) wT wX
-> FL (PrimOf p) wX wY
-> HijackT IO (Maybe String, PatchInfoAnd rt p wT wY)
updatePatchHeader
String
"amend"
(if AmendConfig -> Bool
askDeps AmendConfig
cfg
then forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> AskAboutDeps rt p wR wU wT
AskAboutDeps Repository rt p wR wU wX
_repository
else forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
AskAboutDeps rt p wR wU wT
NoAskAboutDeps)
(AmendConfig -> PatchSelectionOptions
patchSelOpts AmendConfig
cfg)
(AmendConfig -> DiffAlgorithm
diffAlgorithm AmendConfig
cfg)
(AmendConfig -> Bool
keepDate AmendConfig
cfg)
(AmendConfig -> Bool
selectAuthor AmendConfig
cfg)
(AmendConfig -> Maybe String
author AmendConfig
cfg)
(AmendConfig -> Maybe String
patchname AmendConfig
cfg)
(AmendConfig -> Maybe AskLongComment
askLongComment AmendConfig
cfg)
(forall (p :: * -> * -> *) wA wB (q :: * -> * -> *) wC wD.
(FL p wA wB -> FL q wC wD) -> Named p wA wB -> Named q wC wD
fmapFL_Named forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect (forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> p wA wB
hopefully PatchInfoAnd rt p wX wT
oldp))
FL (PrimOf p) wT wY
chs
let fixups :: FL (RebaseFixup (PrimOf p)) wY wZ
fixups =
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL forall (prim :: * -> * -> *) wX wY.
prim wX wY -> RebaseFixup prim wX wY
PrimFixup (forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert FL (PrimOf p) wT wY
chs) forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+
forall wX wY (prim :: * -> * -> *).
RebaseName wX wY -> RebaseFixup prim wX wY
NameFixup (forall wX wY. PatchInfo -> PatchInfo -> RebaseName wX wY
Rename (forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> PatchInfo
info PatchInfoAnd rt p wX wY
newp) (forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> PatchInfo
info PatchInfoAnd rt p wX wT
oldp)) forall (a :: * -> * -> *) wX wX wZ.
a wX wX -> FL a wX wZ -> FL a wX wZ
:>:
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
forall (p :: * -> * -> *) wX wY. PatchInspect p => p wX wY -> IO ()
setEnvDarcsFiles PatchInfoAnd rt p wX wY
newp
Repository rt p wR wU wY
_repository <-
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT wY.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT
-> Compression
-> Verbosity
-> UpdatePending
-> PatchInfoAnd rt p wT wY
-> IO (Repository rt p wR wU wY)
tentativelyAddPatch
Repository rt p wR wU wX
_repository
(AmendConfig -> Compression
compress AmendConfig
cfg)
(AmendConfig -> Verbosity
verbosity AmendConfig
cfg)
UpdatePending
NoUpdatePending
PatchInfoAnd rt p wX wY
newp
forall (m :: * -> *) a. Monad m => a -> m a
return (Repository rt p wR wU wY
_repository, forall {wZ}. FL (RebaseFixup (PrimOf p)) wY wZ
fixups, (Maybe String
mlogf, PatchInfoAnd rt p wX wY
newp))
let failmsg :: String
failmsg = forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\String
lf -> String
"\nLogfile left in " forall a. [a] -> [a] -> [a]
++ String
lf forall a. [a] -> [a] -> [a]
++ String
".") Maybe String
mlogf
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT
-> Verbosity
-> TestChanges
-> SetScriptsExecutable
-> Bool
-> String
-> String
-> Maybe String
-> IO ()
testTentativeAndMaybeExit
Repository rt p wR wU wY
_repository
(AmendConfig -> Verbosity
verbosity AmendConfig
cfg)
(AmendConfig -> TestChanges
testChanges AmendConfig
cfg)
(AmendConfig -> SetScriptsExecutable
sse AmendConfig
cfg)
(AmendConfig -> Bool
isInteractive AmendConfig
cfg)
(String
"you have a bad patch: '" forall a. [a] -> [a] -> [a]
++ forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
PatchInfoAnd rt p wX wY -> String
patchDesc PatchInfoAnd rt p wX wY
newp forall a. [a] -> [a] -> [a]
++ String
"'")
String
"amend it"
(forall a. a -> Maybe a
Just String
failmsg)
forall (rt :: RepoType) (p :: * -> * -> *) wR wO wT wP wU.
RepoPatch p =>
Repository rt p wR wU wT
-> FL (PrimOf p) wO wT
-> FL (PrimOf p) wO wP
-> FL (PrimOf p) wP wU
-> IO ()
tentativelyRemoveFromPW Repository rt p wR wU wY
_repository FL (PrimOf p) wT wY
chs FL (PrimOf p) wT wP
pending FL (PrimOf p) wP wU
working
Repository rt p wY wU wY
_repository <-
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT
-> UpdatePending -> Compression -> IO (Repository rt p wT wU wT)
finalizeRepositoryChanges Repository rt p wR wU wY
_repository UpdatePending
YesUpdatePending (AmendConfig -> Compression
compress AmendConfig
cfg)
forall a. IO a -> String -> IO a
`clarifyErrors` String
failmsg
case AmendConfig -> Verbosity
verbosity AmendConfig
cfg of
Verbosity
O.NormalVerbosity -> Doc -> IO ()
putDocLn Doc
"Finished amending patch."
Verbosity
O.Verbose -> Doc -> IO ()
putDocLn forall a b. (a -> b) -> a -> b
$ Doc
"Finished amending patch:" Doc -> Doc -> Doc
$$ forall (p :: * -> * -> *) wX wY. ShowPatch p => p wX wY -> Doc
description PatchInfoAnd rt p wX wY
newp
Verbosity
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
RepoPatch p =>
FL (PatchInfoAnd rt p) wX wY -> IO ()
setEnvDarcsPatches (PatchInfoAnd rt p wX wY
newp forall (a :: * -> * -> *) wX wX wZ.
a wX wX -> FL a wX wZ -> FL a wX wZ
:>: forall (a :: * -> * -> *) wX. FL a wX wX
NilFL)
filterNotInRemote :: (IsRepoType rt, RepoPatch p)
=> AmendConfig
-> Repository rt p wR wU wT
-> PatchSet rt p Origin wR
-> IO (FlippedSeal (RL (PatchInfoAnd rt p)) wR)
filterNotInRemote :: forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
AmendConfig
-> Repository rt p wR wU wT
-> PatchSet rt p Origin wR
-> IO (FlippedSeal (RL (PatchInfoAnd rt p)) wR)
filterNotInRemote AmendConfig
cfg Repository rt p wR wU wT
repository PatchSet rt p Origin wR
patchSet = do
[String]
nirs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM NotInRemote -> IO String
getNotInRemotePath (AmendConfig -> [NotInRemote]
notInRemote AmendConfig
cfg)
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
nirs
then
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (a :: * -> * -> *) wX wY. a wX wY -> FlippedSeal a wY
FlippedSeal (forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
PatchSet rt p wStart wX -> RL (PatchInfoAnd rt p) wStart wX
patchSet2RL PatchSet rt p Origin wR
patchSet))
else do
AmendConfig -> Doc -> IO ()
putInfo AmendConfig
cfg forall a b. (a -> b) -> a -> b
$
Doc
"Determining patches not in" Doc -> Doc -> Doc
<+> [String] -> Doc
anyOfClause [String]
nirs Doc -> Doc -> Doc
$$ Int -> [String] -> Doc
itemizeVertical Int
2 [String]
nirs
Sealed PatchSet rt p Origin wX
thems <- forall (p :: * -> * -> *) (rt :: RepoType).
(Commute p, Merge p, Eq2 p) =>
[SealedPatchSet rt p Origin] -> SealedPatchSet rt p Origin
patchSetUnion forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO (Sealed (PatchSet rt p Origin))
readNir [String]
nirs
PatchSet rt p Origin wZ
_ :> FL (PatchInfoAnd rt p) wZ wR
only_ours <- forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
Commute p =>
PatchSet rt p Origin wX
-> PatchSet rt p Origin wY
-> (:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wX
findCommonWithThem PatchSet rt p Origin wR
patchSet PatchSet rt p Origin wX
thems
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (a :: * -> * -> *) wX wY. a wX wY -> FlippedSeal a wY
FlippedSeal (forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> RL a wX wZ
reverseFL FL (PatchInfoAnd rt p) wZ wR
only_ours))
where
readNir :: String -> IO (Sealed (PatchSet rt p Origin))
readNir String
loc = do
Repository rt p Any Any Any
repo <- forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT vR vU vT.
ReadingOrWriting
-> Repository rt p wR wU wT
-> UseCache
-> String
-> IO (Repository rt p vR vU vT)
identifyRepositoryFor ReadingOrWriting
Reading Repository rt p wR wU wT
repository (AmendConfig -> UseCache
useCache AmendConfig
cfg) String
loc
PatchSet rt p Origin Any
rps <- forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
Repository rt p wR wU wT -> IO (PatchSet rt p Origin wR)
readRepo Repository rt p Any Any Any
repo
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (a :: * -> *) wX. a wX -> Sealed a
Sealed PatchSet rt p Origin Any
rps)
getNotInRemotePath :: NotInRemote -> IO String
getNotInRemotePath (O.NotInRemotePath String
p) = forall (m :: * -> *) a. Monad m => a -> m a
return String
p
getNotInRemotePath NotInRemote
O.NotInDefaultRepo = do
Maybe String
defaultRepo <- IO (Maybe String)
getDefaultRepo
let err :: IO a
err = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"No default push/pull repo configured, please pass a "
forall a. [a] -> [a] -> [a]
++ String
"repo name to --" forall a. [a] -> [a] -> [a]
++ String
O.notInRemoteFlagName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall {a}. IO a
err forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
defaultRepo
hasEditMetadata :: AmendConfig -> Bool
hasEditMetadata :: AmendConfig -> Bool
hasEditMetadata AmendConfig
cfg = forall a. Maybe a -> Bool
isJust (AmendConfig -> Maybe String
author AmendConfig
cfg)
Bool -> Bool -> Bool
|| AmendConfig -> Bool
selectAuthor AmendConfig
cfg
Bool -> Bool -> Bool
|| forall a. Maybe a -> Bool
isJust (AmendConfig -> Maybe String
patchname AmendConfig
cfg)
Bool -> Bool -> Bool
|| AmendConfig -> Maybe AskLongComment
askLongComment AmendConfig
cfg forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just AskLongComment
O.YesEditLongComment
Bool -> Bool -> Bool
|| AmendConfig -> Maybe AskLongComment
askLongComment AmendConfig
cfg forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just AskLongComment
O.PromptLongComment
Bool -> Bool -> Bool
|| AmendConfig -> Bool
askDeps AmendConfig
cfg
patchSelOpts :: AmendConfig -> S.PatchSelectionOptions
patchSelOpts :: AmendConfig -> PatchSelectionOptions
patchSelOpts AmendConfig
cfg = S.PatchSelectionOptions
{ verbosity :: Verbosity
S.verbosity = AmendConfig -> Verbosity
verbosity AmendConfig
cfg
, matchFlags :: [MatchFlag]
S.matchFlags = AmendConfig -> [MatchFlag]
matchFlags AmendConfig
cfg
, interactive :: Bool
S.interactive = AmendConfig -> Bool
isInteractive AmendConfig
cfg
, selectDeps :: SelectDeps
S.selectDeps = SelectDeps
O.PromptDeps
, withSummary :: WithSummary
S.withSummary = WithSummary
O.NoSummary
, withContext :: WithContext
S.withContext = AmendConfig -> WithContext
withContext AmendConfig
cfg
}
diffingOpts :: AmendConfig -> (O.UseIndex, O.ScanKnown, O.DiffAlgorithm)
diffingOpts :: AmendConfig -> (UseIndex, ScanKnown, DiffAlgorithm)
diffingOpts AmendConfig
cfg = UseIndex
-> LookForAdds
-> IncludeBoring
-> DiffAlgorithm
-> (UseIndex, ScanKnown, DiffAlgorithm)
diffOpts (AmendConfig -> UseIndex
useIndex AmendConfig
cfg) (LookFor -> LookForAdds
O.adds (AmendConfig -> LookFor
lookfor AmendConfig
cfg)) IncludeBoring
O.NoIncludeBoring (AmendConfig -> DiffAlgorithm
diffAlgorithm AmendConfig
cfg)
isInteractive :: AmendConfig -> Bool
isInteractive :: AmendConfig -> Bool
isInteractive = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmendConfig -> Maybe Bool
interactive
putInfo :: AmendConfig -> Doc -> IO ()
putInfo :: AmendConfig -> Doc -> IO ()
putInfo AmendConfig
cfg Doc
what = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (AmendConfig -> Verbosity
verbosity AmendConfig
cfg forall a. Eq a => a -> a -> Bool
== Verbosity
O.Quiet) forall a b. (a -> b) -> a -> b
$ Doc -> IO ()
putDocLn Doc
what