{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
module Darcs.UI.Commands.Unrecord
( unrecord
, unpull
, obliterate
) where
import Darcs.Prelude
import Control.Monad ( unless, void, when )
import Darcs.Util.Tree ( Tree )
import Data.Maybe ( fromJust, isJust )
import System.Directory ( doesPathExist )
import System.Exit ( exitSuccess )
import Darcs.Patch ( RepoPatch, commute, effect, invert )
import Darcs.Patch.Apply ( ApplyState )
import Darcs.Patch.Bundle ( makeBundle, minContext )
import Darcs.Patch.CommuteFn ( commuterFLId )
import Darcs.Patch.Depends ( removeFromPatchSet )
import Darcs.Patch.PatchInfoAnd ( hopefully, patchDesc )
import Darcs.Patch.Permutations ( genCommuteWhatWeCanFL )
import Darcs.Patch.Set ( Origin, PatchSet )
import Darcs.Patch.Witnesses.Ordered ( FL(..), mapFL_FL, nullFL, (:>)(..), (+>+) )
import Darcs.Patch.Witnesses.Sealed ( Sealed(..) )
import Darcs.Repository
( PatchInfoAnd
, RepoJob(..)
, applyToWorking
, finalizeRepositoryChanges
, readPatches
, setTentativePending
, tentativelyRemovePatches
, unrecordedChanges
, withRepoLock
)
import Darcs.Repository.Flags ( UpdatePending(..) )
import Darcs.UI.Commands
( DarcsCommand(..)
, amInHashedRepository
, commandAlias
, nodefaults
, putFinished
, putInfo
, putVerbose
, setEnvDarcsPatches
, withStdOpts
)
import Darcs.UI.Commands.Util
( getUniqueDPatchName
, historyEditHelp
, preselectPatches
, printDryRunMessageAndExit
)
import Darcs.UI.Completion ( noArgs )
import Darcs.UI.Flags
( DarcsFlag
, changesReverse
, diffingOpts
, dryRun
, getOutput
, isInteractive
, minimize
, selectDeps
, umask
, useCache
, verbosity
, xmlOutput
)
import Darcs.UI.Options ( (?), (^) )
import qualified Darcs.UI.Options.All as O
import Darcs.UI.PrintPatch ( printFriendly )
import Darcs.UI.SelectChanges ( WhichChanges(..), runSelection, selectionConfig )
import qualified Darcs.UI.SelectChanges as S ( PatchSelectionOptions(..) )
import Darcs.Util.English ( presentParticiple )
import Darcs.Util.Lock ( writeDocBinFile )
import Darcs.Util.Path ( AbsolutePath, toFilePath, useAbsoluteOrStd )
import Darcs.Util.Printer ( Doc, formatWords, putDoc, sentence, text, ($+$), (<+>) )
import Darcs.Util.Progress ( debugMessage )
import Darcs.Util.Prompt ( promptYorn )
import Darcs.Util.SignalHandler ( catchInterrupt, withSignalsBlocked )
unrecordDescription :: String
unrecordDescription :: String
unrecordDescription =
String
"Remove recorded patches without changing the working tree."
unrecordHelp :: Doc
unrecordHelp :: Doc
unrecordHelp = [String] -> Doc
formatWords
[ String
"Unrecord does the opposite of record: it deletes patches from"
, String
"the repository without changing the working tree. The changes"
, String
"are now again visible with `darcs whatsnew` and you can record"
, String
"or revert them as you please."
]
Doc -> Doc -> Doc
$+$ Doc
historyEditHelp
unrecord :: DarcsCommand
unrecord :: DarcsCommand
unrecord = DarcsCommand
{ commandProgramName :: String
commandProgramName = String
"darcs"
, commandName :: String
commandName = String
"unrecord"
, commandHelp :: Doc
commandHelp = Doc
unrecordHelp
, commandDescription :: String
commandDescription = String
unrecordDescription
, commandExtraArgs :: Int
commandExtraArgs = Int
0
, commandExtraArgHelp :: [String]
commandExtraArgHelp = []
, commandCommand :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
commandCommand = (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
unrecordCmd
, 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]
noArgs
, commandArgdefaults :: [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
commandArgdefaults = [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
nodefaults
, commandOptions :: CommandOptions
commandOptions = CommandOptions
unrecordOpts
}
where
unrecordBasicOpts :: OptSpec
DarcsOptDescr
DarcsFlag
a
([NotInRemote]
-> [MatchFlag] -> SelectDeps -> Maybe Bool -> Maybe String -> a)
unrecordBasicOpts
= PrimOptSpec
DarcsOptDescr
DarcsFlag
([MatchFlag] -> SelectDeps -> Maybe Bool -> Maybe String -> a)
[NotInRemote]
PrimDarcsOption [NotInRemote]
O.notInRemote
PrimOptSpec
DarcsOptDescr
DarcsFlag
([MatchFlag] -> SelectDeps -> Maybe Bool -> Maybe String -> a)
[NotInRemote]
-> OptSpec
DarcsOptDescr
DarcsFlag
(SelectDeps -> Maybe Bool -> Maybe String -> a)
([MatchFlag] -> SelectDeps -> Maybe Bool -> Maybe String -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(SelectDeps -> Maybe Bool -> Maybe String -> a)
([NotInRemote]
-> [MatchFlag] -> SelectDeps -> Maybe Bool -> Maybe String -> 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 -> Maybe String -> a)
([MatchFlag] -> SelectDeps -> Maybe Bool -> Maybe String -> a)
MatchOption
O.matchSeveralOrLast
OptSpec
DarcsOptDescr
DarcsFlag
(SelectDeps -> Maybe Bool -> Maybe String -> a)
([NotInRemote]
-> [MatchFlag] -> SelectDeps -> Maybe Bool -> Maybe String -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(Maybe Bool -> Maybe String -> a)
(SelectDeps -> Maybe Bool -> Maybe String -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(Maybe Bool -> Maybe String -> a)
([NotInRemote]
-> [MatchFlag] -> SelectDeps -> Maybe Bool -> Maybe String -> 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 String -> a)
(SelectDeps -> Maybe Bool -> Maybe String -> a)
PrimDarcsOption SelectDeps
O.selectDeps
OptSpec
DarcsOptDescr
DarcsFlag
(Maybe Bool -> Maybe String -> a)
([NotInRemote]
-> [MatchFlag] -> SelectDeps -> Maybe Bool -> Maybe String -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(Maybe String -> a)
(Maybe Bool -> Maybe String -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(Maybe String -> a)
([NotInRemote]
-> [MatchFlag] -> SelectDeps -> Maybe Bool -> Maybe String -> 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 -> a)
(Maybe Bool -> Maybe String -> a)
PrimDarcsOption (Maybe Bool)
O.interactive
OptSpec
DarcsOptDescr
DarcsFlag
(Maybe String -> a)
([NotInRemote]
-> [MatchFlag] -> SelectDeps -> Maybe Bool -> Maybe String -> a)
-> OptSpec DarcsOptDescr DarcsFlag a (Maybe String -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
a
([NotInRemote]
-> [MatchFlag] -> SelectDeps -> Maybe Bool -> Maybe String -> 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 String -> a)
PrimDarcsOption (Maybe String)
O.repoDir
unrecordAdvancedOpts :: OptSpec DarcsOptDescr DarcsFlag a (UMask -> Bool -> a)
unrecordAdvancedOpts
= PrimOptSpec DarcsOptDescr DarcsFlag (Bool -> a) UMask
PrimDarcsOption UMask
O.umask
PrimOptSpec DarcsOptDescr DarcsFlag (Bool -> a) UMask
-> OptSpec DarcsOptDescr DarcsFlag a (Bool -> a)
-> OptSpec DarcsOptDescr DarcsFlag a (UMask -> 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 (Bool -> a)
PrimDarcsOption Bool
O.changesReverse
unrecordOpts :: CommandOptions
unrecordOpts = OptSpec
DarcsOptDescr
DarcsFlag
(Maybe StdCmdAction
-> Verbosity
-> UMask
-> Bool
-> UseCache
-> UseIndex
-> HooksConfig
-> Bool
-> Bool
-> [DarcsFlag])
([NotInRemote]
-> [MatchFlag]
-> SelectDeps
-> Maybe Bool
-> Maybe String
-> Maybe StdCmdAction
-> Verbosity
-> UMask
-> Bool
-> UseCache
-> UseIndex
-> HooksConfig
-> Bool
-> Bool
-> [DarcsFlag])
forall {a}.
OptSpec
DarcsOptDescr
DarcsFlag
a
([NotInRemote]
-> [MatchFlag] -> SelectDeps -> Maybe Bool -> Maybe String -> a)
unrecordBasicOpts OptSpec
DarcsOptDescr
DarcsFlag
(Maybe StdCmdAction
-> Verbosity
-> UMask
-> Bool
-> UseCache
-> UseIndex
-> HooksConfig
-> Bool
-> Bool
-> [DarcsFlag])
([NotInRemote]
-> [MatchFlag]
-> SelectDeps
-> Maybe Bool
-> Maybe String
-> Maybe StdCmdAction
-> Verbosity
-> UMask
-> Bool
-> UseCache
-> UseIndex
-> HooksConfig
-> Bool
-> Bool
-> [DarcsFlag])
-> DarcsOption
(UseCache
-> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
(UMask
-> Bool
-> 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
-> Bool
-> UseCache
-> UseIndex
-> HooksConfig
-> Bool
-> Bool
-> [DarcsFlag])
forall {a}. OptSpec DarcsOptDescr DarcsFlag a (UMask -> Bool -> a)
unrecordAdvancedOpts
unrecordCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
unrecordCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
unrecordCmd (AbsolutePath, AbsolutePath)
_ [DarcsFlag]
opts [String]
_ =
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
(PatchSet p Origin wZ
_ :> FL (PatchInfoAnd p) wZ wR
removal_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
"unrecord" ([DarcsFlag] -> PatchSelectionOptions
patchSelOpts [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
to_unrecord) <- 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
removal_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
to_unrecord) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
[DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
opts Doc
"No patches selected!"
IO ()
forall a. IO a
exitSuccess
[DarcsFlag] -> Doc -> IO ()
putVerbose [DarcsFlag]
opts (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> Doc
text String
"About to write out (potentially) modified patches..."
FL (PatchInfoAnd p) wZ wR -> IO ()
forall (p :: * -> * -> *) wX wY.
RepoPatch p =>
FL (PatchInfoAnd p) wX wY -> IO ()
setEnvDarcsPatches FL (PatchInfoAnd p) wZ wR
to_unrecord
Repository 'RW p wU wZ
_repository <-
Repository 'RW p wU wR
-> UpdatePending
-> FL (PatchInfoAnd p) wZ wR
-> IO (Repository 'RW p wU wZ)
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
YesUpdatePending FL (PatchInfoAnd p) wZ wR
to_unrecord
Repository 'RO p wU wZ
_ <- 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)
[DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
opts Doc
"Finished unrecording."
unpullDescription :: String
unpullDescription :: String
unpullDescription =
String
"Opposite of pull; unsafe if patch is not in remote repository."
unpullHelp :: Doc
unpullHelp :: Doc
unpullHelp =
String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String
"Unpull is an alias for what is nowadays called `obliterate`."
unpull :: DarcsCommand
unpull :: DarcsCommand
unpull =
(String -> Maybe DarcsCommand -> DarcsCommand -> DarcsCommand
commandAlias String
"unpull" Maybe DarcsCommand
forall a. Maybe a
Nothing DarcsCommand
obliterate)
{ commandHelp = unpullHelp
, commandDescription = unpullDescription
, commandCommand = obliterateCmd "unpull"
}
obliterateDescription :: String
obliterateDescription :: String
obliterateDescription = String
"Delete selected patches from the repository."
obliterateHelp :: Doc
obliterateHelp :: Doc
obliterateHelp = [String] -> Doc
formatWords
[ String
"Obliterate completely removes recorded patches from your local"
, String
"repository. The changes will be undone in your working tree and the"
, String
"patches will not be shown in your changes list anymore. Beware that"
, String
"you can lose precious code by obliterating!"
]
Doc -> Doc -> Doc
$+$ [String] -> Doc
formatWords
[ String
"One way to save obliterated patches is to use the -O flag. A patch"
, String
"bundle will be created locally, that you will be able to apply"
, String
"later to your repository with `darcs apply`. See `darcs send` for"
, String
"a more detailed description."
]
Doc -> Doc -> Doc
$+$ Doc
historyEditHelp
obliterate :: DarcsCommand
obliterate :: DarcsCommand
obliterate = DarcsCommand
{ commandProgramName :: String
commandProgramName = String
"darcs"
, commandName :: String
commandName = String
"obliterate"
, commandHelp :: Doc
commandHelp = Doc
obliterateHelp
, commandDescription :: String
commandDescription = String
obliterateDescription
, commandExtraArgs :: Int
commandExtraArgs = Int
0
, commandExtraArgHelp :: [String]
commandExtraArgHelp = []
, commandCommand :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
commandCommand = String
-> (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
obliterateCmd String
"obliterate"
, 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]
noArgs
, commandArgdefaults :: [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
commandArgdefaults = [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
nodefaults
, commandOptions :: CommandOptions
commandOptions = CommandOptions
obliterateOpts
}
where
obliterateBasicOpts :: OptSpec
DarcsOptDescr
DarcsFlag
a
([NotInRemote]
-> [MatchFlag]
-> SelectDeps
-> Maybe Bool
-> Maybe String
-> WithSummary
-> Maybe Output
-> Bool
-> DiffAlgorithm
-> DryRun
-> XmlOutput
-> a)
obliterateBasicOpts
= PrimOptSpec
DarcsOptDescr
DarcsFlag
([MatchFlag]
-> SelectDeps
-> Maybe Bool
-> Maybe String
-> WithSummary
-> Maybe Output
-> Bool
-> DiffAlgorithm
-> DryRun
-> XmlOutput
-> a)
[NotInRemote]
PrimDarcsOption [NotInRemote]
O.notInRemote
PrimOptSpec
DarcsOptDescr
DarcsFlag
([MatchFlag]
-> SelectDeps
-> Maybe Bool
-> Maybe String
-> WithSummary
-> Maybe Output
-> Bool
-> DiffAlgorithm
-> DryRun
-> XmlOutput
-> a)
[NotInRemote]
-> OptSpec
DarcsOptDescr
DarcsFlag
(SelectDeps
-> Maybe Bool
-> Maybe String
-> WithSummary
-> Maybe Output
-> Bool
-> DiffAlgorithm
-> DryRun
-> XmlOutput
-> a)
([MatchFlag]
-> SelectDeps
-> Maybe Bool
-> Maybe String
-> WithSummary
-> Maybe Output
-> Bool
-> DiffAlgorithm
-> DryRun
-> XmlOutput
-> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(SelectDeps
-> Maybe Bool
-> Maybe String
-> WithSummary
-> Maybe Output
-> Bool
-> DiffAlgorithm
-> DryRun
-> XmlOutput
-> a)
([NotInRemote]
-> [MatchFlag]
-> SelectDeps
-> Maybe Bool
-> Maybe String
-> WithSummary
-> Maybe Output
-> Bool
-> DiffAlgorithm
-> DryRun
-> XmlOutput
-> 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
-> Maybe String
-> WithSummary
-> Maybe Output
-> Bool
-> DiffAlgorithm
-> DryRun
-> XmlOutput
-> a)
([MatchFlag]
-> SelectDeps
-> Maybe Bool
-> Maybe String
-> WithSummary
-> Maybe Output
-> Bool
-> DiffAlgorithm
-> DryRun
-> XmlOutput
-> a)
MatchOption
O.matchSeveralOrLast
OptSpec
DarcsOptDescr
DarcsFlag
(SelectDeps
-> Maybe Bool
-> Maybe String
-> WithSummary
-> Maybe Output
-> Bool
-> DiffAlgorithm
-> DryRun
-> XmlOutput
-> a)
([NotInRemote]
-> [MatchFlag]
-> SelectDeps
-> Maybe Bool
-> Maybe String
-> WithSummary
-> Maybe Output
-> Bool
-> DiffAlgorithm
-> DryRun
-> XmlOutput
-> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(Maybe Bool
-> Maybe String
-> WithSummary
-> Maybe Output
-> Bool
-> DiffAlgorithm
-> DryRun
-> XmlOutput
-> a)
(SelectDeps
-> Maybe Bool
-> Maybe String
-> WithSummary
-> Maybe Output
-> Bool
-> DiffAlgorithm
-> DryRun
-> XmlOutput
-> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(Maybe Bool
-> Maybe String
-> WithSummary
-> Maybe Output
-> Bool
-> DiffAlgorithm
-> DryRun
-> XmlOutput
-> a)
([NotInRemote]
-> [MatchFlag]
-> SelectDeps
-> Maybe Bool
-> Maybe String
-> WithSummary
-> Maybe Output
-> Bool
-> DiffAlgorithm
-> DryRun
-> XmlOutput
-> 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 String
-> WithSummary
-> Maybe Output
-> Bool
-> DiffAlgorithm
-> DryRun
-> XmlOutput
-> a)
(SelectDeps
-> Maybe Bool
-> Maybe String
-> WithSummary
-> Maybe Output
-> Bool
-> DiffAlgorithm
-> DryRun
-> XmlOutput
-> a)
PrimDarcsOption SelectDeps
O.selectDeps
OptSpec
DarcsOptDescr
DarcsFlag
(Maybe Bool
-> Maybe String
-> WithSummary
-> Maybe Output
-> Bool
-> DiffAlgorithm
-> DryRun
-> XmlOutput
-> a)
([NotInRemote]
-> [MatchFlag]
-> SelectDeps
-> Maybe Bool
-> Maybe String
-> WithSummary
-> Maybe Output
-> Bool
-> DiffAlgorithm
-> DryRun
-> XmlOutput
-> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(Maybe String
-> WithSummary
-> Maybe Output
-> Bool
-> DiffAlgorithm
-> DryRun
-> XmlOutput
-> a)
(Maybe Bool
-> Maybe String
-> WithSummary
-> Maybe Output
-> Bool
-> DiffAlgorithm
-> DryRun
-> XmlOutput
-> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(Maybe String
-> WithSummary
-> Maybe Output
-> Bool
-> DiffAlgorithm
-> DryRun
-> XmlOutput
-> a)
([NotInRemote]
-> [MatchFlag]
-> SelectDeps
-> Maybe Bool
-> Maybe String
-> WithSummary
-> Maybe Output
-> Bool
-> DiffAlgorithm
-> DryRun
-> XmlOutput
-> 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
-> WithSummary
-> Maybe Output
-> Bool
-> DiffAlgorithm
-> DryRun
-> XmlOutput
-> a)
(Maybe Bool
-> Maybe String
-> WithSummary
-> Maybe Output
-> Bool
-> DiffAlgorithm
-> DryRun
-> XmlOutput
-> a)
PrimDarcsOption (Maybe Bool)
O.interactive
OptSpec
DarcsOptDescr
DarcsFlag
(Maybe String
-> WithSummary
-> Maybe Output
-> Bool
-> DiffAlgorithm
-> DryRun
-> XmlOutput
-> a)
([NotInRemote]
-> [MatchFlag]
-> SelectDeps
-> Maybe Bool
-> Maybe String
-> WithSummary
-> Maybe Output
-> Bool
-> DiffAlgorithm
-> DryRun
-> XmlOutput
-> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(WithSummary
-> Maybe Output
-> Bool
-> DiffAlgorithm
-> DryRun
-> XmlOutput
-> a)
(Maybe String
-> WithSummary
-> Maybe Output
-> Bool
-> DiffAlgorithm
-> DryRun
-> XmlOutput
-> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(WithSummary
-> Maybe Output
-> Bool
-> DiffAlgorithm
-> DryRun
-> XmlOutput
-> a)
([NotInRemote]
-> [MatchFlag]
-> SelectDeps
-> Maybe Bool
-> Maybe String
-> WithSummary
-> Maybe Output
-> Bool
-> DiffAlgorithm
-> DryRun
-> XmlOutput
-> 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 Output
-> Bool
-> DiffAlgorithm
-> DryRun
-> XmlOutput
-> a)
(Maybe String
-> WithSummary
-> Maybe Output
-> Bool
-> DiffAlgorithm
-> DryRun
-> XmlOutput
-> a)
PrimDarcsOption (Maybe String)
O.repoDir
OptSpec
DarcsOptDescr
DarcsFlag
(WithSummary
-> Maybe Output
-> Bool
-> DiffAlgorithm
-> DryRun
-> XmlOutput
-> a)
([NotInRemote]
-> [MatchFlag]
-> SelectDeps
-> Maybe Bool
-> Maybe String
-> WithSummary
-> Maybe Output
-> Bool
-> DiffAlgorithm
-> DryRun
-> XmlOutput
-> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(Maybe Output -> Bool -> DiffAlgorithm -> DryRun -> XmlOutput -> a)
(WithSummary
-> Maybe Output
-> Bool
-> DiffAlgorithm
-> DryRun
-> XmlOutput
-> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(Maybe Output -> Bool -> DiffAlgorithm -> DryRun -> XmlOutput -> a)
([NotInRemote]
-> [MatchFlag]
-> SelectDeps
-> Maybe Bool
-> Maybe String
-> WithSummary
-> Maybe Output
-> Bool
-> DiffAlgorithm
-> DryRun
-> XmlOutput
-> 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 Output -> Bool -> DiffAlgorithm -> DryRun -> XmlOutput -> a)
(WithSummary
-> Maybe Output
-> Bool
-> DiffAlgorithm
-> DryRun
-> XmlOutput
-> a)
PrimDarcsOption WithSummary
O.withSummary
OptSpec
DarcsOptDescr
DarcsFlag
(Maybe Output -> Bool -> DiffAlgorithm -> DryRun -> XmlOutput -> a)
([NotInRemote]
-> [MatchFlag]
-> SelectDeps
-> Maybe Bool
-> Maybe String
-> WithSummary
-> Maybe Output
-> Bool
-> DiffAlgorithm
-> DryRun
-> XmlOutput
-> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(Bool -> DiffAlgorithm -> DryRun -> XmlOutput -> a)
(Maybe Output -> Bool -> DiffAlgorithm -> DryRun -> XmlOutput -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(Bool -> DiffAlgorithm -> DryRun -> XmlOutput -> a)
([NotInRemote]
-> [MatchFlag]
-> SelectDeps
-> Maybe Bool
-> Maybe String
-> WithSummary
-> Maybe Output
-> Bool
-> DiffAlgorithm
-> DryRun
-> XmlOutput
-> 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 -> DryRun -> XmlOutput -> a)
(Maybe Output -> Bool -> DiffAlgorithm -> DryRun -> XmlOutput -> a)
PrimDarcsOption (Maybe Output)
O.output
OptSpec
DarcsOptDescr
DarcsFlag
(Bool -> DiffAlgorithm -> DryRun -> XmlOutput -> a)
([NotInRemote]
-> [MatchFlag]
-> SelectDeps
-> Maybe Bool
-> Maybe String
-> WithSummary
-> Maybe Output
-> Bool
-> DiffAlgorithm
-> DryRun
-> XmlOutput
-> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(DiffAlgorithm -> DryRun -> XmlOutput -> a)
(Bool -> DiffAlgorithm -> DryRun -> XmlOutput -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(DiffAlgorithm -> DryRun -> XmlOutput -> a)
([NotInRemote]
-> [MatchFlag]
-> SelectDeps
-> Maybe Bool
-> Maybe String
-> WithSummary
-> Maybe Output
-> Bool
-> DiffAlgorithm
-> DryRun
-> XmlOutput
-> 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 -> DryRun -> XmlOutput -> a)
(Bool -> DiffAlgorithm -> DryRun -> XmlOutput -> a)
PrimDarcsOption Bool
O.minimize
OptSpec
DarcsOptDescr
DarcsFlag
(DiffAlgorithm -> DryRun -> XmlOutput -> a)
([NotInRemote]
-> [MatchFlag]
-> SelectDeps
-> Maybe Bool
-> Maybe String
-> WithSummary
-> Maybe Output
-> Bool
-> DiffAlgorithm
-> DryRun
-> XmlOutput
-> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(DryRun -> XmlOutput -> a)
(DiffAlgorithm -> DryRun -> XmlOutput -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(DryRun -> XmlOutput -> a)
([NotInRemote]
-> [MatchFlag]
-> SelectDeps
-> Maybe Bool
-> Maybe String
-> WithSummary
-> Maybe Output
-> Bool
-> DiffAlgorithm
-> DryRun
-> XmlOutput
-> 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 -> a)
(DiffAlgorithm -> DryRun -> XmlOutput -> a)
PrimDarcsOption DiffAlgorithm
O.diffAlgorithm
OptSpec
DarcsOptDescr
DarcsFlag
(DryRun -> XmlOutput -> a)
([NotInRemote]
-> [MatchFlag]
-> SelectDeps
-> Maybe Bool
-> Maybe String
-> WithSummary
-> Maybe Output
-> Bool
-> DiffAlgorithm
-> DryRun
-> XmlOutput
-> a)
-> OptSpec DarcsOptDescr DarcsFlag a (DryRun -> XmlOutput -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
a
([NotInRemote]
-> [MatchFlag]
-> SelectDeps
-> Maybe Bool
-> Maybe String
-> WithSummary
-> Maybe Output
-> Bool
-> DiffAlgorithm
-> DryRun
-> XmlOutput
-> 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 (DryRun -> XmlOutput -> a)
forall a. DarcsOption a (DryRun -> XmlOutput -> a)
O.dryRunXml
obliterateAdvancedOpts :: OptSpec DarcsOptDescr DarcsFlag a (UMask -> Bool -> a)
obliterateAdvancedOpts
= PrimOptSpec DarcsOptDescr DarcsFlag (Bool -> a) UMask
PrimDarcsOption UMask
O.umask
PrimOptSpec DarcsOptDescr DarcsFlag (Bool -> a) UMask
-> OptSpec DarcsOptDescr DarcsFlag a (Bool -> a)
-> OptSpec DarcsOptDescr DarcsFlag a (UMask -> 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 (Bool -> a)
PrimDarcsOption Bool
O.changesReverse
obliterateOpts :: CommandOptions
obliterateOpts = OptSpec
DarcsOptDescr
DarcsFlag
(Maybe StdCmdAction
-> Verbosity
-> UMask
-> Bool
-> UseCache
-> UseIndex
-> HooksConfig
-> Bool
-> Bool
-> [DarcsFlag])
([NotInRemote]
-> [MatchFlag]
-> SelectDeps
-> Maybe Bool
-> Maybe String
-> WithSummary
-> Maybe Output
-> Bool
-> DiffAlgorithm
-> DryRun
-> XmlOutput
-> Maybe StdCmdAction
-> Verbosity
-> UMask
-> Bool
-> UseCache
-> UseIndex
-> HooksConfig
-> Bool
-> Bool
-> [DarcsFlag])
forall {a}.
OptSpec
DarcsOptDescr
DarcsFlag
a
([NotInRemote]
-> [MatchFlag]
-> SelectDeps
-> Maybe Bool
-> Maybe String
-> WithSummary
-> Maybe Output
-> Bool
-> DiffAlgorithm
-> DryRun
-> XmlOutput
-> a)
obliterateBasicOpts OptSpec
DarcsOptDescr
DarcsFlag
(Maybe StdCmdAction
-> Verbosity
-> UMask
-> Bool
-> UseCache
-> UseIndex
-> HooksConfig
-> Bool
-> Bool
-> [DarcsFlag])
([NotInRemote]
-> [MatchFlag]
-> SelectDeps
-> Maybe Bool
-> Maybe String
-> WithSummary
-> Maybe Output
-> Bool
-> DiffAlgorithm
-> DryRun
-> XmlOutput
-> Maybe StdCmdAction
-> Verbosity
-> UMask
-> Bool
-> UseCache
-> UseIndex
-> HooksConfig
-> Bool
-> Bool
-> [DarcsFlag])
-> DarcsOption
(UseCache
-> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
(UMask
-> Bool
-> 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
-> Bool
-> UseCache
-> UseIndex
-> HooksConfig
-> Bool
-> Bool
-> [DarcsFlag])
forall {a}. OptSpec DarcsOptDescr DarcsFlag a (UMask -> Bool -> a)
obliterateAdvancedOpts
obliterateCmd
:: String -> (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
obliterateCmd :: String
-> (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
obliterateCmd String
cmdname (AbsolutePath, AbsolutePath)
_ [DarcsFlag]
opts [String]
_ = do
let verbOpt :: Verbosity
verbOpt = 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
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
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
(PatchSet p Origin wZ
_ :> FL (PatchInfoAnd p) wZ wR
removal_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
cmdname ([DarcsFlag] -> PatchSelectionOptions
patchSelOpts [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
removed) <- 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
removal_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
removed) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
[DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
opts Doc
"No patches selected!"
IO ()
forall a. IO a
exitSuccess
case CommuteFn (FL (PrimOf p)) (PrimOf p)
-> (:>) (FL (PrimOf p)) (FL (PrimOf p)) wZ wU
-> (:>) (FL (PrimOf p)) (FL (PrimOf p) :> FL (PrimOf p)) wZ 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) wZ wR
-> FL (PrimOf (FL (PatchInfoAnd p))) wZ 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) wZ wR
removed FL (PrimOf p) wZ wR
-> FL (PrimOf p) wR wU
-> (:>) (FL (PrimOf p)) (FL (PrimOf p)) wZ 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) wZ wZ
unrecorded' :> FL (PrimOf p) wZ wZ
removed_after_unrecorded :> FL (PrimOf p) wZ wU
to_revert -> do
FL (PrimOf p) wZ wU
effect_removed <-
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
removed_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 unrecorded 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
removed_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 " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cmdname String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" these patches without reverting some unrecorded changes."
String
-> Verbosity
-> WithSummary
-> DryRun
-> XmlOutput
-> Bool
-> FL (PatchInfoAnd p) wZ wR
-> IO ()
forall (p :: * -> * -> *) wX wY.
RepoPatch p =>
String
-> Verbosity
-> WithSummary
-> DryRun
-> XmlOutput
-> Bool
-> FL (PatchInfoAnd p) wX wY
-> IO ()
printDryRunMessageAndExit
String
"obliterate" Verbosity
verbOpt (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) (PrimOptSpec DarcsOptDescr DarcsFlag a DryRun
PrimDarcsOption DryRun
dryRun PrimDarcsOption DryRun -> [DarcsFlag] -> DryRun
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
(PrimOptSpec DarcsOptDescr DarcsFlag a XmlOutput
PrimDarcsOption XmlOutput
xmlOutput PrimDarcsOption XmlOutput -> [DarcsFlag] -> XmlOutput
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (Bool -> [DarcsFlag] -> Bool
isInteractive Bool
True [DarcsFlag]
opts) FL (PatchInfoAnd p) wZ wR
removed
FL (PatchInfoAnd p) wZ wR -> IO ()
forall (p :: * -> * -> *) wX wY.
RepoPatch p =>
FL (PatchInfoAnd p) wX wY -> IO ()
setEnvDarcsPatches FL (PatchInfoAnd p) wZ wR
removed
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe (IO AbsolutePathOrStd) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (IO AbsolutePathOrStd) -> Bool)
-> Maybe (IO AbsolutePathOrStd) -> Bool
forall a b. (a -> b) -> a -> b
$ [DarcsFlag] -> IO String -> Maybe (IO AbsolutePathOrStd)
getOutput [DarcsFlag]
opts (String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"")) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
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 IO (PatchSet p Origin wR)
-> (PatchSet p Origin wR -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [DarcsFlag]
-> FL (PatchInfoAnd p) wZ wR -> PatchSet p Origin wR -> IO ()
forall (p :: * -> * -> *) wX wR.
(RepoPatch p, ApplyState p ~ Tree) =>
[DarcsFlag]
-> FL (PatchInfoAnd p) wX wR -> PatchSet p Origin wR -> IO ()
savetoBundle [DarcsFlag]
opts FL (PatchInfoAnd p) wZ wR
removed
Repository 'RW p wU wZ
_repository <-
Repository 'RW p wU wR
-> UpdatePending
-> FL (PatchInfoAnd p) wZ wR
-> IO (Repository 'RW p wU wZ)
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) wZ wR
removed
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 wZ
unrecorded'
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)
String -> IO ()
debugMessage String
"Applying patches to working tree..."
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 Verbosity
verbOpt (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_removed)
[DarcsFlag] -> String -> IO ()
putFinished [DarcsFlag]
opts (String -> String
presentParticiple String
cmdname)
savetoBundle
:: (RepoPatch p, ApplyState p ~ Tree)
=> [DarcsFlag]
-> FL (PatchInfoAnd p) wX wR
-> PatchSet p Origin wR
-> IO ()
savetoBundle :: forall (p :: * -> * -> *) wX wR.
(RepoPatch p, ApplyState p ~ Tree) =>
[DarcsFlag]
-> FL (PatchInfoAnd p) wX wR -> PatchSet p Origin wR -> IO ()
savetoBundle [DarcsFlag]
_ FL (PatchInfoAnd p) wX wR
NilFL PatchSet p Origin wR
_ = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
savetoBundle [DarcsFlag]
opts removed :: FL (PatchInfoAnd p) wX wR
removed@(PatchInfoAnd p wX wY
x :>: FL (PatchInfoAnd p) wY wR
_) PatchSet p Origin wR
orig = do
let kept :: PatchSet p Origin wX
kept = Maybe (PatchSet p Origin wX) -> PatchSet p Origin wX
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (PatchSet p Origin wX) -> PatchSet p Origin wX)
-> Maybe (PatchSet p Origin wX) -> PatchSet p Origin wX
forall a b. (a -> b) -> a -> b
$ FL (PatchInfoAnd p) wX wR
-> PatchSet p Origin wR -> Maybe (PatchSet p Origin wX)
forall (p :: * -> * -> *) wX wY wStart.
(Commute p, Eq2 p) =>
FL (PatchInfoAnd p) wX wY
-> PatchSet p wStart wY -> Maybe (PatchSet p wStart wX)
removeFromPatchSet FL (PatchInfoAnd p) wX wR
removed PatchSet p Origin wR
orig
genFullBundle :: IO Doc
genFullBundle = Maybe (ApplyState p IO)
-> PatchSet p Origin wX -> FL (Named p) wX wR -> IO Doc
forall (p :: * -> * -> *) wStart wX wY.
(RepoPatch p, ApplyMonadTrans (ApplyState p) IO,
ObjectId (ObjectIdOfPatch p)) =>
Maybe (ApplyState p IO)
-> PatchSet p wStart wX -> FL (Named p) wX wY -> IO Doc
makeBundle Maybe (ApplyState p IO)
forall a. Maybe a
Nothing PatchSet p Origin wX
kept ((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
removed)
Doc
bundle <-
if Bool -> Bool
not (PrimOptSpec DarcsOptDescr DarcsFlag a Bool
PrimDarcsOption Bool
minimize PrimDarcsOption Bool -> [DarcsFlag] -> Bool
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
then IO Doc
genFullBundle
else do
[DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
opts
Doc
"Minimizing context, to generate bundle with full context hit ctrl-C..."
(case PatchSet p Origin wX
-> FL (PatchInfoAnd p) wX wR
-> Sealed ((:>) (PatchSet p) (FL (PatchInfoAnd p)) Origin)
forall (p :: * -> * -> *) wStart wB wC.
RepoPatch p =>
PatchSet p wStart wB
-> FL (PatchInfoAnd p) wB wC
-> Sealed ((:>) (PatchSet p) (FL (PatchInfoAnd p)) wStart)
minContext PatchSet p Origin wX
kept FL (PatchInfoAnd p) wX wR
removed of
Sealed (PatchSet p Origin wZ
kept' :> FL (PatchInfoAnd p) wZ wX
removed') ->
Maybe (ApplyState p IO)
-> PatchSet p Origin wZ -> FL (Named p) wZ wX -> IO Doc
forall (p :: * -> * -> *) wStart wX wY.
(RepoPatch p, ApplyMonadTrans (ApplyState p) IO,
ObjectId (ObjectIdOfPatch p)) =>
Maybe (ApplyState p IO)
-> PatchSet p wStart wX -> FL (Named p) wX wY -> IO Doc
makeBundle Maybe (Tree IO)
Maybe (ApplyState p IO)
forall a. Maybe a
Nothing PatchSet p Origin wZ
kept' ((forall wW wY. PatchInfoAnd p wW wY -> Named p wW wY)
-> FL (PatchInfoAnd p) wZ wX -> FL (Named p) wZ wX
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) wZ wX
removed'))
IO Doc -> IO Doc -> IO Doc
forall a. IO a -> IO a -> IO a
`catchInterrupt` IO Doc
genFullBundle
let filename :: IO String
filename = String -> IO String
getUniqueDPatchName (PatchInfoAnd p wX wY -> String
forall (p :: * -> * -> *) wX wY. PatchInfoAnd p wX wY -> String
patchDesc PatchInfoAnd p wX wY
x)
AbsolutePathOrStd
outname <- Maybe (IO AbsolutePathOrStd) -> IO AbsolutePathOrStd
forall a. HasCallStack => Maybe a -> a
fromJust ([DarcsFlag] -> IO String -> Maybe (IO AbsolutePathOrStd)
getOutput [DarcsFlag]
opts IO String
filename)
Bool
exists <- (AbsolutePath -> IO Bool)
-> IO Bool -> AbsolutePathOrStd -> IO Bool
forall a. (AbsolutePath -> a) -> a -> AbsolutePathOrStd -> a
useAbsoluteOrStd (String -> IO Bool
doesPathExist (String -> IO Bool)
-> (AbsolutePath -> String) -> AbsolutePath -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbsolutePath -> String
forall a. FilePathLike a => a -> String
toFilePath) (Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False) AbsolutePathOrStd
outname
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
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
"Directory or file named '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (AbsolutePathOrStd -> String
forall a. Show a => a -> String
show AbsolutePathOrStd
outname) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' already exists."
(AbsolutePath -> Doc -> IO ())
-> (Doc -> IO ()) -> AbsolutePathOrStd -> Doc -> IO ()
forall a. (AbsolutePath -> a) -> a -> AbsolutePathOrStd -> a
useAbsoluteOrStd AbsolutePath -> Doc -> IO ()
forall p. FilePathLike p => p -> Doc -> IO ()
writeDocBinFile Doc -> IO ()
putDoc AbsolutePathOrStd
outname Doc
bundle
[DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
opts (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ Doc -> Doc
sentence (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
(AbsolutePath -> Doc) -> Doc -> AbsolutePathOrStd -> Doc
forall a. (AbsolutePath -> a) -> a -> AbsolutePathOrStd -> a
useAbsoluteOrStd
((Doc
"Saved patch bundle" Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (AbsolutePath -> Doc) -> AbsolutePath -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
text (String -> Doc) -> (AbsolutePath -> String) -> AbsolutePath -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbsolutePath -> String
forall a. FilePathLike a => a -> String
toFilePath)
(String -> Doc
text String
"stdout")
AbsolutePathOrStd
outname
patchSelOpts :: [DarcsFlag] -> S.PatchSelectionOptions
patchSelOpts :: [DarcsFlag] -> PatchSelectionOptions
patchSelOpts [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
True [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
}