--  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
    , 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 ( Pref(Repos), fileArgs, prefArgs, noArgs )
import Darcs.UI.Flags
    ( DarcsFlag
    , allowConflicts
    , diffingOpts
    , reorder, verbosity
    , useCache, wantGuiPause
    , umask, changesReverse
    , diffAlgorithm, isInteractive
    , selectDeps, hasXmlOutput
    )
import qualified Darcs.UI.Flags as Flags ( getAuthor )
import Darcs.UI.Options ( oid, (?), (^) )
import qualified Darcs.UI.Options.All as O
import Darcs.UI.PatchHeader
    ( AskAboutDeps(..)
    , HijackOptions(..)
    , HijackT
    , editLog
    , getAuthor
    , patchHeaderConfig
    , runHijackT
    , updatePatchHeader
    )
import Darcs.Repository
    ( Repository, RepoJob(..), AccessType(..), withRepoLock, withRepository
    , tentativelyAddPatches, finalizeRepositoryChanges
    , tentativelyRemovePatches, readPatches
    , setTentativePending, unrecordedChanges, applyToWorking
    )
import Darcs.Repository.Flags
    ( AllowConflicts(..)
    , ResolveConflicts(..)
    , UpdatePending(..)
    )
import Darcs.Repository.Merge ( tentativelyMergePatches )
import Darcs.Repository.Rebase
    ( checkHasRebase
    , readRebase
    , readTentativeRebase
    , writeTentativeRebase
    )
import Darcs.Repository.Resolution
    ( StandardResolution(..)
    , rebaseResolution
    , announceConflicts
    )
import Darcs.Repository.State ( updateIndex )
import Darcs.Repository.Transaction ( upgradeOldStyleRebase )

import Darcs.Patch ( PrimOf, invert, effect, commute, RepoPatch )
import Darcs.Patch.Apply ( ApplyState )
import Darcs.Patch.CommuteFn ( commuterFLId, commuterIdFL )
import Darcs.Patch.Info ( displayPatchInfo, piName )
import Darcs.Patch.Match ( secondMatch, splitSecondFL )
import Darcs.Patch.Merge ( cleanMerge )
import Darcs.Patch.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
    , simplifyPush, simplifyPushes
    )
import Darcs.Patch.Rebase.Fixup
    ( RebaseFixup(..)
    , commuteNamedFixup
    , flToNamesPrims
    )
import Darcs.Patch.Rebase.Name ( RebaseName(..), commuteNameNamed )
import Darcs.Patch.Rebase.Suspended ( Suspended(..), addToEditsToSuspended )
import qualified Darcs.Patch.Rebase.Suspended as S ( simplifyPush )
import Darcs.Patch.Permutations ( genCommuteWhatWeCanFL, partitionConflictingFL )
import Darcs.Patch.Progress ( progressRL )
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.PrintPatch
    ( printContent
    , printContentWithPager
    , printFriendly
    , printSummary
    )
import Darcs.UI.Prompt ( PromptChoice(..), PromptConfig(..), runPrompt )
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
    , Sealed2(..)
    )
import Darcs.Patch.Witnesses.Unsafe ( unsafeCoerceP )
import Darcs.Util.English ( englishNum, Noun(Noun) )
import Darcs.Util.Printer
    ( text, redText
    , putDocLnWith, prefix
    , simplePrinters
    , formatWords
    , formatText
    , vcat
    , ($+$), ($$)
    )
import Darcs.Util.Printer.Color ( fancyPrinters )
import Darcs.Util.Progress ( debugMessage )
import Darcs.Util.Prompt ( promptYorn )
import Darcs.Util.Path ( AbsolutePath )

import Darcs.Util.SignalHandler ( withSignalsBlocked )
import Darcs.Util.Tree ( Tree )

import Control.Exception ( throwIO, try )
import Control.Monad ( unless, when, void )
import Control.Monad.Trans ( liftIO )
import System.Exit ( ExitCode(ExitSuccess), 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
normalCommand DarcsCommand
edit
        , 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
    , commandOptions :: CommandOptions
commandOptions = CommandOptions
suspendOpts
    }
  where
    suspendBasicOpts :: OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> WithSummary
   -> DiffAlgorithm
   -> a)
suspendBasicOpts
      = PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  ([MatchFlag]
   -> SelectDeps -> Maybe Bool -> WithSummary -> DiffAlgorithm -> a)
  [NotInRemote]
