module Darcs.UI.Commands.Rebase ( rebase ) where
import Darcs.Prelude
import Darcs.UI.Commands
( DarcsCommand(..), withStdOpts
, normalCommand, hiddenCommand
, commandAlias
, defaultRepo, nodefaults
, putInfo, putVerbose
, amInHashedRepository
)
import Darcs.UI.Commands.Apply ( applyCmd )
import Darcs.UI.Commands.Log ( changelog, logInfoFL )
import Darcs.UI.Commands.Pull ( pullCmd )
import Darcs.UI.Commands.Util ( historyEditHelp, preselectPatches )
import Darcs.UI.Completion ( fileArgs, prefArgs, noArgs )
import Darcs.UI.Flags
( DarcsFlag
, externalMerge, allowConflicts
, compress, diffingOpts
, dryRun, reorder, verbosity, verbose
, useCache, wantGuiPause
, umask, changesReverse
, diffAlgorithm, isInteractive
, selectDeps, hasXmlOutput
)
import qualified Darcs.UI.Flags as Flags ( getAuthor )
import Darcs.UI.Options
( (^), oid, odesc, ocheck
, defaultFlags, (?)
)
import qualified Darcs.UI.Options.All as O
import Darcs.UI.PatchHeader ( HijackT, HijackOptions(..), runHijackT
, getAuthor
, updatePatchHeader, AskAboutDeps(..) )
import Darcs.Repository
( Repository, RepoJob(..), withRepoLock, withRepository
, tentativelyAddPatch, finalizeRepositoryChanges
, invalidateIndex
, tentativelyRemovePatches, readRepo
, tentativelyAddToPending, unrecordedChanges, applyToWorking
, revertRepositoryChanges
)
import Darcs.Repository.Flags ( UpdatePending(..), ExternalMerge(..) )
import Darcs.Repository.Hashed ( upgradeOldStyleRebase )
import Darcs.Repository.Merge ( tentativelyMergePatches )
import Darcs.Repository.Rebase
( readRebase
, readTentativeRebase
, writeTentativeRebase
)
import Darcs.Repository.Resolution
( StandardResolution(..)
, standardResolution
, announceConflicts
)
import Darcs.Patch ( invert, effect, commute, RepoPatch, displayPatch )
import Darcs.Patch.Apply ( ApplyState )
import Darcs.Patch.CommuteFn ( commuterIdFL )
import Darcs.Patch.Info ( displayPatchInfo )
import Darcs.Patch.Match ( secondMatch, splitSecondFL )
import Darcs.Patch.Named ( Named, fmapFL_Named, patchcontents, patch2patchinfo )
import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, hopefully, info, n2pia )
import Darcs.Patch.Prim ( canonizeFL, PrimPatch )
import Darcs.Patch.Rebase.Change
( RebaseChange(RC), rcToPia
, extractRebaseChange, reifyRebaseChange
, partitionUnconflicted
, WithDroppedDeps(..), WDDNamed, commuterIdWDD
, toRebaseChanges
, simplifyPush, simplifyPushes
)
import Darcs.Patch.Rebase.Fixup ( RebaseFixup(..), flToNamesPrims )
import Darcs.Patch.Rebase.Name ( RebaseName(..), commuteNameNamed )
import Darcs.Patch.Rebase.Suspended ( Suspended(..), addToEditsToSuspended )
import Darcs.Patch.Permutations ( partitionConflictingFL )
import Darcs.Patch.Progress ( progressRL )
import Darcs.Patch.RepoType ( RepoType(..), RebaseType(..) )
import Darcs.Patch.Set ( PatchSet, Origin, patchSet2RL )
import Darcs.Patch.Split ( primSplitter )
import Darcs.UI.ApplyPatches
( PatchApplier(..)
, PatchProxy(..)
, applyPatchesStart
, applyPatchesFinish
)
import Darcs.UI.External ( viewDocWith )
import Darcs.UI.SelectChanges
( runSelection, runInvertibleSelection
, selectionConfig, selectionConfigGeneric, selectionConfigPrim
, WhichChanges(First, Last, LastReversed)
, viewChanges
)
import qualified Darcs.UI.SelectChanges as S ( PatchSelectionOptions (..) )
import Darcs.Patch.Witnesses.Eq ( EqCheck(..) )
import Darcs.Patch.Witnesses.Ordered
( FL(..), (+>+), mapFL_FL
, concatFL, mapFL, nullFL, lengthFL, reverseFL
, (:>)(..)
, RL(..), reverseRL, mapRL_RL
, Fork(..)
)
import Darcs.Patch.Witnesses.Sealed
( Sealed(..), seal, unseal
, FlippedSeal(..)
, Sealed2(..)
)
import Darcs.Patch.Witnesses.Unsafe ( unsafeCoerceP )
import Darcs.Util.English ( englishNum, Noun(Noun) )
import Darcs.Util.Printer
( text, ($$), redText
, simplePrinters
, renderString
, formatWords
, formatText
, ($+$)
)
import Darcs.Util.Printer.Color ( fancyPrinters )
import Darcs.Util.Progress ( debugMessage )
import Darcs.Util.Path ( AbsolutePath )
import Darcs.Util.SignalHandler ( withSignalsBlocked )
import Darcs.Util.Tree ( Tree )
import Darcs.Util.Exception ( die )
import Control.Monad ( when, void )
import Control.Monad.Trans ( liftIO )
import System.Exit ( exitSuccess )
rebase :: DarcsCommand
rebase :: DarcsCommand
rebase = SuperCommand
{ commandProgramName :: String
commandProgramName = String
"darcs"
, commandName :: String
commandName = String
"rebase"
, commandHelp :: Doc
commandHelp = Doc
rebaseHelp
, commandDescription :: String
commandDescription = String
rebaseDescription
, commandPrereq :: [DarcsFlag] -> IO (Either String ())
commandPrereq = [DarcsFlag] -> IO (Either String ())
amInHashedRepository
, commandSubCommands :: [CommandControl]
commandSubCommands =
[ DarcsCommand -> CommandControl
normalCommand DarcsCommand
pull
, DarcsCommand -> CommandControl
normalCommand DarcsCommand
apply
, DarcsCommand -> CommandControl
normalCommand DarcsCommand
suspend
, DarcsCommand -> CommandControl
normalCommand DarcsCommand
unsuspend
, DarcsCommand -> CommandControl
hiddenCommand DarcsCommand
reify
, DarcsCommand -> CommandControl
hiddenCommand DarcsCommand
inject
, DarcsCommand -> CommandControl
normalCommand DarcsCommand
obliterate
, DarcsCommand -> CommandControl
normalCommand DarcsCommand
log
, DarcsCommand -> CommandControl
hiddenCommand DarcsCommand
changes
, DarcsCommand -> CommandControl
normalCommand DarcsCommand
upgrade
]
}
where
rebaseDescription :: String
rebaseDescription = String
"Edit several patches at once."
rebaseHelp :: Doc
rebaseHelp = Int -> [String] -> Doc
formatText Int
80
[ String
"The `darcs rebase' command is used to edit a collection of darcs patches."
, String
"The basic idea is that you can suspend patches from the end of\
\ a repository. These patches are no longer part of the history and\
\ have no effect on the working tree. Suspended patches are invisible\
\ to commands that access the repository from the outside, such as\
\ push, pull, clone, send, etc."
, String
"The sequence of suspended patches can be manipulated in ways that are\
\ not allowed for normal patches. For instance, `darcs rebase obliterate`\
\ allows you to remove a patch in this sequence, even if other suspended\
\ patches depend on it. These other patches will as a result become\
\ conflicted."
, String
"You can also operate on the normal patches in the usual way. If you add\
\ or remove normal patches, the suspended patches will be automatically\
\ adapted to still apply to the pristine state, possibly becoming\
\ conflicted in the course."
, String
"Note that as soon as a patch gets suspended, it will irrevocably loose\
\ its identity. This means that suspending a patch is subject to the\
\ usual warnings about editing the history of your project."
, String
"The opposite of suspending a patch is to unsuspend it.\
\ This turns it back into a normal patch.\
\ If the patch is conflicted as a result of previous operations on\
\ either the normal patches or the suspended patches, unsuspending\
\ will create appropriate conflict markup. Note, however, that the\
\ unsuspended patch itself WILL NOT BE CONFLICTED itself. This means\
\ that there is no way to re-generate the conflict markup. Once you\
\ removed it, by editing files or using `darcs revert`, any information\
\ about the conflict is lost."
, String
"As long as you have suspended patches, darcs will display a short\
\ message after each command to remind you that your patch editing\
\ operation is still in progress."
]
suspend :: DarcsCommand
suspend :: DarcsCommand
suspend = DarcsCommand
{ commandProgramName :: String
commandProgramName = String
"darcs"
, commandName :: String
commandName = String
"suspend"
, commandHelp :: Doc
commandHelp = String -> Doc
text String
suspendDescription Doc -> Doc -> Doc
$+$ Doc
historyEditHelp
, commandDescription :: String
commandDescription = String
suspendDescription
, commandPrereq :: [DarcsFlag] -> IO (Either String ())
commandPrereq = [DarcsFlag] -> IO (Either String ())
amInHashedRepository
, commandExtraArgs :: Int
commandExtraArgs = Int
0
, commandExtraArgHelp :: [String]
commandExtraArgHelp = []
, commandCommand :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
commandCommand = (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
suspendCmd
, commandCompleteArgs :: (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
commandCompleteArgs = (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
noArgs
, 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 (Bool -> UseIndex -> UMask -> a)
suspendAdvancedOpts
, commandBasicOptions :: [DarcsOptDescr DarcsFlag]
commandBasicOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc forall {a}.
OptSpec
DarcsOptDescr
DarcsFlag
a
([NotInRemote]
-> [MatchFlag]
-> SelectDeps
-> Maybe Bool
-> WithSummary
-> DiffAlgorithm
-> a)
suspendBasicOpts
, commandDefaults :: [DarcsFlag]
commandDefaults = forall (d :: * -> *) f b. OptSpec d f [f] b -> [f]
defaultFlags forall {a}.
DarcsOption
a
([NotInRemote]
-> [MatchFlag]
-> SelectDeps
-> Maybe Bool
-> WithSummary
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Verbosity
-> Bool
-> UseIndex
-> UMask
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
suspendOpts
, commandCheckOptions :: [DarcsFlag] -> [String]
commandCheckOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [f] -> [String]
ocheck forall {a}.
DarcsOption
a
([NotInRemote]
-> [MatchFlag]
-> SelectDeps
-> Maybe Bool
-> WithSummary
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Verbosity
-> Bool
-> UseIndex
-> UMask
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
suspendOpts
}
where
suspendBasicOpts :: OptSpec
DarcsOptDescr
DarcsFlag
a
([NotInRemote]
-> [MatchFlag]
-> SelectDeps
-> Maybe Bool
-> WithSummary
-> DiffAlgorithm
-> a)
suspendBasicOpts
= 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.matchSeveralOrLast
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption SelectDeps
O.selectDeps
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 WithSummary
O.withSummary
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
suspendAdvancedOpts :: OptSpec DarcsOptDescr DarcsFlag a (Bool -> UseIndex -> UMask -> a)
suspendAdvancedOpts
= PrimDarcsOption Bool
O.changesReverse
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
suspendOpts :: DarcsOption
a
([NotInRemote]
-> [MatchFlag]
-> SelectDeps
-> Maybe Bool
-> WithSummary
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Verbosity
-> Bool
-> UseIndex
-> UMask
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
suspendOpts = forall {a}.
OptSpec
DarcsOptDescr
DarcsFlag
a
([NotInRemote]
-> [MatchFlag]
-> SelectDeps
-> Maybe Bool
-> WithSummary
-> DiffAlgorithm
-> a)
suspendBasicOpts 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 -> UseIndex -> UMask -> a)
suspendAdvancedOpts
suspendDescription :: String
suspendDescription =
String
"Select patches to move into a suspended state at the end of the repo."
suspendCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
suspendCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
suspendCmd (AbsolutePath, AbsolutePath)
_ [DarcsFlag]
opts [String]
_args =
forall a.
DryRun -> UseCache -> UpdatePending -> UMask -> RepoJob a -> IO a
withRepoLock (PrimDarcsOption DryRun
dryRun forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (PrimDarcsOption UseCache
useCache forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) UpdatePending
YesUpdatePending (PrimDarcsOption UMask
umask forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) forall a b. (a -> b) -> a -> b
$
forall a.
(forall (p :: * -> * -> *) wR wU.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository ('RepoType 'IsRebase) p wR wU wR -> IO a)
-> RepoJob a
StartRebaseJob forall a b. (a -> b) -> a -> b
$
\Repository ('RepoType 'IsRebase) p wR wU wR
_repository -> do
Suspended p wR wR
suspended <- forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
RepoPatch p =>
Repository rt p wR wU wT -> IO (Suspended p wT wT)
readTentativeRebase Repository ('RepoType 'IsRebase) p wR wU wR
_repository
(PatchSet ('RepoType 'IsRebase) p Origin wZ
_ :> FL (PatchInfoAnd ('RepoType 'IsRebase) p) wZ wR
candidates) <- forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
[DarcsFlag]
-> Repository rt p wR wU wT
-> IO ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wR)
preselectPatches [DarcsFlag]
opts Repository ('RepoType 'IsRebase) p wR wU wR
_repository
let direction :: WhichChanges
direction = if PrimDarcsOption Bool
changesReverse forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts then WhichChanges
Last else WhichChanges
LastReversed
selection_config :: SelectionConfig (PatchInfoAnd ('RepoType 'IsRebase) p)
selection_config = forall (p :: * -> * -> *).
Matchable p =>
WhichChanges
-> String
-> PatchSelectionOptions
-> Maybe (Splitter p)
-> Maybe [AnchoredPath]
-> SelectionConfig p
selectionConfig
WhichChanges
direction String
"suspend" (Bool -> [DarcsFlag] -> PatchSelectionOptions
patchSelOpts Bool
True [DarcsFlag]
opts) forall a. Maybe a
Nothing forall a. Maybe a
Nothing
(FL (PatchInfoAnd ('RepoType 'IsRebase) p) wZ wZ
_ :> FL (PatchInfoAnd ('RepoType 'IsRebase) p) wZ wR
psToSuspend) <-
forall (p :: * -> * -> *) wX wY.
(MatchableRP p, ShowPatch p, ShowContextPatch p,
ApplyState p ~ Tree, ApplyState p ~ ApplyState (PrimOf p)) =>
FL p wX wY -> SelectionConfig p -> IO ((:>) (FL p) (FL p) wX wY)
runSelection
FL (PatchInfoAnd ('RepoType 'IsRebase) p) wZ wR
candidates
SelectionConfig (PatchInfoAnd ('RepoType 'IsRebase) p)
selection_config
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Bool
nullFL FL (PatchInfoAnd ('RepoType 'IsRebase) p) wZ wR
psToSuspend) forall a b. (a -> b) -> a -> b
$ do
String -> IO ()
putStrLn String
"No patches selected!"
forall a. IO a
exitSuccess
forall (m :: * -> *) a.
Monad m =>
HijackOptions -> HijackT m a -> m a
runHijackT HijackOptions
RequestHijackPermission
forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> Bool -> Maybe String -> PatchInfo -> HijackT IO String
getAuthor String
"suspend" Bool
False forall a. Maybe a
Nothing)
forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> PatchInfo
info FL (PatchInfoAnd ('RepoType 'IsRebase) p) wZ wR
psToSuspend
Repository ('RepoType 'IsRebase) p wR wU wZ
_repository <- forall (p :: * -> * -> *) wR wU wX.
(RepoPatch p, ApplyState p ~ Tree) =>
[DarcsFlag]
-> Repository ('RepoType 'IsRebase) p wR wU wR
-> Suspended p wR wR
-> FL (PatchInfoAnd ('RepoType 'IsRebase) p) wX wR
-> IO (Repository ('RepoType 'IsRebase) p wR wU wX)
doSuspend [DarcsFlag]
opts Repository ('RepoType 'IsRebase) p wR wU wR
_repository Suspended p wR wR
suspended FL (PatchInfoAnd ('RepoType 'IsRebase) p) wZ wR
psToSuspend
Repository ('RepoType 'IsRebase) p wZ wU wZ
_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 ('RepoType 'IsRebase) p wR wU wZ
_repository UpdatePending
YesUpdatePending (PrimDarcsOption Compression
compress forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
forall (m :: * -> *) a. Monad m => a -> m a
return ()
doSuspend
:: forall p wR wU wX
. (RepoPatch p, ApplyState p ~ Tree)
=> [DarcsFlag]
-> Repository ('RepoType 'IsRebase) p wR wU wR
-> Suspended p wR wR
-> FL (PatchInfoAnd ('RepoType 'IsRebase) p) wX wR
-> IO (Repository ('RepoType 'IsRebase) p wR wU wX)
doSuspend :: forall (p :: * -> * -> *) wR wU wX.
(RepoPatch p, ApplyState p ~ Tree) =>
[DarcsFlag]
-> Repository ('RepoType 'IsRebase) p wR wU wR
-> Suspended p wR wR
-> FL (PatchInfoAnd ('RepoType 'IsRebase) p) wX wR
-> IO (Repository ('RepoType 'IsRebase) p wR wU wX)
doSuspend [DarcsFlag]
opts Repository ('RepoType 'IsRebase) p wR wU wR
_repository Suspended p wR wR
suspended FL (PatchInfoAnd ('RepoType 'IsRebase) p) wX wR
psToSuspend = do
let (UseIndex
_, ScanKnown
_, DiffAlgorithm
da) = [DarcsFlag] -> (UseIndex, ScanKnown, DiffAlgorithm)
diffingOpts [DarcsFlag]
opts
FL (PrimOf p) wR wU
pend <- 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) wR wU)
unrecordedChanges ([DarcsFlag] -> (UseIndex, ScanKnown, DiffAlgorithm)
diffingOpts [DarcsFlag]
opts)
LookForMoves
O.NoLookForMoves LookForReplaces
O.NoLookForReplaces
Repository ('RepoType 'IsRebase) p wR wU wR
_repository forall a. Maybe a
Nothing
FlippedSeal FL (PrimOf p) wX wU
psAfterPending <-
let effectPsToSuspend :: FL (PrimOf (FL (PatchInfoAnd ('RepoType 'IsRebase) p))) wX wR
effectPsToSuspend = forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect FL (PatchInfoAnd ('RepoType 'IsRebase) p) wX wR
psToSuspend in
case forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
commute (FL (PrimOf p) wX wR
effectPsToSuspend forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (PrimOf p) wR wU
pend) of
Just (FL (PrimOf p) wX wZ
_ :> FL (PrimOf p) wZ wU
res) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall (a :: * -> * -> *) wX wY. a wX wY -> FlippedSeal a wY
FlippedSeal FL (PrimOf p) wZ wU
res)
Maybe ((:>) (FL (PrimOf p)) (FL (PrimOf p)) wX wU)
Nothing -> do
[DarcsFlag] -> Doc -> IO ()
putVerbose [DarcsFlag]
opts forall a b. (a -> b) -> a -> b
$
let invPsEffect :: FL (PrimOf p) wR wX
invPsEffect = forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert FL (PrimOf p) wX wR
effectPsToSuspend
in
case (forall (p :: * -> * -> *) wX wY wZ.
(Commute p, CleanMerge p) =>
FL p wX wY -> FL p wX wZ -> (:>) (FL p) (FL p) wX wY
partitionConflictingFL FL (PrimOf p) wR wX
invPsEffect FL (PrimOf p) wR wU
pend, forall (p :: * -> * -> *) wX wY wZ.
(Commute p, CleanMerge p) =>
FL p wX wY -> FL p wX wZ -> (:>) (FL p) (FL p) wX wY
partitionConflictingFL FL (PrimOf p) wR wU
pend FL (PrimOf p) wR wX
invPsEffect) of
(FL (PrimOf p) wR wZ
_ :> FL (PrimOf p) wZ wX
invSuspendedConflicts, FL (PrimOf p) wR wZ
_ :> FL (PrimOf p) wZ wU
pendConflicts) ->
let suspendedConflicts :: FL (PrimOf p) wX wZ
suspendedConflicts = forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert FL (PrimOf p) wZ wX
invSuspendedConflicts in
String -> Doc
redText String
"These changes in the suspended patches:" Doc -> Doc -> Doc
$$
forall (p :: * -> * -> *) wX wY. ShowPatchBasic p => p wX wY -> Doc
displayPatch FL (PrimOf p) wX wZ
suspendedConflicts Doc -> Doc -> Doc
$$
String -> Doc
redText String
"...conflict with these local changes:" Doc -> Doc -> Doc
$$
forall (p :: * -> * -> *) wX wY. ShowPatchBasic p => p wX wY -> Doc
displayPatch FL (PrimOf p) wZ wU
pendConflicts
forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Can't suspend selected patches without reverting some unrecorded change."
forall a. [a] -> [a] -> [a]
++ if ([DarcsFlag] -> Bool
verbose [DarcsFlag]
opts) then String
"" else String
" Use --verbose to see the details."
forall t. t -> IO ()
invalidateIndex Repository ('RepoType 'IsRebase) p wR wU wR
_repository
Repository ('RepoType 'IsRebase) 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 ('RepoType 'IsRebase) p wR wU wR
_repository (PrimDarcsOption Compression
compress forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) UpdatePending
YesUpdatePending FL (PatchInfoAnd ('RepoType 'IsRebase) p) wX wR
psToSuspend
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wX wY.
RepoPatch p =>
Repository rt p wR wU wT -> FL (PrimOf p) wX wY -> IO ()
tentativelyAddToPending Repository ('RepoType 'IsRebase) p wR wU wX
_repository forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect FL (PatchInfoAnd ('RepoType 'IsRebase) p) wX wR
psToSuspend
Suspended p wX wX
new_suspended <- forall (p :: * -> * -> *) wX wY.
RepoPatch p =>
DiffAlgorithm
-> FL (Named p) wX wY
-> Suspended p wY wY
-> IO (Suspended p wX wX)
addToEditsToSuspended DiffAlgorithm
da (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 (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> p wA wB
hopefully FL (PatchInfoAnd ('RepoType 'IsRebase) p) wX wR
psToSuspend) Suspended p wR wR
suspended
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
RepoPatch p =>
Repository rt p wR wU wT -> Suspended p wT wT -> IO ()
writeTentativeRebase Repository ('RepoType 'IsRebase) p wR wU wX
_repository Suspended p wX wX
new_suspended
forall a. IO a -> IO a
withSignalsBlocked forall a b. (a -> b) -> a -> b
$
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT wY.
(ApplyState p ~ Tree, RepoPatch p) =>
Repository rt p wR wU wT
-> Verbosity
-> FL (PrimOf p) wU wY
-> IO (Repository rt p wR wY wT)
applyToWorking Repository ('RepoType 'IsRebase) p wR wU wX
_repository (PrimDarcsOption Verbosity
verbosity forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert FL (PrimOf p) wX wU
psAfterPending)
forall (m :: * -> *) a. Monad m => a -> m a
return Repository ('RepoType 'IsRebase) p wR wU wX
_repository
unsuspend :: DarcsCommand
unsuspend :: DarcsCommand
unsuspend = DarcsCommand
{ commandProgramName :: String
commandProgramName = String
"darcs"
, commandName :: String
commandName = String
"unsuspend"
, commandHelp :: Doc
commandHelp = String -> Doc
text String
unsuspendDescription
, commandDescription :: String
commandDescription = String
unsuspendDescription
, commandPrereq :: [DarcsFlag] -> IO (Either String ())
commandPrereq = [DarcsFlag] -> IO (Either String ())
amInHashedRepository
, commandExtraArgs :: Int
commandExtraArgs = Int
0
, commandExtraArgHelp :: [String]
commandExtraArgHelp = []
, commandCommand :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
commandCommand = String
-> Bool
-> (AbsolutePath, AbsolutePath)
-> [DarcsFlag]
-> [String]
-> IO ()
unsuspendCmd String
"unsuspend" Bool
False
, commandCompleteArgs :: (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
commandCompleteArgs = (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
noArgs
, 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 PrimDarcsOption UseIndex
unsuspendAdvancedOpts
, commandBasicOptions :: [DarcsOptDescr DarcsFlag]
commandBasicOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc forall {a}.
OptSpec
DarcsOptDescr
DarcsFlag
a
(Maybe AllowConflicts
-> [MatchFlag]
-> Maybe Bool
-> WithSummary
-> ExternalMerge
-> Bool
-> Maybe String
-> DiffAlgorithm
-> a)
unsuspendBasicOpts
, commandDefaults :: [DarcsFlag]
commandDefaults = forall (d :: * -> *) f b. OptSpec d f [f] b -> [f]
defaultFlags forall {a}.
DarcsOption
a
(Maybe AllowConflicts
-> [MatchFlag]
-> Maybe Bool
-> WithSummary
-> ExternalMerge
-> Bool
-> Maybe String
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Verbosity
-> UseIndex
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
unsuspendOpts
, commandCheckOptions :: [DarcsFlag] -> [String]
commandCheckOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [f] -> [String]
ocheck forall {a}.
DarcsOption
a
(Maybe AllowConflicts
-> [MatchFlag]
-> Maybe Bool
-> WithSummary
-> ExternalMerge
-> Bool
-> Maybe String
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Verbosity
-> UseIndex
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
unsuspendOpts
}
where
unsuspendBasicOpts :: OptSpec
DarcsOptDescr
DarcsFlag
a
(Maybe AllowConflicts
-> [MatchFlag]
-> Maybe Bool
-> WithSummary
-> ExternalMerge
-> Bool
-> Maybe String
-> DiffAlgorithm
-> a)
unsuspendBasicOpts
= PrimDarcsOption (Maybe AllowConflicts)
O.conflictsYes
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ MatchOption
O.matchSeveralOrFirst
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 WithSummary
O.withSummary
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption ExternalMerge
O.externalMerge
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 (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 DiffAlgorithm
O.diffAlgorithm
unsuspendAdvancedOpts :: PrimOptSpec DarcsOptDescr DarcsFlag a UseIndex
unsuspendAdvancedOpts = PrimDarcsOption UseIndex
O.useIndex
unsuspendOpts :: DarcsOption
a
(Maybe AllowConflicts
-> [MatchFlag]
-> Maybe Bool
-> WithSummary
-> ExternalMerge
-> Bool
-> Maybe String
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Verbosity
-> UseIndex
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
unsuspendOpts = forall {a}.
OptSpec
DarcsOptDescr
DarcsFlag
a
(Maybe AllowConflicts
-> [MatchFlag]
-> Maybe Bool
-> WithSummary
-> ExternalMerge
-> Bool
-> Maybe String
-> DiffAlgorithm
-> a)
unsuspendBasicOpts forall b c a.
DarcsOption (Maybe StdCmdAction -> Verbosity -> b) c
-> DarcsOption
(UseCache -> HooksConfig -> Bool -> Bool -> Bool -> a) b
-> DarcsOption a c
`withStdOpts` PrimDarcsOption UseIndex
unsuspendAdvancedOpts
unsuspendDescription :: String
unsuspendDescription =
String
"Select suspended patches to restore to the end of the repo."
reify :: DarcsCommand
reify :: DarcsCommand
reify = DarcsCommand
{ commandProgramName :: String
commandProgramName = String
"darcs"
, commandName :: String
commandName = String
"reify"
, commandHelp :: Doc
commandHelp = String -> Doc
text String
reifyDescription
, commandDescription :: String
commandDescription = String
reifyDescription
, commandPrereq :: [DarcsFlag] -> IO (Either String ())
commandPrereq = [DarcsFlag] -> IO (Either String ())
amInHashedRepository
, commandExtraArgs :: Int
commandExtraArgs = Int
0
, commandExtraArgHelp :: [String]
commandExtraArgHelp = []
, commandCommand :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
commandCommand = String
-> Bool
-> (AbsolutePath, AbsolutePath)
-> [DarcsFlag]
-> [String]
-> IO ()
unsuspendCmd String
"reify" Bool
True
, commandCompleteArgs :: (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
commandCompleteArgs = (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
noArgs
, commandArgdefaults :: [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
commandArgdefaults = [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
nodefaults
, commandAdvancedOptions :: [DarcsOptDescr DarcsFlag]
commandAdvancedOptions = []
, commandBasicOptions :: [DarcsOptDescr DarcsFlag]
commandBasicOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc forall {a}.
OptSpec
DarcsOptDescr
DarcsFlag
a
([MatchFlag]
-> Maybe Bool -> Bool -> Maybe String -> DiffAlgorithm -> a)
reifyBasicOpts
, commandDefaults :: [DarcsFlag]
commandDefaults = forall (d :: * -> *) f b. OptSpec d f [f] b -> [f]
defaultFlags forall {a}.
DarcsOption
a
([MatchFlag]
-> Maybe Bool
-> Bool
-> Maybe String
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Verbosity
-> UMask
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
reifyOpts
, commandCheckOptions :: [DarcsFlag] -> [String]
commandCheckOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [f] -> [String]
ocheck forall {a}.
DarcsOption
a
([MatchFlag]
-> Maybe Bool
-> Bool
-> Maybe String
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Verbosity
-> UMask
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
reifyOpts
}
where
reifyBasicOpts :: OptSpec
DarcsOptDescr
DarcsFlag
a
([MatchFlag]
-> Maybe Bool -> Bool -> Maybe String -> DiffAlgorithm -> a)
reifyBasicOpts
= MatchOption
O.matchSeveralOrFirst
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 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 (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 DiffAlgorithm
O.diffAlgorithm
reifyOpts :: DarcsOption
a
([MatchFlag]
-> Maybe Bool
-> Bool
-> Maybe String
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Verbosity
-> UMask
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
reifyOpts = forall {a}.
OptSpec
DarcsOptDescr
DarcsFlag
a
([MatchFlag]
-> Maybe Bool -> Bool -> Maybe String -> DiffAlgorithm -> a)
reifyBasicOpts forall b c a.
DarcsOption (Maybe StdCmdAction -> Verbosity -> b) c
-> DarcsOption
(UseCache -> HooksConfig -> Bool -> Bool -> Bool -> a) b
-> DarcsOption a c
`withStdOpts` PrimDarcsOption UMask
O.umask
reifyDescription :: String
reifyDescription =
String
"Select suspended patches to restore to the end of the repo,\
\ reifying any fixup patches."
unsuspendCmd :: String -> Bool -> (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
unsuspendCmd :: String
-> Bool
-> (AbsolutePath, AbsolutePath)
-> [DarcsFlag]
-> [String]
-> IO ()
unsuspendCmd String
cmd Bool
reifyFixups (AbsolutePath, AbsolutePath)
_ [DarcsFlag]
opts [String]
_args =
forall a.
DryRun -> UseCache -> UpdatePending -> UMask -> RepoJob a -> IO a
withRepoLock (PrimDarcsOption DryRun
dryRun forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (PrimDarcsOption UseCache
useCache forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) UpdatePending
YesUpdatePending (PrimDarcsOption UMask
umask forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) forall a b. (a -> b) -> a -> b
$
forall a.
(forall (p :: * -> * -> *) wR wU.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository ('RepoType 'IsRebase) p wR wU wR -> IO a)
-> RepoJob a
RebaseJob forall a b. (a -> b) -> a -> b
$
\Repository ('RepoType 'IsRebase) p wR wU wR
_repository -> do
EqCheck wR wU
IsEq <- forall (p :: * -> * -> *) (rt :: RepoType) wR wU.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wR -> IO (EqCheck wR wU)
requireNoUnrecordedChanges Repository ('RepoType 'IsRebase) p wR wU wR
_repository
Items FL (RebaseChange (PrimOf p)) wR wY
selects <- forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
RepoPatch p =>
Repository rt p wR wU wT -> IO (Suspended p wT wT)
readTentativeRebase Repository ('RepoType 'IsRebase) p wR wU wR
_repository
let matchFlags :: [MatchFlag]
matchFlags = MatchOption
O.matchSeveralOrFirst forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts
FL (RebaseChange (PrimOf p)) wR wZ
inRange :> FL (RebaseChange (PrimOf p)) wZ wY
outOfRange <-
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
if [MatchFlag] -> Bool
secondMatch [MatchFlag]
matchFlags then
forall (p :: * -> * -> *) (q :: * -> * -> *) wX wY.
Matchable p =>
(forall wA wB. q wA wB -> Sealed2 p)
-> [MatchFlag] -> FL q wX wY -> (:>) (FL q) (FL q) wX wY
splitSecondFL forall (prim :: * -> * -> *) wX wY.
RebaseChange prim wX wY
-> Sealed2 (PatchInfoAnd ('RepoType 'NoRebase) prim)
rcToPia [MatchFlag]
matchFlags FL (RebaseChange (PrimOf p)) wR wY
selects
else FL (RebaseChange (PrimOf p)) wR wY
selects forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
FL (RebaseChange (PrimOf p)) wR wZ
offer :> RL (RebaseChange (PrimOf p)) wZ wZ
dontoffer <-
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
case PrimDarcsOption (Maybe AllowConflicts)
O.conflictsYes forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts of
Maybe AllowConflicts
Nothing -> forall (prim :: * -> * -> *) wX wY.
Commute prim =>
FL (RebaseChange prim) wX wY
-> (:>) (FL (RebaseChange prim)) (RL (RebaseChange prim)) wX wY
partitionUnconflicted FL (RebaseChange (PrimOf p)) wR wZ
inRange
Just AllowConflicts
_ -> FL (RebaseChange (PrimOf p)) wR wZ
inRange forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> forall (a :: * -> * -> *) wX. RL a wX wX
NilRL
let warnSkip :: RL a wX wZ -> IO ()
warnSkip RL a wX wZ
NilRL = forall (m :: * -> *) a. Monad m => a -> m a
return ()
warnSkip RL a wX wZ
_ = String -> IO ()
putStrLn String
"Skipping some patches which would cause conflicts."
forall {a :: * -> * -> *} {wX} {wZ}. RL a wX wZ -> IO ()
warnSkip RL (RebaseChange (PrimOf p)) wZ wZ
dontoffer
let selection_config :: SelectionConfig (RebaseChange (PrimOf p))
selection_config = forall (p :: * -> * -> *) (q :: * -> * -> *).
Matchable p =>
(forall wX wY. q wX wY -> Sealed2 p)
-> WhichChanges
-> String
-> PatchSelectionOptions
-> Maybe [AnchoredPath]
-> SelectionConfig q
selectionConfigGeneric forall (prim :: * -> * -> *) wX wY.
RebaseChange prim wX wY
-> Sealed2 (PatchInfoAnd ('RepoType 'NoRebase) prim)
rcToPia WhichChanges
First String
"unsuspend" (Bool -> [DarcsFlag] -> PatchSelectionOptions
patchSelOpts Bool
True [DarcsFlag]
opts) forall a. Maybe a
Nothing
(FL (RebaseChange (PrimOf p)) wR wZ
chosen :> FL (RebaseChange (PrimOf p)) wZ wZ
keep) <- forall (p :: * -> * -> *) wX wY.
(MatchableRP p, ShowPatch p, ShowContextPatch p,
ApplyState p ~ Tree, ApplyState p ~ ApplyState (PrimOf p)) =>
FL p wX wY -> SelectionConfig p -> IO ((:>) (FL p) (FL p) wX wY)
runSelection FL (RebaseChange (PrimOf p)) wR wZ
offer SelectionConfig (RebaseChange (PrimOf p))
selection_config
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Bool
nullFL FL (RebaseChange (PrimOf p)) wR wZ
chosen) forall a b. (a -> b) -> a -> b
$ do String -> IO ()
putStrLn String
"No patches selected!"
forall a. IO a
exitSuccess
FL (WithDroppedDeps (Named p)) wR wZ
ps_to_unsuspend :> FL (RebaseFixup (PrimOf p)) wZ wZ
chosen_fixups <-
if Bool
reifyFixups
then do
String
author <- Maybe String -> Bool -> IO String
Flags.getAuthor (PrimDarcsOption (Maybe String)
O.author forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) Bool
False
forall (p :: * -> * -> *) wX wY.
FromPrim p =>
String
-> FL (RebaseChange (PrimOf p)) wX wY
-> IO ((:>) (FL (WDDNamed p)) (FL (RebaseFixup (PrimOf p))) wX wY)
reifyRebaseChange String
author FL (RebaseChange (PrimOf p)) wR wZ
chosen
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) wX wY.
RepoPatch p =>
DiffAlgorithm
-> FL (RebaseChange (PrimOf p)) wX wY
-> (:>) (FL (WDDNamed p)) (FL (RebaseFixup (PrimOf p))) wX wY
extractRebaseChange (PrimDarcsOption DiffAlgorithm
diffAlgorithm forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) FL (RebaseChange (PrimOf p)) wR wZ
chosen
let da :: DiffAlgorithm
da = PrimDarcsOption DiffAlgorithm
diffAlgorithm forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts
ps_to_keep :: Sealed (FL (RebaseChange (PrimOf p)) wZ)
ps_to_keep = forall (prim :: * -> * -> *) wX wY wZ.
PrimPatch prim =>
DiffAlgorithm
-> FL (RebaseFixup prim) wX wY
-> FL (RebaseChange prim) wY wZ
-> Sealed (FL (RebaseChange prim) wX)
simplifyPushes DiffAlgorithm
da FL (RebaseFixup (PrimOf p)) wZ wZ
chosen_fixups forall a b. (a -> b) -> a -> b
$
FL (RebaseChange (PrimOf p)) wZ wZ
keep forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ forall (a :: * -> * -> *) wX wZ. RL a wX wZ -> FL a wX wZ
reverseRL RL (RebaseChange (PrimOf p)) wZ wZ
dontoffer forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ FL (RebaseChange (PrimOf p)) wZ wY
outOfRange
PatchSet ('RepoType 'IsRebase) p Origin wR
context <- 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 ('RepoType 'IsRebase) p wR wU wR
_repository
let conflicts :: StandardResolution (PrimOf p) wZ
conflicts =
forall (p :: * -> * -> *) (rt :: RepoType) wO wX wY.
(Commute p, PrimPatchBase p, Conflict p) =>
RL (PatchInfoAnd rt p) wO wX
-> RL (PatchInfoAnd rt p) wX wY -> StandardResolution (PrimOf p) wY
standardResolution (forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
PatchSet rt p wStart wX -> RL (PatchInfoAnd rt p) wStart wX
patchSet2RL PatchSet ('RepoType 'IsRebase) p Origin wR
context) forall a b. (a -> b) -> a -> b
$
forall (a :: * -> * -> *) wX wY. String -> RL a wX wY -> RL a wX wY
progressRL String
"Examining patches for conflicts" forall a b. (a -> b) -> a -> b
$
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> RL a wX wZ -> RL b wX wZ
mapRL_RL (forall (p :: * -> * -> *) wX wY (rt :: RepoType).
(Ident p, PatchId p ~ PatchInfo) =>
p wX wY -> PatchInfoAndG rt p wX wY
n2pia forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) wX wY. WithDroppedDeps p wX wY -> p wX wY
wddPatch) forall a b. (a -> b) -> a -> b
$
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> RL a wX wZ
reverseFL FL (WithDroppedDeps (Named p)) wR wZ
ps_to_unsuspend
Bool
have_conflicts <- forall (prim :: * -> * -> *) wX.
PrimPatch prim =>
String
-> AllowConflicts
-> ExternalMerge
-> StandardResolution prim wX
-> IO Bool
announceConflicts String
"unsuspend"
([DarcsFlag] -> AllowConflicts
allowConflicts [DarcsFlag]
opts) (PrimDarcsOption ExternalMerge
externalMerge forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) StandardResolution (PrimOf p) wZ
conflicts
Sealed FL (PrimOf p) wZ wX
resolved_p <-
case (PrimDarcsOption ExternalMerge
externalMerge forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts, Bool
have_conflicts) of
(ExternalMerge
NoExternalMerge, Bool
_) ->
case PrimDarcsOption (Maybe AllowConflicts)
O.conflictsYes forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts of
Just AllowConflicts
O.YesAllowConflicts -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (a :: * -> *) wX. a wX -> Sealed a
seal forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
Maybe AllowConflicts
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (prim :: * -> * -> *) wX.
StandardResolution prim wX -> Mangled prim wX
mangled StandardResolution (PrimOf p) wZ
conflicts
(ExternalMerge
_, Bool
False) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (prim :: * -> * -> *) wX.
StandardResolution prim wX -> Mangled prim wX
mangled StandardResolution (PrimOf p) wZ
conflicts
(YesExternalMerge String
_, Bool
True) ->
forall a. HasCallStack => String -> a
error String
"external resolution for unsuspend not implemented yet"
let effect_to_apply :: FL (PrimOf p) wR wX
effect_to_apply = forall (a :: * -> * -> *) wX wZ. FL (FL a) wX wZ -> FL a wX wZ
concatFL (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 (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect FL (WithDroppedDeps (Named p)) wR wZ
ps_to_unsuspend) forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ FL (PrimOf p) wZ wX
resolved_p
forall t. t -> IO ()
invalidateIndex Repository ('RepoType 'IsRebase) p wR wU wR
_repository
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wX wY.
RepoPatch p =>
Repository rt p wR wU wT -> FL (PrimOf p) wX wY -> IO ()
tentativelyAddToPending Repository ('RepoType 'IsRebase) p wR wU wR
_repository FL (PrimOf p) wR wX
effect_to_apply
(Repository ('RepoType 'IsRebase) p wR wU wZ
_repository, FL RebaseName wZ wZ
renames) <- forall (m :: * -> *) a.
Monad m =>
HijackOptions -> HijackT m a -> m a
runHijackT HijackOptions
IgnoreHijack forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) wR wU wT wT2.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository ('RepoType 'IsRebase) p wR wU wT
-> FL (WDDNamed p) wT wT2
-> HijackT
IO
(Repository ('RepoType 'IsRebase) p wR wU wT2,
FL RebaseName wT2 wT2)
doAdd Repository ('RepoType 'IsRebase) p wR wU wR
_repository FL (WithDroppedDeps (Named p)) wR wZ
ps_to_unsuspend
case forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal (forall (prim :: * -> * -> *) wX wY wZ.
PrimPatch prim =>
DiffAlgorithm
-> FL (RebaseFixup prim) wX wY
-> FL (RebaseChange prim) wY wZ
-> Sealed (FL (RebaseChange prim) wX)
simplifyPushes DiffAlgorithm
da (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 wX wY (prim :: * -> * -> *).
RebaseName wX wY -> RebaseFixup prim wX wY
NameFixup FL RebaseName wZ wZ
renames)) Sealed (FL (RebaseChange (PrimOf p)) wZ)
ps_to_keep of
Sealed FL (RebaseChange (PrimOf p)) wZ wX
new_ps -> forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
RepoPatch p =>
Repository rt p wR wU wT -> Suspended p wT wT -> IO ()
writeTentativeRebase Repository ('RepoType 'IsRebase) p wR wU wZ
_repository (forall (p :: * -> * -> *) wX wX.
FL (RebaseChange (PrimOf p)) wX wX -> Suspended p wX wX
Items FL (RebaseChange (PrimOf p)) wZ wX
new_ps)
forall a. IO a -> IO a
withSignalsBlocked forall a b. (a -> b) -> a -> b
$ do
Repository ('RepoType 'IsRebase) p wZ wU wZ
_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 ('RepoType 'IsRebase) p wR wU wZ
_repository UpdatePending
YesUpdatePending (PrimDarcsOption Compression
compress forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT wY.
(ApplyState p ~ Tree, RepoPatch p) =>
Repository rt p wR wU wT
-> Verbosity
-> FL (PrimOf p) wU wY
-> IO (Repository rt p wR wY wT)
applyToWorking Repository ('RepoType 'IsRebase) p wZ wU wZ
_repository (PrimDarcsOption Verbosity
verbosity forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) FL (PrimOf p) wR wX
effect_to_apply
where doAdd :: (RepoPatch p, ApplyState p ~ Tree)
=> Repository ('RepoType 'IsRebase) p wR wU wT
-> FL (WDDNamed p) wT wT2
-> HijackT IO (Repository ('RepoType 'IsRebase) p wR wU wT2, FL RebaseName wT2 wT2)
doAdd :: forall (p :: * -> * -> *) wR wU wT wT2.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository ('RepoType 'IsRebase) p wR wU wT
-> FL (WDDNamed p) wT wT2
-> HijackT
IO
(Repository ('RepoType 'IsRebase) p wR wU wT2,
FL RebaseName wT2 wT2)
doAdd Repository ('RepoType 'IsRebase) p wR wU wT
_repo FL (WDDNamed p) wT wT2
NilFL = forall (m :: * -> *) a. Monad m => a -> m a
return (Repository ('RepoType 'IsRebase) p wR wU wT
_repo, forall (a :: * -> * -> *) wX. FL a wX wX
NilFL)
doAdd Repository ('RepoType 'IsRebase) p wR wU wT
_repo ((WDDNamed p wT wY
p :: WDDNamed p wT wU) :>:FL (WDDNamed p) wY wT2
ps) = do
case forall (p :: * -> * -> *) wX wY.
WithDroppedDeps p wX wY -> [PatchInfo]
wddDependedOn WDDNamed p wT wY
p of
[] -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
[PatchInfo]
deps -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
String -> IO ()
putStr forall a b. (a -> b) -> a -> b
$ String
"Warning: dropping the following explicit "
forall a. [a] -> [a] -> [a]
++ forall n. Countable n => Int -> n -> ShowS
englishNum (forall (t :: * -> *) a. Foldable t => t a -> Int
length [PatchInfo]
deps) (String -> Noun
Noun String
"dependency") String
":\n\n"
let printIndented :: Int -> PatchInfo -> IO ()
printIndented Int
n =
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Int -> a -> [a]
replicate Int
n Char
' 'forall a. [a] -> [a] -> [a]
++)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Doc -> String
renderString forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchInfo -> Doc
displayPatchInfo
String -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> String
renderString forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchInfo -> Doc
displayPatchInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (p :: * -> * -> *) wX wY. Named p wX wY -> PatchInfo
patch2patchinfo forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) wX wY. WithDroppedDeps p wX wY -> p wX wY
wddPatch WDDNamed p wT wY
p
String -> IO ()
putStr String
" depended on:\n"
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Int -> PatchInfo -> IO ()
printIndented Int
2) [PatchInfo]
deps
String -> IO ()
putStr String
"\n"
PatchInfoAnd ('RepoType 'IsRebase) p wT wY
p' <- forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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
"unsuspend"
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
AskAboutDeps rt p wR wU wT
NoAskAboutDeps
(Bool -> [DarcsFlag] -> PatchSelectionOptions
patchSelOpts Bool
True [DarcsFlag]
opts)
(PrimDarcsOption DiffAlgorithm
diffAlgorithm forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
(PrimDarcsOption Bool
O.keepDate forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
(PrimDarcsOption Bool
O.selectAuthor forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
(PrimDarcsOption (Maybe String)
O.author forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
(PrimDarcsOption (Maybe String)
O.patchname forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
(PrimDarcsOption (Maybe AskLongComment)
O.askLongComment forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
(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 (p :: * -> * -> *) wX wY. WithDroppedDeps p wX wY -> p wX wY
wddPatch WDDNamed p wT wY
p)) forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
Repository ('RepoType 'IsRebase) p wR wU wY
_repo <-
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
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 ('RepoType 'IsRebase) p wR wU wT
_repo (PrimDarcsOption Compression
compress forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (PrimDarcsOption Verbosity
verbosity forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) UpdatePending
YesUpdatePending PatchInfoAnd ('RepoType 'IsRebase) p wT wY
p'
let rename :: RebaseName wU wU
rename :: RebaseName wY wY
rename = forall wX wY. PatchInfo -> PatchInfo -> RebaseName wX wY
Rename (forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> PatchInfo
info PatchInfoAnd ('RepoType 'IsRebase) p wT wY
p') (forall (p :: * -> * -> *) wX wY. Named p wX wY -> PatchInfo
patch2patchinfo (forall (p :: * -> * -> *) wX wY. WithDroppedDeps p wX wY -> p wX wY
wddPatch WDDNamed p wT wY
p))
Just (FL (WDDNamed p) wY wZ
ps2 :> (RebaseName wZ wT2
rename2 :: RebaseName wV wT2)) <-
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (p1 :: * -> * -> *) (p2 :: * -> * -> *).
CommuteFn p1 p2 -> CommuteFn p1 (FL p2)
commuterIdFL (forall (p :: * -> * -> *) (q :: * -> * -> *).
CommuteFn p q -> CommuteFn p (WithDroppedDeps q)
commuterIdWDD forall (p :: * -> * -> *). CommuteFn RebaseName (Named p)
commuteNameNamed) (RebaseName wY wY
rename forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (WDDNamed p) wY wT2
ps))
EqCheck wZ wT2
IsEq <- forall (m :: * -> *) a. Monad m => a -> m a
return (forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP forall wA. EqCheck wA wA
IsEq :: EqCheck wV wT2)
(Repository ('RepoType 'IsRebase) p wR wU wZ
_repo, FL RebaseName wZ wZ
renames) <- forall (p :: * -> * -> *) wR wU wT wT2.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository ('RepoType 'IsRebase) p wR wU wT
-> FL (WDDNamed p) wT wT2
-> HijackT
IO
(Repository ('RepoType 'IsRebase) p wR wU wT2,
FL RebaseName wT2 wT2)
doAdd Repository ('RepoType 'IsRebase) p wR wU wY
_repo FL (WDDNamed p) wY wZ
ps2
forall (m :: * -> *) a. Monad m => a -> m a
return (Repository ('RepoType 'IsRebase) p wR wU wZ
_repo, RebaseName wZ wT2
rename2 forall (a :: * -> * -> *) wX wX wZ.
a wX wX -> FL a wX wZ -> FL a wX wZ
:>: FL RebaseName wZ wZ
renames)
requireNoUnrecordedChanges :: (RepoPatch p, ApplyState p ~ Tree)
=> Repository rt p wR wU wR
-> IO (EqCheck wR wU)
requireNoUnrecordedChanges :: forall (p :: * -> * -> *) (rt :: RepoType) wR wU.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wR -> IO (EqCheck wR wU)
requireNoUnrecordedChanges Repository rt p wR wU wR
repo = do
FL (PrimOf p) wR wU
pend <-
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) wR wU)
unrecordedChanges ([DarcsFlag] -> (UseIndex, ScanKnown, DiffAlgorithm)
diffingOpts [DarcsFlag]
opts)
LookForMoves
O.NoLookForMoves LookForReplaces
O.NoLookForReplaces
Repository rt p wR wU wR
repo forall a. Maybe a
Nothing
case FL (PrimOf p) wR wU
pend of
FL (PrimOf p) wR wU
NilFL -> forall (m :: * -> *) a. Monad m => a -> m a
return forall wA. EqCheck wA wA
IsEq
FL (PrimOf p) wR wU
_ -> forall a. String -> IO a
die forall a b. (a -> b) -> a -> b
$ String
"Can't "forall a. [a] -> [a] -> [a]
++String
cmdforall a. [a] -> [a] -> [a]
++String
" when there are unrecorded changes."
inject :: DarcsCommand
inject :: DarcsCommand
inject = DarcsCommand
{ commandProgramName :: String
commandProgramName = String
"darcs"
, commandName :: String
commandName = String
"inject"
, commandHelp :: Doc
commandHelp = String -> Doc
text String
injectDescription
, commandDescription :: String
commandDescription = String
injectDescription
, commandPrereq :: [DarcsFlag] -> IO (Either String ())
commandPrereq = [DarcsFlag] -> IO (Either String ())
amInHashedRepository
, commandExtraArgs :: Int
commandExtraArgs = Int
0
, commandExtraArgHelp :: [String]
commandExtraArgHelp = []
, commandCommand :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
commandCommand = (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
injectCmd
, commandCompleteArgs :: (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
commandCompleteArgs = (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
noArgs
, commandArgdefaults :: [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
commandArgdefaults = [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
nodefaults
, commandAdvancedOptions :: [DarcsOptDescr DarcsFlag]
commandAdvancedOptions = []
, commandBasicOptions :: [DarcsOptDescr DarcsFlag]
commandBasicOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc forall {a}.
OptSpec
DarcsOptDescr
DarcsFlag
a
(Bool -> Maybe String -> DiffAlgorithm -> a)
injectBasicOpts
, commandDefaults :: [DarcsFlag]
commandDefaults = forall (d :: * -> *) f b. OptSpec d f [f] b -> [f]
defaultFlags forall {a}.
DarcsOption
a
(Bool
-> Maybe String
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Verbosity
-> UMask
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
injectOpts
, commandCheckOptions :: [DarcsFlag] -> [String]
commandCheckOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [f] -> [String]
ocheck forall {a}.
DarcsOption
a
(Bool
-> Maybe String
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Verbosity
-> UMask
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
injectOpts
}
where
injectBasicOpts :: OptSpec
DarcsOptDescr
DarcsFlag
a
(Bool -> Maybe String -> DiffAlgorithm -> a)
injectBasicOpts = 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 (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 DiffAlgorithm
O.diffAlgorithm
injectOpts :: DarcsOption
a
(Bool
-> Maybe String
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Verbosity
-> UMask
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
injectOpts = forall {a}.
OptSpec
DarcsOptDescr
DarcsFlag
a
(Bool -> Maybe String -> DiffAlgorithm -> a)
injectBasicOpts forall b c a.
DarcsOption (Maybe StdCmdAction -> Verbosity -> b) c
-> DarcsOption
(UseCache -> HooksConfig -> Bool -> Bool -> Bool -> a) b
-> DarcsOption a c
`withStdOpts` PrimDarcsOption UMask
O.umask
injectDescription :: String
injectDescription =
String
"Merge a change from the fixups of a patch into the patch itself."
injectCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
injectCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
injectCmd (AbsolutePath, AbsolutePath)
_ [DarcsFlag]
opts [String]
_args =
forall a.
DryRun -> UseCache -> UpdatePending -> UMask -> RepoJob a -> IO a
withRepoLock (PrimDarcsOption DryRun
dryRun forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (PrimDarcsOption UseCache
useCache forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) UpdatePending
YesUpdatePending (PrimDarcsOption UMask
umask forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) forall a b. (a -> b) -> a -> b
$
forall a.
(forall (p :: * -> * -> *) wR wU.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository ('RepoType 'IsRebase) p wR wU wR -> IO a)
-> RepoJob a
RebaseJob forall a b. (a -> b) -> a -> b
$
\(Repository ('RepoType 'IsRebase) p wR wU wR
_repository :: Repository ('RepoType 'IsRebase) p wR wU wR) -> do
Items FL (RebaseChange (PrimOf p)) wR wY
selects <- forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
RepoPatch p =>
Repository rt p wR wU wT -> IO (Suspended p wT wT)
readTentativeRebase Repository ('RepoType 'IsRebase) p wR wU wR
_repository
let selection_config :: SelectionConfig (RebaseChange (PrimOf p))
selection_config =
forall (p :: * -> * -> *) (q :: * -> * -> *).
Matchable p =>
(forall wX wY. q wX wY -> Sealed2 p)
-> WhichChanges
-> String
-> PatchSelectionOptions
-> Maybe [AnchoredPath]
-> SelectionConfig q
selectionConfigGeneric forall (prim :: * -> * -> *) wX wY.
RebaseChange prim wX wY
-> Sealed2 (PatchInfoAnd ('RepoType 'NoRebase) prim)
rcToPia WhichChanges
First String
"inject into" (Bool -> [DarcsFlag] -> PatchSelectionOptions
patchSelOpts Bool
True [DarcsFlag]
opts) forall a. Maybe a
Nothing
(FL (RebaseChange (PrimOf p)) wR wZ
chosens :> FL (RebaseChange (PrimOf p)) wZ wY
rest_selects) <- forall (p :: * -> * -> *) wX wY.
(MatchableRP p, ShowPatch p, ShowContextPatch p,
ApplyState p ~ Tree, ApplyState p ~ ApplyState (PrimOf p)) =>
FL p wX wY -> SelectionConfig p -> IO ((:>) (FL p) (FL p) wX wY)
runSelection FL (RebaseChange (PrimOf p)) wR wY
selects SelectionConfig (RebaseChange (PrimOf p))
selection_config
let extractSingle :: FL (RebaseChange prim) wX wY -> (FL (RebaseFixup prim) :> Named prim) wX wY
extractSingle :: forall (prim :: * -> * -> *) wX wY.
FL (RebaseChange prim) wX wY
-> (:>) (FL (RebaseFixup prim)) (Named prim) wX wY
extractSingle (RC FL (RebaseFixup prim) wX wY
fixups Named prim wY wY
toedit :>: FL (RebaseChange prim) wY wY
NilFL) = FL (RebaseFixup prim) wX wY
fixups forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> Named prim wY wY
toedit
extractSingle FL (RebaseChange prim) wX wY
_ = forall a. HasCallStack => String -> a
error String
"You must select precisely one patch!"
FL (RebaseFixup (PrimOf p)) wR wZ
fixups :> Named (PrimOf p) wZ wZ
toedit <- forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (prim :: * -> * -> *) wX wY.
FL (RebaseChange prim) wX wY
-> (:>) (FL (RebaseFixup prim)) (Named prim) wX wY
extractSingle FL (RebaseChange (PrimOf p)) wR wZ
chosens
FL RebaseName wR wZ
name_fixups :> FL (PrimOf p) wZ wZ
prim_fixups <- forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (prim :: * -> * -> *) wX wY.
FL (RebaseFixup prim) wX wY -> (:>) (FL RebaseName) (FL prim) wX wY
flToNamesPrims FL (RebaseFixup (PrimOf p)) wR wZ
fixups
let prim_selection_config :: SelectionConfig (PrimOf p)
prim_selection_config =
forall (prim :: * -> * -> *).
WhichChanges
-> String
-> PatchSelectionOptions
-> Maybe (Splitter prim)
-> Maybe [AnchoredPath]
-> Maybe (Tree IO)
-> SelectionConfig prim
selectionConfigPrim
WhichChanges
Last String
"inject" (Bool -> [DarcsFlag] -> PatchSelectionOptions
patchSelOpts Bool
True [DarcsFlag]
opts)
(forall a. a -> Maybe a
Just (forall (p :: * -> * -> *).
PrimPatch p =>
DiffAlgorithm -> Splitter p
primSplitter (PrimDarcsOption DiffAlgorithm
diffAlgorithm forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts))) forall a. Maybe a
Nothing forall a. Maybe a
Nothing
(FL (PrimOf p) wZ wZ
rest_fixups :> FL (PrimOf p) wZ wZ
injects) <- 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) wZ wZ
prim_fixups SelectionConfig (PrimOf p)
prim_selection_config
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Bool
nullFL FL (PrimOf p) wZ wZ
injects) forall a b. (a -> b) -> a -> b
$ do
String -> IO ()
putStrLn String
"No changes selected!"
forall a. IO a
exitSuccess
let da :: DiffAlgorithm
da = PrimDarcsOption DiffAlgorithm
diffAlgorithm forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts
toeditNew :: Named (PrimOf p) wZ wZ
toeditNew = 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 (prim :: * -> * -> *) wX wY.
PrimCanonize prim =>
DiffAlgorithm -> FL prim wX wY -> FL prim wX wY
canonizeFL DiffAlgorithm
da forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FL (PrimOf p) wZ wZ
injects forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+)) Named (PrimOf p) wZ wZ
toedit
case forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal (forall (prim :: * -> * -> *) wX wY wZ.
PrimPatch prim =>
DiffAlgorithm
-> FL (RebaseFixup prim) wX wY
-> FL (RebaseChange prim) wY wZ
-> Sealed (FL (RebaseChange prim) wX)
simplifyPushes DiffAlgorithm
da (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 wX wY (prim :: * -> * -> *).
RebaseName wX wY -> RebaseFixup prim wX wY
NameFixup FL RebaseName wR wZ
name_fixups))
forall a b. (a -> b) -> a -> b
$ forall (prim :: * -> * -> *) wX wY wZ.
PrimPatch prim =>
DiffAlgorithm
-> FL (RebaseFixup prim) wX wY
-> FL (RebaseChange prim) wY wZ
-> Sealed (FL (RebaseChange prim) wX)
simplifyPushes DiffAlgorithm
da (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 FL (PrimOf p) wZ wZ
rest_fixups)
forall a b. (a -> b) -> a -> b
$ forall (prim :: * -> * -> *) wX wX wZ.
FL (RebaseFixup prim) wX wX
-> Named prim wX wZ -> RebaseChange prim wX wZ
RC forall (a :: * -> * -> *) wX. FL a wX wX
NilFL Named (PrimOf p) wZ wZ
toeditNew forall (a :: * -> * -> *) wX wX wZ.
a wX wX -> FL a wX wZ -> FL a wX wZ
:>: FL (RebaseChange (PrimOf p)) wZ wY
rest_selects of
Sealed FL (RebaseChange (PrimOf p)) wR wX
new_ps -> forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
RepoPatch p =>
Repository rt p wR wU wT -> Suspended p wT wT -> IO ()
writeTentativeRebase Repository ('RepoType 'IsRebase) p wR wU wR
_repository (forall (p :: * -> * -> *) wX wX.
FL (RebaseChange (PrimOf p)) wX wX -> Suspended p wX wX
Items FL (RebaseChange (PrimOf p)) wR wX
new_ps)
Repository ('RepoType 'IsRebase) p wR wU wR
_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 ('RepoType 'IsRebase) p wR wU wR
_repository UpdatePending
YesUpdatePending (PrimDarcsOption Compression
compress forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
forall (m :: * -> *) a. Monad m => a -> m a
return ()
obliterate :: DarcsCommand
obliterate :: DarcsCommand
obliterate = DarcsCommand
{ commandProgramName :: String
commandProgramName = String
"darcs"
, commandName :: String
commandName = String
"obliterate"
, commandHelp :: Doc
commandHelp = String -> Doc
text String
obliterateDescription
, commandDescription :: String
commandDescription = String
obliterateDescription
, commandPrereq :: [DarcsFlag] -> IO (Either String ())
commandPrereq = [DarcsFlag] -> IO (Either String ())
amInHashedRepository
, commandExtraArgs :: Int
commandExtraArgs = Int
0
, commandExtraArgHelp :: [String]
commandExtraArgHelp = []
, commandCommand :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
commandCommand = (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
obliterateCmd
, commandCompleteArgs :: (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
commandCompleteArgs = (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
noArgs
, commandArgdefaults :: [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
commandArgdefaults = [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
nodefaults
, commandAdvancedOptions :: [DarcsOptDescr DarcsFlag]
commandAdvancedOptions = []
, commandBasicOptions :: [DarcsOptDescr DarcsFlag]
commandBasicOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc PrimDarcsOption DiffAlgorithm
obliterateBasicOpts
, commandDefaults :: [DarcsFlag]
commandDefaults = forall (d :: * -> *) f b. OptSpec d f [f] b -> [f]
defaultFlags forall {a}.
DarcsOption
a
(DiffAlgorithm
-> Maybe StdCmdAction
-> Verbosity
-> UMask
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
obliterateOpts
, commandCheckOptions :: [DarcsFlag] -> [String]
commandCheckOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [f] -> [String]
ocheck forall {a}.
DarcsOption
a
(DiffAlgorithm
-> Maybe StdCmdAction
-> Verbosity
-> UMask
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
obliterateOpts
}
where
obliterateBasicOpts :: PrimOptSpec DarcsOptDescr DarcsFlag a DiffAlgorithm
obliterateBasicOpts = PrimDarcsOption DiffAlgorithm
O.diffAlgorithm
obliterateOpts :: DarcsOption
a
(DiffAlgorithm
-> Maybe StdCmdAction
-> Verbosity
-> UMask
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
obliterateOpts = PrimDarcsOption DiffAlgorithm
obliterateBasicOpts forall b c a.
DarcsOption (Maybe StdCmdAction -> Verbosity -> b) c
-> DarcsOption
(UseCache -> HooksConfig -> Bool -> Bool -> Bool -> a) b
-> DarcsOption a c
`withStdOpts` PrimDarcsOption UMask
O.umask
obliterateDescription :: String
obliterateDescription =
String
"Obliterate a patch that is currently suspended."
obliterateCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
obliterateCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
obliterateCmd (AbsolutePath, AbsolutePath)
_ [DarcsFlag]
opts [String]
_args =
forall a.
DryRun -> UseCache -> UpdatePending -> UMask -> RepoJob a -> IO a
withRepoLock (PrimDarcsOption DryRun
dryRun forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (PrimDarcsOption UseCache
useCache forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) UpdatePending
YesUpdatePending (PrimDarcsOption UMask
umask forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) forall a b. (a -> b) -> a -> b
$
forall a.
(forall (p :: * -> * -> *) wR wU.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository ('RepoType 'IsRebase) p wR wU wR -> IO a)
-> RepoJob a
RebaseJob forall a b. (a -> b) -> a -> b
$
\(Repository ('RepoType 'IsRebase) p wR wU wR
_repository :: Repository ('RepoType 'IsRebase) p wR wU wR) -> (do
Items FL (RebaseChange (PrimOf p)) wR wY
selects <- forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
RepoPatch p =>
Repository rt p wR wU wT -> IO (Suspended p wT wT)
readTentativeRebase Repository ('RepoType 'IsRebase) p wR wU wR
_repository
let selection_config :: SelectionConfig (RebaseChange (PrimOf p))
selection_config = forall (p :: * -> * -> *) (q :: * -> * -> *).
Matchable p =>
(forall wX wY. q wX wY -> Sealed2 p)
-> WhichChanges
-> String
-> PatchSelectionOptions
-> Maybe [AnchoredPath]
-> SelectionConfig q
selectionConfigGeneric forall (prim :: * -> * -> *) wX wY.
RebaseChange prim wX wY
-> Sealed2 (PatchInfoAnd ('RepoType 'NoRebase) prim)
rcToPia WhichChanges
First String
"obliterate" ([DarcsFlag] -> PatchSelectionOptions
obliteratePatchSelOpts [DarcsFlag]
opts) forall a. Maybe a
Nothing
(FL (RebaseChange (PrimOf p)) wR wZ
chosen :> FL (RebaseChange (PrimOf p)) wZ wY
keep) <- forall (p :: * -> * -> *) wX wY.
(MatchableRP p, ShowPatch p, ShowContextPatch p,
ApplyState p ~ Tree, ApplyState p ~ ApplyState (PrimOf p)) =>
FL p wX wY -> SelectionConfig p -> IO ((:>) (FL p) (FL p) wX wY)
runSelection FL (RebaseChange (PrimOf p)) wR wY
selects SelectionConfig (RebaseChange (PrimOf p))
selection_config
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Bool
nullFL FL (RebaseChange (PrimOf p)) wR wZ
chosen) forall a b. (a -> b) -> a -> b
$ do String -> IO ()
putStrLn String
"No patches selected!"
forall a. IO a
exitSuccess
let da :: DiffAlgorithm
da = PrimDarcsOption DiffAlgorithm
diffAlgorithm forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts
do_obliterate
:: PrimPatch prim
=> FL (RebaseChange prim) wX wY
-> FL (RebaseChange prim) wY wZ
-> Sealed (FL (RebaseChange prim) wX)
do_obliterate :: forall (prim :: * -> * -> *) wX wY wZ.
PrimPatch prim =>
FL (RebaseChange prim) wX wY
-> FL (RebaseChange prim) wY wZ
-> Sealed (FL (RebaseChange prim) wX)
do_obliterate FL (RebaseChange prim) wX wY
NilFL = forall (a :: * -> *) wX. a wX -> Sealed a
Sealed
do_obliterate (RC FL (RebaseFixup prim) wX wY
fs Named prim wY wY
e :>: FL (RebaseChange prim) wY wY
qs) =
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal (forall (prim :: * -> * -> *) wX wY wZ.
PrimPatch prim =>
DiffAlgorithm
-> FL (RebaseFixup prim) wX wY
-> FL (RebaseChange prim) wY wZ
-> Sealed (FL (RebaseChange prim) wX)
simplifyPushes DiffAlgorithm
da FL (RebaseFixup prim) wX wY
fs) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal (forall (prim :: * -> * -> *) wX wY wZ.
PrimPatch prim =>
DiffAlgorithm
-> RebaseFixup prim wX wY
-> FL (RebaseChange prim) wY wZ
-> Sealed (FL (RebaseChange prim) wX)
simplifyPush DiffAlgorithm
da (forall wX wY (prim :: * -> * -> *).
RebaseName wX wY -> RebaseFixup prim wX wY
NameFixup (forall wX wY. PatchInfo -> RebaseName wX wY
AddName (forall (p :: * -> * -> *) wX wY. Named p wX wY -> PatchInfo
patch2patchinfo Named prim wY wY
e)))) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal (forall (prim :: * -> * -> *) wX wY wZ.
PrimPatch prim =>
DiffAlgorithm
-> FL (RebaseFixup prim) wX wY
-> FL (RebaseChange prim) wY wZ
-> Sealed (FL (RebaseChange prim) wX)
simplifyPushes DiffAlgorithm
da (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. Named p wX wY -> FL p wX wY
patchcontents Named prim wY wY
e))) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (prim :: * -> * -> *) wX wY wZ.
PrimPatch prim =>
FL (RebaseChange prim) wX wY
-> FL (RebaseChange prim) wY wZ
-> Sealed (FL (RebaseChange prim) wX)
do_obliterate FL (RebaseChange prim) wY wY
qs
let ps_to_keep :: Sealed (FL (RebaseChange (PrimOf p)) wR)
ps_to_keep = forall (prim :: * -> * -> *) wX wY wZ.
PrimPatch prim =>
FL (RebaseChange prim) wX wY
-> FL (RebaseChange prim) wY wZ
-> Sealed (FL (RebaseChange prim) wX)
do_obliterate FL (RebaseChange (PrimOf p)) wR wZ
chosen FL (RebaseChange (PrimOf p)) wZ wY
keep
case Sealed (FL (RebaseChange (PrimOf p)) wR)
ps_to_keep of
Sealed FL (RebaseChange (PrimOf p)) wR wX
new_ps -> forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
RepoPatch p =>
Repository rt p wR wU wT -> Suspended p wT wT -> IO ()
writeTentativeRebase Repository ('RepoType 'IsRebase) p wR wU wR
_repository (forall (p :: * -> * -> *) wX wX.
FL (RebaseChange (PrimOf p)) wX wX -> Suspended p wX wX
Items FL (RebaseChange (PrimOf p)) wR wX
new_ps)
Repository ('RepoType 'IsRebase) p wR wU wR
_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 ('RepoType 'IsRebase) p wR wU wR
_repository UpdatePending
YesUpdatePending (PrimDarcsOption Compression
compress forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
forall (m :: * -> *) a. Monad m => a -> m a
return ()
) :: IO ()
pull :: DarcsCommand
pull :: DarcsCommand
pull = DarcsCommand
{ commandProgramName :: String
commandProgramName = String
"darcs"
, commandName :: String
commandName = String
"pull"
, commandHelp :: Doc
commandHelp = String -> Doc
text String
pullDescription
, commandDescription :: String
commandDescription = String
pullDescription
, commandExtraArgs :: Int
commandExtraArgs = -Int
1
, commandExtraArgHelp :: [String]
commandExtraArgHelp = [String
"[REPOSITORY]..."]
, commandCommand :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
commandCommand = forall pa.
PatchApplier pa =>
pa
-> (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
pullCmd RebasePatchApplier
RebasePatchApplier
, commandPrereq :: [DarcsFlag] -> IO (Either String ())
commandPrereq = [DarcsFlag] -> IO (Either String ())
amInHashedRepository
, commandCompleteArgs :: (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
commandCompleteArgs = String
-> (AbsolutePath, AbsolutePath)
-> [DarcsFlag]
-> [String]
-> IO [String]
prefArgs String
"repos"
, commandArgdefaults :: [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
commandArgdefaults = [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
defaultRepo
, commandAdvancedOptions :: [DarcsOptDescr DarcsFlag]
commandAdvancedOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc forall {a}.
OptSpec
DarcsOptDescr
DarcsFlag
a
(RepoCombinator
-> Compression
-> UseIndex
-> RemoteRepos
-> SetScriptsExecutable
-> UMask
-> Bool
-> NetworkOptions
-> a)
pullAdvancedOpts
, commandBasicOptions :: [DarcsOptDescr DarcsFlag]
commandBasicOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc forall {a}.
OptSpec
DarcsOptDescr
DarcsFlag
a
([MatchFlag]
-> Reorder
-> Maybe Bool
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> DryRun
-> XmlOutput
-> WithSummary
-> SelectDeps
-> Maybe String
-> Bool
-> DiffAlgorithm
-> a)
pullBasicOpts
, commandDefaults :: [DarcsFlag]
commandDefaults = forall (d :: * -> *) f b. OptSpec d f [f] b -> [f]
defaultFlags forall {a}.
DarcsOption
a
([MatchFlag]
-> Reorder
-> Maybe Bool
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> DryRun
-> XmlOutput
-> WithSummary
-> SelectDeps
-> Maybe String
-> Bool
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Verbosity
-> RepoCombinator
-> Compression
-> UseIndex
-> RemoteRepos
-> SetScriptsExecutable
-> UMask
-> Bool
-> NetworkOptions
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
pullOpts
, commandCheckOptions :: [DarcsFlag] -> [String]
commandCheckOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [f] -> [String]
ocheck forall {a}.
DarcsOption
a
([MatchFlag]
-> Reorder
-> Maybe Bool
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> DryRun
-> XmlOutput
-> WithSummary
-> SelectDeps
-> Maybe String
-> Bool
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Verbosity
-> RepoCombinator
-> Compression
-> UseIndex
-> RemoteRepos
-> SetScriptsExecutable
-> UMask
-> Bool
-> NetworkOptions
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
pullOpts
}
where
pullBasicOpts :: OptSpec
DarcsOptDescr
DarcsFlag
a
([MatchFlag]
-> Reorder
-> Maybe Bool
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> DryRun
-> XmlOutput
-> WithSummary
-> SelectDeps
-> Maybe String
-> Bool
-> DiffAlgorithm
-> a)
pullBasicOpts
= MatchOption
O.matchSeveral
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption Reorder
O.reorder
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 AllowConflicts)
O.conflictsYes
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption ExternalMerge
O.externalMerge
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption RunTest
O.runTest
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ forall a. DarcsOption a (DryRun -> XmlOutput -> a)
O.dryRunXml
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption WithSummary
O.withSummary
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption SelectDeps
O.selectDeps
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 Bool
O.allowUnrelatedRepos
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
pullAdvancedOpts :: OptSpec
DarcsOptDescr
DarcsFlag
a
(RepoCombinator
-> Compression
-> UseIndex
-> RemoteRepos
-> SetScriptsExecutable
-> UMask
-> Bool
-> NetworkOptions
-> a)
pullAdvancedOpts
= PrimDarcsOption RepoCombinator
O.repoCombinator
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ 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 RemoteRepos
O.remoteRepos
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
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 Bool
O.changesReverse
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption NetworkOptions
O.network
pullOpts :: DarcsOption
a
([MatchFlag]
-> Reorder
-> Maybe Bool
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> DryRun
-> XmlOutput
-> WithSummary
-> SelectDeps
-> Maybe String
-> Bool
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Verbosity
-> RepoCombinator
-> Compression
-> UseIndex
-> RemoteRepos
-> SetScriptsExecutable
-> UMask
-> Bool
-> NetworkOptions
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
pullOpts = forall {a}.
OptSpec
DarcsOptDescr
DarcsFlag
a
([MatchFlag]
-> Reorder
-> Maybe Bool
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> DryRun
-> XmlOutput
-> WithSummary
-> SelectDeps
-> Maybe String
-> Bool
-> DiffAlgorithm
-> a)
pullBasicOpts 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
(RepoCombinator
-> Compression
-> UseIndex
-> RemoteRepos
-> SetScriptsExecutable
-> UMask
-> Bool
-> NetworkOptions
-> a)
pullAdvancedOpts
pullDescription :: String
pullDescription =
String
"Copy and apply patches from another repository,\
\ suspending any local patches that conflict."
stdindefault :: a -> [String] -> IO [String]
stdindefault :: forall a. a -> [String] -> IO [String]
stdindefault a
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return [String
"-"]
stdindefault a
_ [String]
x = forall (m :: * -> *) a. Monad m => a -> m a
return [String]
x
apply :: DarcsCommand
apply :: DarcsCommand
apply = DarcsCommand
{ commandProgramName :: String
commandProgramName = String
"darcs"
, commandName :: String
commandName = String
"apply"
, commandHelp :: Doc
commandHelp = String -> Doc
text String
applyDescription
, commandDescription :: String
commandDescription = String
applyDescription
, commandExtraArgs :: Int
commandExtraArgs = Int
1
, commandExtraArgHelp :: [String]
commandExtraArgHelp = [String
"<PATCHFILE>"]
, commandCommand :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
commandCommand = forall pa.
PatchApplier pa =>
pa
-> (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
applyCmd RebasePatchApplier
RebasePatchApplier
, 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 = forall a b. a -> b -> a
const forall a. a -> [String] -> IO [String]
stdindefault
, commandAdvancedOptions :: [DarcsOptDescr DarcsFlag]
commandAdvancedOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc forall {a}.
OptSpec
DarcsOptDescr
DarcsFlag
a
(UseIndex
-> Compression
-> SetScriptsExecutable
-> UMask
-> Bool
-> WantGuiPause
-> a)
applyAdvancedOpts
, commandBasicOptions :: [DarcsOptDescr DarcsFlag]
commandBasicOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc forall {a}.
OptSpec
DarcsOptDescr
DarcsFlag
a
(Verify
-> Reorder
-> Maybe Bool
-> DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe String
-> DiffAlgorithm
-> a)
applyBasicOpts
, commandDefaults :: [DarcsFlag]
commandDefaults = forall (d :: * -> *) f b. OptSpec d f [f] b -> [f]
defaultFlags forall {a}.
DarcsOption
a
(Verify
-> Reorder
-> Maybe Bool
-> DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe String
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Verbosity
-> UseIndex
-> Compression
-> SetScriptsExecutable
-> UMask
-> Bool
-> WantGuiPause
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
applyOpts
, commandCheckOptions :: [DarcsFlag] -> [String]
commandCheckOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [f] -> [String]
ocheck forall {a}.
DarcsOption
a
(Verify
-> Reorder
-> Maybe Bool
-> DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe String
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Verbosity
-> UseIndex
-> Compression
-> SetScriptsExecutable
-> UMask
-> Bool
-> WantGuiPause
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
applyOpts
}
where
applyBasicOpts :: OptSpec
DarcsOptDescr
DarcsFlag
a
(Verify
-> Reorder
-> Maybe Bool
-> DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe String
-> DiffAlgorithm
-> a)
applyBasicOpts
= PrimDarcsOption Verify
O.verify
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption Reorder
O.reorder
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
^ forall a. DarcsOption a (DryRun -> XmlOutput -> a)
O.dryRunXml
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ MatchOption
O.matchSeveral
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 DiffAlgorithm
O.diffAlgorithm
applyAdvancedOpts :: OptSpec
DarcsOptDescr
DarcsFlag
a
(UseIndex
-> Compression
-> SetScriptsExecutable
-> UMask
-> Bool
-> WantGuiPause
-> a)
applyAdvancedOpts
= 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 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 SetScriptsExecutable
O.setScriptsExecutable
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 Bool
O.changesReverse
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption WantGuiPause
O.pauseForGui
applyOpts :: DarcsOption
a
(Verify
-> Reorder
-> Maybe Bool
-> DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe String
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Verbosity
-> UseIndex
-> Compression
-> SetScriptsExecutable
-> UMask
-> Bool
-> WantGuiPause
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
applyOpts = forall {a}.
OptSpec
DarcsOptDescr
DarcsFlag
a
(Verify
-> Reorder
-> Maybe Bool
-> DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe String
-> DiffAlgorithm
-> a)
applyBasicOpts 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
(UseIndex
-> Compression
-> SetScriptsExecutable
-> UMask
-> Bool
-> WantGuiPause
-> a)
applyAdvancedOpts
applyDescription :: String
applyDescription =
String
"Apply a patch bundle, suspending any local patches that conflict."
data RebasePatchApplier = RebasePatchApplier
instance PatchApplier RebasePatchApplier where
type ApplierRepoTypeConstraint RebasePatchApplier rt = rt ~ 'RepoType 'IsRebase
repoJob :: RebasePatchApplier
-> (forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
(IsRepoType rt, ApplierRepoTypeConstraint RebasePatchApplier rt,
RepoPatch p, ApplyState p ~ Tree) =>
PatchProxy p -> Repository rt p wR wU wR -> IO ())
-> RepoJob ()
repoJob RebasePatchApplier
RebasePatchApplier forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
(IsRepoType rt, ApplierRepoTypeConstraint RebasePatchApplier rt,
RepoPatch p, ApplyState p ~ Tree) =>
PatchProxy p -> Repository rt p wR wU wR -> IO ()
f = forall a.
(forall (p :: * -> * -> *) wR wU.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository ('RepoType 'IsRebase) p wR wU wR -> IO a)
-> RepoJob a
StartRebaseJob (forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
(IsRepoType rt, ApplierRepoTypeConstraint RebasePatchApplier rt,
RepoPatch p, ApplyState p ~ Tree) =>
PatchProxy p -> Repository rt p wR wU wR -> IO ()
f forall (p :: * -> * -> *). PatchProxy p
PatchProxy)
applyPatches :: forall (rt :: RepoType) (p :: * -> * -> *) wR wU wZ.
(ApplierRepoTypeConstraint RebasePatchApplier rt, IsRepoType rt,
RepoPatch p, ApplyState p ~ Tree) =>
RebasePatchApplier
-> PatchProxy p
-> String
-> [DarcsFlag]
-> Repository rt p wR wU wR
-> Fork
(PatchSet rt p)
(FL (PatchInfoAnd rt p))
(FL (PatchInfoAnd rt p))
Origin
wR
wZ
-> IO ()
applyPatches RebasePatchApplier
RebasePatchApplier PatchProxy p
PatchProxy = forall (p :: * -> * -> *) wR wU wZ.
(RepoPatch p, ApplyState p ~ Tree) =>
String
-> [DarcsFlag]
-> Repository ('RepoType 'IsRebase) p wR wU wR
-> Fork
(PatchSet ('RepoType 'IsRebase) p)
(FL (PatchInfoAnd ('RepoType 'IsRebase) p))
(FL (PatchInfoAnd ('RepoType 'IsRebase) p))
Origin
wR
wZ
-> IO ()
applyPatchesForRebaseCmd
applyPatchesForRebaseCmd
:: forall p wR wU wZ
. ( RepoPatch p, ApplyState p ~ Tree )
=> String
-> [DarcsFlag]
-> Repository ('RepoType 'IsRebase) p wR wU wR
-> Fork (PatchSet ('RepoType 'IsRebase) p)
(FL (PatchInfoAnd ('RepoType 'IsRebase) p))
(FL (PatchInfoAnd ('RepoType 'IsRebase) p)) Origin wR wZ
-> IO ()
applyPatchesForRebaseCmd :: forall (p :: * -> * -> *) wR wU wZ.
(RepoPatch p, ApplyState p ~ Tree) =>
String
-> [DarcsFlag]
-> Repository ('RepoType 'IsRebase) p wR wU wR
-> Fork
(PatchSet ('RepoType 'IsRebase) p)
(FL (PatchInfoAnd ('RepoType 'IsRebase) p))
(FL (PatchInfoAnd ('RepoType 'IsRebase) p))
Origin
wR
wZ
-> IO ()
applyPatchesForRebaseCmd String
cmdName [DarcsFlag]
opts Repository ('RepoType 'IsRebase) p wR wU wR
_repository (Fork PatchSet ('RepoType 'IsRebase) p Origin wU
common FL (PatchInfoAnd ('RepoType 'IsRebase) p) wU wR
us' FL (PatchInfoAnd ('RepoType 'IsRebase) p) wU wZ
to_be_applied) = do
forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
(RepoPatch p, ApplyState p ~ Tree) =>
String -> [DarcsFlag] -> FL (PatchInfoAnd rt p) wX wY -> IO ()
applyPatchesStart String
cmdName [DarcsFlag]
opts FL (PatchInfoAnd ('RepoType 'IsRebase) p) wU wZ
to_be_applied
FL (PatchInfoAnd ('RepoType 'IsRebase) p) wU wZ
usOk :> FL (PatchInfoAnd ('RepoType 'IsRebase) p) wZ wR
usConflicted <- forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) wX wY wZ.
(Commute p, CleanMerge p) =>
FL p wX wY -> FL p wX wZ -> (:>) (FL p) (FL p) wX wY
partitionConflictingFL FL (PatchInfoAnd ('RepoType 'IsRebase) p) wU wR
us' FL (PatchInfoAnd ('RepoType 'IsRebase) p) wU wZ
to_be_applied
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Int
lengthFL FL (PatchInfoAnd ('RepoType 'IsRebase) p) wZ wR
usConflicted forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$
[DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
opts forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"The following local patches are in conflict:"
let selection_config :: SelectionConfig (PatchInfoAnd ('RepoType 'IsRebase) p)
selection_config = forall (p :: * -> * -> *).
Matchable p =>
WhichChanges
-> String
-> PatchSelectionOptions
-> Maybe (Splitter p)
-> Maybe [AnchoredPath]
-> SelectionConfig p
selectionConfig WhichChanges
LastReversed String
"suspend" PatchSelectionOptions
applyPatchSelOpts forall a. Maybe a
Nothing forall a. Maybe a
Nothing
(FL (PatchInfoAnd ('RepoType 'IsRebase) p) wZ wZ
usKeep :> FL (PatchInfoAnd ('RepoType 'IsRebase) p) wZ wR
usToSuspend) <- forall (p :: * -> * -> *) wX wY.
(MatchableRP p, ShowPatch p, ShowContextPatch p,
ApplyState p ~ Tree, ApplyState p ~ ApplyState (PrimOf p)) =>
FL p wX wY -> SelectionConfig p -> IO ((:>) (FL p) (FL p) wX wY)
runSelection FL (PatchInfoAnd ('RepoType 'IsRebase) p) wZ wR
usConflicted SelectionConfig (PatchInfoAnd ('RepoType 'IsRebase) p)
selection_config
forall (m :: * -> *) a.
Monad m =>
HijackOptions -> HijackT m a -> m a
runHijackT HijackOptions
RequestHijackPermission
forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> Bool -> Maybe String -> PatchInfo -> HijackT IO String
getAuthor String
"suspend" Bool
False forall a. Maybe a
Nothing)
forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> PatchInfo
info FL (PatchInfoAnd ('RepoType 'IsRebase) p) wZ wR
usToSuspend
Suspended p wR wR
suspended <- forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
RepoPatch p =>
Repository rt p wR wU wT -> IO (Suspended p wT wT)
readTentativeRebase Repository ('RepoType 'IsRebase) p wR wU wR
_repository
Repository ('RepoType 'IsRebase) p wR wU wZ
_repository <- forall (p :: * -> * -> *) wR wU wX.
(RepoPatch p, ApplyState p ~ Tree) =>
[DarcsFlag]
-> Repository ('RepoType 'IsRebase) p wR wU wR
-> Suspended p wR wR
-> FL (PatchInfoAnd ('RepoType 'IsRebase) p) wX wR
-> IO (Repository ('RepoType 'IsRebase) p wR wU wX)
doSuspend [DarcsFlag]
opts Repository ('RepoType 'IsRebase) p wR wU wR
_repository Suspended p wR wR
suspended FL (PatchInfoAnd ('RepoType 'IsRebase) p) wZ wR
usToSuspend
Repository ('RepoType 'IsRebase) p wZ wU wZ
_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 ('RepoType 'IsRebase) p wR wU wZ
_repository UpdatePending
YesUpdatePending (PrimDarcsOption Compression
compress forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
Repository ('RepoType 'IsRebase) p wZ wU wZ
_repository <- forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
RepoPatch p =>
Repository rt p wR wU wT
-> UpdatePending -> IO (Repository rt p wR wU wR)
revertRepositoryChanges Repository ('RepoType 'IsRebase) p wZ wU wZ
_repository UpdatePending
YesUpdatePending
Sealed FL (PrimOf p) wU wX
pw <-
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wY.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wR
-> String
-> AllowConflicts
-> ExternalMerge
-> WantGuiPause
-> Compression
-> Verbosity
-> Reorder
-> (UseIndex, ScanKnown, DiffAlgorithm)
-> Fork
(PatchSet rt p)
(FL (PatchInfoAnd rt p))
(FL (PatchInfoAnd rt p))
Origin
wR
wY
-> IO (Sealed (FL (PrimOf p) wU))
tentativelyMergePatches
Repository ('RepoType 'IsRebase) p wZ wU wZ
_repository String
cmdName
([DarcsFlag] -> AllowConflicts
allowConflicts [DarcsFlag]
opts)
(PrimDarcsOption ExternalMerge
externalMerge forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
([DarcsFlag] -> WantGuiPause
wantGuiPause [DarcsFlag]
opts) (PrimDarcsOption Compression
compress forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (PrimDarcsOption Verbosity
verbosity forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
(PrimDarcsOption Reorder
reorder forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) ([DarcsFlag] -> (UseIndex, ScanKnown, DiffAlgorithm)
diffingOpts [DarcsFlag]
opts)
(forall (common :: * -> * -> *) (left :: * -> * -> *)
(right :: * -> * -> *) wA wX wY wU.
common wA wU
-> left wU wX -> right wU wY -> Fork common left right wA wX wY
Fork PatchSet ('RepoType 'IsRebase) p Origin wU
common (FL (PatchInfoAnd ('RepoType 'IsRebase) p) wU wZ
usOk forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ FL (PatchInfoAnd ('RepoType 'IsRebase) p) wZ wZ
usKeep) FL (PatchInfoAnd ('RepoType 'IsRebase) p) wU wZ
to_be_applied)
forall t. t -> IO ()
invalidateIndex Repository ('RepoType 'IsRebase) p wZ wU wZ
_repository
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wY.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
String
-> [DarcsFlag]
-> Repository rt p wR wU wR
-> FL (PrimOf p) wU wY
-> Bool
-> IO ()
applyPatchesFinish String
cmdName [DarcsFlag]
opts Repository ('RepoType 'IsRebase) p wZ wU wZ
_repository FL (PrimOf p) wU wX
pw (forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Bool
nullFL FL (PatchInfoAnd ('RepoType 'IsRebase) p) wU wZ
to_be_applied)
applyPatchSelOpts :: S.PatchSelectionOptions
applyPatchSelOpts :: PatchSelectionOptions
applyPatchSelOpts = S.PatchSelectionOptions
{ verbosity :: Verbosity
S.verbosity = Verbosity
O.NormalVerbosity
, matchFlags :: [MatchFlag]
S.matchFlags = []
, interactive :: Bool
S.interactive = Bool
True
, selectDeps :: SelectDeps
S.selectDeps = SelectDeps
O.PromptDeps
, withSummary :: WithSummary
S.withSummary = WithSummary
O.NoSummary
, withContext :: WithContext
S.withContext = WithContext
O.NoContext
}
obliteratePatchSelOpts :: [DarcsFlag] -> S.PatchSelectionOptions
obliteratePatchSelOpts :: [DarcsFlag] -> PatchSelectionOptions
obliteratePatchSelOpts [DarcsFlag]
opts = (Bool -> [DarcsFlag] -> PatchSelectionOptions
patchSelOpts Bool
True [DarcsFlag]
opts)
{ selectDeps :: SelectDeps
S.selectDeps = SelectDeps
O.NoDeps
}
patchSelOpts :: Bool -> [DarcsFlag] -> S.PatchSelectionOptions
patchSelOpts :: Bool -> [DarcsFlag] -> PatchSelectionOptions
patchSelOpts Bool
defInteractive [DarcsFlag]
flags = S.PatchSelectionOptions
{ verbosity :: Verbosity
S.verbosity = PrimDarcsOption Verbosity
verbosity forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
flags
, matchFlags :: [MatchFlag]
S.matchFlags = MatchOption
O.matchSeveralOrLast forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
flags
, interactive :: Bool
S.interactive = Bool -> [DarcsFlag] -> Bool
isInteractive Bool
defInteractive [DarcsFlag]
flags
, selectDeps :: SelectDeps
S.selectDeps = PrimDarcsOption SelectDeps
selectDeps forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
flags
, withSummary :: WithSummary
S.withSummary = PrimDarcsOption WithSummary
O.withSummary forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
flags
, withContext :: WithContext
S.withContext = WithContext
O.NoContext
}
log :: DarcsCommand
log :: DarcsCommand
log = DarcsCommand
{ commandProgramName :: String
commandProgramName = String
"darcs"
, commandName :: String
commandName = String
"log"
, commandHelp :: Doc
commandHelp = String -> Doc
text String
logDescription
, commandDescription :: String
commandDescription = String
logDescription
, commandPrereq :: [DarcsFlag] -> IO (Either String ())
commandPrereq = [DarcsFlag] -> IO (Either String ())
amInHashedRepository
, commandExtraArgs :: Int
commandExtraArgs = Int
0
, commandExtraArgHelp :: [String]
commandExtraArgHelp = []
, commandCommand :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
commandCommand = (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
logCmd
, commandCompleteArgs :: (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
commandCompleteArgs = (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
noArgs
, 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 {d :: * -> *} {f} {a}. OptSpec d f a a
logAdvancedOpts
, commandBasicOptions :: [DarcsOptDescr DarcsFlag]
commandBasicOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc forall {a}.
OptSpec DarcsOptDescr DarcsFlag a (WithSummary -> Maybe Bool -> a)
logBasicOpts
, commandDefaults :: [DarcsFlag]
commandDefaults = forall (d :: * -> *) f b. OptSpec d f [f] b -> [f]
defaultFlags forall {a}.
DarcsOption
a
(WithSummary
-> Maybe Bool
-> Maybe StdCmdAction
-> Verbosity
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
logOpts
, commandCheckOptions :: [DarcsFlag] -> [String]
commandCheckOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [f] -> [String]
ocheck forall {a}.
DarcsOption
a
(WithSummary
-> Maybe Bool
-> Maybe StdCmdAction
-> Verbosity
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
logOpts
}
where
logBasicOpts :: OptSpec DarcsOptDescr DarcsFlag a (WithSummary -> Maybe Bool -> a)
logBasicOpts = PrimDarcsOption WithSummary
O.withSummary 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
logAdvancedOpts :: OptSpec d f a a
logAdvancedOpts = forall {d :: * -> *} {f} {a}. OptSpec d f a a
oid
logOpts :: DarcsOption
a
(WithSummary
-> Maybe Bool
-> Maybe StdCmdAction
-> Verbosity
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
logOpts = forall {a}.
OptSpec DarcsOptDescr DarcsFlag a (WithSummary -> Maybe Bool -> a)
logBasicOpts forall b c a.
DarcsOption (Maybe StdCmdAction -> Verbosity -> b) c
-> DarcsOption
(UseCache -> HooksConfig -> Bool -> Bool -> Bool -> a) b
-> DarcsOption a c
`withStdOpts` forall {d :: * -> *} {f} {a}. OptSpec d f a a
logAdvancedOpts
logDescription :: String
logDescription = String
"List the currently suspended changes."
logCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
logCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
logCmd (AbsolutePath, AbsolutePath)
_ [DarcsFlag]
opts [String]
_files =
forall a. UseCache -> RepoJob a -> IO a
withRepository (PrimDarcsOption UseCache
useCache forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) forall a b. (a -> b) -> a -> b
$
forall a.
(forall (p :: * -> * -> *) wR wU.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository ('RepoType 'IsRebase) p wR wU wR -> IO a)
-> RepoJob a
RebaseJob forall a b. (a -> b) -> a -> b
$ \Repository ('RepoType 'IsRebase) p wR wU wR
_repository -> do
Items FL (RebaseChange (PrimOf p)) wR wY
ps <- forall (p :: * -> * -> *) (rt :: RepoType) wR wU.
RepoPatch p =>
Repository rt p wR wU wR -> IO (Suspended p wR wR)
readRebase Repository ('RepoType 'IsRebase) p wR wU wR
_repository
let psToShow :: FL
(PatchInfoAndG ('RepoType 'IsRebase) (RebaseChange (PrimOf p)))
wR
wY
psToShow = forall (prim :: * -> * -> *) wX wY.
FL (RebaseChange prim) wX wY
-> FL
(PatchInfoAndG ('RepoType 'IsRebase) (RebaseChange prim)) wX wY
toRebaseChanges FL (RebaseChange (PrimOf p)) wR wY
ps
if Bool -> [DarcsFlag] -> Bool
isInteractive Bool
False [DarcsFlag]
opts
then forall (p :: * -> * -> *).
(ShowPatch p, ShowContextPatch p, ApplyState p ~ Tree) =>
PatchSelectionOptions -> [Sealed2 p] -> IO ()
viewChanges (Bool -> [DarcsFlag] -> PatchSelectionOptions
patchSelOpts Bool
False [DarcsFlag]
opts) (forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL forall (a :: * -> * -> *) wX wY. a wX wY -> Sealed2 a
Sealed2 FL
(PatchInfoAndG ('RepoType 'IsRebase) (RebaseChange (PrimOf p)))
wR
wY
psToShow)
else do
String -> IO ()
debugMessage String
"About to print the changes..."
let printers :: Printers
printers = if [DarcsFlag] -> Bool
hasXmlOutput [DarcsFlag]
opts then Printers
simplePrinters else Printers
fancyPrinters
let logDoc :: Doc
logDoc = forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
(ShowPatch p, PatchListFormat p, Summary p, HasDeps p,
PrimDetails (PrimOf p)) =>
[DarcsFlag]
-> RL (PatchInfoAndG rt p) wStart wX
-> LogInfo (PatchInfoAndG rt p)
-> Doc
changelog [DarcsFlag]
opts (forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> RL a wX wZ
reverseFL FL
(PatchInfoAndG ('RepoType 'IsRebase) (RebaseChange (PrimOf p)))
wR
wY
psToShow) (forall (p :: * -> * -> *) wX wY. FL p wX wY -> LogInfo p
logInfoFL FL
(PatchInfoAndG ('RepoType 'IsRebase) (RebaseChange (PrimOf p)))
wR
wY
psToShow)
Printers -> Doc -> IO ()
viewDocWith Printers
printers Doc
logDoc
changes :: DarcsCommand
changes :: DarcsCommand
changes = String -> Maybe DarcsCommand -> DarcsCommand -> DarcsCommand
commandAlias String
"changes" forall a. Maybe a
Nothing DarcsCommand
log
upgrade :: DarcsCommand
upgrade :: DarcsCommand
upgrade = DarcsCommand
{ commandProgramName :: String
commandProgramName = String
"darcs"
, commandName :: String
commandName = String
"upgrade"
, commandHelp :: Doc
commandHelp = Doc
help
, commandDescription :: String
commandDescription = String
desc
, commandPrereq :: [DarcsFlag] -> IO (Either String ())
commandPrereq = [DarcsFlag] -> IO (Either String ())
amInHashedRepository
, commandExtraArgs :: Int
commandExtraArgs = Int
0
, commandExtraArgHelp :: [String]
commandExtraArgHelp = []
, commandCommand :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
commandCommand = (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
upgradeCmd
, commandCompleteArgs :: (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
commandCompleteArgs = (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
noArgs
, commandArgdefaults :: [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
commandArgdefaults = [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
nodefaults
, commandAdvancedOptions :: [DarcsOptDescr DarcsFlag]
commandAdvancedOptions = []
, commandBasicOptions :: [DarcsOptDescr DarcsFlag]
commandBasicOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc forall {d :: * -> *} {f} {a}. OptSpec d f a a
basicOpts
, commandDefaults :: [DarcsFlag]
commandDefaults = forall (d :: * -> *) f b. OptSpec d f [f] b -> [f]
defaultFlags forall {a}.
DarcsOption
a
(Maybe StdCmdAction
-> Verbosity
-> UMask
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
opts
, commandCheckOptions :: [DarcsFlag] -> [String]
commandCheckOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [f] -> [String]
ocheck forall {a}.
DarcsOption
a
(Maybe StdCmdAction
-> Verbosity
-> UMask
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
opts
}
where
basicOpts :: OptSpec d f a a
basicOpts = forall {d :: * -> *} {f} {a}. OptSpec d f a a
oid
opts :: DarcsOption
a
(Maybe StdCmdAction
-> Verbosity
-> UMask
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
opts = forall {d :: * -> *} {f} {a}. OptSpec d f a a
basicOpts forall b c a.
DarcsOption (Maybe StdCmdAction -> Verbosity -> b) c
-> DarcsOption
(UseCache -> HooksConfig -> Bool -> Bool -> Bool -> a) b
-> DarcsOption a c
`withStdOpts` PrimDarcsOption UMask
O.umask
desc :: String
desc = String
"Upgrade a repo with an old-style rebase in progress."
help :: Doc
help = String -> Doc
text String
desc Doc -> Doc -> Doc
$+$ [String] -> Doc
formatWords
[ String
"Doing this means you won't be able to use darcs version < 2.15"
, String
"with this repository until the rebase is finished."
]
upgradeCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
upgradeCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
upgradeCmd (AbsolutePath, AbsolutePath)
_ [DarcsFlag]
opts [String]
_args =
forall a.
DryRun -> UseCache -> UpdatePending -> UMask -> RepoJob a -> IO a
withRepoLock (PrimDarcsOption DryRun
dryRun forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (PrimDarcsOption UseCache
useCache forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) UpdatePending
YesUpdatePending (PrimDarcsOption UMask
umask forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) forall a b. (a -> b) -> a -> b
$
forall a.
(forall (p :: * -> * -> *) wR wU.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository ('RepoType 'IsRebase) p wR wU wR -> IO a)
-> RepoJob a
OldRebaseJob forall a b. (a -> b) -> a -> b
$ \(Repository ('RepoType 'IsRebase) p wR wU wR
_repo :: Repository ('RepoType 'IsRebase) p wR wU wR) ->
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT -> Compression -> IO ()
upgradeOldStyleRebase Repository ('RepoType 'IsRebase) p wR wU wR
_repo (PrimDarcsOption Compression
compress forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)