{-# LANGUAGE OverloadedStrings #-}
module Darcs.UI.Commands.Revert ( revert ) where
import Darcs.Prelude
import Control.Monad ( void )
import Darcs.UI.Flags
( DarcsFlag
, diffAlgorithm
, diffingOpts
, dryRun
, isInteractive
, pathSetFromArgs
, umask
, useCache
, verbosity
, withContext
)
import Darcs.UI.Options ( (^), odesc, ocheck, defaultFlags, (?) )
import qualified Darcs.UI.Options.All as O
import Darcs.Repository.Flags ( UpdatePending(..) )
import Darcs.UI.Commands
( DarcsCommand(..)
, amInHashedRepository
, nodefaults
, putInfo
, putFinished
, withStdOpts
)
import Darcs.UI.Commands.Util ( announceFiles )
import Darcs.UI.Commands.Unrevert ( writeUnrevert )
import Darcs.UI.Completion ( modifiedFileArgs )
import Darcs.Util.Global ( debugMessage )
import Darcs.Util.Path ( AbsolutePath )
import Darcs.Util.Printer ( Doc, text )
import Darcs.Util.SignalHandler ( withSignalsBlocked )
import Darcs.Repository
( withRepoLock
, RepoJob(..)
, addToPending
, applyToWorking
, readRecorded
, unrecordedChanges
)
import Darcs.Patch ( invert, effectOnPaths, commuteFL )
import Darcs.Patch.Permutations ( genCommuteWhatWeCanRL )
import Darcs.Patch.Split ( reversePrimSplitter )
import Darcs.Patch.Witnesses.Ordered
( FL(..)
, (:>)(..)
, nullFL
, (+>>+)
, reverseFL
)
import Darcs.Patch.Witnesses.Sealed ( Sealed(..) )
import Darcs.UI.SelectChanges
( WhichChanges(Last)
, selectionConfigPrim
, runInvertibleSelection
)
import qualified Darcs.UI.SelectChanges as S ( PatchSelectionOptions(..) )
import Darcs.Patch.TouchesFiles ( chooseTouching )
revertDescription :: String
revertDescription :: [Char]
revertDescription = [Char]
"Discard unrecorded changes."
revertHelp :: Doc
revertHelp :: Doc
revertHelp = [Char] -> Doc
text ([Char] -> Doc) -> [Char] -> Doc
forall a b. (a -> b) -> a -> b
$
[Char]
"The `darcs revert` command discards unrecorded changes the working\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
"tree. As with `darcs record`, you will be asked which hunks (changes)\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
"to revert. The `--all` switch can be used to avoid such prompting. If\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
"files or directories are specified, other parts of the working tree\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
"are not reverted.\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
"\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
"In you accidentally reverted something you wanted to keep (for\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
"example, typing `darcs rev -a` instead of `darcs rec -a`), you can\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
"immediately run `darcs unrevert` to restore it. This is only\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
"guaranteed to work if the repository has not changed since `darcs\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
"revert` ran.\n"
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 = []
, interactive :: Bool
S.interactive = Bool -> [DarcsFlag] -> Bool
isInteractive Bool
True [DarcsFlag]
flags
, selectDeps :: SelectDeps
S.selectDeps = SelectDeps
O.PromptDeps
, withSummary :: WithSummary
S.withSummary = WithSummary
O.NoSummary
, withContext :: WithContext
S.withContext = PrimOptSpec DarcsOptDescr DarcsFlag a WithContext
PrimDarcsOption WithContext
withContext PrimDarcsOption WithContext -> [DarcsFlag] -> WithContext
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
flags
}
revert :: DarcsCommand
revert :: DarcsCommand
revert = DarcsCommand
{ commandProgramName :: [Char]
commandProgramName = [Char]
"darcs"
, commandName :: [Char]
commandName = [Char]
"revert"
, commandHelp :: Doc
commandHelp = Doc
revertHelp
, commandDescription :: [Char]
commandDescription = [Char]
revertDescription
, commandExtraArgs :: Int
commandExtraArgs = -Int
1
, commandExtraArgHelp :: [[Char]]
commandExtraArgHelp = [[Char]
"[FILE or DIRECTORY]..."]
, commandCommand :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [[Char]] -> IO ()
commandCommand = (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [[Char]] -> IO ()
revertCmd
, commandPrereq :: [DarcsFlag] -> IO (Either [Char] ())
commandPrereq = [DarcsFlag] -> IO (Either [Char] ())
amInHashedRepository
, commandCompleteArgs :: (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [[Char]] -> IO [[Char]]
commandCompleteArgs = (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [[Char]] -> IO [[Char]]
modifiedFileArgs
, commandArgdefaults :: [DarcsFlag] -> AbsolutePath -> [[Char]] -> IO [[Char]]
commandArgdefaults = [DarcsFlag] -> AbsolutePath -> [[Char]] -> IO [[Char]]
nodefaults
, commandAdvancedOptions :: [DarcsOptDescr DarcsFlag]
commandAdvancedOptions = OptSpec DarcsOptDescr DarcsFlag Any (UseIndex -> UMask -> Any)
-> [DarcsOptDescr DarcsFlag]
forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc OptSpec DarcsOptDescr DarcsFlag Any (UseIndex -> UMask -> Any)
forall {a}.
OptSpec DarcsOptDescr DarcsFlag a (UseIndex -> UMask -> a)
revertAdvancedOpts
, commandBasicOptions :: [DarcsOptDescr DarcsFlag]
commandBasicOptions = OptSpec
DarcsOptDescr
DarcsFlag
Any
(Maybe Bool -> Maybe [Char] -> WithContext -> DiffAlgorithm -> Any)
-> [DarcsOptDescr DarcsFlag]
forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc OptSpec
DarcsOptDescr
DarcsFlag
Any
(Maybe Bool -> Maybe [Char] -> WithContext -> DiffAlgorithm -> Any)
forall {a}.
OptSpec
DarcsOptDescr
DarcsFlag
a
(Maybe Bool -> Maybe [Char] -> WithContext -> DiffAlgorithm -> a)
revertBasicOpts
, commandDefaults :: [DarcsFlag]
commandDefaults = OptSpec
DarcsOptDescr
DarcsFlag
[DarcsFlag]
(Maybe Bool
-> Maybe [Char]
-> WithContext
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Verbosity
-> UseIndex
-> UMask
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> [DarcsFlag])
-> [DarcsFlag]
forall (d :: * -> *) f b. OptSpec d f [f] b -> [f]
defaultFlags OptSpec
DarcsOptDescr
DarcsFlag
[DarcsFlag]
(Maybe Bool
-> Maybe [Char]
-> WithContext
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Verbosity
-> UseIndex
-> UMask
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> [DarcsFlag])
forall {a}.
DarcsOption
a
(Maybe Bool
-> Maybe [Char]
-> WithContext
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Verbosity
-> UseIndex
-> UMask
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
revertOpts
, commandCheckOptions :: [DarcsFlag] -> [[Char]]
commandCheckOptions = OptSpec
DarcsOptDescr
DarcsFlag
Any
(Maybe Bool
-> Maybe [Char]
-> WithContext
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Verbosity
-> UseIndex
-> UMask
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> Any)
-> [DarcsFlag] -> [[Char]]
forall (d :: * -> *) f a b. OptSpec d f a b -> [f] -> [[Char]]
ocheck OptSpec
DarcsOptDescr
DarcsFlag
Any
(Maybe Bool
-> Maybe [Char]
-> WithContext
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Verbosity
-> UseIndex
-> UMask
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> Any)
forall {a}.
DarcsOption
a
(Maybe Bool
-> Maybe [Char]
-> WithContext
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Verbosity
-> UseIndex
-> UMask
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
revertOpts
}
where
revertBasicOpts :: OptSpec
DarcsOptDescr
DarcsFlag
a
(Maybe Bool -> Maybe [Char] -> WithContext -> DiffAlgorithm -> a)
revertBasicOpts
= PrimOptSpec
DarcsOptDescr
DarcsFlag
(Maybe [Char] -> WithContext -> DiffAlgorithm -> a)
(Maybe Bool)
PrimDarcsOption (Maybe Bool)
O.interactive
PrimOptSpec
DarcsOptDescr
DarcsFlag
(Maybe [Char] -> WithContext -> DiffAlgorithm -> a)
(Maybe Bool)
-> OptSpec
DarcsOptDescr
DarcsFlag
(WithContext -> DiffAlgorithm -> a)
(Maybe [Char] -> WithContext -> DiffAlgorithm -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(WithContext -> DiffAlgorithm -> a)
(Maybe Bool -> Maybe [Char] -> 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 [Char] -> WithContext -> DiffAlgorithm -> a)
PrimDarcsOption (Maybe [Char])
O.repoDir
OptSpec
DarcsOptDescr
DarcsFlag
(WithContext -> DiffAlgorithm -> a)
(Maybe Bool -> Maybe [Char] -> WithContext -> DiffAlgorithm -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(DiffAlgorithm -> a)
(WithContext -> DiffAlgorithm -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(DiffAlgorithm -> a)
(Maybe Bool -> Maybe [Char] -> 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)
(Maybe Bool -> Maybe [Char] -> WithContext -> DiffAlgorithm -> a)
-> OptSpec DarcsOptDescr DarcsFlag a (DiffAlgorithm -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
a
(Maybe Bool -> Maybe [Char] -> 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
revertAdvancedOpts :: OptSpec DarcsOptDescr DarcsFlag a (UseIndex -> UMask -> a)
revertAdvancedOpts = PrimOptSpec DarcsOptDescr DarcsFlag (UMask -> a) UseIndex
PrimDarcsOption UseIndex
O.useIndex PrimOptSpec DarcsOptDescr DarcsFlag (UMask -> a) UseIndex
-> OptSpec DarcsOptDescr DarcsFlag a (UMask -> a)
-> OptSpec DarcsOptDescr DarcsFlag a (UseIndex -> 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
revertOpts :: DarcsOption
a
(Maybe Bool
-> Maybe [Char]
-> WithContext
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Verbosity
-> UseIndex
-> UMask
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
revertOpts = OptSpec
DarcsOptDescr
DarcsFlag
(Maybe StdCmdAction
-> Verbosity
-> UseIndex
-> UMask
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
(Maybe Bool
-> Maybe [Char]
-> WithContext
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Verbosity
-> UseIndex
-> UMask
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
forall {a}.
OptSpec
DarcsOptDescr
DarcsFlag
a
(Maybe Bool -> Maybe [Char] -> WithContext -> DiffAlgorithm -> a)
revertBasicOpts OptSpec
DarcsOptDescr
DarcsFlag
(Maybe StdCmdAction
-> Verbosity
-> UseIndex
-> UMask
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
(Maybe Bool
-> Maybe [Char]
-> WithContext
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Verbosity
-> UseIndex
-> UMask
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
-> DarcsOption
(UseCache -> HooksConfig -> Bool -> Bool -> Bool -> a)
(UseIndex
-> UMask -> UseCache -> HooksConfig -> Bool -> Bool -> Bool -> a)
-> DarcsOption
a
(Maybe Bool
-> Maybe [Char]
-> WithContext
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Verbosity
-> UseIndex
-> UMask
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
forall b c a.
DarcsOption (Maybe StdCmdAction -> Verbosity -> b) c
-> DarcsOption
(UseCache -> HooksConfig -> Bool -> Bool -> Bool -> a) b
-> DarcsOption a c
`withStdOpts` DarcsOption
(UseCache -> HooksConfig -> Bool -> Bool -> Bool -> a)
(UseIndex
-> UMask -> UseCache -> HooksConfig -> Bool -> Bool -> Bool -> a)
forall {a}.
OptSpec DarcsOptDescr DarcsFlag a (UseIndex -> UMask -> a)
revertAdvancedOpts
revertCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
revertCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [[Char]] -> IO ()
revertCmd (AbsolutePath, AbsolutePath)
fps [DarcsFlag]
opts [[Char]]
args =
DryRun -> UseCache -> UpdatePending -> UMask -> RepoJob () -> IO ()
forall a.
DryRun -> UseCache -> UpdatePending -> UMask -> RepoJob a -> IO a
withRepoLock (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 UseCache
PrimDarcsOption UseCache
useCache PrimDarcsOption UseCache -> [DarcsFlag] -> UseCache
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) UpdatePending
YesUpdatePending (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 () -> 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 rt p wR wU wR
repository -> do
Maybe [AnchoredPath]
files <- (AbsolutePath, AbsolutePath)
-> [[Char]] -> IO (Maybe [AnchoredPath])
pathSetFromArgs (AbsolutePath, AbsolutePath)
fps [[Char]]
args
Verbosity -> Maybe [AnchoredPath] -> [Char] -> IO ()
announceFiles (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) Maybe [AnchoredPath]
files [Char]
"Reverting changes in"
FL (PrimOf p) wR wU
changes <- (UseIndex, ScanKnown, DiffAlgorithm)
-> LookForMoves
-> LookForReplaces
-> Repository rt p wR wU wR
-> Maybe [AnchoredPath]
-> IO (FL (PrimOf p) wR wU)
forall (p :: * -> * -> *) (rt :: RepoType) wR wU.
(RepoPatch p, ApplyState p ~ Tree) =>
(UseIndex, ScanKnown, DiffAlgorithm)
-> LookForMoves
-> LookForReplaces
-> Repository rt p wR wU wR
-> Maybe [AnchoredPath]
-> IO (FL (PrimOf p) wR wU)
unrecordedChanges ([DarcsFlag] -> (UseIndex, ScanKnown, DiffAlgorithm)
diffingOpts [DarcsFlag]
opts )
LookForMoves
O.NoLookForMoves LookForReplaces
O.NoLookForReplaces Repository rt p wR wU wR
repository Maybe [AnchoredPath]
files
let pre_changed_files :: Maybe [AnchoredPath]
pre_changed_files = FL (PrimOf p) wU wR -> [AnchoredPath] -> [AnchoredPath]
forall (p :: * -> * -> *) wX wY.
(Apply p, ApplyState p ~ Tree) =>
p wX wY -> [AnchoredPath] -> [AnchoredPath]
effectOnPaths (FL (PrimOf p) wR wU -> FL (PrimOf p) wU wR
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) wR wU
changes) ([AnchoredPath] -> [AnchoredPath])
-> Maybe [AnchoredPath] -> Maybe [AnchoredPath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [AnchoredPath]
files
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
Sealed FL (PrimOf p) wR wX
touching_changes <- Sealed (FL (PrimOf p) wR) -> IO (Sealed (FL (PrimOf p) wR))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [AnchoredPath]
-> FL (PrimOf p) wR wU -> Sealed (FL (PrimOf p) wR)
forall (p :: * -> * -> *) wX wY.
(Apply p, Commute p, PatchInspect p, ApplyState p ~ Tree) =>
Maybe [AnchoredPath] -> FL p wX wY -> Sealed (FL p wX)
chooseTouching Maybe [AnchoredPath]
pre_changed_files FL (PrimOf p) wR wU
changes)
case FL (PrimOf p) wR wX
touching_changes of
FL (PrimOf p) wR wX
NilFL -> [DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
opts Doc
"There are no changes to revert!"
FL (PrimOf p) wR wX
_ -> do
let selection_config :: SelectionConfig (PrimOf p)
selection_config = WhichChanges
-> [Char]
-> PatchSelectionOptions
-> Maybe (Splitter (PrimOf p))
-> Maybe [AnchoredPath]
-> Maybe (Tree IO)
-> SelectionConfig (PrimOf p)
forall (prim :: * -> * -> *).
WhichChanges
-> [Char]
-> PatchSelectionOptions
-> Maybe (Splitter prim)
-> Maybe [AnchoredPath]
-> Maybe (Tree IO)
-> SelectionConfig prim
selectionConfigPrim
WhichChanges
Last [Char]
"revert" ([DarcsFlag] -> PatchSelectionOptions
patchSelOpts [DarcsFlag]
opts)
(Splitter (PrimOf p) -> Maybe (Splitter (PrimOf p))
forall a. a -> Maybe a
Just (DiffAlgorithm -> Splitter (PrimOf p)
forall (prim :: * -> * -> *).
PrimPatch prim =>
DiffAlgorithm -> Splitter prim
reversePrimSplitter (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]
pre_changed_files (Tree IO -> Maybe (Tree IO)
forall a. a -> Maybe a
Just Tree IO
recorded)
FL (PrimOf p) wR wZ
norevert :> FL (PrimOf p) wZ wU
torevert <- FL (PrimOf p) wR wU
-> SelectionConfig (PrimOf p)
-> IO ((:>) (FL (PrimOf p)) (FL (PrimOf p)) wR wU)
forall (p :: * -> * -> *) wX wY.
(Invert p, MatchableRP p, ShowPatch p, ShowContextPatch p,
ApplyState p ~ Tree) =>
FL p wX wY -> SelectionConfig p -> IO ((:>) (FL p) (FL p) wX wY)
runInvertibleSelection FL (PrimOf p) wR wU
changes SelectionConfig (PrimOf p)
selection_config
if FL (PrimOf p) wZ wU -> Bool
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Bool
nullFL FL (PrimOf p) wZ wU
torevert
then [DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
opts (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$
Doc
"If you don't want to revert after all, that's fine with me!"
else 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
-> UseIndex -> FL (PrimOf p) wU wZ -> IO ()
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wY.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wR
-> UseIndex -> FL (PrimOf p) wU wY -> IO ()
addToPending Repository rt p wR wU wR
repository (PrimOptSpec DarcsOptDescr DarcsFlag a UseIndex
PrimDarcsOption UseIndex
O.useIndex PrimDarcsOption UseIndex -> [DarcsFlag] -> UseIndex
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (FL (PrimOf p) wU wZ -> IO ()) -> FL (PrimOf p) wU wZ -> IO ()
forall a b. (a -> b) -> a -> b
$ 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
torevert
[Char] -> IO ()
debugMessage [Char]
"About to write the unrevert file."
case (forall wA wB.
(:>) (PrimOf p) (FL (PrimOf p)) wA wB
-> Maybe ((:>) (FL (PrimOf p)) (PrimOf p) wA wB))
-> (:>) (RL (PrimOf p)) (FL (PrimOf p)) wR wU
-> (:>) (RL (PrimOf p)) (FL (PrimOf p) :> RL (PrimOf p)) wR wU
forall (p :: * -> * -> *) (q :: * -> * -> *) wX wY.
Commute p =>
(forall wA wB. (:>) p q wA wB -> Maybe ((:>) q p wA wB))
-> (:>) (RL p) q wX wY -> (:>) (RL p) (q :> RL p) wX wY
genCommuteWhatWeCanRL (:>) (PrimOf p) (FL (PrimOf p)) wA wB
-> Maybe ((:>) (FL (PrimOf p)) (PrimOf p) wA wB)
forall wA wB.
(:>) (PrimOf p) (FL (PrimOf p)) wA wB
-> Maybe ((:>) (FL (PrimOf p)) (PrimOf p) wA wB)
forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p (FL p) wX wY -> Maybe ((:>) (FL p) p wX wY)
commuteFL (FL (PrimOf p) wR wZ -> RL (PrimOf p) wR wZ
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> RL a wX wZ
reverseFL FL (PrimOf p) wR wZ
norevert RL (PrimOf p) wR wZ
-> FL (PrimOf p) wZ wU
-> (:>) (RL (PrimOf p)) (FL (PrimOf p)) wR wU
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (PrimOf p) wZ wU
torevert) of
RL (PrimOf p) wR wZ
deps :> FL (PrimOf p) wZ wZ
torevert' :> RL (PrimOf p) wZ wU
_ ->
Repository rt p wR wU wR
-> FL (PrimOf p) wR wZ -> Tree IO -> FL (PrimOf p) wR wR -> 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 (RL (PrimOf p) wR wZ
deps RL (PrimOf p) wR wZ -> FL (PrimOf p) wZ wZ -> FL (PrimOf p) wR wZ
forall (p :: * -> * -> *) wX wY wZ.
RL p wX wY -> FL p wY wZ -> FL p wX wZ
+>>+ FL (PrimOf p) wZ wZ
torevert') Tree IO
recorded FL (PrimOf p) wR wR
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
[Char] -> IO ()
debugMessage [Char]
"About to apply to the working tree."
IO (Repository rt p wR wZ wR) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Repository rt p wR wZ wR) -> IO ())
-> IO (Repository rt p wR wZ wR) -> IO ()
forall a b. (a -> b) -> a -> b
$ 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 (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) 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
torevert)
[DarcsFlag] -> [Char] -> IO ()
putFinished [DarcsFlag]
opts [Char]
"reverting"