--  Copyright (C) 2009 Ganesh Sittampalam
--
--  BSD3

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
    -- test all patches for hijacking and abort if rejected
    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 -- skip conflicts
              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 -- i.e. don't mark them
                    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
    -- TODO should catch logfiles (fst value from updatePatchHeader) and clean them up as in AmendRecord
    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
    -- we can just let hijack attempts through here because we already asked about them on suspend time
    (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
                      -- It might make sense to only print out this message once, but we might find
                      -- that the dropped dependencies are interspersed with other output,
                      -- e.g. if running with --ask-deps
                      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"

              -- TODO should catch logfiles (fst value from updatePatchHeader)
              -- and clean them up as in AmendRecord
              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'
              -- create a rename that undoes the change we just made, so the contexts match up
              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))
              -- push it through the remaining patches to fix them up
              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))
              -- assert that the rename still has a null effect on the context after commuting
              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
              -- return the renames so that the suspended patch can be fixed up
              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

    -- TODO this selection doesn't need to respect dependencies
    -- TODO we only want to select one patch: generalise withSelectedPatchFromList
    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

    -- Don't bother to update patch header since unsuspend will do that later
    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

    -- TODO this selection doesn't need to respect dependencies
    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
.
          -- since Named doesn't have any witness context for the
          -- patch names, the AddName here will be inferred to be wX wX
          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:"

    -- TODO: we assume the options apply only to the main
    -- command, review if there are any we should keep
    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

    -- test all patches for hijacking and abort if rejected
    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
    -- the new rebase patch containing the suspended patches is now in the repo
    -- and the suspended patches have been removed

    -- TODO This is a nasty hack, caused by the fact that most functions
    -- in Darcs.Repository.State require the recorded state to be equal to the
    -- tentative state and thus must not be called after the repo was changed.
    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)

-- TODO I doubt this is right, e.g. withContext should be inherited
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 -- option not supported, use default
    , 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 -- False
    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 is an alias for log
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)

{-
TODO:

 - amend-record shows the diff between the conflicted state and the
   resolution, which is unhelpful
 - make aggregate commands
 - argument handling
 - what should happen to patch comment on unsuspend?
 - warn about suspending conflicts
 - indication of expected conflicts on unsuspend
    - why isn't ! when you do x accurate?
 - rebase pull needs more UI work
    - automatically answer yes re suspension
    - offer all patches (so they can be kept in order)
       - or perhaps rebase suspend --complement?
 - make unsuspend actually display the patch helpfully like normal selection
 - amended patches will often be in both the target repo and in the rebase context, detect?
 - can we be more intelligent about conflict resolutions?
 - --all option to unsuspend
 - review other conflict options for unsuspend
 - warning message on suspend about not being able to unsuspend with unrecorded changes
 - aborting during a rebase pull or rebase suspend causes it to leave the repo marked for rebase
 - patch count: get English right in <n> suspended patch(es)
 - darcs check should check integrity of rebase patch
 - review existence of reify and inject commands - bit of an internals hack
-}