PrimDarcsOption [NotInRemote]
O.notInRemote
      PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  ([MatchFlag]
   -> SelectDeps -> Maybe Bool -> WithSummary -> DiffAlgorithm -> a)
  [NotInRemote]
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (SelectDeps -> Maybe Bool -> WithSummary -> DiffAlgorithm -> a)
     ([MatchFlag]
      -> SelectDeps -> Maybe Bool -> WithSummary -> DiffAlgorithm -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (SelectDeps -> Maybe Bool -> WithSummary -> DiffAlgorithm -> a)
     ([NotInRemote]
      -> [MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> WithSummary
      -> DiffAlgorithm
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (SelectDeps -> Maybe Bool -> WithSummary -> DiffAlgorithm -> a)
  ([MatchFlag]
   -> SelectDeps -> Maybe Bool -> WithSummary -> DiffAlgorithm -> a)
MatchOption
O.matchSeveralOrLast
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (SelectDeps -> Maybe Bool -> WithSummary -> DiffAlgorithm -> a)
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> WithSummary
   -> DiffAlgorithm
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe Bool -> WithSummary -> DiffAlgorithm -> a)
     (SelectDeps -> Maybe Bool -> WithSummary -> DiffAlgorithm -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe Bool -> WithSummary -> DiffAlgorithm -> a)
     ([NotInRemote]
      -> [MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> WithSummary
      -> DiffAlgorithm
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe Bool -> WithSummary -> DiffAlgorithm -> a)
  (SelectDeps -> Maybe Bool -> WithSummary -> DiffAlgorithm -> a)
PrimDarcsOption SelectDeps
O.selectDeps
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe Bool -> WithSummary -> DiffAlgorithm -> a)
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> WithSummary
   -> DiffAlgorithm
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (WithSummary -> DiffAlgorithm -> a)
     (Maybe Bool -> WithSummary -> DiffAlgorithm -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (WithSummary -> DiffAlgorithm -> a)
     ([NotInRemote]
      -> [MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> WithSummary
      -> DiffAlgorithm
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (WithSummary -> DiffAlgorithm -> a)
  (Maybe Bool -> WithSummary -> DiffAlgorithm -> a)
PrimDarcsOption (Maybe Bool)
O.interactive
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (WithSummary -> DiffAlgorithm -> a)
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> WithSummary
   -> DiffAlgorithm
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (DiffAlgorithm -> a)
     (WithSummary -> DiffAlgorithm -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (DiffAlgorithm -> a)
     ([NotInRemote]
      -> [MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> WithSummary
      -> DiffAlgorithm
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (DiffAlgorithm -> a)
  (WithSummary -> DiffAlgorithm -> a)
PrimDarcsOption WithSummary
O.withSummary
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (DiffAlgorithm -> a)
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> WithSummary
   -> DiffAlgorithm
   -> a)
-> OptSpec DarcsOptDescr DarcsFlag a (DiffAlgorithm -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     a
     ([NotInRemote]
      -> [MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> WithSummary
      -> DiffAlgorithm
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec DarcsOptDescr DarcsFlag a (DiffAlgorithm -> a)
PrimDarcsOption DiffAlgorithm
O.diffAlgorithm
    suspendAdvancedOpts :: OptSpec DarcsOptDescr DarcsFlag a (Bool -> UMask -> a)
suspendAdvancedOpts
      = PrimOptSpec DarcsOptDescr DarcsFlag (UMask -> a) Bool
PrimDarcsOption Bool
O.changesReverse
      PrimOptSpec DarcsOptDescr DarcsFlag (UMask -> a) Bool
-> OptSpec DarcsOptDescr DarcsFlag a (UMask -> a)
-> OptSpec DarcsOptDescr DarcsFlag a (Bool -> UMask -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec DarcsOptDescr DarcsFlag a (UMask -> a)
PrimDarcsOption UMask
O.umask
    suspendOpts :: CommandOptions
suspendOpts = OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Verbosity
   -> Bool
   -> UMask
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> WithSummary
   -> DiffAlgorithm
   -> Maybe StdCmdAction
   -> Verbosity
   -> Bool
   -> UMask
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
forall {a}.
OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> WithSummary
   -> DiffAlgorithm
   -> a)
suspendBasicOpts OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Verbosity
   -> Bool
   -> UMask
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> WithSummary
   -> DiffAlgorithm
   -> Maybe StdCmdAction
   -> Verbosity
   -> Bool
   -> UMask
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
-> DarcsOption
     (UseCache
      -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
     (Bool
      -> UMask
      -> UseCache
      -> UseIndex
      -> HooksConfig
      -> Bool
      -> Bool
      -> [DarcsFlag])
-> CommandOptions
forall b c.
DarcsOption (Maybe StdCmdAction -> Verbosity -> b) c
-> DarcsOption
     (UseCache
      -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
     b
-> CommandOptions
`withStdOpts` DarcsOption
  (UseCache
   -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
  (Bool
   -> UMask
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
forall {a}. OptSpec DarcsOptDescr DarcsFlag a (Bool -> 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 =
  UseCache -> UMask -> RepoJob 'RW () -> IO ()
forall a. UseCache -> UMask -> RepoJob 'RW a -> IO a
withRepoLock (PrimOptSpec DarcsOptDescr DarcsFlag a UseCache
PrimDarcsOption UseCache
useCache PrimDarcsOption UseCache -> [DarcsFlag] -> UseCache
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (PrimOptSpec DarcsOptDescr DarcsFlag a UMask
PrimDarcsOption UMask
umask PrimDarcsOption UMask -> [DarcsFlag] -> UMask
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (RepoJob 'RW () -> IO ()) -> RepoJob 'RW () -> IO ()
forall a b. (a -> b) -> a -> b
$ TreePatchJob 'RW () -> RepoJob 'RW ()
forall (rt :: AccessType) a. TreePatchJob rt a -> RepoJob rt a
RepoJob (TreePatchJob 'RW () -> RepoJob 'RW ())
-> TreePatchJob 'RW () -> RepoJob 'RW ()
forall a b. (a -> b) -> a -> b
$ \Repository 'RW p wU wR
_repository -> do
    Suspended p wR
suspended <- Repository 'RW p wU wR -> IO (Suspended p wR)
forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
RepoPatch p =>
Repository rt p wU wR -> IO (Suspended p wR)
readTentativeRebase Repository 'RW p wU wR
_repository
    (PatchSet p Origin wZ
_ :> FL (PatchInfoAnd p) wZ wR
candidates) <- [DarcsFlag]
-> Repository 'RW p wU wR
-> IO ((:>) (PatchSet p) (FL (PatchInfoAnd p)) Origin wR)
forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
RepoPatch p =>
[DarcsFlag]
-> Repository rt p wU wR
-> IO ((:>) (PatchSet p) (FL (PatchInfoAnd p)) Origin wR)
preselectPatches [DarcsFlag]
opts Repository 'RW p wU wR
_repository
    let direction :: WhichChanges
direction = if PrimOptSpec DarcsOptDescr DarcsFlag a Bool
PrimDarcsOption Bool
changesReverse PrimDarcsOption Bool -> [DarcsFlag] -> Bool
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 p)
selection_config = WhichChanges
-> String
-> PatchSelectionOptions
-> Maybe (Splitter (PatchInfoAnd p))
-> Maybe [AnchoredPath]
-> SelectionConfig (PatchInfoAnd p)
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) Maybe (Splitter (PatchInfoAnd p))
forall a. Maybe a
Nothing Maybe [AnchoredPath]
forall a. Maybe a
Nothing
    (FL (PatchInfoAnd p) wZ wZ
_ :> FL (PatchInfoAnd p) wZ wR
psToSuspend) <-
        FL (PatchInfoAnd p) wZ wR
-> SelectionConfig (PatchInfoAnd p)
-> IO ((:>) (FL (PatchInfoAnd p)) (FL (PatchInfoAnd p)) wZ wR)
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 p) wZ wR
candidates
            SelectionConfig (PatchInfoAnd p)
selection_config
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FL (PatchInfoAnd p) wZ wR -> Bool
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Bool
nullFL FL (PatchInfoAnd p) wZ wR
psToSuspend) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        String -> IO ()
putStrLn String
"No patches selected!"
        IO ()
forall a. IO a
exitSuccess
    -- test all patches for hijacking and abort if rejected
    HijackOptions -> HijackT IO () -> IO ()
forall (m :: * -> *) a.
Monad m =>
HijackOptions -> HijackT m a -> m a
runHijackT HijackOptions
RequestHijackPermission
        (HijackT IO () -> IO ()) -> HijackT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ (PatchInfo -> StateT HijackOptions IO String)
-> [PatchInfo] -> HijackT IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String
-> Bool
-> Maybe String
-> PatchInfo
-> StateT HijackOptions IO String
getAuthor String
"suspend" Bool
False Maybe String
forall a. Maybe a
Nothing)
        ([PatchInfo] -> HijackT IO ()) -> [PatchInfo] -> HijackT IO ()
forall a b. (a -> b) -> a -> b
$ (forall wW wZ. PatchInfoAnd p wW wZ -> PatchInfo)
-> FL (PatchInfoAnd p) wZ wR -> [PatchInfo]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL PatchInfoAndG (Named p) wW wZ -> PatchInfo
forall wW wZ. PatchInfoAnd p wW wZ -> PatchInfo
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> PatchInfo
info FL (PatchInfoAnd p) wZ wR
psToSuspend
    (Repository 'RW p wU wZ
_repository, Sealed FL (PrimOf p) wU wX
toWorking) <-
      String
-> [DarcsFlag]
-> Repository 'RW p wU wR
-> Suspended p wR
-> FL (PatchInfoAnd p) wZ wR
-> IO (Repository 'RW p wU wZ, Sealed (FL (PrimOf p) wU))
forall (p :: * -> * -> *) wU wR wX.
(RepoPatch p, ApplyState p ~ Tree) =>
String
-> [DarcsFlag]
-> Repository 'RW p wU wR
-> Suspended p wR
-> FL (PatchInfoAnd p) wX wR
-> IO (Repository 'RW p wU wX, Sealed (FL (PrimOf p) wU))
doSuspend String
"suspend" [DarcsFlag]
opts Repository 'RW p wU wR
_repository Suspended p wR
suspended FL (PatchInfoAnd p) wZ wR
psToSuspend
    IO () -> IO ()
forall a. IO a -> IO a
withSignalsBlocked (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      IO (Repository 'RO p wU wZ) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Repository 'RO p wU wZ) -> IO ())
-> IO (Repository 'RO p wU wZ) -> IO ()
forall a b. (a -> b) -> a -> b
$ Repository 'RW p wU wZ -> DryRun -> IO (Repository 'RO p wU wZ)
forall (p :: * -> * -> *) wU wR.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository 'RW p wU wR -> DryRun -> IO (Repository 'RO p wU wR)
finalizeRepositoryChanges Repository 'RW p wU wZ
_repository (PrimOptSpec DarcsOptDescr DarcsFlag a DryRun
PrimDarcsOption DryRun
O.dryRun PrimDarcsOption DryRun -> [DarcsFlag] -> DryRun
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (DryRun -> Bool
forall a. YesNo a => a -> Bool
O.yes (PrimOptSpec DarcsOptDescr DarcsFlag a DryRun
PrimDarcsOption DryRun
O.dryRun PrimDarcsOption DryRun -> [DarcsFlag] -> DryRun
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        IO (Repository 'RW p wX wZ) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Repository 'RW p wX wZ) -> IO ())
-> IO (Repository 'RW p wX wZ) -> IO ()
forall a b. (a -> b) -> a -> b
$ Repository 'RW p wU wZ
-> Verbosity -> FL (PrimOf p) wU wX -> IO (Repository 'RW p wX wZ)
forall (p :: * -> * -> *) (rt :: AccessType) wU wR wY.
(ApplyState p ~ Tree, RepoPatch p) =>
Repository rt p wU wR
-> Verbosity -> FL (PrimOf p) wU wY -> IO (Repository rt p wY wR)
applyToWorking Repository 'RW p wU wZ
_repository (PrimOptSpec DarcsOptDescr DarcsFlag a Verbosity
PrimDarcsOption Verbosity
verbosity PrimDarcsOption Verbosity -> [DarcsFlag] -> Verbosity
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) FL (PrimOf p) wU wX
toWorking

doSuspend
    :: (RepoPatch p, ApplyState p ~ Tree)
    => String
    -> [DarcsFlag]
    -> Repository 'RW p wU wR
    -> Suspended p wR
    -> FL (PatchInfoAnd p) wX wR
    -> IO (Repository 'RW p wU wX, Sealed (FL (PrimOf p) wU))
doSuspend :: forall (p :: * -> * -> *) wU wR wX.
(RepoPatch p, ApplyState p ~ Tree) =>
String
-> [DarcsFlag]
-> Repository 'RW p wU wR
-> Suspended p wR
-> FL (PatchInfoAnd p) wX wR
-> IO (Repository 'RW p wU wX, Sealed (FL (PrimOf p) wU))
doSuspend String
cmdname [DarcsFlag]
opts Repository 'RW p wU wR
_repository Suspended p wR
suspended FL (PatchInfoAnd p) wX wR
to_suspend = do
  FL (PrimOf p) wR wU
unrecorded <- DiffOpts
-> Repository 'RW p wU wR
-> Maybe [AnchoredPath]
-> IO (FL (PrimOf p) wR wU)
forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
(RepoPatch p, ApplyState p ~ Tree) =>
DiffOpts
-> Repository rt p wU wR
-> Maybe [AnchoredPath]
-> IO (FL (PrimOf p) wR wU)
unrecordedChanges ([DarcsFlag] -> DiffOpts
diffingOpts [DarcsFlag]
opts) Repository 'RW p wU wR
_repository Maybe [AnchoredPath]
forall a. Maybe a
Nothing
  case CommuteFn (FL (PrimOf p)) (PrimOf p)
-> (:>) (FL (PrimOf p)) (FL (PrimOf p)) wX wU
-> (:>) (FL (PrimOf p)) (FL (PrimOf p) :> FL (PrimOf p)) wX wU
forall (q :: * -> * -> *) (p :: * -> * -> *) wX wY.
Commute q =>
CommuteFn p q
-> (:>) p (FL q) wX wY -> (:>) (FL q) (p :> FL q) wX wY
genCommuteWhatWeCanFL (CommuteFn (PrimOf p) (PrimOf p)
-> CommuteFn (FL (PrimOf p)) (PrimOf p)
forall (p1 :: * -> * -> *) (p2 :: * -> * -> *).
CommuteFn p1 p2 -> CommuteFn (FL p1) p2
commuterFLId (:>) (PrimOf p) (PrimOf p) wX wY
-> Maybe ((:>) (PrimOf p) (PrimOf p) wX wY)
CommuteFn (PrimOf p) (PrimOf p)
forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
commute) (FL (PatchInfoAnd p) wX wR
-> FL (PrimOf (FL (PatchInfoAnd p))) wX wR
forall wX wY.
FL (PatchInfoAnd p) wX wY
-> FL (PrimOf (FL (PatchInfoAnd p))) wX wY
forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect FL (PatchInfoAnd p) wX wR
to_suspend FL (PrimOf p) wX wR
-> FL (PrimOf p) wR wU
-> (:>) (FL (PrimOf p)) (FL (PrimOf p)) wX wU
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (PrimOf p) wR wU
unrecorded) of
    FL (PrimOf p) wX wZ
unrecorded' :> FL (PrimOf p) wZ wZ
to_suspend_after_unrecorded :> FL (PrimOf p) wZ wU
to_revert -> do
      FL (PrimOf p) wZ wU
effect_to_suspend <-
        case FL (PrimOf p) wZ wU
to_revert of
          FL (PrimOf p) wZ wU
NilFL -> FL (PrimOf p) wZ wU -> IO (FL (PrimOf p) wZ wU)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FL (PrimOf p) wZ wU
FL (PrimOf p) wZ wZ
to_suspend_after_unrecorded
          FL (PrimOf p) wZ wU
_ ->
            if Bool -> [DarcsFlag] -> Bool
isInteractive Bool
True [DarcsFlag]
opts then do
              String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
                String
"These unrecorded changes conflict with the " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cmdname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":"
              Verbosity -> WithSummary -> FL (PrimOf p) wZ wU -> IO ()
forall (p :: * -> * -> *) wX wY.
ShowPatch p =>
Verbosity -> WithSummary -> p wX wY -> IO ()
printFriendly Verbosity
O.Verbose WithSummary
O.NoSummary FL (PrimOf p) wZ wU
to_revert
              Bool
yes <- String -> IO Bool
promptYorn String
"Do you want to revert these changes?"
              if Bool
yes then
                FL (PrimOf p) wZ wU -> IO (FL (PrimOf p) wZ wU)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FL (PrimOf p) wZ wU -> IO (FL (PrimOf p) wZ wU))
-> FL (PrimOf p) wZ wU -> IO (FL (PrimOf p) wZ wU)
forall a b. (a -> b) -> a -> b
$ FL (PrimOf p) wZ wZ
to_suspend_after_unrecorded FL (PrimOf p) wZ wZ -> FL (PrimOf p) wZ wU -> FL (PrimOf p) wZ wU
forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ FL (PrimOf p) wZ wU
to_revert
              else do
                String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Okay, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cmdname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" cancelled."
                IO (FL (PrimOf p) wZ wU)
forall a. IO a
exitSuccess
            else
              String -> IO (FL (PrimOf p) wZ wU)
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO (FL (PrimOf p) wZ wU))
-> String -> IO (FL (PrimOf p) wZ wU)
forall a b. (a -> b) -> a -> b
$
                String
"Can't suspend these patches without reverting some unrecorded changes."
      Repository 'RW p wU wX
_repository <-
        Repository 'RW p wU wR
-> UpdatePending
-> FL (PatchInfoAnd p) wX wR
-> IO (Repository 'RW p wU wX)
forall (p :: * -> * -> *) wU wR wX.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository 'RW p wU wR
-> UpdatePending
-> FL (PatchInfoAnd p) wX wR
-> IO (Repository 'RW p wU wX)
tentativelyRemovePatches Repository 'RW p wU wR
_repository UpdatePending
NoUpdatePending FL (PatchInfoAnd p) wX wR
to_suspend
      -- rely on sifting to commute out prims not belonging in pending:
      Repository 'RW p wU wX -> FL (PrimOf p) wX wZ -> IO ()
forall (p :: * -> * -> *) wU wR wP.
RepoPatch p =>
Repository 'RW p wU wR -> FL (PrimOf p) wR wP -> IO ()
setTentativePending Repository 'RW p wU wX
_repository FL (PrimOf p) wX wZ
unrecorded'
      Suspended p wX
new_suspended <-
        DiffAlgorithm
-> FL (Named p) wX wR -> Suspended p wR -> IO (Suspended p wX)
forall (p :: * -> * -> *) wX wY.
RepoPatch p =>
DiffAlgorithm
-> FL (Named p) wX wY -> Suspended p wY -> IO (Suspended p wX)
addToEditsToSuspended (PrimOptSpec DarcsOptDescr DarcsFlag a DiffAlgorithm
PrimDarcsOption DiffAlgorithm
O.diffAlgorithm PrimDarcsOption DiffAlgorithm -> [DarcsFlag] -> DiffAlgorithm
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
          ((forall wW wY. PatchInfoAnd p wW wY -> Named p wW wY)
-> FL (PatchInfoAnd p) wX wR -> FL (Named p) wX wR
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL PatchInfoAndG (Named p) wW wY -> Named p wW wY
forall wW wY. PatchInfoAnd p wW wY -> Named p wW wY
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> p wA wB
hopefully FL (PatchInfoAnd p) wX wR
to_suspend) Suspended p wR
suspended
      Repository 'RW p wU wX -> Suspended p wX -> IO ()
forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
RepoPatch p =>
Repository rt p wU wR -> Suspended p wR -> IO ()
writeTentativeRebase Repository 'RW p wU wX
_repository Suspended p wX
new_suspended
      (Repository 'RW p wU wX, Sealed (FL (PrimOf p) wU))
-> IO (Repository 'RW p wU wX, Sealed (FL (PrimOf p) wU))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Repository 'RW p wU wX
_repository, FL (PrimOf p) wU wZ -> Sealed (FL (PrimOf p) wU)
forall (a :: * -> *) wX. a wX -> Sealed a
Sealed (FL (PrimOf p) wZ wU -> FL (PrimOf p) wU wZ
forall wX wY. FL (PrimOf p) wX wY -> FL (PrimOf p) wY wX
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert FL (PrimOf p) wZ wU
effect_to_suspend))

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
    , commandOptions :: CommandOptions
commandOptions = CommandOptions
unsuspendOpts
    }
  where
    unsuspendBasicOpts :: OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  (Maybe AllowConflicts
   -> [MatchFlag]
   -> Maybe Bool
   -> WithSummary
   -> Maybe String
   -> Bool
   -> Maybe String
   -> Bool
   -> Maybe AskLongComment
   -> Bool
   -> DiffAlgorithm
   -> a)
unsuspendBasicOpts
      = PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  ([MatchFlag]
   -> Maybe Bool
   -> WithSummary
   -> Maybe String
   -> Bool
   -> Maybe String
   -> Bool
   -> Maybe AskLongComment
   -> Bool
   -> DiffAlgorithm
   -> a)
  (Maybe AllowConflicts)
PrimDarcsOption (Maybe AllowConflicts)
O.conflictsYes
      PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  ([MatchFlag]
   -> Maybe Bool
   -> WithSummary
   -> Maybe String
   -> Bool
   -> Maybe String
   -> Bool
   -> Maybe AskLongComment
   -> Bool
   -> DiffAlgorithm
   -> a)
  (Maybe AllowConflicts)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe Bool
      -> WithSummary
      -> Maybe String
      -> Bool
      -> Maybe String
      -> Bool
      -> Maybe AskLongComment
      -> Bool
      -> DiffAlgorithm
      -> a)
     ([MatchFlag]
      -> Maybe Bool
      -> WithSummary
      -> Maybe String
      -> Bool
      -> Maybe String
      -> Bool
      -> Maybe AskLongComment
      -> Bool
      -> DiffAlgorithm
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe Bool
      -> WithSummary
      -> Maybe String
      -> Bool
      -> Maybe String
      -> Bool
      -> Maybe AskLongComment
      -> Bool
      -> DiffAlgorithm
      -> a)
     (Maybe AllowConflicts
      -> [MatchFlag]
      -> Maybe Bool
      -> WithSummary
      -> Maybe String
      -> Bool
      -> Maybe String
      -> Bool
      -> Maybe AskLongComment
      -> Bool
      -> DiffAlgorithm
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe Bool
   -> WithSummary
   -> Maybe String
   -> Bool
   -> Maybe String
   -> Bool
   -> Maybe AskLongComment
   -> Bool
   -> DiffAlgorithm
   -> a)
  ([MatchFlag]
   -> Maybe Bool
   -> WithSummary
   -> Maybe String
   -> Bool
   -> Maybe String
   -> Bool
   -> Maybe AskLongComment
   -> Bool
   -> DiffAlgorithm
   -> a)
MatchOption
O.matchSeveralOrFirst
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe Bool
   -> WithSummary
   -> Maybe String
   -> Bool
   -> Maybe String
   -> Bool
   -> Maybe AskLongComment
   -> Bool
   -> DiffAlgorithm
   -> a)
  (Maybe AllowConflicts
   -> [MatchFlag]
   -> Maybe Bool
   -> WithSummary
   -> Maybe String
   -> Bool
   -> Maybe String
   -> Bool
   -> Maybe AskLongComment
   -> Bool
   -> DiffAlgorithm
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (WithSummary
      -> Maybe String
      -> Bool
      -> Maybe String
      -> Bool
      -> Maybe AskLongComment
      -> Bool
      -> DiffAlgorithm
      -> a)
     (Maybe Bool
      -> WithSummary
      -> Maybe String
      -> Bool
      -> Maybe String
      -> Bool
      -> Maybe AskLongComment
      -> Bool
      -> DiffAlgorithm
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (WithSummary
      -> Maybe String
      -> Bool
      -> Maybe String
      -> Bool
      -> Maybe AskLongComment
      -> Bool
      -> DiffAlgorithm
      -> a)
     (Maybe AllowConflicts
      -> [MatchFlag]
      -> Maybe Bool
      -> WithSummary
      -> Maybe String
      -> Bool
      -> Maybe String
      -> Bool
      -> Maybe AskLongComment
      -> Bool
      -> DiffAlgorithm
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (WithSummary
   -> Maybe String
   -> Bool
   -> Maybe String
   -> Bool
   -> Maybe AskLongComment
   -> Bool
   -> DiffAlgorithm
   -> a)
  (Maybe Bool
   -> WithSummary
   -> Maybe String
   -> Bool
   -> Maybe String
   -> Bool
   -> Maybe AskLongComment
   -> Bool
   -> DiffAlgorithm
   -> a)
PrimDarcsOption (Maybe Bool)
O.interactive
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (WithSummary
   -> Maybe String
   -> Bool
   -> Maybe String
   -> Bool
   -> Maybe AskLongComment
   -> Bool
   -> DiffAlgorithm
   -> a)
  (Maybe AllowConflicts
   -> [MatchFlag]
   -> Maybe Bool
   -> WithSummary
   -> Maybe String
   -> Bool
   -> Maybe String
   -> Bool
   -> Maybe AskLongComment
   -> Bool
   -> DiffAlgorithm
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe String
      -> Bool
      -> Maybe String
      -> Bool
      -> Maybe AskLongComment
      -> Bool
      -> DiffAlgorithm
      -> a)
     (WithSummary
      -> Maybe String
      -> Bool
      -> Maybe String
      -> Bool
      -> Maybe AskLongComment
      -> Bool
      -> DiffAlgorithm
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe String
      -> Bool
      -> Maybe String
      -> Bool
      -> Maybe AskLongComment
      -> Bool
      -> DiffAlgorithm
      -> a)
     (Maybe AllowConflicts
      -> [MatchFlag]
      -> Maybe Bool
      -> WithSummary
      -> Maybe String
      -> Bool
      -> Maybe String
      -> Bool
      -> Maybe AskLongComment
      -> Bool
      -> DiffAlgorithm
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe String
   -> Bool
   -> Maybe String
   -> Bool
   -> Maybe AskLongComment
   -> Bool
   -> DiffAlgorithm
   -> a)
  (WithSummary
   -> Maybe String
   -> Bool
   -> Maybe String
   -> Bool
   -> Maybe AskLongComment
   -> Bool
   -> DiffAlgorithm
   -> a)
PrimDarcsOption WithSummary
O.withSummary
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe String
   -> Bool
   -> Maybe String
   -> Bool
   -> Maybe AskLongComment
   -> Bool
   -> DiffAlgorithm
   -> a)
  (Maybe AllowConflicts
   -> [MatchFlag]
   -> Maybe Bool
   -> WithSummary
   -> Maybe String
   -> Bool
   -> Maybe String
   -> Bool
   -> Maybe AskLongComment
   -> Bool
   -> DiffAlgorithm
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Bool
      -> Maybe String
      -> Bool
      -> Maybe AskLongComment
      -> Bool
      -> DiffAlgorithm
      -> a)
     (Maybe String
      -> Bool
      -> Maybe String
      -> Bool
      -> Maybe AskLongComment
      -> Bool
      -> DiffAlgorithm
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Bool
      -> Maybe String
      -> Bool
      -> Maybe AskLongComment
      -> Bool
      -> DiffAlgorithm
      -> a)
     (Maybe AllowConflicts
      -> [MatchFlag]
      -> Maybe Bool
      -> WithSummary
      -> Maybe String
      -> Bool
      -> Maybe String
      -> Bool
      -> Maybe AskLongComment
      -> Bool
      -> DiffAlgorithm
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (Bool
   -> Maybe String
   -> Bool
   -> Maybe AskLongComment
   -> Bool
   -> DiffAlgorithm
   -> a)
  (Maybe String
   -> Bool
   -> Maybe String
   -> Bool
   -> Maybe AskLongComment
   -> Bool
   -> DiffAlgorithm
   -> a)
PrimDarcsOption (Maybe String)
O.author
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Bool
   -> Maybe String
   -> Bool
   -> Maybe AskLongComment
   -> Bool
   -> DiffAlgorithm
   -> a)
  (Maybe AllowConflicts
   -> [MatchFlag]
   -> Maybe Bool
   -> WithSummary
   -> Maybe String
   -> Bool
   -> Maybe String
   -> Bool
   -> Maybe AskLongComment
   -> Bool
   -> DiffAlgorithm
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe String
      -> Bool -> Maybe AskLongComment -> Bool -> DiffAlgorithm -> a)
     (Bool
      -> Maybe String
      -> Bool
      -> Maybe AskLongComment
      -> Bool
      -> DiffAlgorithm
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe String
      -> Bool -> Maybe AskLongComment -> Bool -> DiffAlgorithm -> a)
     (Maybe AllowConflicts
      -> [MatchFlag]
      -> Maybe Bool
      -> WithSummary
      -> Maybe String
      -> Bool
      -> Maybe String
      -> Bool
      -> Maybe AskLongComment
      -> Bool
      -> DiffAlgorithm
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe String
   -> Bool -> Maybe AskLongComment -> Bool -> DiffAlgorithm -> a)
  (Bool
   -> Maybe String
   -> Bool
   -> Maybe AskLongComment
   -> Bool
   -> DiffAlgorithm
   -> a)
PrimDarcsOption Bool
O.selectAuthor
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe String
   -> Bool -> Maybe AskLongComment -> Bool -> DiffAlgorithm -> a)
  (Maybe AllowConflicts
   -> [MatchFlag]
   -> Maybe Bool
   -> WithSummary
   -> Maybe String
   -> Bool
   -> Maybe String
   -> Bool
   -> Maybe AskLongComment
   -> Bool
   -> DiffAlgorithm
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Bool -> Maybe AskLongComment -> Bool -> DiffAlgorithm -> a)
     (Maybe String
      -> Bool -> Maybe AskLongComment -> Bool -> DiffAlgorithm -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Bool -> Maybe AskLongComment -> Bool -> DiffAlgorithm -> a)
     (Maybe AllowConflicts
      -> [MatchFlag]
      -> Maybe Bool
      -> WithSummary
      -> Maybe String
      -> Bool
      -> Maybe String
      -> Bool
      -> Maybe AskLongComment
      -> Bool
      -> DiffAlgorithm
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (Bool -> Maybe AskLongComment -> Bool -> DiffAlgorithm -> a)
  (Maybe String
   -> Bool -> Maybe AskLongComment -> Bool -> DiffAlgorithm -> a)
PrimDarcsOption (Maybe String)
O.patchname
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Bool -> Maybe AskLongComment -> Bool -> DiffAlgorithm -> a)
  (Maybe AllowConflicts
   -> [MatchFlag]
   -> Maybe Bool
   -> WithSummary
   -> Maybe String
   -> Bool
   -> Maybe String
   -> Bool
   -> Maybe AskLongComment
   -> Bool
   -> DiffAlgorithm
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe AskLongComment -> Bool -> DiffAlgorithm -> a)
     (Bool -> Maybe AskLongComment -> Bool -> DiffAlgorithm -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe AskLongComment -> Bool -> DiffAlgorithm -> a)
     (Maybe AllowConflicts
      -> [MatchFlag]
      -> Maybe Bool
      -> WithSummary
      -> Maybe String
      -> Bool
      -> Maybe String
      -> Bool
      -> Maybe AskLongComment
      -> Bool
      -> DiffAlgorithm
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe AskLongComment -> Bool -> DiffAlgorithm -> a)
  (Bool -> Maybe AskLongComment -> Bool -> DiffAlgorithm -> a)
PrimDarcsOption Bool
O.askDeps
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe AskLongComment -> Bool -> DiffAlgorithm -> a)
  (Maybe AllowConflicts
   -> [MatchFlag]
   -> Maybe Bool
   -> WithSummary
   -> Maybe String
   -> Bool
   -> Maybe String
   -> Bool
   -> Maybe AskLongComment
   -> Bool
   -> DiffAlgorithm
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Bool -> DiffAlgorithm -> a)
     (Maybe AskLongComment -> Bool -> DiffAlgorithm -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Bool -> DiffAlgorithm -> a)
     (Maybe AllowConflicts
      -> [MatchFlag]
      -> Maybe Bool
      -> WithSummary
      -> Maybe String
      -> Bool
      -> Maybe String
      -> Bool
      -> Maybe AskLongComment
      -> Bool
      -> DiffAlgorithm
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (Bool -> DiffAlgorithm -> a)
  (Maybe AskLongComment -> Bool -> DiffAlgorithm -> a)
PrimDarcsOption (Maybe AskLongComment)
O.askLongComment
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Bool -> DiffAlgorithm -> a)
  (Maybe AllowConflicts
   -> [MatchFlag]
   -> Maybe Bool
   -> WithSummary
   -> Maybe String
   -> Bool
   -> Maybe String
   -> Bool
   -> Maybe AskLongComment
   -> Bool
   -> DiffAlgorithm
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (DiffAlgorithm -> a)
     (Bool -> DiffAlgorithm -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (DiffAlgorithm -> a)
     (Maybe AllowConflicts
      -> [MatchFlag]
      -> Maybe Bool
      -> WithSummary
      -> Maybe String
      -> Bool
      -> Maybe String
      -> Bool
      -> Maybe AskLongComment
      -> Bool
      -> DiffAlgorithm
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (DiffAlgorithm -> a)
  (Bool -> DiffAlgorithm -> a)
PrimDarcsOption Bool
O.keepDate
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (DiffAlgorithm -> a)
  (Maybe AllowConflicts
   -> [MatchFlag]
   -> Maybe Bool
   -> WithSummary
   -> Maybe String
   -> Bool
   -> Maybe String
   -> Bool
   -> Maybe AskLongComment
   -> Bool
   -> DiffAlgorithm
   -> a)
-> OptSpec DarcsOptDescr DarcsFlag a (DiffAlgorithm -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     a
     (Maybe AllowConflicts
      -> [MatchFlag]
      -> Maybe Bool
      -> WithSummary
      -> Maybe String
      -> Bool
      -> Maybe String
      -> Bool
      -> Maybe AskLongComment
      -> Bool
      -> DiffAlgorithm
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec DarcsOptDescr DarcsFlag a (DiffAlgorithm -> a)
PrimDarcsOption DiffAlgorithm
O.diffAlgorithm
    unsuspendOpts :: CommandOptions
unsuspendOpts = OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Verbosity
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
  (Maybe AllowConflicts
   -> [MatchFlag]
   -> Maybe Bool
   -> WithSummary
   -> Maybe String
   -> Bool
   -> Maybe String
   -> Bool
   -> Maybe AskLongComment
   -> Bool
   -> DiffAlgorithm
   -> Maybe StdCmdAction
   -> Verbosity
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
forall {a}.
OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  (Maybe AllowConflicts
   -> [MatchFlag]
   -> Maybe Bool
   -> WithSummary
   -> Maybe String
   -> Bool
   -> Maybe String
   -> Bool
   -> Maybe AskLongComment
   -> Bool
   -> DiffAlgorithm
   -> a)
unsuspendBasicOpts OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Verbosity
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
  (Maybe AllowConflicts
   -> [MatchFlag]
   -> Maybe Bool
   -> WithSummary
   -> Maybe String
   -> Bool
   -> Maybe String
   -> Bool
   -> Maybe AskLongComment
   -> Bool
   -> DiffAlgorithm
   -> Maybe StdCmdAction
   -> Verbosity
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
-> DarcsOption
     (UseCache
      -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
     (UseCache
      -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
-> CommandOptions
forall b c.
DarcsOption (Maybe StdCmdAction -> Verbosity -> b) c
-> DarcsOption
     (UseCache
      -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
     b
-> CommandOptions
`withStdOpts` DarcsOption
  (UseCache
   -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
  (UseCache
   -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
forall (d :: * -> *) f a. OptSpec d f a a
oid
    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
    , commandOptions :: CommandOptions
commandOptions = CommandOptions
reifyOpts
    }
  where
    reifyBasicOpts :: OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  ([MatchFlag]
   -> Maybe Bool
   -> WithSummary
   -> Bool
   -> Maybe String
   -> DiffAlgorithm
   -> a)
reifyBasicOpts
      = PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe Bool
   -> WithSummary -> Bool -> Maybe String -> DiffAlgorithm -> a)
  [MatchFlag]
MatchOption
O.matchSeveralOrFirst
      PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe Bool
   -> WithSummary -> Bool -> Maybe String -> DiffAlgorithm -> a)
  [MatchFlag]
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (WithSummary -> Bool -> Maybe String -> DiffAlgorithm -> a)
     (Maybe Bool
      -> WithSummary -> Bool -> Maybe String -> DiffAlgorithm -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (WithSummary -> Bool -> Maybe String -> DiffAlgorithm -> a)
     ([MatchFlag]
      -> Maybe Bool
      -> WithSummary
      -> Bool
      -> Maybe String
      -> DiffAlgorithm
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (WithSummary -> Bool -> Maybe String -> DiffAlgorithm -> a)
  (Maybe Bool
   -> WithSummary -> Bool -> Maybe String -> DiffAlgorithm -> a)
PrimDarcsOption (Maybe Bool)
O.interactive
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (WithSummary -> Bool -> Maybe String -> DiffAlgorithm -> a)
  ([MatchFlag]
   -> Maybe Bool
   -> WithSummary
   -> Bool
   -> Maybe String
   -> DiffAlgorithm
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Bool -> Maybe String -> DiffAlgorithm -> a)
     (WithSummary -> Bool -> Maybe String -> DiffAlgorithm -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Bool -> Maybe String -> DiffAlgorithm -> a)
     ([MatchFlag]
      -> Maybe Bool
      -> WithSummary
      -> Bool
      -> Maybe String
      -> DiffAlgorithm
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (Bool -> Maybe String -> DiffAlgorithm -> a)
  (WithSummary -> Bool -> Maybe String -> DiffAlgorithm -> a)
PrimDarcsOption WithSummary
O.withSummary
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Bool -> Maybe String -> DiffAlgorithm -> a)
  ([MatchFlag]
   -> Maybe Bool
   -> WithSummary
   -> Bool
   -> Maybe String
   -> DiffAlgorithm
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe String -> DiffAlgorithm -> a)
     (Bool -> Maybe String -> DiffAlgorithm -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe String -> DiffAlgorithm -> a)
     ([MatchFlag]
      -> Maybe Bool
      -> WithSummary
      -> Bool
      -> Maybe String
      -> DiffAlgorithm
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe String -> DiffAlgorithm -> a)
  (Bool -> Maybe String -> DiffAlgorithm -> a)
PrimDarcsOption Bool
O.keepDate
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe String -> DiffAlgorithm -> a)
  ([MatchFlag]
   -> Maybe Bool
   -> WithSummary
   -> Bool
   -> Maybe String
   -> DiffAlgorithm
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (DiffAlgorithm -> a)
     (Maybe String -> DiffAlgorithm -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (DiffAlgorithm -> a)
     ([MatchFlag]
      -> Maybe Bool
      -> WithSummary
      -> Bool
      -> Maybe String
      -> DiffAlgorithm
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (DiffAlgorithm -> a)
  (Maybe String -> DiffAlgorithm -> a)
PrimDarcsOption (Maybe String)
O.author
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (DiffAlgorithm -> a)
  ([MatchFlag]
   -> Maybe Bool
   -> WithSummary
   -> Bool
   -> Maybe String
   -> DiffAlgorithm
   -> a)
-> OptSpec DarcsOptDescr DarcsFlag a (DiffAlgorithm -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     a
     ([MatchFlag]
      -> Maybe Bool
      -> WithSummary
      -> Bool
      -> Maybe String
      -> DiffAlgorithm
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec DarcsOptDescr DarcsFlag a (DiffAlgorithm -> a)
PrimDarcsOption DiffAlgorithm
O.diffAlgorithm
    reifyOpts :: CommandOptions
reifyOpts = OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Verbosity
   -> UMask
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
  ([MatchFlag]
   -> Maybe Bool
   -> WithSummary
   -> Bool
   -> Maybe String
   -> DiffAlgorithm
   -> Maybe StdCmdAction
   -> Verbosity
   -> UMask
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
forall {a}.
OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  ([MatchFlag]
   -> Maybe Bool
   -> WithSummary
   -> Bool
   -> Maybe String
   -> DiffAlgorithm
   -> a)
reifyBasicOpts OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Verbosity
   -> UMask
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
  ([MatchFlag]
   -> Maybe Bool
   -> WithSummary
   -> Bool
   -> Maybe String
   -> DiffAlgorithm
   -> Maybe StdCmdAction
   -> Verbosity
   -> UMask
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
-> DarcsOption
     (UseCache
      -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
     (UMask
      -> UseCache
      -> UseIndex
      -> HooksConfig
      -> Bool
      -> Bool
      -> [DarcsFlag])
-> CommandOptions
forall b c.
DarcsOption (Maybe StdCmdAction -> Verbosity -> b) c
-> DarcsOption
     (UseCache
      -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
     b
-> CommandOptions
`withStdOpts` DarcsOption
  (UseCache
   -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
  (UMask
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
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 =
  UseCache -> UMask -> RepoJob 'RW () -> IO ()
forall a. UseCache -> UMask -> RepoJob 'RW a -> IO a
withRepoLock (PrimOptSpec DarcsOptDescr DarcsFlag a UseCache
PrimDarcsOption UseCache
useCache PrimDarcsOption UseCache -> [DarcsFlag] -> UseCache
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (PrimOptSpec DarcsOptDescr DarcsFlag a UMask
PrimDarcsOption UMask
umask PrimDarcsOption UMask -> [DarcsFlag] -> UMask
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (RepoJob 'RW () -> IO ()) -> RepoJob 'RW () -> IO ()
forall a b. (a -> b) -> a -> b
$ TreePatchJob 'RW () -> RepoJob 'RW ()
forall (rt :: AccessType) a. TreePatchJob rt a -> RepoJob rt a
RepoJob (TreePatchJob 'RW () -> RepoJob 'RW ())
-> TreePatchJob 'RW () -> RepoJob 'RW ()
forall a b. (a -> b) -> a -> b
$ \Repository 'RW p wU wR
_repository -> do
    Repository 'RW p wU wR -> IO ()
forall (rt :: AccessType) (p :: * -> * -> *) wU wR.
Repository rt p wU wR -> IO ()
checkHasRebase Repository 'RW p wU wR
_repository
    Items FL (RebaseChange (PrimOf p)) wR wY
suspended <- Repository 'RW p wU wR -> IO (Suspended p wR)
forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
RepoPatch p =>
Repository rt p wU wR -> IO (Suspended p wR)
readTentativeRebase Repository 'RW p wU wR
_repository

    let matchFlags :: [MatchFlag]
matchFlags = PrimOptSpec DarcsOptDescr DarcsFlag a [MatchFlag]
MatchOption
O.matchSeveralOrFirst MatchOption -> [DarcsFlag] -> [MatchFlag]
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 <-
        (:>)
  (FL (RebaseChange (PrimOf p))) (FL (RebaseChange (PrimOf p))) wR wY
-> IO
     ((:>)
        (FL (RebaseChange (PrimOf p)))
        (FL (RebaseChange (PrimOf p)))
        wR
        wY)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((:>)
   (FL (RebaseChange (PrimOf p))) (FL (RebaseChange (PrimOf p))) wR wY
 -> IO
      ((:>)
         (FL (RebaseChange (PrimOf p)))
         (FL (RebaseChange (PrimOf p)))
         wR
         wY))
-> (:>)
     (FL (RebaseChange (PrimOf p))) (FL (RebaseChange (PrimOf p))) wR wY
-> IO
     ((:>)
        (FL (RebaseChange (PrimOf p)))
        (FL (RebaseChange (PrimOf p)))
        wR
        wY)
forall a b. (a -> b) -> a -> b
$
            if [MatchFlag] -> Bool
secondMatch [MatchFlag]
matchFlags then
            (forall wA wB.
 RebaseChange (PrimOf p) wA wB -> Sealed2 (PatchInfoAnd (PrimOf p)))
-> [MatchFlag]
-> FL (RebaseChange (PrimOf p)) wR wY
-> (:>)
     (FL (RebaseChange (PrimOf p))) (FL (RebaseChange (PrimOf p))) wR wY
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 RebaseChange (PrimOf p) wA wB -> Sealed2 (PatchInfoAnd (PrimOf p))
forall wA wB.
RebaseChange (PrimOf p) wA wB -> Sealed2 (PatchInfoAnd (PrimOf p))
forall (prim :: * -> * -> *) wX wY.
RebaseChange prim wX wY -> Sealed2 (PatchInfoAnd prim)
rcToPia [MatchFlag]
matchFlags FL (RebaseChange (PrimOf p)) wR wY
suspended
            else FL (RebaseChange (PrimOf p)) wR wY
suspended FL (RebaseChange (PrimOf p)) wR wY
-> FL (RebaseChange (PrimOf p)) wY wY
-> (:>)
     (FL (RebaseChange (PrimOf p))) (FL (RebaseChange (PrimOf p))) wR wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (RebaseChange (PrimOf p)) wY wY
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL

    FL (RebaseChange (PrimOf p)) wR wZ
offer :> RL (RebaseChange (PrimOf p)) wZ wZ
dontoffer <-
        (:>)
  (FL (RebaseChange (PrimOf p))) (RL (RebaseChange (PrimOf p))) wR wZ
-> IO
     ((:>)
        (FL (RebaseChange (PrimOf p)))
        (RL (RebaseChange (PrimOf p)))
        wR
        wZ)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((:>)
   (FL (RebaseChange (PrimOf p))) (RL (RebaseChange (PrimOf p))) wR wZ
 -> IO
      ((:>)
         (FL (RebaseChange (PrimOf p)))
         (RL (RebaseChange (PrimOf p)))
         wR
         wZ))
-> (:>)
     (FL (RebaseChange (PrimOf p))) (RL (RebaseChange (PrimOf p))) wR wZ
-> IO
     ((:>)
        (FL (RebaseChange (PrimOf p)))
        (RL (RebaseChange (PrimOf p)))
        wR
        wZ)
forall a b. (a -> b) -> a -> b
$
            case PrimOptSpec DarcsOptDescr DarcsFlag a (Maybe AllowConflicts)
PrimDarcsOption (Maybe AllowConflicts)
O.conflictsYes PrimDarcsOption (Maybe AllowConflicts)
-> [DarcsFlag] -> Maybe AllowConflicts
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts of
              Maybe AllowConflicts
Nothing -> FL (RebaseChange (PrimOf p)) wR wZ
-> (:>)
     (FL (RebaseChange (PrimOf p))) (RL (RebaseChange (PrimOf p))) wR wZ
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 FL (RebaseChange (PrimOf p)) wR wZ
-> RL (RebaseChange (PrimOf p)) wZ wZ
-> (:>)
     (FL (RebaseChange (PrimOf p))) (RL (RebaseChange (PrimOf p))) wR wZ
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RL (RebaseChange (PrimOf p)) wZ wZ
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL

    let warnSkip :: RL a wX wZ -> IO ()
warnSkip RL a wX wZ
NilRL = () -> IO ()
forall a. a -> IO a
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."

    RL (RebaseChange (PrimOf p)) wZ wZ -> IO ()
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 wA wB.
 RebaseChange (PrimOf p) wA wB -> Sealed2 (PatchInfoAnd (PrimOf p)))
-> WhichChanges
-> String
-> PatchSelectionOptions
-> Maybe [AnchoredPath]
-> SelectionConfig (RebaseChange (PrimOf p))
forall (p :: * -> * -> *) (q :: * -> * -> *).
Matchable p =>
(forall wX wY. q wX wY -> Sealed2 p)
-> WhichChanges
-> String
-> PatchSelectionOptions
-> Maybe [AnchoredPath]
-> SelectionConfig q
selectionConfigGeneric RebaseChange (PrimOf p) wX wY -> Sealed2 (PatchInfoAnd (PrimOf p))
forall wA wB.
RebaseChange (PrimOf p) wA wB -> Sealed2 (PatchInfoAnd (PrimOf p))
forall (prim :: * -> * -> *) wX wY.
RebaseChange prim wX wY -> Sealed2 (PatchInfoAnd prim)
rcToPia WhichChanges
First String
cmd
            (Bool -> [DarcsFlag] -> PatchSelectionOptions
patchSelOpts Bool
True [DarcsFlag]
opts) Maybe [AnchoredPath]
forall a. Maybe a
Nothing
    (FL (RebaseChange (PrimOf p)) wR wZ
chosen :> FL (RebaseChange (PrimOf p)) wZ wZ
keep) <- FL (RebaseChange (PrimOf p)) wR wZ
-> SelectionConfig (RebaseChange (PrimOf p))
-> IO
     ((:>)
        (FL (RebaseChange (PrimOf p)))
        (FL (RebaseChange (PrimOf p)))
        wR
        wZ)
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
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FL (RebaseChange (PrimOf p)) wR wZ -> Bool
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Bool
nullFL FL (RebaseChange (PrimOf p)) wR wZ
chosen) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do String -> IO ()
putStrLn String
"No patches selected!"
                              IO ()
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 (PrimOptSpec DarcsOptDescr DarcsFlag a (Maybe String)
PrimDarcsOption (Maybe String)
O.author PrimDarcsOption (Maybe String) -> [DarcsFlag] -> Maybe String
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) Bool
False
          String
-> FL (RebaseChange (PrimOf p)) wR wZ
-> IO
     ((:>)
        (FL (WithDroppedDeps (Named p)))
        (FL (RebaseFixup (PrimOf p)))
        wR
        wZ)
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 (:>)
  (FL (WithDroppedDeps (Named p)))
  (FL (RebaseFixup (PrimOf p)))
  wR
  wZ
-> IO
     ((:>)
        (FL (WithDroppedDeps (Named p)))
        (FL (RebaseFixup (PrimOf p)))
        wR
        wZ)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((:>)
   (FL (WithDroppedDeps (Named p)))
   (FL (RebaseFixup (PrimOf p)))
   wR
   wZ
 -> IO
      ((:>)
         (FL (WithDroppedDeps (Named p)))
         (FL (RebaseFixup (PrimOf p)))
         wR
         wZ))
-> (:>)
     (FL (WithDroppedDeps (Named p)))
     (FL (RebaseFixup (PrimOf p)))
     wR
     wZ
-> IO
     ((:>)
        (FL (WithDroppedDeps (Named p)))
        (FL (RebaseFixup (PrimOf p)))
        wR
        wZ)
forall a b. (a -> b) -> a -> b
$ DiffAlgorithm
-> FL (RebaseChange (PrimOf p)) wR wZ
-> (:>)
     (FL (WithDroppedDeps (Named p)))
     (FL (RebaseFixup (PrimOf p)))
     wR
     wZ
forall (p :: * -> * -> *) wX wY.
RepoPatch p =>
DiffAlgorithm
-> FL (RebaseChange (PrimOf p)) wX wY
-> (:>) (FL (WDDNamed p)) (FL (RebaseFixup (PrimOf p))) wX wY
extractRebaseChange (PrimOptSpec DarcsOptDescr DarcsFlag a DiffAlgorithm
PrimDarcsOption DiffAlgorithm
diffAlgorithm PrimDarcsOption DiffAlgorithm -> [DarcsFlag] -> DiffAlgorithm
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) FL (RebaseChange (PrimOf p)) wR wZ
chosen

    let ps_to_keep :: Sealed (FL (RebaseChange (PrimOf p)) wZ)
ps_to_keep = DiffAlgorithm
-> FL (RebaseFixup (PrimOf p)) wZ wZ
-> FL (RebaseChange (PrimOf p)) wZ wY
-> Sealed (FL (RebaseChange (PrimOf p)) wZ)
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 (FL (RebaseChange (PrimOf p)) wZ wY
 -> Sealed (FL (RebaseChange (PrimOf p)) wZ))
-> FL (RebaseChange (PrimOf p)) wZ wY
-> Sealed (FL (RebaseChange (PrimOf p)) wZ)
forall a b. (a -> b) -> a -> b
$
                     FL (RebaseChange (PrimOf p)) wZ wZ
keep FL (RebaseChange (PrimOf p)) wZ wZ
-> FL (RebaseChange (PrimOf p)) wZ wY
-> FL (RebaseChange (PrimOf p)) wZ wY
forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ RL (RebaseChange (PrimOf p)) wZ wZ
-> FL (RebaseChange (PrimOf p)) wZ wZ
forall (a :: * -> * -> *) wX wZ. RL a wX wZ -> FL a wX wZ
reverseRL RL (RebaseChange (PrimOf p)) wZ wZ
dontoffer FL (RebaseChange (PrimOf p)) wZ wZ
-> FL (RebaseChange (PrimOf p)) wZ wY
-> FL (RebaseChange (PrimOf p)) wZ wY
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 p Origin wR
context <- Repository 'RW p wU wR -> IO (PatchSet p Origin wR)
forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
RepoPatch p =>
Repository rt p wU wR -> IO (PatchSet p Origin wR)
readPatches Repository 'RW p wU wR
_repository

    let conflicts :: StandardResolution (PrimOf p) wZ
conflicts =
          RL (PatchInfoAnd p) Origin wR
-> RL (Named p) wR wZ -> StandardResolution (PrimOf p) wZ
forall (p :: * -> * -> *) wO wX wY.
(Conflict p, PrimPatch (PrimOf p)) =>
RL (PatchInfoAnd p) wO wX
-> RL (Named p) wX wY -> StandardResolution (PrimOf p) wY
rebaseResolution (PatchSet p Origin wR -> RL (PatchInfoAnd p) Origin wR
forall (p :: * -> * -> *) wStart wX.
PatchSet p wStart wX -> RL (PatchInfoAnd p) wStart wX
patchSet2RL PatchSet p Origin wR
context) (RL (Named p) wR wZ -> StandardResolution (PrimOf p) wZ)
-> RL (Named p) wR wZ -> StandardResolution (PrimOf p) wZ
forall a b. (a -> b) -> a -> b
$
          String -> RL (Named p) wR wZ -> RL (Named p) wR wZ
forall (a :: * -> * -> *) wX wY. String -> RL a wX wY -> RL a wX wY
progressRL String
"Examining patches for conflicts" (RL (Named p) wR wZ -> RL (Named p) wR wZ)
-> RL (Named p) wR wZ -> RL (Named p) wR wZ
forall a b. (a -> b) -> a -> b
$
          (forall wW wY. WithDroppedDeps (Named p) wW wY -> Named p wW wY)
-> RL (WithDroppedDeps (Named p)) wR wZ -> RL (Named p) wR wZ
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> RL a wX wZ -> RL b wX wZ
mapRL_RL WithDroppedDeps (Named p) wW wY -> Named p wW wY
forall wW wY. WithDroppedDeps (Named p) wW wY -> Named p wW wY
forall (p :: * -> * -> *) wX wY. WithDroppedDeps p wX wY -> p wX wY
wddPatch (RL (WithDroppedDeps (Named p)) wR wZ -> RL (Named p) wR wZ)
-> RL (WithDroppedDeps (Named p)) wR wZ -> RL (Named p) wR wZ
forall a b. (a -> b) -> a -> b
$
          FL (WithDroppedDeps (Named p)) wR wZ
-> RL (WithDroppedDeps (Named p)) wR wZ
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 <- String
-> AllowConflicts -> StandardResolution (PrimOf p) wZ -> IO Bool
forall (prim :: * -> * -> *) wX.
PrimPatch prim =>
String -> AllowConflicts -> StandardResolution prim wX -> IO Bool
announceConflicts String
cmd ([DarcsFlag] -> AllowConflicts
allowConflicts [DarcsFlag]
opts) StandardResolution (PrimOf p) wZ
conflicts
    String -> IO ()
debugMessage String
"Working out conflict markup..."
    Sealed FL (PrimOf p) wZ wX
resolution <-
      if Bool
have_conflicts then
        case PrimOptSpec DarcsOptDescr DarcsFlag a (Maybe AllowConflicts)
PrimDarcsOption (Maybe AllowConflicts)
O.conflictsYes PrimDarcsOption (Maybe AllowConflicts)
-> [DarcsFlag] -> Maybe AllowConflicts
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts of
          Just (YesAllowConflicts (ExternalMerge String
_)) ->
            String -> IO (Sealed (FL (PrimOf p) wZ))
forall a. HasCallStack => String -> a
error (String -> IO (Sealed (FL (PrimOf p) wZ)))
-> String -> IO (Sealed (FL (PrimOf p) wZ))
forall a b. (a -> b) -> a -> b
$ String
"external resolution for "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
cmdString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" not implemented yet"
          Just (YesAllowConflicts ResolveConflicts
NoResolveConflicts) -> Sealed (FL (PrimOf p) wZ) -> IO (Sealed (FL (PrimOf p) wZ))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (FL (PrimOf p) wZ) -> IO (Sealed (FL (PrimOf p) wZ)))
-> Sealed (FL (PrimOf p) wZ) -> IO (Sealed (FL (PrimOf p) wZ))
forall a b. (a -> b) -> a -> b
$ FL (PrimOf p) wZ wZ -> Sealed (FL (PrimOf p) wZ)
forall (a :: * -> *) wX. a wX -> Sealed a
seal FL (PrimOf p) wZ wZ
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
          Just (YesAllowConflicts ResolveConflicts
MarkConflicts) -> Sealed (FL (PrimOf p) wZ) -> IO (Sealed (FL (PrimOf p) wZ))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (FL (PrimOf p) wZ) -> IO (Sealed (FL (PrimOf p) wZ)))
-> Sealed (FL (PrimOf p) wZ) -> IO (Sealed (FL (PrimOf p) wZ))
forall a b. (a -> b) -> a -> b
$ StandardResolution (PrimOf p) wZ -> Sealed (FL (PrimOf p) wZ)
forall (prim :: * -> * -> *) wX.
StandardResolution prim wX -> Mangled prim wX
mangled StandardResolution (PrimOf p) wZ
conflicts
          Just AllowConflicts
NoAllowConflicts -> String -> IO (Sealed (FL (PrimOf p) wZ))
forall a. HasCallStack => String -> a
error String
"impossible" -- was handled in announceConflicts
          Maybe AllowConflicts
Nothing -> String -> IO (Sealed (FL (PrimOf p) wZ))
forall a. HasCallStack => String -> a
error String
"impossible"
      else Sealed (FL (PrimOf p) wZ) -> IO (Sealed (FL (PrimOf p) wZ))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (FL (PrimOf p) wZ) -> IO (Sealed (FL (PrimOf p) wZ)))
-> Sealed (FL (PrimOf p) wZ) -> IO (Sealed (FL (PrimOf p) wZ))
forall a b. (a -> b) -> a -> b
$ FL (PrimOf p) wZ wZ -> Sealed (FL (PrimOf p) wZ)
forall (a :: * -> *) wX. a wX -> Sealed a
seal FL (PrimOf p) wZ wZ
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL

    FL (PrimOf p) wR wU
unrec <- DiffOpts
-> Repository 'RW p wU wR
-> Maybe [AnchoredPath]
-> IO (FL (PrimOf p) wR wU)
forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
(RepoPatch p, ApplyState p ~ Tree) =>
DiffOpts
-> Repository rt p wU wR
-> Maybe [AnchoredPath]
-> IO (FL (PrimOf p) wR wU)
unrecordedChanges ([DarcsFlag] -> DiffOpts
diffingOpts [DarcsFlag]
opts) Repository 'RW p wU wR
_repository Maybe [AnchoredPath]
forall a. Maybe a
Nothing

    -- TODO should catch logfiles (fst value from updatePatchHeader) and
    -- clean them up as in AmendRecord
    -- Note: we can allow hijack attempts here without warning the user
    -- because we already asked about that on suspend time
    (FL (PatchInfoAnd p) wR wZ
unsuspended_ps, Suspended p wZ
ps_to_keep') <-
      HijackOptions
-> HijackT IO (FL (PatchInfoAnd p) wR wZ, Suspended p wZ)
-> IO (FL (PatchInfoAnd p) wR wZ, Suspended p wZ)
forall (m :: * -> *) a.
Monad m =>
HijackOptions -> HijackT m a -> m a
runHijackT HijackOptions
IgnoreHijack (HijackT IO (FL (PatchInfoAnd p) wR wZ, Suspended p wZ)
 -> IO (FL (PatchInfoAnd p) wR wZ, Suspended p wZ))
-> HijackT IO (FL (PatchInfoAnd p) wR wZ, Suspended p wZ)
-> IO (FL (PatchInfoAnd p) wR wZ, Suspended p wZ)
forall a b. (a -> b) -> a -> b
$ FL (WithDroppedDeps (Named p)) wR wZ
-> Suspended p wZ
-> HijackT IO (FL (PatchInfoAnd p) wR wZ, Suspended p wZ)
forall (p :: * -> * -> *) wR wT.
(RepoPatch p, ApplyState p ~ Tree) =>
FL (WDDNamed p) wR wT
-> Suspended p wT
-> HijackT IO (FL (PatchInfoAnd p) wR wT, Suspended p wT)
handleUnsuspend FL (WithDroppedDeps (Named p)) wR wZ
ps_to_unsuspend ((forall wX. FL (RebaseChange (PrimOf p)) wZ wX -> Suspended p wZ)
-> Sealed (FL (RebaseChange (PrimOf p)) wZ) -> Suspended p wZ
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal FL (RebaseChange (PrimOf p)) wZ wX -> Suspended p wZ
forall wX. FL (RebaseChange (PrimOf p)) wZ wX -> Suspended p wZ
forall (p :: * -> * -> *) wX wY.
FL (RebaseChange (PrimOf p)) wX wY -> Suspended p wX
Items Sealed (FL (RebaseChange (PrimOf p)) wZ)
ps_to_keep)
    Repository 'RW p wU wZ
_repository <-
      Repository 'RW p wU wR
-> UpdatePending
-> FL (PatchInfoAnd p) wR wZ
-> IO (Repository 'RW p wU wZ)
forall (p :: * -> * -> *) wU wR wY.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository 'RW p wU wR
-> UpdatePending
-> FL (PatchInfoAnd p) wR wY
-> IO (Repository 'RW p wU wY)
tentativelyAddPatches Repository 'RW p wU wR
_repository UpdatePending
NoUpdatePending FL (PatchInfoAnd p) wR wZ
unsuspended_ps
    let effect_unsuspended :: FL (PrimOf p) wR wZ
effect_unsuspended = FL (FL (PrimOf p)) wR wZ -> FL (PrimOf p) wR wZ
forall (a :: * -> * -> *) wX wZ. FL (FL a) wX wZ -> FL a wX wZ
concatFL ((forall wW wY. PatchInfoAnd p wW wY -> FL (PrimOf p) wW wY)
-> FL (PatchInfoAnd p) wR wZ -> FL (FL (PrimOf p)) wR wZ
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL PatchInfoAnd p wW wY -> FL (PrimOf p) wW wY
PatchInfoAnd p wW wY -> FL (PrimOf (PatchInfoAnd p)) wW wY
forall wW wY. PatchInfoAnd p wW wY -> FL (PrimOf p) wW wY
forall wX wY.
PatchInfoAnd p wX wY -> FL (PrimOf (PatchInfoAnd p)) wX wY
forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect FL (PatchInfoAnd p) wR wZ
unsuspended_ps)
    case (:\/:) (FL (PrimOf p)) (FL (PrimOf p)) wZ wU
-> Maybe ((:/\:) (FL (PrimOf p)) (FL (PrimOf p)) wZ wU)
forall wX wY.
(:\/:) (FL (PrimOf p)) (FL (PrimOf p)) wX wY
-> Maybe ((:/\:) (FL (PrimOf p)) (FL (PrimOf p)) wX wY)
forall (p :: * -> * -> *) wX wY.
CleanMerge p =>
(:\/:) p p wX wY -> Maybe ((:/\:) p p wX wY)
cleanMerge (FL (PrimOf p) wR wZ
effect_unsuspended FL (PrimOf p) wR wZ
-> FL (PrimOf p) wR wU
-> (:\/:) (FL (PrimOf p)) (FL (PrimOf p)) wZ wU
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wZ wX -> a2 wZ wY -> (:\/:) a1 a2 wX wY
:\/: FL (PrimOf p) wR wU
unrec) of
      Maybe ((:/\:) (FL (PrimOf p)) (FL (PrimOf p)) wZ wU)
Nothing ->
        String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Can't "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
cmdString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" because there are conflicting unrecorded changes."
      Just (FL (PrimOf p) wZ wZ
unrec' :/\: FL (PrimOf p) wU wZ
effect_unsuspended') ->
        case (:\/:) (FL (PrimOf p)) (FL (PrimOf p)) wX wZ
-> Maybe ((:/\:) (FL (PrimOf p)) (FL (PrimOf p)) wX wZ)
forall wX wY.
(:\/:) (FL (PrimOf p)) (FL (PrimOf p)) wX wY
-> Maybe ((:/\:) (FL (PrimOf p)) (FL (PrimOf p)) wX wY)
forall (p :: * -> * -> *) wX wY.
CleanMerge p =>
(:\/:) p p wX wY -> Maybe ((:/\:) p p wX wY)
cleanMerge (FL (PrimOf p) wZ wX
resolution FL (PrimOf p) wZ wX
-> FL (PrimOf p) wZ wZ
-> (:\/:) (FL (PrimOf p)) (FL (PrimOf p)) wX wZ
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wZ wX -> a2 wZ wY -> (:\/:) a1 a2 wX wY
:\/: FL (PrimOf p) wZ wZ
unrec') of
          Maybe ((:/\:) (FL (PrimOf p)) (FL (PrimOf p)) wX wZ)
Nothing ->
            String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Can't "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
cmdString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" because there are conflicting unrecorded changes."
          Just (FL (PrimOf p) wX wZ
unrec'' :/\: FL (PrimOf p) wZ wZ
resolution') -> do
            let effect_to_apply :: FL (PrimOf p) wU wZ
effect_to_apply = FL (PrimOf p) wU wZ
effect_unsuspended' FL (PrimOf p) wU wZ -> FL (PrimOf p) wZ wZ -> FL (PrimOf p) wU wZ
forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ FL (PrimOf p) wZ wZ
resolution'
            Repository 'RW p wU wZ -> FL (PrimOf p) wZ wZ -> IO ()
forall (p :: * -> * -> *) wU wR wP.
RepoPatch p =>
Repository 'RW p wU wR -> FL (PrimOf p) wR wP -> IO ()
setTentativePending Repository 'RW p wU wZ
_repository (FL (PrimOf p) wZ wX
resolution FL (PrimOf p) wZ wX -> FL (PrimOf p) wX wZ -> FL (PrimOf p) wZ wZ
forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ FL (PrimOf p) wX wZ
unrec'')
            Repository 'RW p wU wZ -> Suspended p wZ -> IO ()
forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
RepoPatch p =>
Repository rt p wU wR -> Suspended p wR -> IO ()
writeTentativeRebase Repository 'RW p wU wZ
_repository Suspended p wZ
ps_to_keep'
            IO () -> IO ()
forall a. IO a -> IO a
withSignalsBlocked (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
              Repository 'RO p wU wZ
_repository <- Repository 'RW p wU wZ -> DryRun -> IO (Repository 'RO p wU wZ)
forall (p :: * -> * -> *) wU wR.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository 'RW p wU wR -> DryRun -> IO (Repository 'RO p wU wR)
finalizeRepositoryChanges Repository 'RW p wU wZ
_repository (PrimOptSpec DarcsOptDescr DarcsFlag a DryRun
PrimDarcsOption DryRun
O.dryRun PrimDarcsOption DryRun -> [DarcsFlag] -> DryRun
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
              Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (DryRun -> Bool
forall a. YesNo a => a -> Bool
O.yes (PrimOptSpec DarcsOptDescr DarcsFlag a DryRun
PrimDarcsOption DryRun
O.dryRun PrimDarcsOption DryRun -> [DarcsFlag] -> DryRun
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                IO (Repository 'RO p wZ wZ) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Repository 'RO p wZ wZ) -> IO ())
-> IO (Repository 'RO p wZ wZ) -> IO ()
forall a b. (a -> b) -> a -> b
$ Repository 'RO p wU wZ
-> Verbosity -> FL (PrimOf p) wU wZ -> IO (Repository 'RO p wZ wZ)
forall (p :: * -> * -> *) (rt :: AccessType) wU wR wY.
(ApplyState p ~ Tree, RepoPatch p) =>
Repository rt p wU wR
-> Verbosity -> FL (PrimOf p) wU wY -> IO (Repository rt p wY wR)
applyToWorking Repository 'RO p wU wZ
_repository (PrimOptSpec DarcsOptDescr DarcsFlag a Verbosity
PrimDarcsOption Verbosity
verbosity PrimDarcsOption Verbosity -> [DarcsFlag] -> Verbosity
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) FL (PrimOf p) wU wZ
effect_to_apply

    where da :: DiffAlgorithm
da = PrimOptSpec DarcsOptDescr DarcsFlag a DiffAlgorithm
PrimDarcsOption DiffAlgorithm
diffAlgorithm PrimDarcsOption DiffAlgorithm -> [DarcsFlag] -> DiffAlgorithm
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts

          handleUnsuspend
                 :: forall p wR wT. (RepoPatch p, ApplyState p ~ Tree)
                 => FL (WDDNamed p) wR wT
                 -> Suspended p wT
                 -> HijackT IO (FL (PatchInfoAnd p) wR wT, Suspended p wT)
          handleUnsuspend :: forall (p :: * -> * -> *) wR wT.
(RepoPatch p, ApplyState p ~ Tree) =>
FL (WDDNamed p) wR wT
-> Suspended p wT
-> HijackT IO (FL (PatchInfoAnd p) wR wT, Suspended p wT)
handleUnsuspend FL (WDDNamed p) wR wT
NilFL Suspended p wT
to_keep = (FL (PatchInfoAnd p) wR wT, Suspended p wT)
-> StateT
     HijackOptions IO (FL (PatchInfoAnd p) wR wT, Suspended p wT)
forall a. a -> StateT HijackOptions IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FL (PatchInfoAnd p) wR wR
FL (PatchInfoAnd p) wR wT
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL, Suspended p wT
to_keep)
          handleUnsuspend (WDDNamed p wR wY
p :>: FL (WDDNamed p) wY wT
ps) Suspended p wT
to_keep = do
              case WDDNamed p wR wY -> [PatchInfo]
forall (p :: * -> * -> *) wX wY.
WithDroppedDeps p wX wY -> [PatchInfo]
wddDependedOn WDDNamed p wR wY
p of
                  [] -> () -> HijackT IO ()
forall a. a -> StateT HijackOptions IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                  [PatchInfo]
deps -> IO () -> HijackT IO ()
forall a. IO a -> StateT HijackOptions IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HijackT IO ()) -> IO () -> HijackT IO ()
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
                      let indent :: Int -> Doc -> Doc
indent Int
n = String -> Doc -> Doc
prefix (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
n Char
' ')
                      Printers -> Doc -> IO ()
putDocLnWith Printers
fancyPrinters (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$
                        String -> Doc
redText (String
"Dropping the following explicit " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                          Int -> Noun -> String -> String
forall n. Countable n => Int -> n -> String -> String
englishNum ([PatchInfo] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PatchInfo]
deps) (String -> Noun
Noun String
"dependency") String
":") Doc -> Doc -> Doc
$$
                        PatchInfo -> Doc
displayPatchInfo (Named p wR wY -> PatchInfo
forall (p :: * -> * -> *) wX wY. Named p wX wY -> PatchInfo
patch2patchinfo (WDDNamed p wR wY -> Named p wR wY
forall (p :: * -> * -> *) wX wY. WithDroppedDeps p wX wY -> p wX wY
wddPatch WDDNamed p wR wY
p)) Doc -> Doc -> Doc
$$
                        Int -> Doc -> Doc
indent Int
1 (String -> Doc
redText String
"depended on:") Doc -> Doc -> Doc
$$
                        Int -> Doc -> Doc
indent Int
2 ([Doc] -> Doc
vcat ((PatchInfo -> Doc) -> [PatchInfo] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map PatchInfo -> Doc
displayPatchInfo [PatchInfo]
deps))

              -- TODO should catch logfiles (fst value from updatePatchHeader)
              -- and clean them up as in AmendRecord
              -- TODO should also ask user to supply explicit dependencies as
              -- replacements for those that have been lost (if any, see above)
              PatchInfoAnd p wR wY
p' <- (Maybe String, PatchInfoAnd p wR wY) -> PatchInfoAnd p wR wY
forall a b. (a, b) -> b
snd ((Maybe String, PatchInfoAnd p wR wY) -> PatchInfoAnd p wR wY)
-> StateT HijackOptions IO (Maybe String, PatchInfoAnd p wR wY)
-> StateT HijackOptions IO (PatchInfoAnd p wR wY)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (p :: * -> * -> *) wX wY wZ.
(RepoPatch p, ApplyState p ~ Tree) =>
String
-> AskAboutDeps p wX
-> PatchSelectionOptions
-> PatchHeaderConfig
-> Named (PrimOf p) wX wY
-> FL (PrimOf p) wY wZ
-> HijackT IO (Maybe String, PatchInfoAnd p wX wZ)
updatePatchHeader @p String
cmd
                      AskAboutDeps p wR
forall (p :: * -> * -> *) wX. AskAboutDeps p wX
NoAskAboutDeps
                      (Bool -> [DarcsFlag] -> PatchSelectionOptions
patchSelOpts Bool
True [DarcsFlag]
opts)
                      ([DarcsFlag] -> PatchHeaderConfig
patchHeaderConfig [DarcsFlag]
opts)
                      ((FL p wR wY -> FL (PrimOf p) wR wY)
-> Named p wR wY -> Named (PrimOf p) wR wY
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 FL p wR wY -> FL (PrimOf p) wR wY
FL p wR wY -> FL (PrimOf (FL p)) wR wY
forall wX wY. FL p wX wY -> FL (PrimOf (FL p)) wX wY
forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect (WDDNamed p wR wY -> Named p wR wY
forall (p :: * -> * -> *) wX wY. WithDroppedDeps p wX wY -> p wX wY
wddPatch WDDNamed p wR wY
p)) FL (PrimOf p) wY wY
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
              -- Create a rename that undoes the change we just made, so that the
              -- context of patch names match up in the following sequence. We don't
              -- track patch names properly in witnesses yet and so the rename appears
              -- to have a null effect on the context.
              --   p' :: WDDNamed p wR wR2
              --   rename :: RebaseName wR2 wR2
              --   ps :: FL (WDDNamed p) wR2 wT
              let rename :: RebaseName wR2 wR2
                  rename :: forall wR2. RebaseName wR2 wR2
rename = PatchInfo -> PatchInfo -> RebaseName wR2 wR2
forall wX wY. PatchInfo -> PatchInfo -> RebaseName wX wY
Rename (PatchInfoAnd p wR wY -> PatchInfo
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> PatchInfo
info PatchInfoAnd p wR wY
p') (Named p wR wY -> PatchInfo
forall (p :: * -> * -> *) wX wY. Named p wX wY -> PatchInfo
patch2patchinfo (WDDNamed p wR wY -> Named p wR wY
forall (p :: * -> * -> *) wX wY. WithDroppedDeps p wX wY -> p wX wY
wddPatch WDDNamed p wR wY
p))
              -- push it through the remaining patches to fix them up, which should leave
              -- us with
              --   p' :: WDDNamed p wR wR2
              --   ps2 :: FL (WDDNamed p) wR2 wT2
              --   rename2 :: RebaseName wT2 wT2
              Just (FL (WDDNamed p) wY wZ
ps2 :> (RebaseName wZ wT
rename2 :: RebaseName wT2 wT2')) <-
                Maybe ((:>) (FL (WDDNamed p)) RebaseName wY wT)
-> StateT
     HijackOptions IO (Maybe ((:>) (FL (WDDNamed p)) RebaseName wY wT))
forall a. a -> StateT HijackOptions IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ((:>) (FL (WDDNamed p)) RebaseName wY wT)
 -> StateT
      HijackOptions IO (Maybe ((:>) (FL (WDDNamed p)) RebaseName wY wT)))
-> Maybe ((:>) (FL (WDDNamed p)) RebaseName wY wT)
-> StateT
     HijackOptions IO (Maybe ((:>) (FL (WDDNamed p)) RebaseName wY wT))
forall a b. (a -> b) -> a -> b
$ CommuteFn RebaseName (WDDNamed p)
-> CommuteFn RebaseName (FL (WDDNamed p))
forall (p1 :: * -> * -> *) (p2 :: * -> * -> *).
CommuteFn p1 p2 -> CommuteFn p1 (FL p2)
commuterIdFL (CommuteFn RebaseName (Named p) -> CommuteFn RebaseName (WDDNamed p)
forall (p :: * -> * -> *) (q :: * -> * -> *).
CommuteFn p q -> CommuteFn p (WithDroppedDeps q)
commuterIdWDD (:>) RebaseName (Named p) wX wY
-> Maybe ((:>) (Named p) RebaseName wX wY)
CommuteFn RebaseName (Named p)
forall (p :: * -> * -> *) wX wY.
(:>) RebaseName (Named p) wX wY
-> Maybe ((:>) (Named p) RebaseName wX wY)
commuteNameNamed) (RebaseName wY wY
forall wR2. RebaseName wR2 wR2
rename RebaseName wY wY
-> FL (WDDNamed p) wY wT -> (:>) RebaseName (FL (WDDNamed p)) wY wT
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (WDDNamed p) wY wT
ps)
              -- However the commute operation loses the information that the rename2 has
              -- a null effect on the context so we have to assert it manually.
              EqCheck wZ wT
IsEq <- EqCheck wZ wT -> StateT HijackOptions IO (EqCheck wZ wT)
forall a. a -> StateT HijackOptions IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (EqCheck Any Any -> EqCheck wZ wT
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP EqCheck Any Any
forall wA. EqCheck wA wA
IsEq :: EqCheck wT2 wT2')
              Suspended p wZ
to_keep' <- Suspended p wZ -> StateT HijackOptions IO (Suspended p wZ)
forall a. a -> StateT HijackOptions IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Suspended p wZ -> StateT HijackOptions IO (Suspended p wZ))
-> Suspended p wZ -> StateT HijackOptions IO (Suspended p wZ)
forall a b. (a -> b) -> a -> b
$ DiffAlgorithm
-> RebaseFixup (PrimOf p) wZ wT -> Suspended p wT -> Suspended p wZ
forall (p :: * -> * -> *) wX wY.
PrimPatchBase p =>
DiffAlgorithm
-> RebaseFixup (PrimOf p) wX wY -> Suspended p wY -> Suspended p wX
S.simplifyPush DiffAlgorithm
da (RebaseName wZ wT -> RebaseFixup (PrimOf p) wZ wT
forall wX wY (prim :: * -> * -> *).
RebaseName wX wY -> RebaseFixup prim wX wY
NameFixup RebaseName wZ wT
rename2) Suspended p wT
to_keep
              (FL (PatchInfoAnd p) wY wZ
converted, Suspended p wZ
to_keep'') <- FL (WDDNamed p) wY wZ
-> Suspended p wZ
-> HijackT IO (FL (PatchInfoAnd p) wY wZ, Suspended p wZ)
forall (p :: * -> * -> *) wR wT.
(RepoPatch p, ApplyState p ~ Tree) =>
FL (WDDNamed p) wR wT
-> Suspended p wT
-> HijackT IO (FL (PatchInfoAnd p) wR wT, Suspended p wT)
handleUnsuspend FL (WDDNamed p) wY wZ
ps2 Suspended p wZ
to_keep'
              (FL (PatchInfoAnd p) wR wT, Suspended p wT)
-> StateT
     HijackOptions IO (FL (PatchInfoAnd p) wR wT, Suspended p wT)
forall a. a -> StateT HijackOptions IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (PatchInfoAnd p wR wY
p' PatchInfoAnd p wR wY
-> FL (PatchInfoAnd p) wY wT -> FL (PatchInfoAnd p) wR wT
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL (PatchInfoAnd p) wY wT
FL (PatchInfoAnd p) wY wZ
converted, Suspended p wT
Suspended p wZ
to_keep'')

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
    , commandOptions :: CommandOptions
commandOptions = CommandOptions
injectOpts
    }
  where
    injectBasicOpts :: OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  (Bool -> Maybe String -> DiffAlgorithm -> a)
injectBasicOpts = PrimOptSpec
  DarcsOptDescr DarcsFlag (Maybe String -> DiffAlgorithm -> a) Bool
PrimDarcsOption Bool
O.keepDate PrimOptSpec
  DarcsOptDescr DarcsFlag (Maybe String -> DiffAlgorithm -> a) Bool
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (DiffAlgorithm -> a)
     (Maybe String -> DiffAlgorithm -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (DiffAlgorithm -> a)
     (Bool -> Maybe String -> DiffAlgorithm -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (DiffAlgorithm -> a)
  (Maybe String -> DiffAlgorithm -> a)
PrimDarcsOption (Maybe String)
O.author OptSpec
  DarcsOptDescr
  DarcsFlag
  (DiffAlgorithm -> a)
  (Bool -> Maybe String -> DiffAlgorithm -> a)
-> OptSpec DarcsOptDescr DarcsFlag a (DiffAlgorithm -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     a
     (Bool -> Maybe String -> DiffAlgorithm -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec DarcsOptDescr DarcsFlag a (DiffAlgorithm -> a)
PrimDarcsOption DiffAlgorithm
O.diffAlgorithm
    injectOpts :: CommandOptions
injectOpts = OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Verbosity
   -> UMask
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
  (Bool
   -> Maybe String
   -> DiffAlgorithm
   -> Maybe StdCmdAction
   -> Verbosity
   -> UMask
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
forall {a}.
OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  (Bool -> Maybe String -> DiffAlgorithm -> a)
injectBasicOpts OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Verbosity
   -> UMask
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
  (Bool
   -> Maybe String
   -> DiffAlgorithm
   -> Maybe StdCmdAction
   -> Verbosity
   -> UMask
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
-> DarcsOption
     (UseCache
      -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
     (UMask
      -> UseCache
      -> UseIndex
      -> HooksConfig
      -> Bool
      -> Bool
      -> [DarcsFlag])
-> CommandOptions
forall b c.
DarcsOption (Maybe StdCmdAction -> Verbosity -> b) c
-> DarcsOption
     (UseCache
      -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
     b
-> CommandOptions
`withStdOpts` DarcsOption
  (UseCache
   -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
  (UMask
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
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 =
  UseCache -> UMask -> RepoJob 'RW () -> IO ()
forall a. UseCache -> UMask -> RepoJob 'RW a -> IO a
withRepoLock (PrimOptSpec DarcsOptDescr DarcsFlag a UseCache
PrimDarcsOption UseCache
useCache PrimDarcsOption UseCache -> [DarcsFlag] -> UseCache
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (PrimOptSpec DarcsOptDescr DarcsFlag a UMask
PrimDarcsOption UMask
umask PrimDarcsOption UMask -> [DarcsFlag] -> UMask
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (RepoJob 'RW () -> IO ()) -> RepoJob 'RW () -> IO ()
forall a b. (a -> b) -> a -> b
$ TreePatchJob 'RW () -> RepoJob 'RW ()
forall (rt :: AccessType) a. TreePatchJob rt a -> RepoJob rt a
RepoJob (TreePatchJob 'RW () -> RepoJob 'RW ())
-> TreePatchJob 'RW () -> RepoJob 'RW ()
forall a b. (a -> b) -> a -> b
$
    \(Repository 'RW p wU wR
_repository :: Repository 'RW p wU wR) -> do
    Repository 'RW p wU wR -> IO ()
forall (rt :: AccessType) (p :: * -> * -> *) wU wR.
Repository rt p wU wR -> IO ()
checkHasRebase Repository 'RW p wU wR
_repository
    Items FL (RebaseChange (PrimOf p)) wR wY
selects <- Repository 'RW p wU wR -> IO (Suspended p wR)
forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
RepoPatch p =>
Repository rt p wU wR -> IO (Suspended p wR)
readTentativeRebase Repository 'RW p 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 wX wY.
 RebaseChange (PrimOf p) wX wY -> Sealed2 (PatchInfoAnd (PrimOf p)))
-> WhichChanges
-> String
-> PatchSelectionOptions
-> Maybe [AnchoredPath]
-> SelectionConfig (RebaseChange (PrimOf p))
forall (p :: * -> * -> *) (q :: * -> * -> *).
Matchable p =>
(forall wX wY. q wX wY -> Sealed2 p)
-> WhichChanges
-> String
-> PatchSelectionOptions
-> Maybe [AnchoredPath]
-> SelectionConfig q
selectionConfigGeneric RebaseChange (PrimOf p) wX wY -> Sealed2 (PatchInfoAnd (PrimOf p))
forall wX wY.
RebaseChange (PrimOf p) wX wY -> Sealed2 (PatchInfoAnd (PrimOf p))
forall (prim :: * -> * -> *) wX wY.
RebaseChange prim wX wY -> Sealed2 (PatchInfoAnd prim)
rcToPia WhichChanges
First String
"inject into" (Bool -> [DarcsFlag] -> PatchSelectionOptions
patchSelOpts Bool
True [DarcsFlag]
opts) Maybe [AnchoredPath]
forall a. Maybe a
Nothing
    (FL (RebaseChange (PrimOf p)) wR wZ
to_inject :> FL (RebaseChange (PrimOf p)) wZ wY
keep) <- FL (RebaseChange (PrimOf p)) wR wY
-> SelectionConfig (RebaseChange (PrimOf p))
-> IO
     ((:>)
        (FL (RebaseChange (PrimOf p)))
        (FL (RebaseChange (PrimOf p)))
        wR
        wY)
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 -> RebaseChange prim wX wY
        extractSingle :: forall (prim :: * -> * -> *) wX wY.
FL (RebaseChange prim) wX wY -> RebaseChange prim wX wY
extractSingle (RebaseChange prim wX wY
rc :>: FL (RebaseChange prim) wY wY
NilFL) = RebaseChange prim wX wY
RebaseChange prim wX wY
rc
        extractSingle FL (RebaseChange prim) wX wY
_ = String -> RebaseChange prim wX wY
forall a. HasCallStack => String -> a
error String
"You must select precisely one patch!"

    RebaseChange (PrimOf p) wR wZ
rc <- RebaseChange (PrimOf p) wR wZ -> IO (RebaseChange (PrimOf p) wR wZ)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (RebaseChange (PrimOf p) wR wZ
 -> IO (RebaseChange (PrimOf p) wR wZ))
-> RebaseChange (PrimOf p) wR wZ
-> IO (RebaseChange (PrimOf p) wR wZ)
forall a b. (a -> b) -> a -> b
$ FL (RebaseChange (PrimOf p)) wR wZ -> RebaseChange (PrimOf p) wR wZ
forall (prim :: * -> * -> *) wX wY.
FL (RebaseChange prim) wX wY -> RebaseChange prim wX wY
extractSingle FL (RebaseChange (PrimOf p)) wR wZ
to_inject
    Sealed FL (RebaseChange (PrimOf p)) wR wX
new <- [DarcsFlag]
-> RebaseChange (PrimOf p) wR wZ
-> FL (RebaseChange (PrimOf p)) wZ wY
-> IO (Sealed (FL (RebaseChange (PrimOf p)) wR))
forall (prim :: * -> * -> *) wX wY wZ.
(PrimPatch prim, ApplyState prim ~ Tree) =>
[DarcsFlag]
-> RebaseChange prim wX wY
-> FL (RebaseChange prim) wY wZ
-> IO (Sealed (FL (RebaseChange prim) wX))
injectOne [DarcsFlag]
opts RebaseChange (PrimOf p) wR wZ
rc FL (RebaseChange (PrimOf p)) wZ wY
keep

    Repository 'RW p wU wR -> Suspended p wR -> IO ()
forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
RepoPatch p =>
Repository rt p wU wR -> Suspended p wR -> IO ()
writeTentativeRebase Repository 'RW p wU wR
_repository (Suspended p wR -> IO ()) -> Suspended p wR -> IO ()
forall a b. (a -> b) -> a -> b
$ FL (RebaseChange (PrimOf p)) wR wX -> Suspended p wR
forall (p :: * -> * -> *) wX wY.
FL (RebaseChange (PrimOf p)) wX wY -> Suspended p wX
Items FL (RebaseChange (PrimOf p)) wR wX
new
    IO (Repository 'RO p wU wR) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Repository 'RO p wU wR) -> IO ())
-> IO (Repository 'RO p wU wR) -> IO ()
forall a b. (a -> b) -> a -> b
$ Repository 'RW p wU wR -> DryRun -> IO (Repository 'RO p wU wR)
forall (p :: * -> * -> *) wU wR.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository 'RW p wU wR -> DryRun -> IO (Repository 'RO p wU wR)
finalizeRepositoryChanges Repository 'RW p wU wR
_repository (PrimOptSpec DarcsOptDescr DarcsFlag a DryRun
PrimDarcsOption DryRun
O.dryRun PrimDarcsOption DryRun -> [DarcsFlag] -> DryRun
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)

-- | Inject fixups into a 'RebaseChange' and update the remainder of the rebase
-- state. This is in 'IO' because it involves interactive selection of the
-- fixups to inject.
-- TODO: We currently offer only prim fixups, not name fixups, for injection. I
-- think it would make sense to extend this to name fixups, so the user can
-- explicitly resolve a lost dependency in cases where is clear that it won't
-- re-appear.
injectOne
  :: (PrimPatch prim, ApplyState prim ~ Tree)
  => [DarcsFlag]
  -> RebaseChange prim wX wY
  -> FL (RebaseChange prim) wY wZ
  -> IO (Sealed (FL (RebaseChange prim) wX))
injectOne :: forall (prim :: * -> * -> *) wX wY wZ.
(PrimPatch prim, ApplyState prim ~ Tree) =>
[DarcsFlag]
-> RebaseChange prim wX wY
-> FL (RebaseChange prim) wY wZ
-> IO (Sealed (FL (RebaseChange prim) wX))
injectOne [DarcsFlag]
opts (RC FL (RebaseFixup prim) wX wY1
fixups Named prim wY1 wY
toedit) FL (RebaseChange prim) wY wZ
rest_suspended = do
  FL RebaseName wX wZ
name_fixups :> FL prim wZ wY1
prim_fixups <- (:>) (FL RebaseName) (FL prim) wX wY1
-> IO ((:>) (FL RebaseName) (FL prim) wX wY1)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((:>) (FL RebaseName) (FL prim) wX wY1
 -> IO ((:>) (FL RebaseName) (FL prim) wX wY1))
-> (:>) (FL RebaseName) (FL prim) wX wY1
-> IO ((:>) (FL RebaseName) (FL prim) wX wY1)
forall a b. (a -> b) -> a -> b
$ FL (RebaseFixup prim) wX wY1
-> (:>) (FL RebaseName) (FL prim) wX wY1
forall (prim :: * -> * -> *) wX wY.
FL (RebaseFixup prim) wX wY -> (:>) (FL RebaseName) (FL prim) wX wY
flToNamesPrims FL (RebaseFixup prim) wX wY1
fixups
  let prim_selection_config :: SelectionConfig prim
prim_selection_config =
        WhichChanges
-> String
-> PatchSelectionOptions
-> Maybe (Splitter prim)
-> Maybe [AnchoredPath]
-> SelectionConfig prim
forall (prim :: * -> * -> *).
WhichChanges
-> String
-> PatchSelectionOptions
-> Maybe (Splitter prim)
-> Maybe [AnchoredPath]
-> SelectionConfig prim
selectionConfigPrim
          WhichChanges
Last
          String
"inject"
          (Bool -> [DarcsFlag] -> PatchSelectionOptions
patchSelOpts Bool
True [DarcsFlag]
opts)
          (Splitter prim -> Maybe (Splitter prim)
forall a. a -> Maybe a
Just (DiffAlgorithm -> Splitter prim
forall (p :: * -> * -> *).
PrimPatch p =>
DiffAlgorithm -> Splitter p
primSplitter (PrimOptSpec DarcsOptDescr DarcsFlag a DiffAlgorithm
PrimDarcsOption DiffAlgorithm
diffAlgorithm PrimDarcsOption DiffAlgorithm -> [DarcsFlag] -> DiffAlgorithm
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)))
          Maybe [AnchoredPath]
forall a. Maybe a
Nothing
  (FL prim wZ wZ
rest_fixups :> FL prim wZ wY1
injects) <-
    FL prim wZ wY1
-> SelectionConfig prim -> IO ((:>) (FL prim) (FL prim) wZ wY1)
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 prim wZ wY1
prim_fixups SelectionConfig prim
prim_selection_config
  let da :: DiffAlgorithm
da = PrimOptSpec DarcsOptDescr DarcsFlag a DiffAlgorithm
PrimDarcsOption DiffAlgorithm
diffAlgorithm PrimDarcsOption DiffAlgorithm -> [DarcsFlag] -> DiffAlgorithm
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts
      toeditNew :: Named prim wZ wY
toeditNew = (FL prim wY1 wY -> FL prim wZ wY)
-> Named prim wY1 wY -> Named prim wZ wY
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 (DiffAlgorithm -> FL prim wZ wY -> FL prim wZ wY
forall (prim :: * -> * -> *) wX wY.
(IsHunk prim, PrimCoalesce prim, PrimConstruct prim) =>
DiffAlgorithm -> FL prim wX wY -> FL prim wX wY
canonizeFL DiffAlgorithm
da (FL prim wZ wY -> FL prim wZ wY)
-> (FL prim wY1 wY -> FL prim wZ wY)
-> FL prim wY1 wY
-> FL prim wZ wY
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FL prim wZ wY1
injects FL prim wZ wY1 -> FL prim wY1 wY -> FL prim wZ wY
forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+)) Named prim wY1 wY
toedit
  Sealed (FL (RebaseChange prim) wX)
-> IO (Sealed (FL (RebaseChange prim) wX))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (FL (RebaseChange prim) wX)
 -> IO (Sealed (FL (RebaseChange prim) wX)))
-> Sealed (FL (RebaseChange prim) wX)
-> IO (Sealed (FL (RebaseChange prim) wX))
forall a b. (a -> b) -> a -> b
$
    (forall wX.
 FL (RebaseChange prim) wZ wX -> Sealed (FL (RebaseChange prim) wX))
-> Sealed (FL (RebaseChange prim) wZ)
-> Sealed (FL (RebaseChange prim) wX)
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal (DiffAlgorithm
-> FL (RebaseFixup prim) wX wZ
-> FL (RebaseChange prim) wZ wX
-> Sealed (FL (RebaseChange prim) wX)
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 wW wY. RebaseName wW wY -> RebaseFixup prim wW wY)
-> FL RebaseName wX wZ -> FL (RebaseFixup prim) wX wZ
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL RebaseName wW wY -> RebaseFixup prim wW wY
forall wW wY. RebaseName wW wY -> RebaseFixup prim wW wY
forall wX wY (prim :: * -> * -> *).
RebaseName wX wY -> RebaseFixup prim wX wY
NameFixup FL RebaseName wX wZ
name_fixups)) (Sealed (FL (RebaseChange prim) wZ)
 -> Sealed (FL (RebaseChange prim) wX))
-> Sealed (FL (RebaseChange prim) wZ)
-> Sealed (FL (RebaseChange prim) wX)
forall a b. (a -> b) -> a -> b
$
    DiffAlgorithm
-> FL (RebaseFixup prim) wZ wZ
-> FL (RebaseChange prim) wZ wZ
-> Sealed (FL (RebaseChange prim) wZ)
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 wW wY. prim wW wY -> RebaseFixup prim wW wY)
-> FL prim wZ wZ -> FL (RebaseFixup prim) wZ wZ
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL prim wW wY -> RebaseFixup prim wW wY
forall wW wY. prim wW wY -> RebaseFixup prim wW wY
forall (prim :: * -> * -> *) wX wY.
prim wX wY -> RebaseFixup prim wX wY
PrimFixup FL prim wZ wZ
rest_fixups) (FL (RebaseChange prim) wZ wZ
 -> Sealed (FL (RebaseChange prim) wZ))
-> FL (RebaseChange prim) wZ wZ
-> Sealed (FL (RebaseChange prim) wZ)
forall a b. (a -> b) -> a -> b
$
    FL (RebaseFixup prim) wZ wZ
-> Named prim wZ wY -> RebaseChange prim wZ wY
forall (prim :: * -> * -> *) wX wY1 wY.
FL (RebaseFixup prim) wX wY1
-> Named prim wY1 wY -> RebaseChange prim wX wY
RC FL (RebaseFixup prim) wZ wZ
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL Named prim wZ wY
toeditNew RebaseChange prim wZ wY
-> FL (RebaseChange prim) wY wZ -> FL (RebaseChange prim) wZ wZ
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL (RebaseChange prim) wY wZ
rest_suspended


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
    , commandOptions :: CommandOptions
commandOptions = CommandOptions
obliterateOpts
    }
  where
    obliterateBasicOpts :: PrimOptSpec DarcsOptDescr DarcsFlag a DiffAlgorithm
obliterateBasicOpts = PrimOptSpec DarcsOptDescr DarcsFlag a DiffAlgorithm
PrimDarcsOption DiffAlgorithm
O.diffAlgorithm
    obliterateOpts :: CommandOptions
obliterateOpts = PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Verbosity
   -> UMask
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
  DiffAlgorithm
PrimDarcsOption DiffAlgorithm
obliterateBasicOpts PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Verbosity
   -> UMask
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
  DiffAlgorithm
-> DarcsOption
     (UseCache
      -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
     (UMask
      -> UseCache
      -> UseIndex
      -> HooksConfig
      -> Bool
      -> Bool
      -> [DarcsFlag])
-> CommandOptions
forall b c.
DarcsOption (Maybe StdCmdAction -> Verbosity -> b) c
-> DarcsOption
     (UseCache
      -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
     b
-> CommandOptions
`withStdOpts` DarcsOption
  (UseCache
   -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
  (UMask
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
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 =
  UseCache -> UMask -> RepoJob 'RW () -> IO ()
forall a. UseCache -> UMask -> RepoJob 'RW a -> IO a
withRepoLock (PrimOptSpec DarcsOptDescr DarcsFlag a UseCache
PrimDarcsOption UseCache
useCache PrimDarcsOption UseCache -> [DarcsFlag] -> UseCache
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (PrimOptSpec DarcsOptDescr DarcsFlag a UMask
PrimDarcsOption UMask
umask PrimDarcsOption UMask -> [DarcsFlag] -> UMask
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (RepoJob 'RW () -> IO ()) -> RepoJob 'RW () -> IO ()
forall a b. (a -> b) -> a -> b
$ TreePatchJob 'RW () -> RepoJob 'RW ()
forall (rt :: AccessType) a. TreePatchJob rt a -> RepoJob rt a
RepoJob (TreePatchJob 'RW () -> RepoJob 'RW ())
-> TreePatchJob 'RW () -> RepoJob 'RW ()
forall a b. (a -> b) -> a -> b
$ \Repository 'RW p wU wR
_repository -> do
    Repository 'RW p wU wR -> IO ()
forall (rt :: AccessType) (p :: * -> * -> *) wU wR.
Repository rt p wU wR -> IO ()
checkHasRebase Repository 'RW p wU wR
_repository
    Items FL (RebaseChange (PrimOf p)) wR wY
selects <- Repository 'RW p wU wR -> IO (Suspended p wR)
forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
RepoPatch p =>
Repository rt p wU wR -> IO (Suspended p wR)
readTentativeRebase Repository 'RW p wU wR
_repository

    -- TODO this selection doesn't need to respect dependencies
    let selection_config :: SelectionConfig (RebaseChange (PrimOf p))
selection_config = (forall wX wY.
 RebaseChange (PrimOf p) wX wY -> Sealed2 (PatchInfoAnd (PrimOf p)))
-> WhichChanges
-> String
-> PatchSelectionOptions
-> Maybe [AnchoredPath]
-> SelectionConfig (RebaseChange (PrimOf p))
forall (p :: * -> * -> *) (q :: * -> * -> *).
Matchable p =>
(forall wX wY. q wX wY -> Sealed2 p)
-> WhichChanges
-> String
-> PatchSelectionOptions
-> Maybe [AnchoredPath]
-> SelectionConfig q
selectionConfigGeneric RebaseChange (PrimOf p) wX wY -> Sealed2 (PatchInfoAnd (PrimOf p))
forall wX wY.
RebaseChange (PrimOf p) wX wY -> Sealed2 (PatchInfoAnd (PrimOf p))
forall (prim :: * -> * -> *) wX wY.
RebaseChange prim wX wY -> Sealed2 (PatchInfoAnd prim)
rcToPia WhichChanges
First String
"obliterate" ([DarcsFlag] -> PatchSelectionOptions
obliteratePatchSelOpts [DarcsFlag]
opts) Maybe [AnchoredPath]
forall a. Maybe a
Nothing
    (FL (RebaseChange (PrimOf p)) wR wZ
chosen :> FL (RebaseChange (PrimOf p)) wZ wY
keep) <- FL (RebaseChange (PrimOf p)) wR wY
-> SelectionConfig (RebaseChange (PrimOf p))
-> IO
     ((:>)
        (FL (RebaseChange (PrimOf p)))
        (FL (RebaseChange (PrimOf p)))
        wR
        wY)
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
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FL (RebaseChange (PrimOf p)) wR wZ -> Bool
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Bool
nullFL FL (RebaseChange (PrimOf p)) wR wZ
chosen) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do String -> IO ()
putStrLn String
"No patches selected!"
                              IO ()
forall a. IO a
exitSuccess

    let ps_to_keep :: Sealed (FL (RebaseChange (PrimOf p)) wR)
ps_to_keep =
          (forall wA wB.
 RebaseChange (PrimOf p) wA wB
 -> Sealed (FL (RebaseChange (PrimOf p)) wB)
 -> Sealed (FL (RebaseChange (PrimOf p)) wA))
-> FL (RebaseChange (PrimOf p)) wR wZ
-> Sealed (FL (RebaseChange (PrimOf p)) wZ)
-> Sealed (FL (RebaseChange (PrimOf p)) wR)
forall (p :: * -> * -> *) (q :: * -> * -> *) wX wY.
(forall wA wB. p wA wB -> Sealed (q wB) -> Sealed (q wA))
-> FL p wX wY -> Sealed (q wY) -> Sealed (q wX)
foldSealedFL (DiffAlgorithm
-> RebaseChange (PrimOf p) wA wB
-> Sealed (FL (RebaseChange (PrimOf p)) wB)
-> Sealed (FL (RebaseChange (PrimOf p)) wA)
forall (prim :: * -> * -> *) wX wY.
PrimPatch prim =>
DiffAlgorithm
-> RebaseChange prim wX wY
-> Sealed (FL (RebaseChange prim) wY)
-> Sealed (FL (RebaseChange prim) wX)
obliterateOne (PrimOptSpec DarcsOptDescr DarcsFlag a DiffAlgorithm
PrimDarcsOption DiffAlgorithm
diffAlgorithm PrimDarcsOption DiffAlgorithm -> [DarcsFlag] -> DiffAlgorithm
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)) FL (RebaseChange (PrimOf p)) wR wZ
chosen (FL (RebaseChange (PrimOf p)) wZ wY
-> Sealed (FL (RebaseChange (PrimOf p)) wZ)
forall (a :: * -> *) wX. a wX -> Sealed a
Sealed FL (RebaseChange (PrimOf p)) wZ wY
keep)
    Repository 'RW p wU wR -> Suspended p wR -> IO ()
forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
RepoPatch p =>
Repository rt p wU wR -> Suspended p wR -> IO ()
writeTentativeRebase Repository 'RW p wU wR
_repository ((forall wX. FL (RebaseChange (PrimOf p)) wR wX -> Suspended p wR)
-> Sealed (FL (RebaseChange (PrimOf p)) wR) -> Suspended p wR
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal FL (RebaseChange (PrimOf p)) wR wX -> Suspended p wR
forall wX. FL (RebaseChange (PrimOf p)) wR wX -> Suspended p wR
forall (p :: * -> * -> *) wX wY.
FL (RebaseChange (PrimOf p)) wX wY -> Suspended p wX
Items Sealed (FL (RebaseChange (PrimOf p)) wR)
ps_to_keep)

    IO (Repository 'RO p wU wR) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Repository 'RO p wU wR) -> IO ())
-> IO (Repository 'RO p wU wR) -> IO ()
forall a b. (a -> b) -> a -> b
$ Repository 'RW p wU wR -> DryRun -> IO (Repository 'RO p wU wR)
forall (p :: * -> * -> *) wU wR.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository 'RW p wU wR -> DryRun -> IO (Repository 'RO p wU wR)
finalizeRepositoryChanges Repository 'RW p wU wR
_repository (PrimOptSpec DarcsOptDescr DarcsFlag a DryRun
PrimDarcsOption DryRun
O.dryRun PrimDarcsOption DryRun -> [DarcsFlag] -> DryRun
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)

-- TODO: move to Darcs.Patch.Witnesses.Ordered ?
-- | Map a cons-like operation that may change the end state over an 'FL'.
-- Unfortunately this can't be generalized to 'foldrwFL', even though it has
-- exactly the same definition, because 'Sealed' doesn't have the right kind.
-- We could play with a newtype wrapper to fix this but the ensuing wrapping
-- and unwrapping would hardly make it clearer what's going on.
foldSealedFL
  :: (forall wA wB . p wA wB -> Sealed (q wB) -> Sealed (q wA))
  -> FL p wX wY -> Sealed (q wY) -> Sealed (q wX)
-- kind error: foldSealedFL = foldrwFL
foldSealedFL :: forall (p :: * -> * -> *) (q :: * -> * -> *) wX wY.
(forall wA wB. p wA wB -> Sealed (q wB) -> Sealed (q wA))
-> FL p wX wY -> Sealed (q wY) -> Sealed (q wX)
foldSealedFL forall wA wB. p wA wB -> Sealed (q wB) -> Sealed (q wA)
_ FL p wX wY
NilFL Sealed (q wY)
acc = Sealed (q wX)
Sealed (q wY)
acc
foldSealedFL forall wA wB. p wA wB -> Sealed (q wB) -> Sealed (q wA)
f (p wX wY
p :>: FL p wY wY
ps) Sealed (q wY)
acc = p wX wY -> Sealed (q wY) -> Sealed (q wX)
forall wA wB. p wA wB -> Sealed (q wB) -> Sealed (q wA)
f p wX wY
p ((forall wA wB. p wA wB -> Sealed (q wB) -> Sealed (q wA))
-> FL p wY wY -> Sealed (q wY) -> Sealed (q wY)
forall (p :: * -> * -> *) (q :: * -> * -> *) wX wY.
(forall wA wB. p wA wB -> Sealed (q wB) -> Sealed (q wA))
-> FL p wX wY -> Sealed (q wY) -> Sealed (q wX)
foldSealedFL p wA wB -> Sealed (q wB) -> Sealed (q wA)
forall wA wB. p wA wB -> Sealed (q wB) -> Sealed (q wA)
f FL p wY wY
ps Sealed (q wY)
acc)

obliterateOne
  :: PrimPatch prim
  => O.DiffAlgorithm
  -> RebaseChange prim wX wY
  -> Sealed (FL (RebaseChange prim) wY)
  -> Sealed (FL (RebaseChange prim) wX)
obliterateOne :: forall (prim :: * -> * -> *) wX wY.
PrimPatch prim =>
DiffAlgorithm
-> RebaseChange prim wX wY
-> Sealed (FL (RebaseChange prim) wY)
-> Sealed (FL (RebaseChange prim) wX)
obliterateOne DiffAlgorithm
da (RC FL (RebaseFixup prim) wX wY1
fs Named prim wY1 wY
e) =
  (forall wX.
 FL (RebaseChange prim) wY1 wX
 -> Sealed (FL (RebaseChange prim) wX))
-> Sealed (FL (RebaseChange prim) wY1)
-> Sealed (FL (RebaseChange prim) wX)
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal (DiffAlgorithm
-> FL (RebaseFixup prim) wX wY1
-> FL (RebaseChange prim) wY1 wX
-> Sealed (FL (RebaseChange prim) wX)
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 wY1
fs) (Sealed (FL (RebaseChange prim) wY1)
 -> Sealed (FL (RebaseChange prim) wX))
-> (Sealed (FL (RebaseChange prim) wY)
    -> Sealed (FL (RebaseChange prim) wY1))
-> Sealed (FL (RebaseChange prim) wY)
-> Sealed (FL (RebaseChange prim) wX)
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 wX.
 FL (RebaseChange prim) wY1 wX
 -> Sealed (FL (RebaseChange prim) wY1))
-> Sealed (FL (RebaseChange prim) wY1)
-> Sealed (FL (RebaseChange prim) wY1)
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal (DiffAlgorithm
-> RebaseFixup prim wY1 wY1
-> FL (RebaseChange prim) wY1 wX
-> Sealed (FL (RebaseChange prim) wY1)
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 (RebaseName wY1 wY1 -> RebaseFixup prim wY1 wY1
forall wX wY (prim :: * -> * -> *).
RebaseName wX wY -> RebaseFixup prim wX wY
NameFixup (PatchInfo -> RebaseName wY1 wY1
forall wX wY. PatchInfo -> RebaseName wX wY
AddName (Named prim wY1 wY -> PatchInfo
forall (p :: * -> * -> *) wX wY. Named p wX wY -> PatchInfo
patch2patchinfo Named prim wY1 wY
e)))) (Sealed (FL (RebaseChange prim) wY1)
 -> Sealed (FL (RebaseChange prim) wY1))
-> (Sealed (FL (RebaseChange prim) wY)
    -> Sealed (FL (RebaseChange prim) wY1))
-> Sealed (FL (RebaseChange prim) wY)
-> Sealed (FL (RebaseChange prim) wY1)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (forall wX.
 FL (RebaseChange prim) wY wX
 -> Sealed (FL (RebaseChange prim) wY1))
-> Sealed (FL (RebaseChange prim) wY)
-> Sealed (FL (RebaseChange prim) wY1)
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal (DiffAlgorithm
-> FL (RebaseFixup prim) wY1 wY
-> FL (RebaseChange prim) wY wX
-> Sealed (FL (RebaseChange prim) wY1)
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 wW wY. prim wW wY -> RebaseFixup prim wW wY)
-> FL prim wY1 wY -> FL (RebaseFixup prim) wY1 wY
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL prim wW wY -> RebaseFixup prim wW wY
forall wW wY. prim wW wY -> RebaseFixup prim wW wY
forall (prim :: * -> * -> *) wX wY.
prim wX wY -> RebaseFixup prim wX wY
PrimFixup (Named prim wY1 wY -> FL prim wY1 wY
forall (p :: * -> * -> *) wX wY. Named p wX wY -> FL p wX wY
patchcontents Named prim wY1 wY
e)))

edit :: DarcsCommand
edit :: DarcsCommand
edit = DarcsCommand
    { commandProgramName :: String
commandProgramName = String
"darcs"
    , commandName :: String
commandName = String
"edit"
    , commandHelp :: Doc
commandHelp = String -> Doc
text String
description
    , commandDescription :: String
commandDescription = String
description
    , 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 ()
editCmd
    , 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
    , commandOptions :: CommandOptions
commandOptions = CommandOptions
opts
    }
  where
    basicOpts :: OptSpec
  DarcsOptDescr DarcsFlag a (DiffAlgorithm -> WithSummary -> a)
basicOpts = PrimOptSpec
  DarcsOptDescr DarcsFlag (WithSummary -> a) DiffAlgorithm
PrimDarcsOption DiffAlgorithm
O.diffAlgorithm PrimOptSpec
  DarcsOptDescr DarcsFlag (WithSummary -> a) DiffAlgorithm
-> OptSpec DarcsOptDescr DarcsFlag a (WithSummary -> a)
-> OptSpec
     DarcsOptDescr DarcsFlag a (DiffAlgorithm -> WithSummary -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec DarcsOptDescr DarcsFlag a (WithSummary -> a)
PrimDarcsOption WithSummary
O.withSummary
    opts :: CommandOptions
opts = OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Verbosity
   -> UMask
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
  (DiffAlgorithm
   -> WithSummary
   -> Maybe StdCmdAction
   -> Verbosity
   -> UMask
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
forall {a}.
OptSpec
  DarcsOptDescr DarcsFlag a (DiffAlgorithm -> WithSummary -> a)
basicOpts OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Verbosity
   -> UMask
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
  (DiffAlgorithm
   -> WithSummary
   -> Maybe StdCmdAction
   -> Verbosity
   -> UMask
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
-> DarcsOption
     (UseCache
      -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
     (UMask
      -> UseCache
      -> UseIndex
      -> HooksConfig
      -> Bool
      -> Bool
      -> [DarcsFlag])
-> CommandOptions
forall b c.
DarcsOption (Maybe StdCmdAction -> Verbosity -> b) c
-> DarcsOption
     (UseCache
      -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
     b
-> CommandOptions
`withStdOpts` DarcsOption
  (UseCache
   -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
  (UMask
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
PrimDarcsOption UMask
O.umask
    description :: String
description = String
"Edit suspended patches."

data EditState prim wX = EditState
  { forall (prim :: * -> * -> *) wX. EditState prim wX -> Int
count :: Int
  , forall (prim :: * -> * -> *) wX. EditState prim wX -> Int
index :: Int
  , forall (prim :: * -> * -> *) wX.
EditState prim wX
-> Sealed
     ((:>) (RL (RebaseChange prim)) (FL (RebaseChange prim)) wX)
patches :: Sealed ((RL (RebaseChange prim) :> FL (RebaseChange prim)) wX)
  }

data Edit prim wX = Edit
  { forall (prim :: * -> * -> *) wX. Edit prim wX -> String
eWhat :: String
  , forall (prim :: * -> * -> *) wX. Edit prim wX -> EditState prim wX
eState :: EditState prim wX
  }

editCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
editCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
editCmd (AbsolutePath, AbsolutePath)
_ [DarcsFlag]
opts [String]
_args =
  UseCache -> UMask -> RepoJob 'RW () -> IO ()
forall a. UseCache -> UMask -> RepoJob 'RW a -> IO a
withRepoLock (PrimOptSpec DarcsOptDescr DarcsFlag a UseCache
PrimDarcsOption UseCache
useCache PrimDarcsOption UseCache -> [DarcsFlag] -> UseCache
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (PrimOptSpec DarcsOptDescr DarcsFlag a UMask
PrimDarcsOption UMask
umask PrimDarcsOption UMask -> [DarcsFlag] -> UMask
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (RepoJob 'RW () -> IO ()) -> RepoJob 'RW () -> IO ()
forall a b. (a -> b) -> a -> b
$ TreePatchJob 'RW () -> RepoJob 'RW ()
forall (rt :: AccessType) a. TreePatchJob rt a -> RepoJob rt a
RepoJob (TreePatchJob 'RW () -> RepoJob 'RW ())
-> TreePatchJob 'RW () -> RepoJob 'RW ()
forall a b. (a -> b) -> a -> b
$ \Repository 'RW p wU wR
_repository -> do
    Repository 'RW p wU wR -> IO ()
forall (rt :: AccessType) (p :: * -> * -> *) wU wR.
Repository rt p wU wR -> IO ()
checkHasRebase Repository 'RW p wU wR
_repository
    Items FL (RebaseChange (PrimOf p)) wR wY
items <- Repository 'RW p wU wR -> IO (Suspended p wR)
forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
RepoPatch p =>
Repository rt p wU wR -> IO (Suspended p wR)
readTentativeRebase Repository 'RW p wU wR
_repository
    let initial_state :: EditState (PrimOf p) wR
initial_state =
          EditState
            { count :: Int
count = FL (RebaseChange (PrimOf p)) wR wY -> Int
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Int
lengthFL FL (RebaseChange (PrimOf p)) wR wY
items
            , index :: Int
index = Int
0
            , patches :: Sealed
  ((:>)
     (RL (RebaseChange (PrimOf p))) (FL (RebaseChange (PrimOf p))) wR)
patches = (:>)
  (RL (RebaseChange (PrimOf p))) (FL (RebaseChange (PrimOf p))) wR wY
-> Sealed
     ((:>)
        (RL (RebaseChange (PrimOf p))) (FL (RebaseChange (PrimOf p))) wR)
forall (a :: * -> *) wX. a wX -> Sealed a
Sealed (RL (RebaseChange (PrimOf p)) wR wR
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL RL (RebaseChange (PrimOf p)) wR wR
-> FL (RebaseChange (PrimOf p)) wR wY
-> (:>)
     (RL (RebaseChange (PrimOf p))) (FL (RebaseChange (PrimOf p))) wR wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (RebaseChange (PrimOf p)) wR wY
items)
            }
    Sealed FL (RebaseChange (PrimOf p)) wR wX
items' <- [DarcsFlag]
-> [Edit (PrimOf p) wR]
-> EditState (PrimOf p) wR
-> [Edit (PrimOf p) wR]
-> IO (Sealed (FL (RebaseChange (PrimOf p)) wR))
forall (prim :: * -> * -> *) wR.
(PrimPatch prim, ApplyState prim ~ Tree) =>
[DarcsFlag]
-> [Edit prim wR]
-> EditState prim wR
-> [Edit prim wR]
-> IO (Sealed (FL (RebaseChange prim) wR))
interactiveEdit [DarcsFlag]
opts [] EditState (PrimOf p) wR
initial_state []
    Repository 'RW p wU wR -> Suspended p wR -> IO ()
forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
RepoPatch p =>
Repository rt p wU wR -> Suspended p wR -> IO ()
writeTentativeRebase Repository 'RW p wU wR
_repository (FL (RebaseChange (PrimOf p)) wR wX -> Suspended p wR
forall (p :: * -> * -> *) wX wY.
FL (RebaseChange (PrimOf p)) wX wY -> Suspended p wX
Items FL (RebaseChange (PrimOf p)) wR wX
items')
    IO (Repository 'RO p wU wR) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Repository 'RO p wU wR) -> IO ())
-> IO (Repository 'RO p wU wR) -> IO ()
forall a b. (a -> b) -> a -> b
$ Repository 'RW p wU wR -> DryRun -> IO (Repository 'RO p wU wR)
forall (p :: * -> * -> *) wU wR.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository 'RW p wU wR -> DryRun -> IO (Repository 'RO p wU wR)
finalizeRepositoryChanges Repository 'RW p wU wR
_repository (PrimOptSpec DarcsOptDescr DarcsFlag a DryRun
PrimDarcsOption DryRun
O.dryRun PrimDarcsOption DryRun -> [DarcsFlag] -> DryRun
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)

interactiveEdit
  :: (PrimPatch prim, ApplyState prim ~ Tree)
  => [DarcsFlag]
  -> [Edit prim wR]     -- ^ stack of undone edits, for redo
  -> EditState prim wR  -- ^ current state
  -> [Edit prim wR]     -- ^ stack of past edits, for undo
  -> IO (Sealed (FL (RebaseChange prim) wR))
interactiveEdit :: forall (prim :: * -> * -> *) wR.
(PrimPatch prim, ApplyState prim ~ Tree) =>
[DarcsFlag]
-> [Edit prim wR]
-> EditState prim wR
-> [Edit prim wR]
-> IO (Sealed (FL (RebaseChange prim) wR))
interactiveEdit [DarcsFlag]
opts [Edit prim wR]
redos s :: EditState prim wR
s@EditState{Int
Sealed ((:>) (RL (RebaseChange prim)) (FL (RebaseChange prim)) wR)
count :: forall (prim :: * -> * -> *) wX. EditState prim wX -> Int
index :: forall (prim :: * -> * -> *) wX. EditState prim wX -> Int
patches :: forall (prim :: * -> * -> *) wX.
EditState prim wX
-> Sealed
     ((:>) (RL (RebaseChange prim)) (FL (RebaseChange prim)) wX)
count :: Int
index :: Int
patches :: Sealed ((:>) (RL (RebaseChange prim)) (FL (RebaseChange prim)) wR)
..} [Edit prim wR]
undos =
  -- invariants:
  --  * the "todo" patches are empty only if the "done" patches are; formally:
  --      case patches of Sealed (done :> todo) -> nullFL todo ==> nullRL done
  case Sealed ((:>) (RL (RebaseChange prim)) (FL (RebaseChange prim)) wR)
patches of
    Sealed (RL (RebaseChange prim) wR wZ
_ :> FL (RebaseChange prim) wZ wX
NilFL) -> IO (Sealed (FL (RebaseChange prim) wR))
prompt
    Sealed (RL (RebaseChange prim) wR wZ
_ :> RebaseChange prim wZ wY
p :>: FL (RebaseChange prim) wY wX
_) -> RebaseChange prim wZ wY -> IO ()
forall {wX} {wY}. RebaseChange prim wX wY -> IO ()
defaultPrintFriendly RebaseChange prim wZ wY
p IO ()
-> IO (Sealed (FL (RebaseChange prim) wR))
-> IO (Sealed (FL (RebaseChange prim) wR))
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO (Sealed (FL (RebaseChange prim) wR))
prompt
  where
    da :: DiffAlgorithm
da = PrimOptSpec DarcsOptDescr DarcsFlag a DiffAlgorithm
PrimDarcsOption DiffAlgorithm
diffAlgorithm PrimDarcsOption DiffAlgorithm -> [DarcsFlag] -> DiffAlgorithm
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts

    -- helper functions
    defaultPrintFriendly :: RebaseChange prim wX wY -> IO ()
defaultPrintFriendly =
      IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ())
-> (RebaseChange prim wX wY -> IO ())
-> RebaseChange prim wX wY
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Verbosity -> WithSummary -> RebaseChange prim wX wY -> IO ()
forall (p :: * -> * -> *) wX wY.
ShowPatch p =>
Verbosity -> WithSummary -> p wX wY -> IO ()
printFriendly (PrimOptSpec DarcsOptDescr DarcsFlag a Verbosity
PrimDarcsOption Verbosity
O.verbosity PrimDarcsOption Verbosity -> [DarcsFlag] -> Verbosity
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (PrimOptSpec DarcsOptDescr DarcsFlag a WithSummary
PrimDarcsOption WithSummary
O.withSummary PrimDarcsOption WithSummary -> [DarcsFlag] -> WithSummary
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)

    -- common actions
    undo :: IO (Sealed (FL (RebaseChange prim) wR))
undo =
      case [Edit prim wR]
undos of
        [] -> String -> IO (Sealed (FL (RebaseChange prim) wR))
forall a. HasCallStack => String -> a
error String
"impossible"
        Edit prim wR
e : [Edit prim wR]
undos' ->
          -- pop last state from undos, push current state onto redos
          [DarcsFlag]
-> [Edit prim wR]
-> EditState prim wR
-> [Edit prim wR]
-> IO (Sealed (FL (RebaseChange prim) wR))
forall (prim :: * -> * -> *) wR.
(PrimPatch prim, ApplyState prim ~ Tree) =>
[DarcsFlag]
-> [Edit prim wR]
-> EditState prim wR
-> [Edit prim wR]
-> IO (Sealed (FL (RebaseChange prim) wR))
interactiveEdit [DarcsFlag]
opts (String -> EditState prim wR -> Edit prim wR
forall (prim :: * -> * -> *) wX.
String -> EditState prim wX -> Edit prim wX
Edit (Edit prim wR -> String
forall (prim :: * -> * -> *) wX. Edit prim wX -> String
eWhat Edit prim wR
e) EditState prim wR
s Edit prim wR -> [Edit prim wR] -> [Edit prim wR]
forall a. a -> [a] -> [a]
: [Edit prim wR]
redos) (Edit prim wR -> EditState prim wR
forall (prim :: * -> * -> *) wX. Edit prim wX -> EditState prim wX
eState Edit prim wR
e) [Edit prim wR]
undos'
    redo :: IO (Sealed (FL (RebaseChange prim) wR))
redo =
      case [Edit prim wR]
redos of
        [] -> String -> IO (Sealed (FL (RebaseChange prim) wR))
forall a. HasCallStack => String -> a
error String
"impossible"
        Edit prim wR
e : [Edit prim wR]
redos' ->
          -- pop last state from redos, push current state onto undos
          [DarcsFlag]
-> [Edit prim wR]
-> EditState prim wR
-> [Edit prim wR]
-> IO (Sealed (FL (RebaseChange prim) wR))
forall (prim :: * -> * -> *) wR.
(PrimPatch prim, ApplyState prim ~ Tree) =>
[DarcsFlag]
-> [Edit prim wR]
-> EditState prim wR
-> [Edit prim wR]
-> IO (Sealed (FL (RebaseChange prim) wR))
interactiveEdit [DarcsFlag]
opts [Edit prim wR]
redos' (Edit prim wR -> EditState prim wR
forall (prim :: * -> * -> *) wX. Edit prim wX -> EditState prim wX
eState Edit prim wR
e) (String -> EditState prim wR -> Edit prim wR
forall (prim :: * -> * -> *) wX.
String -> EditState prim wX -> Edit prim wX
Edit (Edit prim wR -> String
forall (prim :: * -> * -> *) wX. Edit prim wX -> String
eWhat Edit prim wR
e) EditState prim wR
s Edit prim wR -> [Edit prim wR] -> [Edit prim wR]
forall a. a -> [a] -> [a]
: [Edit prim wR]
undos)
    quit :: IO b
quit = do
      [DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
opts (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"Okay, rebase edit cancelled."
      IO b
forall a. IO a
exitSuccess
    commit :: IO (Sealed (FL (RebaseChange prim) wR))
commit =
      case Sealed ((:>) (RL (RebaseChange prim)) (FL (RebaseChange prim)) wR)
patches of
        Sealed (RL (RebaseChange prim) wR wZ
done :> FL (RebaseChange prim) wZ wX
todo) -> Sealed (FL (RebaseChange prim) wR)
-> IO (Sealed (FL (RebaseChange prim) wR))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (FL (RebaseChange prim) wR)
 -> IO (Sealed (FL (RebaseChange prim) wR)))
-> Sealed (FL (RebaseChange prim) wR)
-> IO (Sealed (FL (RebaseChange prim) wR))
forall a b. (a -> b) -> a -> b
$ FL (RebaseChange prim) wR wX -> Sealed (FL (RebaseChange prim) wR)
forall (a :: * -> *) wX. a wX -> Sealed a
Sealed (RL (RebaseChange prim) wR wZ
done RL (RebaseChange prim) wR wZ
-> FL (RebaseChange prim) wZ wX -> FL (RebaseChange prim) wR wX
forall (p :: * -> * -> *) wX wY wZ.
RL p wX wY -> FL p wY wZ -> FL p wX wZ
+>>+ FL (RebaseChange prim) wZ wX
todo)
    list :: IO (Sealed (FL (RebaseChange prim) wR))
list = (Edit prim wR -> IO ()) -> [Edit prim wR] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> IO ()
putStrLn (String -> IO ())
-> (Edit prim wR -> String) -> Edit prim wR -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Edit prim wR -> String
forall (prim :: * -> * -> *) wX. Edit prim wX -> String
eWhat) ([Edit prim wR] -> [Edit prim wR]
forall a. [a] -> [a]
reverse [Edit prim wR]
undos) IO ()
-> IO (Sealed (FL (RebaseChange prim) wR))
-> IO (Sealed (FL (RebaseChange prim) wR))
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO (Sealed (FL (RebaseChange prim) wR))
prompt
    choicesCommon :: [PromptChoice (Sealed (FL (RebaseChange prim) wR))]
choicesCommon =
      [ Char
-> Bool
-> IO (Sealed (FL (RebaseChange prim) wR))
-> String
-> PromptChoice (Sealed (FL (RebaseChange prim) wR))
forall a. Char -> Bool -> IO a -> String -> PromptChoice a
PromptChoice Char
'q' Bool
True IO (Sealed (FL (RebaseChange prim) wR))
forall a. IO a
quit String
"quit, discard all edits"
      , Char
-> Bool
-> IO (Sealed (FL (RebaseChange prim) wR))
-> String
-> PromptChoice (Sealed (FL (RebaseChange prim) wR))
forall a. Char -> Bool -> IO a -> String -> PromptChoice a
PromptChoice Char
'd' Bool
True IO (Sealed (FL (RebaseChange prim) wR))
commit String
"done editing, commit"
      , Char
-> Bool
-> IO (Sealed (FL (RebaseChange prim) wR))
-> String
-> PromptChoice (Sealed (FL (RebaseChange prim) wR))
forall a. Char -> Bool -> IO a -> String -> PromptChoice a
PromptChoice Char
'l' Bool
True IO (Sealed (FL (RebaseChange prim) wR))
list String
"list edits made so far"
      , Char
-> Bool
-> IO (Sealed (FL (RebaseChange prim) wR))
-> String
-> PromptChoice (Sealed (FL (RebaseChange prim) wR))
forall a. Char -> Bool -> IO a -> String -> PromptChoice a
PromptChoice Char
'u' (Bool -> Bool
not ([Edit prim wR] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Edit prim wR]
undos)) IO (Sealed (FL (RebaseChange prim) wR))
undo String
"undo previous edit"
      , Char
-> Bool
-> IO (Sealed (FL (RebaseChange prim) wR))
-> String
-> PromptChoice (Sealed (FL (RebaseChange prim) wR))
forall a. Char -> Bool -> IO a -> String -> PromptChoice a
PromptChoice Char
'r' (Bool -> Bool
not ([Edit prim wR] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Edit prim wR]
redos)) IO (Sealed (FL (RebaseChange prim) wR))
redo String
"redo previously undone edit"
      ]

    prompt :: IO (Sealed (FL (RebaseChange prim) wR))
prompt =
      case Sealed ((:>) (RL (RebaseChange prim)) (FL (RebaseChange prim)) wR)
patches of
        Sealed (RL (RebaseChange prim) wR wZ
_ :> FL (RebaseChange prim) wZ wX
NilFL) -> -- empty rebase state
          PromptConfig (Sealed (FL (RebaseChange prim) wR))
-> IO (Sealed (FL (RebaseChange prim) wR))
forall a. PromptConfig a -> IO a
runPrompt PromptConfig
            { pPrompt :: String
pPrompt = String
"No more suspended patches. What shall I do?"
            , pVerb :: String
pVerb = String
"rebase edit"
            , pChoices :: [[PromptChoice (Sealed (FL (RebaseChange prim) wR))]]
pChoices = [[PromptChoice (Sealed (FL (RebaseChange prim) wR))]
choicesCommon]
            , pDefault :: Maybe Char
pDefault = Maybe Char
forall a. Maybe a
Nothing
            }
        Sealed (RL (RebaseChange prim) wR wZ
done :> todo :: FL (RebaseChange prim) wZ wX
todo@(RebaseChange prim wZ wY
p :>: FL (RebaseChange prim) wY wX
todo')) -> -- non-empty rebase state
          PromptConfig (Sealed (FL (RebaseChange prim) wR))
-> IO (Sealed (FL (RebaseChange prim) wR))
forall a. PromptConfig a -> IO a
runPrompt PromptConfig
            { pPrompt :: String
pPrompt = String
"What shall I do with this patch? " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                  String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
count String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
            , pVerb :: String
pVerb = String
"rebase edit"
            , pChoices :: [[PromptChoice (Sealed (FL (RebaseChange prim) wR))]]
pChoices = [[PromptChoice (Sealed (FL (RebaseChange prim) wR))]
choicesEdit, [PromptChoice (Sealed (FL (RebaseChange prim) wR))]
choicesCommon, [PromptChoice (Sealed (FL (RebaseChange prim) wR))]
choicesView, [PromptChoice (Sealed (FL (RebaseChange prim) wR))]
choicesNav]
            , pDefault :: Maybe Char
pDefault = Maybe Char
forall a. Maybe a
Nothing
            }
          where

            choicesEdit :: [PromptChoice (Sealed (FL (RebaseChange prim) wR))]
choicesEdit =
              [ Char
-> Bool
-> IO (Sealed (FL (RebaseChange prim) wR))
-> String
-> PromptChoice (Sealed (FL (RebaseChange prim) wR))
forall a. Char -> Bool -> IO a -> String -> PromptChoice a
PromptChoice Char
'o' Bool
True IO (Sealed (FL (RebaseChange prim) wR))
dropit String
"drop (obliterate, dissolve into fixups)"
              , Char
-> Bool
-> IO (Sealed (FL (RebaseChange prim) wR))
-> String
-> PromptChoice (Sealed (FL (RebaseChange prim) wR))
forall a. Char -> Bool -> IO a -> String -> PromptChoice a
PromptChoice Char
'e' Bool
True IO (Sealed (FL (RebaseChange prim) wR))
reword String
"edit name and/or long comment (log)"
              , Char
-> Bool
-> IO (Sealed (FL (RebaseChange prim) wR))
-> String
-> PromptChoice (Sealed (FL (RebaseChange prim) wR))
forall a. Char -> Bool -> IO a -> String -> PromptChoice a
PromptChoice Char
's' (Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) IO (Sealed (FL (RebaseChange prim) wR))
squash String
"squash with previous patch"
              , Char
-> Bool
-> IO (Sealed (FL (RebaseChange prim) wR))
-> String
-> PromptChoice (Sealed (FL (RebaseChange prim) wR))
forall a. Char -> Bool -> IO a -> String -> PromptChoice a
PromptChoice Char
'i' Bool
can_inject IO (Sealed (FL (RebaseChange prim) wR))
inject' String
"inject fixups"
              -- TODO
              -- , PromptChoice 'c' True ??? "select individual changes for editing"
              ]
            choicesView :: [PromptChoice (Sealed (FL (RebaseChange prim) wR))]
choicesView =
              [ Char
-> Bool
-> IO (Sealed (FL (RebaseChange prim) wR))
-> String
-> PromptChoice (Sealed (FL (RebaseChange prim) wR))
forall a. Char -> Bool -> IO a -> String -> PromptChoice a
PromptChoice Char
'v' Bool
True IO (Sealed (FL (RebaseChange prim) wR))
view String
"view this patch in full"
              , Char
-> Bool
-> IO (Sealed (FL (RebaseChange prim) wR))
-> String
-> PromptChoice (Sealed (FL (RebaseChange prim) wR))
forall a. Char -> Bool -> IO a -> String -> PromptChoice a
PromptChoice Char
'p' Bool
True IO (Sealed (FL (RebaseChange prim) wR))
pager String
"view this patch in full with pager"
              , Char
-> Bool
-> IO (Sealed (FL (RebaseChange prim) wR))
-> String
-> PromptChoice (Sealed (FL (RebaseChange prim) wR))
forall a. Char -> Bool -> IO a -> String -> PromptChoice a
PromptChoice Char
'y' Bool
True IO (Sealed (FL (RebaseChange prim) wR))
display String
"view this patch"
              , Char
-> Bool
-> IO (Sealed (FL (RebaseChange prim) wR))
-> String
-> PromptChoice (Sealed (FL (RebaseChange prim) wR))
forall a. Char -> Bool -> IO a -> String -> PromptChoice a
PromptChoice Char
'x' Bool
can_summarize IO (Sealed (FL (RebaseChange prim) wR))
summary
                String
"view a summary of this patch"
              ]
            choicesNav :: [PromptChoice (Sealed (FL (RebaseChange prim) wR))]
choicesNav =
              [ Char
-> Bool
-> IO (Sealed (FL (RebaseChange prim) wR))
-> String
-> PromptChoice (Sealed (FL (RebaseChange prim) wR))
forall a. Char -> Bool -> IO a -> String -> PromptChoice a
PromptChoice Char
'n' (Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
count) IO (Sealed (FL (RebaseChange prim) wR))
next String
"skip to next patch"
              , Char
-> Bool
-> IO (Sealed (FL (RebaseChange prim) wR))
-> String
-> PromptChoice (Sealed (FL (RebaseChange prim) wR))
forall a. Char -> Bool -> IO a -> String -> PromptChoice a
PromptChoice Char
'k' (Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) IO (Sealed (FL (RebaseChange prim) wR))
prev String
"back up to previous patch"
              , Char
-> Bool
-> IO (Sealed (FL (RebaseChange prim) wR))
-> String
-> PromptChoice (Sealed (FL (RebaseChange prim) wR))
forall a. Char -> Bool -> IO a -> String -> PromptChoice a
PromptChoice Char
'g' (Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) IO (Sealed (FL (RebaseChange prim) wR))
first String
"start over from the first patch"
              ]

            -- helper functions
            edit' :: String
-> EditState prim wR -> IO (Sealed (FL (RebaseChange prim) wR))
edit' String
op EditState prim wR
s' = do
              let what :: String
what =
                    case RebaseChange prim wZ wY
p of RC FL (RebaseFixup prim) wZ wY1
_ Named prim wY1 wY
np -> String
op String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PatchInfo -> String
piName (Named prim wY1 wY -> PatchInfo
forall (p :: * -> * -> *) wX wY. Named p wX wY -> PatchInfo
patch2patchinfo Named prim wY1 wY
np)
              -- set new state s' and push the current one onto the undo stack
              -- discarding the redo stack
              [DarcsFlag]
-> [Edit prim wR]
-> EditState prim wR
-> [Edit prim wR]
-> IO (Sealed (FL (RebaseChange prim) wR))
forall (prim :: * -> * -> *) wR.
(PrimPatch prim, ApplyState prim ~ Tree) =>
[DarcsFlag]
-> [Edit prim wR]
-> EditState prim wR
-> [Edit prim wR]
-> IO (Sealed (FL (RebaseChange prim) wR))
interactiveEdit [DarcsFlag]
opts [] EditState prim wR
s' (String -> EditState prim wR -> Edit prim wR
forall (prim :: * -> * -> *) wX.
String -> EditState prim wX -> Edit prim wX
Edit String
what EditState prim wR
s Edit prim wR -> [Edit prim wR] -> [Edit prim wR]
forall a. a -> [a] -> [a]
: [Edit prim wR]
undos)
            navigate :: EditState prim wR -> IO (Sealed (FL (RebaseChange prim) wR))
navigate EditState prim wR
s' =
              -- set new state s' with no undo or redo stack modification
              [DarcsFlag]
-> [Edit prim wR]
-> EditState prim wR
-> [Edit prim wR]
-> IO (Sealed (FL (RebaseChange prim) wR))
forall (prim :: * -> * -> *) wR.
(PrimPatch prim, ApplyState prim ~ Tree) =>
[DarcsFlag]
-> [Edit prim wR]
-> EditState prim wR
-> [Edit prim wR]
-> IO (Sealed (FL (RebaseChange prim) wR))
interactiveEdit [DarcsFlag]
opts [Edit prim wR]
redos EditState prim wR
s' [Edit prim wR]
undos

            can_summarize :: Bool
can_summarize = Bool -> Bool
not (WithSummary -> Bool
forall a. YesNo a => a -> Bool
O.yes (PrimOptSpec DarcsOptDescr DarcsFlag a WithSummary
PrimDarcsOption WithSummary
O.withSummary PrimDarcsOption WithSummary -> [DarcsFlag] -> WithSummary
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts))
            can_inject :: Bool
can_inject = case RebaseChange prim wZ wY
p of (RC FL (RebaseFixup prim) wZ wY1
NilFL Named prim wY1 wY
_) -> Bool
False; RebaseChange prim wZ wY
_ -> Bool
True

            -- editing
            dropit :: IO (Sealed (FL (RebaseChange prim) wR))
dropit = do
              Sealed FL (RebaseChange prim) wZ wX
todo'' <- Sealed (FL (RebaseChange prim) wZ)
-> IO (Sealed (FL (RebaseChange prim) wZ))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (FL (RebaseChange prim) wZ)
 -> IO (Sealed (FL (RebaseChange prim) wZ)))
-> Sealed (FL (RebaseChange prim) wZ)
-> IO (Sealed (FL (RebaseChange prim) wZ))
forall a b. (a -> b) -> a -> b
$ DiffAlgorithm
-> RebaseChange prim wZ wY
-> Sealed (FL (RebaseChange prim) wY)
-> Sealed (FL (RebaseChange prim) wZ)
forall (prim :: * -> * -> *) wX wY.
PrimPatch prim =>
DiffAlgorithm
-> RebaseChange prim wX wY
-> Sealed (FL (RebaseChange prim) wY)
-> Sealed (FL (RebaseChange prim) wX)
obliterateOne DiffAlgorithm
da RebaseChange prim wZ wY
p (FL (RebaseChange prim) wY wX -> Sealed (FL (RebaseChange prim) wY)
forall (a :: * -> *) wX. a wX -> Sealed a
Sealed FL (RebaseChange prim) wY wX
todo')
              String
-> EditState prim wR -> IO (Sealed (FL (RebaseChange prim) wR))
edit' String
"drop  " EditState prim wR
s { count = count - 1 , patches = Sealed (done :> todo'') }
            inject' :: IO (Sealed (FL (RebaseChange prim) wR))
inject' = do
              Either ExitCode (Sealed (FL (RebaseChange prim) wZ))
result <- IO (Sealed (FL (RebaseChange prim) wZ))
-> IO (Either ExitCode (Sealed (FL (RebaseChange prim) wZ)))
forall e a. Exception e => IO a -> IO (Either e a)
try (IO (Sealed (FL (RebaseChange prim) wZ))
 -> IO (Either ExitCode (Sealed (FL (RebaseChange prim) wZ))))
-> IO (Sealed (FL (RebaseChange prim) wZ))
-> IO (Either ExitCode (Sealed (FL (RebaseChange prim) wZ)))
forall a b. (a -> b) -> a -> b
$ [DarcsFlag]
-> RebaseChange prim wZ wY
-> FL (RebaseChange prim) wY wX
-> IO (Sealed (FL (RebaseChange prim) wZ))
forall (prim :: * -> * -> *) wX wY wZ.
(PrimPatch prim, ApplyState prim ~ Tree) =>
[DarcsFlag]
-> RebaseChange prim wX wY
-> FL (RebaseChange prim) wY wZ
-> IO (Sealed (FL (RebaseChange prim) wX))
injectOne [DarcsFlag]
opts RebaseChange prim wZ wY
p FL (RebaseChange prim) wY wX
todo'
              case Either ExitCode (Sealed (FL (RebaseChange prim) wZ))
result of
                Left ExitCode
ExitSuccess -> IO (Sealed (FL (RebaseChange prim) wR))
prompt
                Left ExitCode
e -> ExitCode -> IO (Sealed (FL (RebaseChange prim) wR))
forall e a. Exception e => e -> IO a
throwIO ExitCode
e
                Right (Sealed FL (RebaseChange prim) wZ wX
todo'') ->
                  String
-> EditState prim wR -> IO (Sealed (FL (RebaseChange prim) wR))
edit' String
"inject" EditState prim wR
s { patches = Sealed (done :> todo'') }
            reword :: IO (Sealed (FL (RebaseChange prim) wR))
reword = do
              Sealed FL (RebaseChange prim) wZ wX
todo'' <- DiffAlgorithm
-> RebaseChange prim wZ wY
-> FL (RebaseChange prim) wY wX
-> IO (Sealed (FL (RebaseChange prim) wZ))
forall (prim :: * -> * -> *) wX wY wZ.
(PrimPatch prim, ApplyState prim ~ Tree) =>
DiffAlgorithm
-> RebaseChange prim wX wY
-> FL (RebaseChange prim) wY wZ
-> IO (Sealed (FL (RebaseChange prim) wX))
rewordOne DiffAlgorithm
da RebaseChange prim wZ wY
p FL (RebaseChange prim) wY wX
todo'
              String
-> EditState prim wR -> IO (Sealed (FL (RebaseChange prim) wR))
edit' String
"reword" EditState prim wR
s { patches = Sealed (done :> todo'') }
            squash :: IO (Sealed (FL (RebaseChange prim) wR))
squash =
              case RL (RebaseChange prim) wR wZ
done of
                RL (RebaseChange prim) wR wZ
NilRL -> String -> IO (Sealed (FL (RebaseChange prim) wR))
forall a. HasCallStack => String -> a
error String
"impossible"
                RL (RebaseChange prim) wR wY
done' :<: RebaseChange prim wY wZ
q ->
                  case DiffAlgorithm
-> RebaseChange prim wY wZ
-> RebaseChange prim wZ wY
-> FL (RebaseChange prim) wY wX
-> Maybe (Sealed (FL (RebaseChange prim) wY))
forall (prim :: * -> * -> *) wX wY wZ wW.
PrimPatch prim =>
DiffAlgorithm
-> RebaseChange prim wX wY
-> RebaseChange prim wY wZ
-> FL (RebaseChange prim) wZ wW
-> Maybe (Sealed (FL (RebaseChange prim) wX))
squashOne DiffAlgorithm
da RebaseChange prim wY wZ
q RebaseChange prim wZ wY
p FL (RebaseChange prim) wY wX
todo' of
                    Just (Sealed FL (RebaseChange prim) wY wX
todo'') ->
                      -- this moves back by one so the new squashed patch is
                      -- selected; useful in case you now want to edit the
                      -- comment or look at the result
                      String
-> EditState prim wR -> IO (Sealed (FL (RebaseChange prim) wR))
edit' String
"squash" EditState prim wR
s
                        { count = count - 1
                        , index = index - 1
                        , patches = Sealed (done' :> todo'')
                        }
                    Maybe (Sealed (FL (RebaseChange prim) wY))
Nothing -> do
                      String -> IO ()
putStrLn String
"Failed to commute fixups backward, try inject first."
                      IO (Sealed (FL (RebaseChange prim) wR))
prompt

            -- viewing
            view :: IO (Sealed (FL (RebaseChange prim) wR))
view = RebaseChange prim wZ wY -> IO ()
forall (p :: * -> * -> *) wX wY. ShowPatch p => p wX wY -> IO ()
printContent RebaseChange prim wZ wY
p IO ()
-> IO (Sealed (FL (RebaseChange prim) wR))
-> IO (Sealed (FL (RebaseChange prim) wR))
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO (Sealed (FL (RebaseChange prim) wR))
prompt
            pager :: IO (Sealed (FL (RebaseChange prim) wR))
pager = RebaseChange prim wZ wY -> IO ()
forall (p :: * -> * -> *) wX wY. ShowPatch p => p wX wY -> IO ()
printContentWithPager RebaseChange prim wZ wY
p IO ()
-> IO (Sealed (FL (RebaseChange prim) wR))
-> IO (Sealed (FL (RebaseChange prim) wR))
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO (Sealed (FL (RebaseChange prim) wR))
prompt
            display :: IO (Sealed (FL (RebaseChange prim) wR))
display = RebaseChange prim wZ wY -> IO ()
forall {wX} {wY}. RebaseChange prim wX wY -> IO ()
defaultPrintFriendly RebaseChange prim wZ wY
p IO ()
-> IO (Sealed (FL (RebaseChange prim) wR))
-> IO (Sealed (FL (RebaseChange prim) wR))
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO (Sealed (FL (RebaseChange prim) wR))
prompt
            summary :: IO (Sealed (FL (RebaseChange prim) wR))
summary = RebaseChange prim wZ wY -> IO ()
forall (p :: * -> * -> *) wX wY. ShowPatch p => p wX wY -> IO ()
printSummary RebaseChange prim wZ wY
p IO ()
-> IO (Sealed (FL (RebaseChange prim) wR))
-> IO (Sealed (FL (RebaseChange prim) wR))
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO (Sealed (FL (RebaseChange prim) wR))
prompt

            -- navigation
            next :: IO (Sealed (FL (RebaseChange prim) wR))
next =
              case FL (RebaseChange prim) wY wX
todo' of
                FL (RebaseChange prim) wY wX
NilFL -> String -> IO (Sealed (FL (RebaseChange prim) wR))
forall a. HasCallStack => String -> a
error String
"impossible"
                FL (RebaseChange prim) wY wX
_ ->
                  EditState prim wR -> IO (Sealed (FL (RebaseChange prim) wR))
navigate
                    EditState prim wR
s { index = index + 1, patches = Sealed (done :<: p :> todo') }
            prev :: IO (Sealed (FL (RebaseChange prim) wR))
prev =
              case RL (RebaseChange prim) wR wZ
done of
                RL (RebaseChange prim) wR wZ
NilRL -> String -> IO (Sealed (FL (RebaseChange prim) wR))
forall a. HasCallStack => String -> a
error String
"impossible"
                RL (RebaseChange prim) wR wY
done' :<: RebaseChange prim wY wZ
p' ->
                  EditState prim wR -> IO (Sealed (FL (RebaseChange prim) wR))
navigate
                    EditState prim wR
s { index = index - 1, patches = Sealed (done' :> p' :>: todo) }
            first :: IO (Sealed (FL (RebaseChange prim) wR))
first =
              EditState prim wR -> IO (Sealed (FL (RebaseChange prim) wR))
navigate EditState prim wR
s { index = 0, patches = Sealed (NilRL :> done +>>+ todo) }

-- | Squash second patch with first, updating the rest of the rebase state.
-- This can fail if the second patch has fixups that don't commute with the
-- contents of the first patch.
squashOne
  :: PrimPatch prim
  => O.DiffAlgorithm
  -> RebaseChange prim wX wY
  -> RebaseChange prim wY wZ
  -> FL (RebaseChange prim) wZ wW
  -> Maybe (Sealed (FL (RebaseChange prim) wX))
squashOne :: forall (prim :: * -> * -> *) wX wY wZ wW.
PrimPatch prim =>
DiffAlgorithm
-> RebaseChange prim wX wY
-> RebaseChange prim wY wZ
-> FL (RebaseChange prim) wZ wW
-> Maybe (Sealed (FL (RebaseChange prim) wX))
squashOne DiffAlgorithm
da (RC FL (RebaseFixup prim) wX wY1
fs1 Named prim wY1 wY
e1) (RC FL (RebaseFixup prim) wY wY1
fs2 Named prim wY1 wZ
e2) FL (RebaseChange prim) wZ wW
rest = do
  FL (RebaseFixup prim) wY1 wZ
fs2' :> Named prim wZ wY1
e1' <- CommuteFn (Named prim) (RebaseFixup prim)
-> CommuteFn (Named prim) (FL (RebaseFixup prim))
forall (p1 :: * -> * -> *) (p2 :: * -> * -> *).
CommuteFn p1 p2 -> CommuteFn p1 (FL p2)
commuterIdFL (:>) (Named prim) (RebaseFixup prim) wX wY
-> Maybe ((:>) (RebaseFixup prim) (Named prim) wX wY)
CommuteFn (Named prim) (RebaseFixup prim)
forall (prim :: * -> * -> *) wX wY.
Commute prim =>
(:>) (Named prim) (RebaseFixup prim) wX wY
-> Maybe ((:>) (RebaseFixup prim) (Named prim) wX wY)
commuteNamedFixup (Named prim wY1 wY
e1 Named prim wY1 wY
-> FL (RebaseFixup prim) wY wY1
-> (:>) (Named prim) (FL (RebaseFixup prim)) wY1 wY1
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (RebaseFixup prim) wY wY1
fs2)
  let e1'' :: Named prim wZ wZ
e1'' = (FL prim wZ wY1 -> FL prim wZ wZ)
-> Named prim wZ wY1 -> Named prim wZ wZ
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 (DiffAlgorithm -> FL prim wZ wZ -> FL prim wZ wZ
forall (prim :: * -> * -> *) wX wY.
(IsHunk prim, PrimCoalesce prim, PrimConstruct prim) =>
DiffAlgorithm -> FL prim wX wY -> FL prim wX wY
canonizeFL DiffAlgorithm
da (FL prim wZ wZ -> FL prim wZ wZ)
-> (FL prim wZ wY1 -> FL prim wZ wZ)
-> FL prim wZ wY1
-> FL prim wZ wZ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FL prim wZ wY1 -> FL prim wY1 wZ -> FL prim wZ wZ
forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ Named prim wY1 wZ -> FL prim wY1 wZ
forall (p :: * -> * -> *) wX wY. Named p wX wY -> FL p wX wY
patchcontents Named prim wY1 wZ
e2)) Named prim wZ wY1
e1'
      e2_name_fixup :: RebaseFixup prim wX wY
e2_name_fixup = RebaseName wX wY -> RebaseFixup prim wX wY
forall wX wY (prim :: * -> * -> *).
RebaseName wX wY -> RebaseFixup prim wX wY
NameFixup (PatchInfo -> RebaseName wX wY
forall wX wY. PatchInfo -> RebaseName wX wY
AddName (Named prim wY1 wZ -> PatchInfo
forall (p :: * -> * -> *) wX wY. Named p wX wY -> PatchInfo
patch2patchinfo Named prim wY1 wZ
e2))
  Sealed (FL (RebaseChange prim) wX)
-> Maybe (Sealed (FL (RebaseChange prim) wX))
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (FL (RebaseChange prim) wX)
 -> Maybe (Sealed (FL (RebaseChange prim) wX)))
-> Sealed (FL (RebaseChange prim) wX)
-> Maybe (Sealed (FL (RebaseChange prim) wX))
forall a b. (a -> b) -> a -> b
$
    case DiffAlgorithm
-> RebaseFixup prim wZ wZ
-> FL (RebaseChange prim) wZ wW
-> Sealed (FL (RebaseChange prim) wZ)
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 RebaseFixup prim wZ wZ
forall {prim :: * -> * -> *} {wX} {wY}. RebaseFixup prim wX wY
e2_name_fixup FL (RebaseChange prim) wZ wW
rest of
      Sealed FL (RebaseChange prim) wZ wX
rest' -> DiffAlgorithm
-> FL (RebaseFixup prim) wX wZ
-> FL (RebaseChange prim) wZ wX
-> Sealed (FL (RebaseChange prim) wX)
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 wY1
fs1 FL (RebaseFixup prim) wX wY1
-> FL (RebaseFixup prim) wY1 wZ -> FL (RebaseFixup prim) wX wZ
forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ FL (RebaseFixup prim) wY1 wZ
fs2') (FL (RebaseFixup prim) wZ wZ
-> Named prim wZ wZ -> RebaseChange prim wZ wZ
forall (prim :: * -> * -> *) wX wY1 wY.
FL (RebaseFixup prim) wX wY1
-> Named prim wY1 wY -> RebaseChange prim wX wY
RC FL (RebaseFixup prim) wZ wZ
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL Named prim wZ wZ
e1'' RebaseChange prim wZ wZ
-> FL (RebaseChange prim) wZ wX -> FL (RebaseChange prim) wZ wX
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL (RebaseChange prim) wZ wX
rest')

rewordOne
  :: (PrimPatch prim, ApplyState prim ~ Tree)
  => O.DiffAlgorithm
  -> RebaseChange prim wX wY
  -> FL (RebaseChange prim) wY wZ
  -> IO (Sealed (FL (RebaseChange prim) wX))
rewordOne :: forall (prim :: * -> * -> *) wX wY wZ.
(PrimPatch prim, ApplyState prim ~ Tree) =>
DiffAlgorithm
-> RebaseChange prim wX wY
-> FL (RebaseChange prim) wY wZ
-> IO (Sealed (FL (RebaseChange prim) wX))
rewordOne DiffAlgorithm
da (RC FL (RebaseFixup prim) wX wY1
fs Named prim wY1 wY
e) FL (RebaseChange prim) wY wZ
rest = do
  Named prim wY1 wY
e' <- Named prim wY1 wY -> IO (Named prim wY1 wY)
forall (prim :: * -> * -> *) wX wY.
Named prim wX wY -> IO (Named prim wX wY)
editLog Named prim wY1 wY
e
  let rename :: RebaseFixup prim wX wY
rename = RebaseName wX wY -> RebaseFixup prim wX wY
forall wX wY (prim :: * -> * -> *).
RebaseName wX wY -> RebaseFixup prim wX wY
NameFixup (RebaseName wX wY -> RebaseFixup prim wX wY)
-> RebaseName wX wY -> RebaseFixup prim wX wY
forall a b. (a -> b) -> a -> b
$ PatchInfo -> PatchInfo -> RebaseName wX wY
forall wX wY. PatchInfo -> PatchInfo -> RebaseName wX wY
Rename (Named prim wY1 wY -> PatchInfo
forall (p :: * -> * -> *) wX wY. Named p wX wY -> PatchInfo
patch2patchinfo Named prim wY1 wY
e') (Named prim wY1 wY -> PatchInfo
forall (p :: * -> * -> *) wX wY. Named p wX wY -> PatchInfo
patch2patchinfo Named prim wY1 wY
e)
  case DiffAlgorithm
-> RebaseFixup prim wY wY
-> FL (RebaseChange prim) wY wZ
-> Sealed (FL (RebaseChange prim) wY)
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 RebaseFixup prim wY wY
forall {prim :: * -> * -> *} {wX} {wY}. RebaseFixup prim wX wY
rename FL (RebaseChange prim) wY wZ
rest of
    Sealed FL (RebaseChange prim) wY wX
rest' -> Sealed (FL (RebaseChange prim) wX)
-> IO (Sealed (FL (RebaseChange prim) wX))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (FL (RebaseChange prim) wX)
 -> IO (Sealed (FL (RebaseChange prim) wX)))
-> Sealed (FL (RebaseChange prim) wX)
-> IO (Sealed (FL (RebaseChange prim) wX))
forall a b. (a -> b) -> a -> b
$ FL (RebaseChange prim) wX wX -> Sealed (FL (RebaseChange prim) wX)
forall (a :: * -> *) wX. a wX -> Sealed a
Sealed (FL (RebaseChange prim) wX wX
 -> Sealed (FL (RebaseChange prim) wX))
-> FL (RebaseChange prim) wX wX
-> Sealed (FL (RebaseChange prim) wX)
forall a b. (a -> b) -> a -> b
$ FL (RebaseFixup prim) wX wY1
-> Named prim wY1 wY -> RebaseChange prim wX wY
forall (prim :: * -> * -> *) wX wY1 wY.
FL (RebaseFixup prim) wX wY1
-> Named prim wY1 wY -> RebaseChange prim wX wY
RC FL (RebaseFixup prim) wX wY1
fs Named prim wY1 wY
e' RebaseChange prim wX wY
-> FL (RebaseChange prim) wY wX -> FL (RebaseChange prim) wX wX
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL (RebaseChange prim) wY wX
rest'

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 = RebasePatchApplier
-> (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
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 = Pref
-> (AbsolutePath, AbsolutePath)
-> [DarcsFlag]
-> [String]
-> IO [String]
prefArgs Pref
Repos
    , commandArgdefaults :: [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
commandArgdefaults = [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
defaultRepo
    , commandOptions :: CommandOptions
commandOptions = CommandOptions
pullOpts
    }
  where
    pullBasicOpts :: OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  ([MatchFlag]
   -> Reorder
   -> Maybe Bool
   -> Maybe AllowConflicts
   -> TestChanges
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> SelectDeps
   -> Maybe String
   -> Bool
   -> DiffAlgorithm
   -> a)
pullBasicOpts
      = PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  (Reorder
   -> Maybe Bool
   -> Maybe AllowConflicts
   -> TestChanges
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> SelectDeps
   -> Maybe String
   -> Bool
   -> DiffAlgorithm
   -> a)
  [MatchFlag]
MatchOption
O.matchSeveral
      PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  (Reorder
   -> Maybe Bool
   -> Maybe AllowConflicts
   -> TestChanges
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> SelectDeps
   -> Maybe String
   -> Bool
   -> DiffAlgorithm
   -> a)
  [MatchFlag]
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe Bool
      -> Maybe AllowConflicts
      -> TestChanges
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> SelectDeps
      -> Maybe String
      -> Bool
      -> DiffAlgorithm
      -> a)
     (Reorder
      -> Maybe Bool
      -> Maybe AllowConflicts
      -> TestChanges
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> SelectDeps
      -> Maybe String
      -> Bool
      -> DiffAlgorithm
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe Bool
      -> Maybe AllowConflicts
      -> TestChanges
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> SelectDeps
      -> Maybe String
      -> Bool
      -> DiffAlgorithm
      -> a)
     ([MatchFlag]
      -> Reorder
      -> Maybe Bool
      -> Maybe AllowConflicts
      -> TestChanges
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> SelectDeps
      -> Maybe String
      -> Bool
      -> DiffAlgorithm
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe Bool
   -> Maybe AllowConflicts
   -> TestChanges
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> SelectDeps
   -> Maybe String
   -> Bool
   -> DiffAlgorithm
   -> a)
  (Reorder
   -> Maybe Bool
   -> Maybe AllowConflicts
   -> TestChanges
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> SelectDeps
   -> Maybe String
   -> Bool
   -> DiffAlgorithm
   -> a)
PrimDarcsOption Reorder
O.reorder
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe Bool
   -> Maybe AllowConflicts
   -> TestChanges
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> SelectDeps
   -> Maybe String
   -> Bool
   -> DiffAlgorithm
   -> a)
  ([MatchFlag]
   -> Reorder
   -> Maybe Bool
   -> Maybe AllowConflicts
   -> TestChanges
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> SelectDeps
   -> Maybe String
   -> Bool
   -> DiffAlgorithm
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe AllowConflicts
      -> TestChanges
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> SelectDeps
      -> Maybe String
      -> Bool
      -> DiffAlgorithm
      -> a)
     (Maybe Bool
      -> Maybe AllowConflicts
      -> TestChanges
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> SelectDeps
      -> Maybe String
      -> Bool
      -> DiffAlgorithm
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe AllowConflicts
      -> TestChanges
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> SelectDeps
      -> Maybe String
      -> Bool
      -> DiffAlgorithm
      -> a)
     ([MatchFlag]
      -> Reorder
      -> Maybe Bool
      -> Maybe AllowConflicts
      -> TestChanges
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> SelectDeps
      -> Maybe String
      -> Bool
      -> DiffAlgorithm
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe AllowConflicts
   -> TestChanges
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> SelectDeps
   -> Maybe String
   -> Bool
   -> DiffAlgorithm
   -> a)
  (Maybe Bool
   -> Maybe AllowConflicts
   -> TestChanges
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> SelectDeps
   -> Maybe String
   -> Bool
   -> DiffAlgorithm
   -> a)
PrimDarcsOption (Maybe Bool)
O.interactive
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe AllowConflicts
   -> TestChanges
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> SelectDeps
   -> Maybe String
   -> Bool
   -> DiffAlgorithm
   -> a)
  ([MatchFlag]
   -> Reorder
   -> Maybe Bool
   -> Maybe AllowConflicts
   -> TestChanges
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> SelectDeps
   -> Maybe String
   -> Bool
   -> DiffAlgorithm
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (TestChanges
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> SelectDeps
      -> Maybe String
      -> Bool
      -> DiffAlgorithm
      -> a)
     (Maybe AllowConflicts
      -> TestChanges
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> SelectDeps
      -> Maybe String
      -> Bool
      -> DiffAlgorithm
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (TestChanges
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> SelectDeps
      -> Maybe String
      -> Bool
      -> DiffAlgorithm
      -> a)
     ([MatchFlag]
      -> Reorder
      -> Maybe Bool
      -> Maybe AllowConflicts
      -> TestChanges
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> SelectDeps
      -> Maybe String
      -> Bool
      -> DiffAlgorithm
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (TestChanges
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> SelectDeps
   -> Maybe String
   -> Bool
   -> DiffAlgorithm
   -> a)
  (Maybe AllowConflicts
   -> TestChanges
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> SelectDeps
   -> Maybe String
   -> Bool
   -> DiffAlgorithm
   -> a)
PrimDarcsOption (Maybe AllowConflicts)
O.conflictsYes
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (TestChanges
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> SelectDeps
   -> Maybe String
   -> Bool
   -> DiffAlgorithm
   -> a)
  ([MatchFlag]
   -> Reorder
   -> Maybe Bool
   -> Maybe AllowConflicts
   -> TestChanges
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> SelectDeps
   -> Maybe String
   -> Bool
   -> DiffAlgorithm
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (DryRun
      -> XmlOutput
      -> WithSummary
      -> SelectDeps
      -> Maybe String
      -> Bool
      -> DiffAlgorithm
      -> a)
     (TestChanges
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> SelectDeps
      -> Maybe String
      -> Bool
      -> DiffAlgorithm
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (DryRun
      -> XmlOutput
      -> WithSummary
      -> SelectDeps
      -> Maybe String
      -> Bool
      -> DiffAlgorithm
      -> a)
     ([MatchFlag]
      -> Reorder
      -> Maybe Bool
      -> Maybe AllowConflicts
      -> TestChanges
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> SelectDeps
      -> Maybe String
      -> Bool
      -> DiffAlgorithm
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (DryRun
   -> XmlOutput
   -> WithSummary
   -> SelectDeps
   -> Maybe String
   -> Bool
   -> DiffAlgorithm
   -> a)
  (TestChanges
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> SelectDeps
   -> Maybe String
   -> Bool
   -> DiffAlgorithm
   -> a)
PrimDarcsOption TestChanges
O.testChanges
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (DryRun
   -> XmlOutput
   -> WithSummary
   -> SelectDeps
   -> Maybe String
   -> Bool
   -> DiffAlgorithm
   -> a)
  ([MatchFlag]
   -> Reorder
   -> Maybe Bool
   -> Maybe AllowConflicts
   -> TestChanges
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> SelectDeps
   -> Maybe String
   -> Bool
   -> DiffAlgorithm
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (WithSummary
      -> SelectDeps -> Maybe String -> Bool -> DiffAlgorithm -> a)
     (DryRun
      -> XmlOutput
      -> WithSummary
      -> SelectDeps
      -> Maybe String
      -> Bool
      -> DiffAlgorithm
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (WithSummary
      -> SelectDeps -> Maybe String -> Bool -> DiffAlgorithm -> a)
     ([MatchFlag]
      -> Reorder
      -> Maybe Bool
      -> Maybe AllowConflicts
      -> TestChanges
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> SelectDeps
      -> Maybe String
      -> Bool
      -> DiffAlgorithm
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (WithSummary
   -> SelectDeps -> Maybe String -> Bool -> DiffAlgorithm -> a)
  (DryRun
   -> XmlOutput
   -> WithSummary
   -> SelectDeps
   -> Maybe String
   -> Bool
   -> DiffAlgorithm
   -> a)
forall a. DarcsOption a (DryRun -> XmlOutput -> a)
O.dryRunXml
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (WithSummary
   -> SelectDeps -> Maybe String -> Bool -> DiffAlgorithm -> a)
  ([MatchFlag]
   -> Reorder
   -> Maybe Bool
   -> Maybe AllowConflicts
   -> TestChanges
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> SelectDeps
   -> Maybe String
   -> Bool
   -> DiffAlgorithm
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (SelectDeps -> Maybe String -> Bool -> DiffAlgorithm -> a)
     (WithSummary
      -> SelectDeps -> Maybe String -> Bool -> DiffAlgorithm -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (SelectDeps -> Maybe String -> Bool -> DiffAlgorithm -> a)
     ([MatchFlag]
      -> Reorder
      -> Maybe Bool
      -> Maybe AllowConflicts
      -> TestChanges
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> SelectDeps
      -> Maybe String
      -> Bool
      -> DiffAlgorithm
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (SelectDeps -> Maybe String -> Bool -> DiffAlgorithm -> a)
  (WithSummary
   -> SelectDeps -> Maybe String -> Bool -> DiffAlgorithm -> a)
PrimDarcsOption WithSummary
O.withSummary
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (SelectDeps -> Maybe String -> Bool -> DiffAlgorithm -> a)
  ([MatchFlag]
   -> Reorder
   -> Maybe Bool
   -> Maybe AllowConflicts
   -> TestChanges
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> SelectDeps
   -> Maybe String
   -> Bool
   -> DiffAlgorithm
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe String -> Bool -> DiffAlgorithm -> a)
     (SelectDeps -> Maybe String -> Bool -> DiffAlgorithm -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe String -> Bool -> DiffAlgorithm -> a)
     ([MatchFlag]
      -> Reorder
      -> Maybe Bool
      -> Maybe AllowConflicts
      -> TestChanges
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> SelectDeps
      -> Maybe String
      -> Bool
      -> DiffAlgorithm
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe String -> Bool -> DiffAlgorithm -> a)
  (SelectDeps -> Maybe String -> Bool -> DiffAlgorithm -> a)
PrimDarcsOption SelectDeps
O.selectDeps
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe String -> Bool -> DiffAlgorithm -> a)
  ([MatchFlag]
   -> Reorder
   -> Maybe Bool
   -> Maybe AllowConflicts
   -> TestChanges
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> SelectDeps
   -> Maybe String
   -> Bool
   -> DiffAlgorithm
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Bool -> DiffAlgorithm -> a)
     (Maybe String -> Bool -> DiffAlgorithm -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Bool -> DiffAlgorithm -> a)
     ([MatchFlag]
      -> Reorder
      -> Maybe Bool
      -> Maybe AllowConflicts
      -> TestChanges
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> SelectDeps
      -> Maybe String
      -> Bool
      -> DiffAlgorithm
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (Bool -> DiffAlgorithm -> a)
  (Maybe String -> Bool -> DiffAlgorithm -> a)
PrimDarcsOption (Maybe String)
O.repoDir
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Bool -> DiffAlgorithm -> a)
  ([MatchFlag]
   -> Reorder
   -> Maybe Bool
   -> Maybe AllowConflicts
   -> TestChanges
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> SelectDeps
   -> Maybe String
   -> Bool
   -> DiffAlgorithm
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (DiffAlgorithm -> a)
     (Bool -> DiffAlgorithm -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (DiffAlgorithm -> a)
     ([MatchFlag]
      -> Reorder
      -> Maybe Bool
      -> Maybe AllowConflicts
      -> TestChanges
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> SelectDeps
      -> Maybe String
      -> Bool
      -> DiffAlgorithm
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (DiffAlgorithm -> a)
  (Bool -> DiffAlgorithm -> a)
PrimDarcsOption Bool
O.allowUnrelatedRepos
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (DiffAlgorithm -> a)
  ([MatchFlag]
   -> Reorder
   -> Maybe Bool
   -> Maybe AllowConflicts
   -> TestChanges
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> SelectDeps
   -> Maybe String
   -> Bool
   -> DiffAlgorithm
   -> a)
-> OptSpec DarcsOptDescr DarcsFlag a (DiffAlgorithm -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     a
     ([MatchFlag]
      -> Reorder
      -> Maybe Bool
      -> Maybe AllowConflicts
      -> TestChanges
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> SelectDeps
      -> Maybe String
      -> Bool
      -> DiffAlgorithm
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec DarcsOptDescr DarcsFlag a (DiffAlgorithm -> a)
PrimDarcsOption DiffAlgorithm
O.diffAlgorithm
    pullAdvancedOpts :: OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  (RepoCombinator
   -> SetScriptsExecutable -> UMask -> Bool -> RemoteDarcs -> a)
pullAdvancedOpts
      = PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  (SetScriptsExecutable -> UMask -> Bool -> RemoteDarcs -> a)
  RepoCombinator
PrimDarcsOption RepoCombinator
O.repoCombinator
      PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  (SetScriptsExecutable -> UMask -> Bool -> RemoteDarcs -> a)
  RepoCombinator
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (UMask -> Bool -> RemoteDarcs -> a)
     (SetScriptsExecutable -> UMask -> Bool -> RemoteDarcs -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (UMask -> Bool -> RemoteDarcs -> a)
     (RepoCombinator
      -> SetScriptsExecutable -> UMask -> Bool -> RemoteDarcs -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (UMask -> Bool -> RemoteDarcs -> a)
  (SetScriptsExecutable -> UMask -> Bool -> RemoteDarcs -> a)
PrimDarcsOption SetScriptsExecutable
O.setScriptsExecutable
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (UMask -> Bool -> RemoteDarcs -> a)
  (RepoCombinator
   -> SetScriptsExecutable -> UMask -> Bool -> RemoteDarcs -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Bool -> RemoteDarcs -> a)
     (UMask -> Bool -> RemoteDarcs -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Bool -> RemoteDarcs -> a)
     (RepoCombinator
      -> SetScriptsExecutable -> UMask -> Bool -> RemoteDarcs -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (Bool -> RemoteDarcs -> a)
  (UMask -> Bool -> RemoteDarcs -> a)
PrimDarcsOption UMask
O.umask
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Bool -> RemoteDarcs -> a)
  (RepoCombinator
   -> SetScriptsExecutable -> UMask -> Bool -> RemoteDarcs -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (RemoteDarcs -> a)
     (Bool -> RemoteDarcs -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (RemoteDarcs -> a)
     (RepoCombinator
      -> SetScriptsExecutable -> UMask -> Bool -> RemoteDarcs -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (RemoteDarcs -> a)
  (Bool -> RemoteDarcs -> a)
PrimDarcsOption Bool
O.changesReverse
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (RemoteDarcs -> a)
  (RepoCombinator
   -> SetScriptsExecutable -> UMask -> Bool -> RemoteDarcs -> a)
-> OptSpec DarcsOptDescr DarcsFlag a (RemoteDarcs -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     a
     (RepoCombinator
      -> SetScriptsExecutable -> UMask -> Bool -> RemoteDarcs -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec DarcsOptDescr DarcsFlag a (RemoteDarcs -> a)
PrimDarcsOption RemoteDarcs
O.remoteDarcs
    pullOpts :: CommandOptions
pullOpts = OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Verbosity
   -> RepoCombinator
   -> SetScriptsExecutable
   -> UMask
   -> Bool
   -> RemoteDarcs
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
  ([MatchFlag]
   -> Reorder
   -> Maybe Bool
   -> Maybe AllowConflicts
   -> TestChanges
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> SelectDeps
   -> Maybe String
   -> Bool
   -> DiffAlgorithm
   -> Maybe StdCmdAction
   -> Verbosity
   -> RepoCombinator
   -> SetScriptsExecutable
   -> UMask
   -> Bool
   -> RemoteDarcs
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
forall {a}.
OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  ([MatchFlag]
   -> Reorder
   -> Maybe Bool
   -> Maybe AllowConflicts
   -> TestChanges
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> SelectDeps
   -> Maybe String
   -> Bool
   -> DiffAlgorithm
   -> a)
pullBasicOpts OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Verbosity
   -> RepoCombinator
   -> SetScriptsExecutable
   -> UMask
   -> Bool
   -> RemoteDarcs
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
  ([MatchFlag]
   -> Reorder
   -> Maybe Bool
   -> Maybe AllowConflicts
   -> TestChanges
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> SelectDeps
   -> Maybe String
   -> Bool
   -> DiffAlgorithm
   -> Maybe StdCmdAction
   -> Verbosity
   -> RepoCombinator
   -> SetScriptsExecutable
   -> UMask
   -> Bool
   -> RemoteDarcs
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
-> DarcsOption
     (UseCache
      -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
     (RepoCombinator
      -> SetScriptsExecutable
      -> UMask
      -> Bool
      -> RemoteDarcs
      -> UseCache
      -> UseIndex
      -> HooksConfig
      -> Bool
      -> Bool
      -> [DarcsFlag])
-> CommandOptions
forall b c.
DarcsOption (Maybe StdCmdAction -> Verbosity -> b) c
-> DarcsOption
     (UseCache
      -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
     b
-> CommandOptions
`withStdOpts` DarcsOption
  (UseCache
   -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
  (RepoCombinator
   -> SetScriptsExecutable
   -> UMask
   -> Bool
   -> RemoteDarcs
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
forall {a}.
OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  (RepoCombinator
   -> SetScriptsExecutable -> UMask -> Bool -> RemoteDarcs -> 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
_ [] = [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [String
"-"]
stdindefault a
_ [String]
x = [String] -> IO [String]
forall a. a -> IO a
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 = RebasePatchApplier
-> (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
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 = (AbsolutePath -> [String] -> IO [String])
-> [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
forall a b. a -> b -> a
const AbsolutePath -> [String] -> IO [String]
forall a. a -> [String] -> IO [String]
stdindefault
    , commandOptions :: CommandOptions
commandOptions = CommandOptions
applyOpts
    }
  where
    applyBasicOpts :: OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  (Verify
   -> Reorder
   -> Maybe Bool
   -> DryRun
   -> XmlOutput
   -> [MatchFlag]
   -> Maybe String
   -> DiffAlgorithm
   -> a)
applyBasicOpts
      = PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  (Reorder
   -> Maybe Bool
   -> DryRun
   -> XmlOutput
   -> [MatchFlag]
   -> Maybe String
   -> DiffAlgorithm
   -> a)
  Verify
PrimDarcsOption Verify
O.verify
      PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  (Reorder
   -> Maybe Bool
   -> DryRun
   -> XmlOutput
   -> [MatchFlag]
   -> Maybe String
   -> DiffAlgorithm
   -> a)
  Verify
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe Bool
      -> DryRun
      -> XmlOutput
      -> [MatchFlag]
      -> Maybe String
      -> DiffAlgorithm
      -> a)
     (Reorder
      -> Maybe Bool
      -> DryRun
      -> XmlOutput
      -> [MatchFlag]
      -> Maybe String
      -> DiffAlgorithm
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe Bool
      -> DryRun
      -> XmlOutput
      -> [MatchFlag]
      -> Maybe String
      -> DiffAlgorithm
      -> a)
     (Verify
      -> Reorder
      -> Maybe Bool
      -> DryRun
      -> XmlOutput
      -> [MatchFlag]
      -> Maybe String
      -> DiffAlgorithm
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe Bool
   -> DryRun
   -> XmlOutput
   -> [MatchFlag]
   -> Maybe String
   -> DiffAlgorithm
   -> a)
  (Reorder
   -> Maybe Bool
   -> DryRun
   -> XmlOutput
   -> [MatchFlag]
   -> Maybe String
   -> DiffAlgorithm
   -> a)
PrimDarcsOption Reorder
O.reorder
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe Bool
   -> DryRun
   -> XmlOutput
   -> [MatchFlag]
   -> Maybe String
   -> DiffAlgorithm
   -> a)
  (Verify
   -> Reorder
   -> Maybe Bool
   -> DryRun
   -> XmlOutput
   -> [MatchFlag]
   -> Maybe String
   -> DiffAlgorithm
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (DryRun
      -> XmlOutput -> [MatchFlag] -> Maybe String -> DiffAlgorithm -> a)
     (Maybe Bool
      -> DryRun
      -> XmlOutput
      -> [MatchFlag]
      -> Maybe String
      -> DiffAlgorithm
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (DryRun
      -> XmlOutput -> [MatchFlag] -> Maybe String -> DiffAlgorithm -> a)
     (Verify
      -> Reorder
      -> Maybe Bool
      -> DryRun
      -> XmlOutput
      -> [MatchFlag]
      -> Maybe String
      -> DiffAlgorithm
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (DryRun
   -> XmlOutput -> [MatchFlag] -> Maybe String -> DiffAlgorithm -> a)
  (Maybe Bool
   -> DryRun
   -> XmlOutput
   -> [MatchFlag]
   -> Maybe String
   -> DiffAlgorithm
   -> a)
PrimDarcsOption (Maybe Bool)
O.interactive
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (DryRun
   -> XmlOutput -> [MatchFlag] -> Maybe String -> DiffAlgorithm -> a)
  (Verify
   -> Reorder
   -> Maybe Bool
   -> DryRun
   -> XmlOutput
   -> [MatchFlag]
   -> Maybe String
   -> DiffAlgorithm
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     ([MatchFlag] -> Maybe String -> DiffAlgorithm -> a)
     (DryRun
      -> XmlOutput -> [MatchFlag] -> Maybe String -> DiffAlgorithm -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     ([MatchFlag] -> Maybe String -> DiffAlgorithm -> a)
     (Verify
      -> Reorder
      -> Maybe Bool
      -> DryRun
      -> XmlOutput
      -> [MatchFlag]
      -> Maybe String
      -> DiffAlgorithm
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  ([MatchFlag] -> Maybe String -> DiffAlgorithm -> a)
  (DryRun
   -> XmlOutput -> [MatchFlag] -> Maybe String -> DiffAlgorithm -> a)
forall a. DarcsOption a (DryRun -> XmlOutput -> a)
O.dryRunXml
      OptSpec
  DarcsOptDescr
  DarcsFlag
  ([MatchFlag] -> Maybe String -> DiffAlgorithm -> a)
  (Verify
   -> Reorder
   -> Maybe Bool
   -> DryRun
   -> XmlOutput
   -> [MatchFlag]
   -> Maybe String
   -> DiffAlgorithm
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe String -> DiffAlgorithm -> a)
     ([MatchFlag] -> Maybe String -> DiffAlgorithm -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe String -> DiffAlgorithm -> a)
     (Verify
      -> Reorder
      -> Maybe Bool
      -> DryRun
      -> XmlOutput
      -> [MatchFlag]
      -> Maybe String
      -> DiffAlgorithm
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe String -> DiffAlgorithm -> a)
  ([MatchFlag] -> Maybe String -> DiffAlgorithm -> a)
MatchOption
O.matchSeveral
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe String -> DiffAlgorithm -> a)
  (Verify
   -> Reorder
   -> Maybe Bool
   -> DryRun
   -> XmlOutput
   -> [MatchFlag]
   -> Maybe String
   -> DiffAlgorithm
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (DiffAlgorithm -> a)
     (Maybe String -> DiffAlgorithm -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (DiffAlgorithm -> a)
     (Verify
      -> Reorder
      -> Maybe Bool
      -> DryRun
      -> XmlOutput
      -> [MatchFlag]
      -> Maybe String
      -> DiffAlgorithm
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (DiffAlgorithm -> a)
  (Maybe String -> DiffAlgorithm -> a)
PrimDarcsOption (Maybe String)
O.repoDir
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (DiffAlgorithm -> a)
  (Verify
   -> Reorder
   -> Maybe Bool
   -> DryRun
   -> XmlOutput
   -> [MatchFlag]
   -> Maybe String
   -> DiffAlgorithm
   -> a)
-> OptSpec DarcsOptDescr DarcsFlag a (DiffAlgorithm -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     a
     (Verify
      -> Reorder
      -> Maybe Bool
      -> DryRun
      -> XmlOutput
      -> [MatchFlag]
      -> Maybe String
      -> DiffAlgorithm
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec DarcsOptDescr DarcsFlag a (DiffAlgorithm -> a)
PrimDarcsOption DiffAlgorithm
O.diffAlgorithm
    applyAdvancedOpts :: OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  (SetScriptsExecutable -> UMask -> Bool -> WantGuiPause -> a)
applyAdvancedOpts
      = PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  (UMask -> Bool -> WantGuiPause -> a)
  SetScriptsExecutable
PrimDarcsOption SetScriptsExecutable
O.setScriptsExecutable
      PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  (UMask -> Bool -> WantGuiPause -> a)
  SetScriptsExecutable
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Bool -> WantGuiPause -> a)
     (UMask -> Bool -> WantGuiPause -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Bool -> WantGuiPause -> a)
     (SetScriptsExecutable -> UMask -> Bool -> WantGuiPause -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (Bool -> WantGuiPause -> a)
  (UMask -> Bool -> WantGuiPause -> a)
PrimDarcsOption UMask
O.umask
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Bool -> WantGuiPause -> a)
  (SetScriptsExecutable -> UMask -> Bool -> WantGuiPause -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (WantGuiPause -> a)
     (Bool -> WantGuiPause -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (WantGuiPause -> a)
     (SetScriptsExecutable -> UMask -> Bool -> WantGuiPause -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (WantGuiPause -> a)
  (Bool -> WantGuiPause -> a)
PrimDarcsOption Bool
O.changesReverse
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (WantGuiPause -> a)
  (SetScriptsExecutable -> UMask -> Bool -> WantGuiPause -> a)
-> OptSpec DarcsOptDescr DarcsFlag a (WantGuiPause -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     a
     (SetScriptsExecutable -> UMask -> Bool -> WantGuiPause -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec DarcsOptDescr DarcsFlag a (WantGuiPause -> a)
PrimDarcsOption WantGuiPause
O.pauseForGui
    applyOpts :: CommandOptions
applyOpts = OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Verbosity
   -> SetScriptsExecutable
   -> UMask
   -> Bool
   -> WantGuiPause
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
  (Verify
   -> Reorder
   -> Maybe Bool
   -> DryRun
   -> XmlOutput
   -> [MatchFlag]
   -> Maybe String
   -> DiffAlgorithm
   -> Maybe StdCmdAction
   -> Verbosity
   -> SetScriptsExecutable
   -> UMask
   -> Bool
   -> WantGuiPause
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
forall {a}.
OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  (Verify
   -> Reorder
   -> Maybe Bool
   -> DryRun
   -> XmlOutput
   -> [MatchFlag]
   -> Maybe String
   -> DiffAlgorithm
   -> a)
applyBasicOpts OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Verbosity
   -> SetScriptsExecutable
   -> UMask
   -> Bool
   -> WantGuiPause
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
  (Verify
   -> Reorder
   -> Maybe Bool
   -> DryRun
   -> XmlOutput
   -> [MatchFlag]
   -> Maybe String
   -> DiffAlgorithm
   -> Maybe StdCmdAction
   -> Verbosity
   -> SetScriptsExecutable
   -> UMask
   -> Bool
   -> WantGuiPause
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
-> DarcsOption
     (UseCache
      -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
     (SetScriptsExecutable
      -> UMask
      -> Bool
      -> WantGuiPause
      -> UseCache
      -> UseIndex
      -> HooksConfig
      -> Bool
      -> Bool
      -> [DarcsFlag])
-> CommandOptions
forall b c.
DarcsOption (Maybe StdCmdAction -> Verbosity -> b) c
-> DarcsOption
     (UseCache
      -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
     b
-> CommandOptions
`withStdOpts` DarcsOption
  (UseCache
   -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
  (SetScriptsExecutable
   -> UMask
   -> Bool
   -> WantGuiPause
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
forall {a}.
OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  (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
    repoJob :: RebasePatchApplier
-> (forall (p :: * -> * -> *) wR wU.
    (RepoPatch p, ApplyState p ~ Tree) =>
    PatchProxy p -> Repository 'RW p wU wR -> IO ())
-> RepoJob 'RW ()
repoJob RebasePatchApplier
RebasePatchApplier forall (p :: * -> * -> *) wR wU.
(RepoPatch p, ApplyState p ~ Tree) =>
PatchProxy p -> Repository 'RW p wU wR -> IO ()
f = TreePatchJob 'RW () -> RepoJob 'RW ()
forall (rt :: AccessType) a. TreePatchJob rt a -> RepoJob rt a
RepoJob (PatchProxy p -> Repository 'RW p wU wR -> IO ()
forall (p :: * -> * -> *) wR wU.
(RepoPatch p, ApplyState p ~ Tree) =>
PatchProxy p -> Repository 'RW p wU wR -> IO ()
f PatchProxy p
forall (p :: * -> * -> *). PatchProxy p
PatchProxy)
    applyPatches :: forall (p :: * -> * -> *) wR wU wZ.
(RepoPatch p, ApplyState p ~ Tree) =>
RebasePatchApplier
-> PatchProxy p
-> String
-> [DarcsFlag]
-> Repository 'RW p wU wR
-> Fork
     (PatchSet p)
     (FL (PatchInfoAnd p))
     (FL (PatchInfoAnd p))
     Origin
     wR
     wZ
-> IO ()
applyPatches RebasePatchApplier
RebasePatchApplier PatchProxy p
PatchProxy = String
-> [DarcsFlag]
-> Repository 'RW p wU wR
-> Fork
     (PatchSet p)
     (FL (PatchInfoAnd p))
     (FL (PatchInfoAnd p))
     Origin
     wR
     wZ
-> IO ()
forall (p :: * -> * -> *) wR wU wZ.
(RepoPatch p, ApplyState p ~ Tree) =>
String
-> [DarcsFlag]
-> Repository 'RW p wU wR
-> Fork
     (PatchSet p)
     (FL (PatchInfoAnd p))
     (FL (PatchInfoAnd p))
     Origin
     wR
     wZ
-> IO ()
applyPatchesForRebaseCmd

applyPatchesForRebaseCmd
    :: forall p wR wU wZ
     . ( RepoPatch p, ApplyState p ~ Tree )
    => String
    -> [DarcsFlag]
    -> Repository 'RW p wU wR
    -> Fork (PatchSet p)
            (FL (PatchInfoAnd p))
            (FL (PatchInfoAnd p)) Origin wR wZ
    -> IO ()
applyPatchesForRebaseCmd :: forall (p :: * -> * -> *) wR wU wZ.
(RepoPatch p, ApplyState p ~ Tree) =>
String
-> [DarcsFlag]
-> Repository 'RW p wU wR
-> Fork
     (PatchSet p)
     (FL (PatchInfoAnd p))
     (FL (PatchInfoAnd p))
     Origin
     wR
     wZ
-> IO ()
applyPatchesForRebaseCmd String
cmdName [DarcsFlag]
opts Repository 'RW p wU wR
_repository (Fork PatchSet p Origin wU
common FL (PatchInfoAnd p) wU wR
us' FL (PatchInfoAnd p) wU wZ
to_be_applied) = do
    String -> [DarcsFlag] -> FL (PatchInfoAnd p) wU wZ -> IO ()
forall (p :: * -> * -> *) wX wY.
(RepoPatch p, ApplyState p ~ Tree) =>
String -> [DarcsFlag] -> FL (PatchInfoAnd p) wX wY -> IO ()
applyPatchesStart String
cmdName [DarcsFlag]
opts FL (PatchInfoAnd p) wU wZ
to_be_applied

    FL (PatchInfoAnd p) wU wZ
usOk :> FL (PatchInfoAnd p) wZ wR
usConflicted <- (:>) (FL (PatchInfoAnd p)) (FL (PatchInfoAnd p)) wU wR
-> IO ((:>) (FL (PatchInfoAnd p)) (FL (PatchInfoAnd p)) wU wR)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((:>) (FL (PatchInfoAnd p)) (FL (PatchInfoAnd p)) wU wR
 -> IO ((:>) (FL (PatchInfoAnd p)) (FL (PatchInfoAnd p)) wU wR))
-> (:>) (FL (PatchInfoAnd p)) (FL (PatchInfoAnd p)) wU wR
-> IO ((:>) (FL (PatchInfoAnd p)) (FL (PatchInfoAnd p)) wU wR)
forall a b. (a -> b) -> a -> b
$ FL (PatchInfoAnd p) wU wR
-> FL (PatchInfoAnd p) wU wZ
-> (:>) (FL (PatchInfoAnd p)) (FL (PatchInfoAnd p)) wU wR
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 p) wU wR
us' FL (PatchInfoAnd p) wU wZ
to_be_applied

    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FL (PatchInfoAnd p) wZ wR -> Int
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Int
lengthFL FL (PatchInfoAnd p) wZ wR
usConflicted Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        [DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
opts (Doc -> IO ()) -> Doc -> IO ()
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 p)
selection_config = WhichChanges
-> String
-> PatchSelectionOptions
-> Maybe (Splitter (PatchInfoAnd p))
-> Maybe [AnchoredPath]
-> SelectionConfig (PatchInfoAnd p)
forall (p :: * -> * -> *).
Matchable p =>
WhichChanges
-> String
-> PatchSelectionOptions
-> Maybe (Splitter p)
-> Maybe [AnchoredPath]
-> SelectionConfig p
selectionConfig WhichChanges
LastReversed String
"suspend" PatchSelectionOptions
applyPatchSelOpts Maybe (Splitter (PatchInfoAnd p))
forall a. Maybe a
Nothing Maybe [AnchoredPath]
forall a. Maybe a
Nothing

    (FL (PatchInfoAnd p) wZ wZ
usKeep :> FL (PatchInfoAnd p) wZ wR
usToSuspend) <- FL (PatchInfoAnd p) wZ wR
-> SelectionConfig (PatchInfoAnd p)
-> IO ((:>) (FL (PatchInfoAnd p)) (FL (PatchInfoAnd p)) wZ wR)
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 p) wZ wR
usConflicted SelectionConfig (PatchInfoAnd p)
selection_config

    -- test all patches for hijacking and abort if rejected
    HijackOptions -> HijackT IO () -> IO ()
forall (m :: * -> *) a.
Monad m =>
HijackOptions -> HijackT m a -> m a
runHijackT HijackOptions
RequestHijackPermission
        (HijackT IO () -> IO ()) -> HijackT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ (PatchInfo -> StateT HijackOptions IO String)
-> [PatchInfo] -> HijackT IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String
-> Bool
-> Maybe String
-> PatchInfo
-> StateT HijackOptions IO String
getAuthor String
"suspend" Bool
False Maybe String
forall a. Maybe a
Nothing)
        ([PatchInfo] -> HijackT IO ()) -> [PatchInfo] -> HijackT IO ()
forall a b. (a -> b) -> a -> b
$ (forall wW wZ. PatchInfoAnd p wW wZ -> PatchInfo)
-> FL (PatchInfoAnd p) wZ wR -> [PatchInfo]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL PatchInfoAndG (Named p) wW wZ -> PatchInfo
forall wW wZ. PatchInfoAnd p wW wZ -> PatchInfo
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> PatchInfo
info FL (PatchInfoAnd p) wZ wR
usToSuspend

    Suspended p wR
suspended <- Repository 'RW p wU wR -> IO (Suspended p wR)
forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
RepoPatch p =>
Repository rt p wU wR -> IO (Suspended p wR)
readTentativeRebase Repository 'RW p wU wR
_repository

    (Repository 'RW p wU wZ
_repository, Sealed FL (PrimOf p) wU wX
toWorking) <-
      String
-> [DarcsFlag]
-> Repository 'RW p wU wR
-> Suspended p wR
-> FL (PatchInfoAnd p) wZ wR
-> IO (Repository 'RW p wU wZ, Sealed (FL (PrimOf p) wU))
forall (p :: * -> * -> *) wU wR wX.
(RepoPatch p, ApplyState p ~ Tree) =>
String
-> [DarcsFlag]
-> Repository 'RW p wU wR
-> Suspended p wR
-> FL (PatchInfoAnd p) wX wR
-> IO (Repository 'RW p wU wX, Sealed (FL (PrimOf p) wU))
doSuspend String
cmdName [DarcsFlag]
opts Repository 'RW p wU wR
_repository Suspended p wR
suspended FL (PatchInfoAnd p) wZ wR
usToSuspend
    -- the new rebase patch containing the suspended patches is now in the repo
    -- and the suspended patches have been removed

    -- We must apply the suspend to working because tentativelyMergePatches
    -- calls unrecordedChanges. We also have to update the index, since that is
    -- used to filter the working tree (unless --ignore-times is in effect).
    Repository 'RW p wU wZ -> IO ()
forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wU wR -> IO ()
updateIndex Repository 'RW p wU wZ
_repository
    Repository 'RW p wX wZ
_repository <- IO (Repository 'RW p wX wZ) -> IO (Repository 'RW p wX wZ)
forall a. IO a -> IO a
withSignalsBlocked (IO (Repository 'RW p wX wZ) -> IO (Repository 'RW p wX wZ))
-> IO (Repository 'RW p wX wZ) -> IO (Repository 'RW p wX wZ)
forall a b. (a -> b) -> a -> b
$ do
        Repository 'RW p wU wZ
-> Verbosity -> FL (PrimOf p) wU wX -> IO (Repository 'RW p wX wZ)
forall (p :: * -> * -> *) (rt :: AccessType) wU wR wY.
(ApplyState p ~ Tree, RepoPatch p) =>
Repository rt p wU wR
-> Verbosity -> FL (PrimOf p) wU wY -> IO (Repository rt p wY wR)
applyToWorking Repository 'RW p wU wZ
_repository (PrimOptSpec DarcsOptDescr DarcsFlag a Verbosity
PrimDarcsOption Verbosity
verbosity PrimDarcsOption Verbosity -> [DarcsFlag] -> Verbosity
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) FL (PrimOf p) wU wX
toWorking

    Sealed FL (PrimOf p) wX wX
pw <-
        Repository 'RW p wX wZ
-> String
-> AllowConflicts
-> WantGuiPause
-> Reorder
-> DiffOpts
-> Fork
     (PatchSet p)
     (FL (PatchInfoAnd p))
     (FL (PatchInfoAnd p))
     Origin
     wZ
     wZ
-> IO (Sealed (FL (PrimOf p) wX))
forall (p :: * -> * -> *) wU wR wY.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository 'RW p wU wR
-> String
-> AllowConflicts
-> WantGuiPause
-> Reorder
-> DiffOpts
-> Fork
     (PatchSet p)
     (FL (PatchInfoAnd p))
     (FL (PatchInfoAnd p))
     Origin
     wR
     wY
-> IO (Sealed (FL (PrimOf p) wU))
tentativelyMergePatches
            Repository 'RW p wX wZ
_repository String
cmdName
            ([DarcsFlag] -> AllowConflicts
allowConflicts [DarcsFlag]
opts)
            ([DarcsFlag] -> WantGuiPause
wantGuiPause [DarcsFlag]
opts)
            (PrimOptSpec DarcsOptDescr DarcsFlag a Reorder
PrimDarcsOption Reorder
reorder PrimDarcsOption Reorder -> [DarcsFlag] -> Reorder
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) ([DarcsFlag] -> DiffOpts
diffingOpts [DarcsFlag]
opts)
            (PatchSet p Origin wU
-> FL (PatchInfoAnd p) wU wZ
-> FL (PatchInfoAnd p) wU wZ
-> Fork
     (PatchSet p)
     (FL (PatchInfoAnd p))
     (FL (PatchInfoAnd p))
     Origin
     wZ
     wZ
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 p Origin wU
common (FL (PatchInfoAnd p) wU wZ
usOk FL (PatchInfoAnd p) wU wZ
-> FL (PatchInfoAnd p) wZ wZ -> FL (PatchInfoAnd p) wU wZ
forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ FL (PatchInfoAnd p) wZ wZ
usKeep) FL (PatchInfoAnd p) wU wZ
to_be_applied)

    String
-> [DarcsFlag]
-> Repository 'RW p wX wZ
-> FL (PrimOf p) wX wX
-> Bool
-> IO ()
forall (p :: * -> * -> *) wU wR wY.
(RepoPatch p, ApplyState p ~ Tree) =>
String
-> [DarcsFlag]
-> Repository 'RW p wU wR
-> FL (PrimOf p) wU wY
-> Bool
-> IO ()
applyPatchesFinish String
cmdName [DarcsFlag]
opts Repository 'RW p wX wZ
_repository FL (PrimOf p) wX wX
pw (FL (PatchInfoAnd p) wU wZ -> Bool
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Bool
nullFL FL (PatchInfoAnd p) wU wZ
to_be_applied)

applyPatchSelOpts :: S.PatchSelectionOptions
applyPatchSelOpts :: PatchSelectionOptions
applyPatchSelOpts = S.PatchSelectionOptions
    { verbosity :: Verbosity
S.verbosity = Verbosity
O.NormalVerbosity
    , matchFlags :: [MatchFlag]
S.matchFlags = []
    , interactive :: Bool
S.interactive = Bool
True
    , selectDeps :: SelectDeps
S.selectDeps = SelectDeps
O.PromptDeps -- option not supported, use default
    , withSummary :: WithSummary
S.withSummary = WithSummary
O.NoSummary
    }

obliteratePatchSelOpts :: [DarcsFlag] -> S.PatchSelectionOptions
obliteratePatchSelOpts :: [DarcsFlag] -> PatchSelectionOptions
obliteratePatchSelOpts [DarcsFlag]
opts = (Bool -> [DarcsFlag] -> PatchSelectionOptions
patchSelOpts Bool
True [DarcsFlag]
opts)
    { S.selectDeps = O.NoDeps
    }

patchSelOpts :: Bool -> [DarcsFlag] -> S.PatchSelectionOptions
patchSelOpts :: Bool -> [DarcsFlag] -> PatchSelectionOptions
patchSelOpts Bool
defInteractive [DarcsFlag]
flags = S.PatchSelectionOptions
    { verbosity :: Verbosity
S.verbosity = PrimOptSpec DarcsOptDescr DarcsFlag a Verbosity
PrimDarcsOption Verbosity
verbosity PrimDarcsOption Verbosity -> [DarcsFlag] -> Verbosity
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
flags
    , matchFlags :: [MatchFlag]
S.matchFlags = PrimOptSpec DarcsOptDescr DarcsFlag a [MatchFlag]
MatchOption
O.matchSeveralOrLast MatchOption -> [DarcsFlag] -> [MatchFlag]
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 = PrimOptSpec DarcsOptDescr DarcsFlag a SelectDeps
PrimDarcsOption SelectDeps
selectDeps PrimDarcsOption SelectDeps -> [DarcsFlag] -> SelectDeps
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
flags
    , withSummary :: WithSummary
S.withSummary = PrimOptSpec DarcsOptDescr DarcsFlag a WithSummary
PrimDarcsOption WithSummary
O.withSummary PrimDarcsOption WithSummary -> [DarcsFlag] -> WithSummary
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
flags
    }

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
    , commandOptions :: CommandOptions
commandOptions = CommandOptions
logOpts
    }
  where
    logBasicOpts :: OptSpec DarcsOptDescr DarcsFlag a (WithSummary -> Maybe Bool -> a)
logBasicOpts = PrimOptSpec DarcsOptDescr DarcsFlag (Maybe Bool -> a) WithSummary
PrimDarcsOption WithSummary
O.withSummary PrimOptSpec DarcsOptDescr DarcsFlag (Maybe Bool -> a) WithSummary
-> OptSpec DarcsOptDescr DarcsFlag a (Maybe Bool -> a)
-> OptSpec
     DarcsOptDescr DarcsFlag a (WithSummary -> Maybe Bool -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec DarcsOptDescr DarcsFlag a (Maybe Bool -> a)
PrimDarcsOption (Maybe Bool)
O.interactive -- False
    logAdvancedOpts :: OptSpec d f a a
logAdvancedOpts = OptSpec d f a a
forall (d :: * -> *) f a. OptSpec d f a a
oid
    logOpts :: CommandOptions
logOpts = OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Verbosity
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
  (WithSummary
   -> Maybe Bool
   -> Maybe StdCmdAction
   -> Verbosity
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
forall {a}.
OptSpec DarcsOptDescr DarcsFlag a (WithSummary -> Maybe Bool -> a)
logBasicOpts OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Verbosity
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
  (WithSummary
   -> Maybe Bool
   -> Maybe StdCmdAction
   -> Verbosity
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
-> DarcsOption
     (UseCache
      -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
     (UseCache
      -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
-> CommandOptions
forall b c.
DarcsOption (Maybe StdCmdAction -> Verbosity -> b) c
-> DarcsOption
     (UseCache
      -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
     b
-> CommandOptions
`withStdOpts` DarcsOption
  (UseCache
   -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
  (UseCache
   -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
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 =
    UseCache -> RepoJob 'RO () -> IO ()
forall a. UseCache -> RepoJob 'RO a -> IO a
withRepository (PrimOptSpec DarcsOptDescr DarcsFlag a UseCache
PrimDarcsOption UseCache
useCache PrimDarcsOption UseCache -> [DarcsFlag] -> UseCache
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (RepoJob 'RO () -> IO ()) -> RepoJob 'RO () -> IO ()
forall a b. (a -> b) -> a -> b
$ TreePatchJob 'RO () -> RepoJob 'RO ()
forall (rt :: AccessType) a. TreePatchJob rt a -> RepoJob rt a
RepoJob (TreePatchJob 'RO () -> RepoJob 'RO ())
-> TreePatchJob 'RO () -> RepoJob 'RO ()
forall a b. (a -> b) -> a -> b
$ \Repository 'RO p wU wR
_repository -> do
        Repository 'RO p wU wR -> IO ()
forall (rt :: AccessType) (p :: * -> * -> *) wU wR.
Repository rt p wU wR -> IO ()
checkHasRebase Repository 'RO p wU wR
_repository
        Items FL (RebaseChange (PrimOf p)) wR wY
ps <- Repository 'RO p wU wR -> IO (Suspended p wR)
forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
RepoPatch p =>
Repository rt p wU wR -> IO (Suspended p wR)
readRebase Repository 'RO p wU wR
_repository
        let psToShow :: FL (PatchInfoAndG (RebaseChange (PrimOf p))) wR wY
psToShow = (forall wW wY.
 RebaseChange (PrimOf p) wW wY
 -> PatchInfoAndG (RebaseChange (PrimOf p)) wW wY)
-> FL (RebaseChange (PrimOf p)) wR wY
-> FL (PatchInfoAndG (RebaseChange (PrimOf p))) wR wY
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL RebaseChange (PrimOf p) wW wY
-> PatchInfoAndG (RebaseChange (PrimOf p)) wW wY
forall wW wY.
RebaseChange (PrimOf p) wW wY
-> PatchInfoAndG (RebaseChange (PrimOf p)) wW wY
forall (p :: * -> * -> *) wX wY.
(Ident p, PatchId p ~ PatchInfo) =>
p wX wY -> PatchInfoAndG p wX wY
n2pia FL (RebaseChange (PrimOf p)) wR wY
ps
        if Bool -> [DarcsFlag] -> Bool
isInteractive Bool
False [DarcsFlag]
opts
            then PatchSelectionOptions
-> [Sealed2 (PatchInfoAndG (RebaseChange (PrimOf p)))] -> IO ()
forall (p :: * -> * -> *).
(ShowPatch p, ShowContextPatch p, ApplyState p ~ Tree) =>
PatchSelectionOptions -> [Sealed2 p] -> IO ()
viewChanges (Bool -> [DarcsFlag] -> PatchSelectionOptions
patchSelOpts Bool
False [DarcsFlag]
opts) ((forall wW wZ.
 PatchInfoAndG (RebaseChange (PrimOf p)) wW wZ
 -> Sealed2 (PatchInfoAndG (RebaseChange (PrimOf p))))
-> FL (PatchInfoAndG (RebaseChange (PrimOf p))) wR wY
-> [Sealed2 (PatchInfoAndG (RebaseChange (PrimOf p)))]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL PatchInfoAndG (RebaseChange (PrimOf p)) wW wZ
-> Sealed2 (PatchInfoAndG (RebaseChange (PrimOf p)))
forall wW wZ.
PatchInfoAndG (RebaseChange (PrimOf p)) wW wZ
-> Sealed2 (PatchInfoAndG (RebaseChange (PrimOf p)))
forall (a :: * -> * -> *) wX wY. a wX wY -> Sealed2 a
Sealed2 FL (PatchInfoAndG (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 = [DarcsFlag]
-> RL (PatchInfoAndG (RebaseChange (PrimOf p))) wR wY
-> LogInfo (PatchInfoAndG (RebaseChange (PrimOf p)))
-> Doc
forall (p :: * -> * -> *) wStart wX.
(ShowPatch p, PatchListFormat p, Summary p, HasDeps p,
 PrimDetails (PrimOf p)) =>
[DarcsFlag]
-> RL (PatchInfoAndG p) wStart wX
-> LogInfo (PatchInfoAndG p)
-> Doc
changelog [DarcsFlag]
opts (FL (PatchInfoAndG (RebaseChange (PrimOf p))) wR wY
-> RL (PatchInfoAndG (RebaseChange (PrimOf p))) wR wY
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> RL a wX wZ
reverseFL FL (PatchInfoAndG (RebaseChange (PrimOf p))) wR wY
psToShow) (FL (PatchInfoAndG (RebaseChange (PrimOf p))) wR wY
-> LogInfo (PatchInfoAndG (RebaseChange (PrimOf p)))
forall (p :: * -> * -> *) wX wY. FL p wX wY -> LogInfo p
logInfoFL FL (PatchInfoAndG (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" Maybe DarcsCommand
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
    , commandOptions :: CommandOptions
commandOptions = CommandOptions
opts
    }
  where
    basicOpts :: OptSpec d f a a
basicOpts = OptSpec d f a a
forall (d :: * -> *) f a. OptSpec d f a a
oid
    opts :: CommandOptions
opts = OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Verbosity
   -> UMask
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
  (Maybe StdCmdAction
   -> Verbosity
   -> UMask
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
forall (d :: * -> *) f a. OptSpec d f a a
basicOpts OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Verbosity
   -> UMask
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
  (Maybe StdCmdAction
   -> Verbosity
   -> UMask
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
-> DarcsOption
     (UseCache
      -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
     (UMask
      -> UseCache
      -> UseIndex
      -> HooksConfig
      -> Bool
      -> Bool
      -> [DarcsFlag])
-> CommandOptions
forall b c.
DarcsOption (Maybe StdCmdAction -> Verbosity -> b) c
-> DarcsOption
     (UseCache
      -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
     b
-> CommandOptions
`withStdOpts` DarcsOption
  (UseCache
   -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
  (UMask
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
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 =
  UseCache -> UMask -> RepoJob 'RW () -> IO ()
forall a. UseCache -> UMask -> RepoJob 'RW a -> IO a
withRepoLock (PrimOptSpec DarcsOptDescr DarcsFlag a UseCache
PrimDarcsOption UseCache
useCache PrimDarcsOption UseCache -> [DarcsFlag] -> UseCache
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (PrimOptSpec DarcsOptDescr DarcsFlag a UMask
PrimDarcsOption UMask
umask PrimDarcsOption UMask -> [DarcsFlag] -> UMask
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (RepoJob 'RW () -> IO ()) -> RepoJob 'RW () -> IO ()
forall a b. (a -> b) -> a -> b
$ TreePatchJob 'RW () -> RepoJob 'RW ()
forall (rt :: AccessType) a. TreePatchJob rt a -> RepoJob rt a
OldRebaseJob (TreePatchJob 'RW () -> RepoJob 'RW ())
-> TreePatchJob 'RW () -> RepoJob 'RW ()
forall a b. (a -> b) -> a -> b
$ \Repository 'RW p wU wR
repo ->
    Repository 'RW p wU wR -> IO ()
forall (p :: * -> * -> *) wU wR.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository 'RW p wU wR -> IO ()
upgradeOldStyleRebase Repository 'RW p wU wR
repo

{-
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/apply should suspend patches such that their order is not changed
 - 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
 - darcs check should check integrity of rebase patch
 - review existence of reify and inject commands - bit of an internals hack
-}