module Darcs.UI.Commands.Unrevert ( unrevert, writeUnrevert ) where
import Prelude ()
import Darcs.Prelude
import Control.Exception ( catch, IOException )
import System.Exit ( exitSuccess )
import Darcs.Util.Tree( Tree )
import Darcs.UI.Commands ( DarcsCommand(..), withStdOpts, nodefaults, amInHashedRepository )
import Darcs.UI.Completion ( noArgs )
import Darcs.UI.Flags
( diffingOpts, verbosity, useCache, umask, compress, diffAlgorithm
, isInteractive, withContext )
import Darcs.Repository.Flags
( UseIndex(..), ScanKnown (..), Reorder(..), AllowConflicts(..), ExternalMerge(..)
, WantGuiPause(..), UpdateWorking(..), DryRun(NoDryRun) )
import Darcs.UI.Flags ( DarcsFlag )
import Darcs.UI.Options ( (^), odesc, ocheck, onormalise, defaultFlags, (?) )
import qualified Darcs.UI.Options.All as O
import Darcs.Repository ( SealedPatchSet, Repository, withRepoLock, RepoJob(..),
unrevertUrl, considerMergeToWorking,
tentativelyAddToPending, finalizeRepositoryChanges,
readRepo,
readRecorded,
applyToWorking, unrecordedChanges )
import Darcs.Patch ( IsRepoType, RepoPatch, PrimOf, commute, fromPrims )
import Darcs.Patch.Apply( ApplyState )
import Darcs.Patch.Named.Wrapped ( namepatch )
import Darcs.Patch.Rebase ( dropAnyRebase )
import Darcs.Patch.Set ( Origin )
import Darcs.Patch.Witnesses.Sealed ( Sealed(Sealed) )
import Darcs.Patch.Witnesses.Ordered ( FL(..), (:>)(..), (+>+) )
import Darcs.UI.SelectChanges
( WhichChanges(First)
, runSelection
, selectionContextPrim
)
import qualified Darcs.UI.SelectChanges as S ( PatchSelectionOptions (..) )
import qualified Data.ByteString as B
import Darcs.Util.Lock ( writeDocBinFile, removeFileMayNotExist )
import Darcs.Patch.Depends ( mergeThem )
import Darcs.UI.External ( catchall )
import Darcs.Util.Prompt ( askUser )
import Darcs.Patch.Bundle ( scanBundle, makeBundleN )
import Darcs.Util.IsoDate ( getIsoDateTime )
import Darcs.Util.SignalHandler ( withSignalsBlocked )
import Darcs.Util.Progress ( debugMessage )
import Darcs.Util.Path ( AbsolutePath )
unrevertDescription :: String
unrevertDescription :: String
unrevertDescription =
"Undo the last revert."
unrevertHelp :: String
unrevertHelp :: String
unrevertHelp =
"Unrevert is a rescue command in case you accidentally reverted\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"something you wanted to keep (for example, typing `darcs rev -a`\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"instead of `darcs rec -a`).\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"This command may fail if the repository has changed since the revert\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"took place. Darcs will ask for confirmation before executing an\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"interactive command that will DEFINITELY prevent unreversion.\n"
patchSelOpts :: [DarcsFlag] -> S.PatchSelectionOptions
patchSelOpts :: [DarcsFlag] -> PatchSelectionOptions
patchSelOpts flags :: [DarcsFlag]
flags = PatchSelectionOptions :: Verbosity
-> [MatchFlag]
-> Bool
-> SelectDeps
-> Summary
-> WithContext
-> PatchSelectionOptions
S.PatchSelectionOptions
{ verbosity :: Verbosity
S.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 = []
, interactive :: Bool
S.interactive = Bool -> [DarcsFlag] -> Bool
isInteractive Bool
True [DarcsFlag]
flags
, selectDeps :: SelectDeps
S.selectDeps = SelectDeps
O.PromptDeps
, summary :: Summary
S.summary = Summary
O.NoSummary
, withContext :: WithContext
S.withContext = PrimDarcsOption WithContext
withContext PrimDarcsOption WithContext -> [DarcsFlag] -> WithContext
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
flags
}
unrevert :: DarcsCommand [DarcsFlag]
unrevert :: DarcsCommand [DarcsFlag]
unrevert = DarcsCommand :: forall parsedFlags.
String
-> String
-> String
-> String
-> Int
-> [String]
-> ((AbsolutePath, AbsolutePath)
-> parsedFlags -> [String] -> IO ())
-> ([DarcsFlag] -> IO (Either String ()))
-> ((AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String])
-> ([DarcsFlag] -> AbsolutePath -> [String] -> IO [String])
-> [DarcsOptDescr DarcsFlag]
-> [DarcsOptDescr DarcsFlag]
-> [DarcsFlag]
-> ([DarcsFlag] -> [String])
-> ([DarcsFlag] -> parsedFlags)
-> DarcsCommand parsedFlags
DarcsCommand
{ commandProgramName :: String
commandProgramName = "darcs"
, commandName :: String
commandName = "unrevert"
, commandHelp :: String
commandHelp = String
unrevertHelp
, commandDescription :: String
commandDescription = String
unrevertDescription
, commandExtraArgs :: Int
commandExtraArgs = 0
, commandExtraArgHelp :: [String]
commandExtraArgHelp = []
, commandCommand :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
commandCommand = (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
unrevertCmd
, 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
, commandAdvancedOptions :: [DarcsOptDescr DarcsFlag]
commandAdvancedOptions = OptSpec DarcsOptDescr DarcsFlag Any (UMask -> Any)
-> [DarcsOptDescr DarcsFlag]
forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc OptSpec DarcsOptDescr DarcsFlag Any (UMask -> Any)
forall a. PrimOptSpec DarcsOptDescr DarcsFlag a UMask
unrevertAdvancedOpts
, commandBasicOptions :: [DarcsOptDescr DarcsFlag]
commandBasicOptions = OptSpec
DarcsOptDescr
DarcsFlag
Any
(UseIndex
-> Maybe Bool
-> Maybe String
-> WithContext
-> DiffAlgorithm
-> Any)
-> [DarcsOptDescr DarcsFlag]
forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc OptSpec
DarcsOptDescr
DarcsFlag
Any
(UseIndex
-> Maybe Bool
-> Maybe String
-> WithContext
-> DiffAlgorithm
-> Any)
forall a.
OptSpec
DarcsOptDescr
DarcsFlag
a
(UseIndex
-> Maybe Bool -> Maybe String -> WithContext -> DiffAlgorithm -> a)
unrevertBasicOpts
, commandDefaults :: [DarcsFlag]
commandDefaults = OptSpec
DarcsOptDescr
DarcsFlag
[DarcsFlag]
(UseIndex
-> Maybe Bool
-> Maybe String
-> WithContext
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> UMask
-> UseCache
-> HooksConfig
-> [DarcsFlag])
-> [DarcsFlag]
forall (d :: * -> *) f b. OptSpec d f [f] b -> [f]
defaultFlags OptSpec
DarcsOptDescr
DarcsFlag
[DarcsFlag]
(UseIndex
-> Maybe Bool
-> Maybe String
-> WithContext
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> UMask
-> UseCache
-> HooksConfig
-> [DarcsFlag])
forall a.
DarcsOption
a
(UseIndex
-> Maybe Bool
-> Maybe String
-> WithContext
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> UMask
-> UseCache
-> HooksConfig
-> a)
unrevertOpts
, commandCheckOptions :: [DarcsFlag] -> [String]
commandCheckOptions = OptSpec
DarcsOptDescr
DarcsFlag
Any
(UseIndex
-> Maybe Bool
-> Maybe String
-> WithContext
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> UMask
-> UseCache
-> HooksConfig
-> Any)
-> [DarcsFlag] -> [String]
forall (d :: * -> *) f a b. OptSpec d f a b -> [f] -> [String]
ocheck OptSpec
DarcsOptDescr
DarcsFlag
Any
(UseIndex
-> Maybe Bool
-> Maybe String
-> WithContext
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> UMask
-> UseCache
-> HooksConfig
-> Any)
forall a.
DarcsOption
a
(UseIndex
-> Maybe Bool
-> Maybe String
-> WithContext
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> UMask
-> UseCache
-> HooksConfig
-> a)
unrevertOpts
, commandParseOptions :: [DarcsFlag] -> [DarcsFlag]
commandParseOptions = OptSpec
DarcsOptDescr
DarcsFlag
[DarcsFlag]
(UseIndex
-> Maybe Bool
-> Maybe String
-> WithContext
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> UMask
-> UseCache
-> HooksConfig
-> [DarcsFlag])
-> [DarcsFlag] -> [DarcsFlag]
forall (d :: * -> *) f b. OptSpec d f [f] b -> [f] -> [f]
onormalise OptSpec
DarcsOptDescr
DarcsFlag
[DarcsFlag]
(UseIndex
-> Maybe Bool
-> Maybe String
-> WithContext
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> UMask
-> UseCache
-> HooksConfig
-> [DarcsFlag])
forall a.
DarcsOption
a
(UseIndex
-> Maybe Bool
-> Maybe String
-> WithContext
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> UMask
-> UseCache
-> HooksConfig
-> a)
unrevertOpts
}
where
unrevertBasicOpts :: OptSpec
DarcsOptDescr
DarcsFlag
a
(UseIndex
-> Maybe Bool -> Maybe String -> WithContext -> DiffAlgorithm -> a)
unrevertBasicOpts
= PrimOptSpec
DarcsOptDescr
DarcsFlag
(Maybe Bool -> Maybe String -> WithContext -> DiffAlgorithm -> a)
UseIndex
PrimDarcsOption UseIndex
O.useIndex
PrimOptSpec
DarcsOptDescr
DarcsFlag
(Maybe Bool -> Maybe String -> WithContext -> DiffAlgorithm -> a)
UseIndex
-> OptSpec
DarcsOptDescr
DarcsFlag
(Maybe String -> WithContext -> DiffAlgorithm -> a)
(Maybe Bool -> Maybe String -> WithContext -> DiffAlgorithm -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(Maybe String -> WithContext -> DiffAlgorithm -> a)
(UseIndex
-> Maybe Bool -> Maybe String -> WithContext -> 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 -> WithContext -> DiffAlgorithm -> a)
(Maybe Bool -> Maybe String -> WithContext -> DiffAlgorithm -> a)
PrimDarcsOption (Maybe Bool)
O.interactive
OptSpec
DarcsOptDescr
DarcsFlag
(Maybe String -> WithContext -> DiffAlgorithm -> a)
(UseIndex
-> Maybe Bool -> Maybe String -> WithContext -> DiffAlgorithm -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(WithContext -> DiffAlgorithm -> a)
(Maybe String -> WithContext -> DiffAlgorithm -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(WithContext -> DiffAlgorithm -> a)
(UseIndex
-> Maybe Bool -> Maybe String -> WithContext -> 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
(WithContext -> DiffAlgorithm -> a)
(Maybe String -> WithContext -> DiffAlgorithm -> a)
PrimDarcsOption (Maybe String)
O.repoDir
OptSpec
DarcsOptDescr
DarcsFlag
(WithContext -> DiffAlgorithm -> a)
(UseIndex
-> Maybe Bool -> Maybe String -> WithContext -> DiffAlgorithm -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(DiffAlgorithm -> a)
(WithContext -> DiffAlgorithm -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(DiffAlgorithm -> a)
(UseIndex
-> Maybe Bool -> Maybe String -> WithContext -> 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)
(WithContext -> DiffAlgorithm -> a)
PrimDarcsOption WithContext
O.withContext
OptSpec
DarcsOptDescr
DarcsFlag
(DiffAlgorithm -> a)
(UseIndex
-> Maybe Bool -> Maybe String -> WithContext -> DiffAlgorithm -> a)
-> OptSpec DarcsOptDescr DarcsFlag a (DiffAlgorithm -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
a
(UseIndex
-> Maybe Bool -> Maybe String -> WithContext -> 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
unrevertAdvancedOpts :: PrimOptSpec DarcsOptDescr DarcsFlag a UMask
unrevertAdvancedOpts = PrimOptSpec DarcsOptDescr DarcsFlag a UMask
forall a. PrimOptSpec DarcsOptDescr DarcsFlag a UMask
O.umask
unrevertOpts :: DarcsOption
a
(UseIndex
-> Maybe Bool
-> Maybe String
-> WithContext
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> UMask
-> UseCache
-> HooksConfig
-> a)
unrevertOpts = OptSpec
DarcsOptDescr
DarcsFlag
(Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> UMask
-> UseCache
-> HooksConfig
-> a)
(UseIndex
-> Maybe Bool
-> Maybe String
-> WithContext
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> UMask
-> UseCache
-> HooksConfig
-> a)
forall a.
OptSpec
DarcsOptDescr
DarcsFlag
a
(UseIndex
-> Maybe Bool -> Maybe String -> WithContext -> DiffAlgorithm -> a)
unrevertBasicOpts OptSpec
DarcsOptDescr
DarcsFlag
(Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> UMask
-> UseCache
-> HooksConfig
-> a)
(UseIndex
-> Maybe Bool
-> Maybe String
-> WithContext
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> UMask
-> UseCache
-> HooksConfig
-> a)
-> DarcsOption
(UseCache -> HooksConfig -> a)
(UMask -> UseCache -> HooksConfig -> a)
-> DarcsOption
a
(UseIndex
-> Maybe Bool
-> Maybe String
-> WithContext
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> UMask
-> UseCache
-> HooksConfig
-> a)
forall b c a.
DarcsOption
(Maybe StdCmdAction -> Bool -> Bool -> Verbosity -> Bool -> b) c
-> DarcsOption (UseCache -> HooksConfig -> a) b -> DarcsOption a c
`withStdOpts` DarcsOption
(UseCache -> HooksConfig -> a)
(UMask -> UseCache -> HooksConfig -> a)
forall a. PrimOptSpec DarcsOptDescr DarcsFlag a UMask
unrevertAdvancedOpts
unrevertCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
unrevertCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
unrevertCmd _ opts :: [DarcsFlag]
opts [] =
DryRun -> UseCache -> UpdateWorking -> UMask -> RepoJob () -> IO ()
forall a.
DryRun -> UseCache -> UpdateWorking -> UMask -> RepoJob a -> IO a
withRepoLock DryRun
NoDryRun (PrimDarcsOption UseCache
useCache PrimDarcsOption UseCache -> [DarcsFlag] -> UseCache
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) UpdateWorking
YesUpdateWorking (forall a. PrimOptSpec DarcsOptDescr DarcsFlag a UMask
umask (forall a. PrimOptSpec DarcsOptDescr DarcsFlag a UMask)
-> [DarcsFlag] -> UMask
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (RepoJob () -> IO ()) -> RepoJob () -> IO ()
forall a b. (a -> b) -> a -> b
$ (forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wR -> IO ())
-> RepoJob ()
forall a.
(forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wR -> IO a)
-> RepoJob a
RepoJob ((forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wR -> IO ())
-> RepoJob ())
-> (forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wR -> IO ())
-> RepoJob ()
forall a b. (a -> b) -> a -> b
$ \repository :: Repository rt p wR wU wR
repository -> do
PatchSet rt p Origin wR
us <- Repository rt p wR wU wR -> IO (PatchSet rt p Origin wR)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
Repository rt p wR wU wT -> IO (PatchSet rt p Origin wR)
readRepo Repository rt p wR wU wR
repository
Sealed them :: PatchSet rt p Origin wX
them <- Repository rt p wR wU wR -> IO (Sealed (PatchSet rt p Origin))
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
RepoPatch p =>
Repository rt p wR wU wT -> IO (SealedPatchSet rt p Origin)
unrevertPatchBundle Repository rt p wR wU wR
repository
Tree IO
recorded <- Repository rt p wR wU wR -> IO (Tree IO)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> IO (Tree IO)
readRecorded Repository rt p wR wU wR
repository
FL (PrimOf p) wR wU
unrecorded <- (UseIndex, ScanKnown, DiffAlgorithm)
-> LookForMoves
-> LookForReplaces
-> Repository rt p wR wU wR
-> Maybe [SubPath]
-> IO (FL (PrimOf p) wR wU)
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
(RepoPatch p, ApplyState p ~ Tree) =>
(UseIndex, ScanKnown, DiffAlgorithm)
-> LookForMoves
-> LookForReplaces
-> Repository rt p wR wU wT
-> Maybe [SubPath]
-> IO (FL (PrimOf p) wT wU)
unrecordedChanges ([DarcsFlag] -> (UseIndex, ScanKnown, DiffAlgorithm)
diffingOpts [DarcsFlag]
opts )
LookForMoves
O.NoLookForMoves LookForReplaces
O.NoLookForReplaces Repository rt p wR wU wR
repository Maybe [SubPath]
forall a. Maybe a
Nothing
Sealed h_them :: FL (PatchInfoAnd rt p) wR wX
h_them <- Sealed (FL (PatchInfoAnd rt p) wR)
-> IO (Sealed (FL (PatchInfoAnd rt p) wR))
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (FL (PatchInfoAnd rt p) wR)
-> IO (Sealed (FL (PatchInfoAnd rt p) wR)))
-> Sealed (FL (PatchInfoAnd rt p) wR)
-> IO (Sealed (FL (PatchInfoAnd rt p) wR))
forall a b. (a -> b) -> a -> b
$ PatchSet rt p Origin wR
-> PatchSet rt p Origin wX -> Sealed (FL (PatchInfoAnd rt p) wR)
forall (p :: * -> * -> *) (rt :: RepoType) wStart wX wY.
Merge p =>
PatchSet rt p wStart wX
-> PatchSet rt p wStart wY -> Sealed (FL (PatchInfoAnd rt p) wX)
mergeThem PatchSet rt p Origin wR
us PatchSet rt p Origin wX
them
Sealed pw :: FL (PrimOf p) wU wX
pw <- Repository rt p wR wU wR
-> String
-> AllowConflicts
-> UpdateWorking
-> ExternalMerge
-> WantGuiPause
-> Compression
-> Verbosity
-> Reorder
-> (UseIndex, ScanKnown, DiffAlgorithm)
-> FL (PatchInfoAnd rt p) wR wR
-> FL (PatchInfoAnd rt p) wR wX
-> IO (Sealed (FL (PrimOf p) wU))
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wX wY.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT
-> String
-> AllowConflicts
-> UpdateWorking
-> ExternalMerge
-> WantGuiPause
-> Compression
-> Verbosity
-> Reorder
-> (UseIndex, ScanKnown, DiffAlgorithm)
-> FL (PatchInfoAnd rt p) wX wT
-> FL (PatchInfoAnd rt p) wX wY
-> IO (Sealed (FL (PrimOf p) wU))
considerMergeToWorking Repository rt p wR wU wR
repository "unrevert"
AllowConflicts
YesAllowConflictsAndMark UpdateWorking
YesUpdateWorking
ExternalMerge
NoExternalMerge WantGuiPause
NoWantGuiPause
(PrimDarcsOption Compression
compress PrimDarcsOption Compression -> [DarcsFlag] -> Compression
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (PrimDarcsOption Verbosity
verbosity PrimDarcsOption Verbosity -> [DarcsFlag] -> Verbosity
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) Reorder
NoReorder
( UseIndex
UseIndex, ScanKnown
ScanKnown, PrimDarcsOption DiffAlgorithm
diffAlgorithm PrimDarcsOption DiffAlgorithm -> [DarcsFlag] -> DiffAlgorithm
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts )
FL (PatchInfoAnd rt p) wR wR
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL FL (PatchInfoAnd rt p) wR wX
h_them
let context :: PatchSelectionContext prim
context = WhichChanges
-> String
-> PatchSelectionOptions
-> Maybe (Splitter prim)
-> Maybe [String]
-> Maybe (Tree IO)
-> PatchSelectionContext prim
forall (prim :: * -> * -> *).
WhichChanges
-> String
-> PatchSelectionOptions
-> Maybe (Splitter prim)
-> Maybe [String]
-> Maybe (Tree IO)
-> PatchSelectionContext prim
selectionContextPrim WhichChanges
First "unrevert" ([DarcsFlag] -> PatchSelectionOptions
patchSelOpts [DarcsFlag]
opts) Maybe (Splitter prim)
forall a. Maybe a
Nothing Maybe [String]
forall a. Maybe a
Nothing (Tree IO -> Maybe (Tree IO)
forall a. a -> Maybe a
Just Tree IO
recorded)
(p :: FL (PrimOf p) wU wZ
p :> skipped :: FL (PrimOf p) wZ wX
skipped) <- FL (PrimOf p) wU wX
-> PatchSelectionContext (PrimOf p)
-> IO ((:>) (FL (PrimOf p)) (FL (PrimOf p)) wU wX)
forall (p :: * -> * -> *) wX wY.
(Invert p, Commute p, Apply p, PatchInspect p, ShowPatch p,
ShowContextPatch p, ApplyState p ~ Tree) =>
FL p wX wY
-> PatchSelectionContext p -> IO ((:>) (FL p) (FL p) wX wY)
runSelection FL (PrimOf p) wU wX
pw PatchSelectionContext (PrimOf p)
forall (prim :: * -> * -> *). PatchSelectionContext prim
context
Repository rt p wR wU wR
-> UpdateWorking -> FL (PrimOf p) wU wZ -> IO ()
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wX wY.
RepoPatch p =>
Repository rt p wR wU wT
-> UpdateWorking -> FL (PrimOf p) wX wY -> IO ()
tentativelyAddToPending Repository rt p wR wU wR
repository UpdateWorking
YesUpdateWorking FL (PrimOf p) wU wZ
p
IO () -> IO ()
forall a. IO a -> IO a
withSignalsBlocked (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
do Repository rt p wR wU wR -> UpdateWorking -> Compression -> IO ()
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT -> UpdateWorking -> Compression -> IO ()
finalizeRepositoryChanges Repository rt p wR wU wR
repository UpdateWorking
YesUpdateWorking (PrimDarcsOption Compression
compress PrimDarcsOption Compression -> [DarcsFlag] -> Compression
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
Repository rt p wR wZ wR
_ <- Repository rt p wR wU wR
-> Verbosity
-> FL (PrimOf p) wU wZ
-> IO (Repository rt p wR wZ wR)
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT wY.
(ApplyState p ~ Tree, RepoPatch p) =>
Repository rt p wR wU wT
-> Verbosity
-> FL (PrimOf p) wU wY
-> IO (Repository rt p wR wY wT)
applyToWorking Repository rt p wR wU wR
repository (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
p IO (Repository rt p wR wZ wR)
-> (IOException -> IO (Repository rt p wR wZ wR))
-> IO (Repository rt p wR wZ wR)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(IOException
e :: IOException) ->
String -> IO (Repository rt p wR wZ wR)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ("Error applying unrevert to working directory...\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ IOException -> String
forall a. Show a => a -> String
show IOException
e)
String -> IO ()
debugMessage "I'm about to writeUnrevert."
Repository rt p wR wU wR
-> FL (PrimOf p) wZ wX -> Tree IO -> FL (PrimOf p) wR wZ -> IO ()
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wX wY.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT
-> FL (PrimOf p) wX wY -> Tree IO -> FL (PrimOf p) wR wX -> IO ()
writeUnrevert Repository rt p wR wU wR
repository FL (PrimOf p) wZ wX
skipped Tree IO
recorded (FL (PrimOf p) wR wU
unrecordedFL (PrimOf p) wR wU -> FL (PrimOf p) wU wZ -> FL (PrimOf p) wR wZ
forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+FL (PrimOf p) wU wZ
p)
String -> IO ()
debugMessage "Finished unreverting."
unrevertCmd _ _ _ = IO ()
forall a. a
impossible
writeUnrevert :: (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree)
=> Repository rt p wR wU wT -> FL (PrimOf p) wX wY
-> Tree IO -> FL (PrimOf p) wR wX -> IO ()
writeUnrevert :: Repository rt p wR wU wT
-> FL (PrimOf p) wX wY -> Tree IO -> FL (PrimOf p) wR wX -> IO ()
writeUnrevert repository :: Repository rt p wR wU wT
repository NilFL _ _ = String -> IO ()
forall p. FilePathLike p => p -> IO ()
removeFileMayNotExist (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Repository rt p wR wU wT -> String
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> String
unrevertUrl Repository rt p wR wU wT
repository
writeUnrevert repository :: Repository rt p wR wU wT
repository ps :: FL (PrimOf p) wX wY
ps recorded :: Tree IO
recorded pend :: FL (PrimOf p) wR wX
pend =
case (:>) (FL (PrimOf p)) (FL (PrimOf p)) wR wY
-> Maybe ((:>) (FL (PrimOf p)) (FL (PrimOf p)) wR wY)
forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
commute (FL (PrimOf p) wR wX
pend FL (PrimOf p) wR wX
-> FL (PrimOf p) wX wY
-> (:>) (FL (PrimOf p)) (FL (PrimOf p)) wR wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (PrimOf p) wX wY
ps) of
Nothing -> do String
really <- String -> IO String
askUser "You will not be able to unrevert this operation! Proceed? "
case String
really of ('y':_) -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> IO ()
forall a. IO a
exitSuccess
Repository rt p wR wU wT
-> FL (PrimOf p) wX wX -> Tree IO -> FL (PrimOf p) wR wX -> IO ()
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wX wY.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT
-> FL (PrimOf p) wX wY -> Tree IO -> FL (PrimOf p) wR wX -> IO ()
writeUnrevert Repository rt p wR wU wT
repository FL (PrimOf p) wX wX
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL Tree IO
recorded FL (PrimOf p) wR wX
pend
Just (p' :: FL (PrimOf p) wR wZ
p' :> _) -> do
PatchSet rt p Origin wR
rep <- PatchSet rt p Origin wR -> PatchSet rt p Origin wR
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
IsRepoType rt =>
PatchSet rt p wA wB -> PatchSet rt p wA wB
dropAnyRebase (PatchSet rt p Origin wR -> PatchSet rt p Origin wR)
-> IO (PatchSet rt p Origin wR) -> IO (PatchSet rt p Origin wR)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Repository rt p wR wU wT -> IO (PatchSet rt p Origin wR)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
Repository rt p wR wU wT -> IO (PatchSet rt p Origin wR)
readRepo Repository rt p wR wU wT
repository
String
date <- IO String
getIsoDateTime
WrappedNamed rt p wR wZ
np <- String
-> String
-> String
-> [String]
-> FL p wR wZ
-> IO (WrappedNamed rt p wR wZ)
forall (p :: * -> * -> *) wX wY (rt :: RepoType).
String
-> String
-> String
-> [String]
-> FL p wX wY
-> IO (WrappedNamed rt p wX wY)
namepatch String
date "unrevert" "anon" [] (Repository rt p wR wU wT -> FL (PrimOf p) wR wZ -> FL p wR wZ
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT wY.
RepoPatch p =>
Repository rt p wR wU wT -> FL (PrimOf p) wR wY -> FL p wR wY
fromRepoPrims Repository rt p wR wU wT
repository FL (PrimOf p) wR wZ
p')
Doc
bundle <- Maybe (Tree IO)
-> PatchSet rt p Origin wR
-> FL (WrappedNamed rt p) wR wZ
-> IO Doc
forall (p :: * -> * -> *) (rt :: RepoType) wStart wX wY.
(ApplyState p ~ Tree, RepoPatch p) =>
Maybe (Tree IO)
-> PatchSet rt p wStart wX
-> FL (WrappedNamed rt p) wX wY
-> IO Doc
makeBundleN (Tree IO -> Maybe (Tree IO)
forall a. a -> Maybe a
Just Tree IO
recorded) PatchSet rt p Origin wR
rep (WrappedNamed rt p wR wZ
np WrappedNamed rt p wR wZ
-> FL (WrappedNamed rt p) wZ wZ -> FL (WrappedNamed rt p) wR wZ
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL (WrappedNamed rt p) wZ wZ
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL)
String -> Doc -> IO ()
forall p. FilePathLike p => p -> Doc -> IO ()
writeDocBinFile (Repository rt p wR wU wT -> String
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> String
unrevertUrl Repository rt p wR wU wT
repository) Doc
bundle
where fromRepoPrims :: RepoPatch p => Repository rt p wR wU wT -> FL (PrimOf p) wR wY -> FL p wR wY
fromRepoPrims :: Repository rt p wR wU wT -> FL (PrimOf p) wR wY -> FL p wR wY
fromRepoPrims _ = FL (PrimOf p) wR wY -> FL p wR wY
forall (p :: * -> * -> *) wX wY.
FromPrims p =>
FL (PrimOf p) wX wY -> p wX wY
fromPrims
unrevertPatchBundle :: RepoPatch p => Repository rt p wR wU wT -> IO (SealedPatchSet rt p Origin)
unrevertPatchBundle :: Repository rt p wR wU wT -> IO (SealedPatchSet rt p Origin)
unrevertPatchBundle repository :: Repository rt p wR wU wT
repository = do
ByteString
pf <- String -> IO ByteString
B.readFile (Repository rt p wR wU wT -> String
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> String
unrevertUrl Repository rt p wR wU wT
repository)
IO ByteString -> IO ByteString -> IO ByteString
forall a. IO a -> IO a -> IO a
`catchall` String -> IO ByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "There's nothing to unrevert!"
case ByteString -> Either String (SealedPatchSet rt p Origin)
forall (rt :: RepoType) (p :: * -> * -> *).
RepoPatch p =>
ByteString -> Either String (SealedPatchSet rt p Origin)
scanBundle ByteString
pf of
Right ps :: SealedPatchSet rt p Origin
ps -> SealedPatchSet rt p Origin -> IO (SealedPatchSet rt p Origin)
forall (m :: * -> *) a. Monad m => a -> m a
return SealedPatchSet rt p Origin
ps
Left err :: String
err -> String -> IO (SealedPatchSet rt p Origin)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO (SealedPatchSet rt p Origin))
-> String -> IO (SealedPatchSet rt p Origin)
forall a b. (a -> b) -> a -> b
$ "Couldn't parse unrevert patch:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err