--  Copyright (C) 2002-2005 David Roundy
--
--  This program is free software; you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation; either version 2, or (at your option)
--  any later version.
--
--  This program is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--  GNU General Public License for more details.
--
--  You should have received a copy of the GNU General Public License
--  along with this program; see the file COPYING.  If not, write to
--  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
--  Boston, MA 02110-1301, USA.

{-# LANGUAGE OverloadedStrings #-}
module Darcs.UI.Commands.Revert ( revert ) where

import Prelude ()
import Darcs.Prelude

import Control.Exception ( catch, IOException )
import Data.List ( sort )

import Darcs.UI.Flags
    ( DarcsFlag, diffingOpts, verbosity, diffAlgorithm, isInteractive, withContext
    , dryRun, umask, useCache, fixSubPaths )
import Darcs.UI.Options ( (^), odesc, ocheck, onormalise, defaultFlags, (?) )
import qualified Darcs.UI.Options.All as O
import Darcs.Repository.Flags ( UpdateWorking(..) )
import Darcs.UI.Commands ( DarcsCommand(..), withStdOpts, nodefaults, amInHashedRepository, putInfo )
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 ( toFilePath, AbsolutePath )
import Darcs.Repository
    ( withRepoLock
    , RepoJob(..)
    , addToPending
    , applyToWorking
    , readRecorded
    , unrecordedChanges
    )
import Darcs.Patch ( invert, effectOnFilePaths, commute )
import Darcs.Patch.Split ( reversePrimSplitter )
import Darcs.Patch.Witnesses.Ordered ( FL(..), (:>)(..), nullFL, (+>+) )
import Darcs.Patch.Witnesses.Sealed ( Sealed(..) )
import Darcs.UI.SelectChanges
    ( WhichChanges(Last)
    , selectionContextPrim
    , runSelection
    )
import qualified Darcs.UI.SelectChanges as S ( PatchSelectionOptions(..) )
import Darcs.Patch.TouchesFiles ( chooseTouching )


revertDescription :: String
revertDescription :: String
revertDescription = "Discard unrecorded changes."

revertHelp :: String
revertHelp :: String
revertHelp =
 "The `darcs revert` command discards unrecorded changes the working\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 "tree.  As with `darcs record`, you will be asked which hunks (changes)\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 "to revert.  The `--all` switch can be used to avoid such prompting. If\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 "files or directories are specified, other parts of the working tree\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 "are not reverted.\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 "\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 "In you accidentally reverted something you wanted to keep (for\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 "example, typing `darcs rev -a` instead of `darcs rec -a`), you can\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 "immediately run `darcs unrevert` to restore it.  This is only\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 "guaranteed to work if the repository has not changed since `darcs\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 "revert` ran.\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 -- option not supported, use default
    , summary :: Summary
S.summary = Summary
O.NoSummary -- option not supported, use default
    , 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
    }

revert :: DarcsCommand [DarcsFlag]
revert :: DarcsCommand [DarcsFlag]
revert = 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 = "revert"
    , commandHelp :: String
commandHelp = String
revertHelp
    , commandDescription :: String
commandDescription = String
revertDescription
    , commandExtraArgs :: Int
commandExtraArgs = -1
    , commandExtraArgHelp :: [String]
commandExtraArgHelp = ["[FILE or DIRECTORY]..."]
    , commandCommand :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
commandCommand = (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
revertCmd
    , 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]
modifiedFileArgs
    , commandArgdefaults :: [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
commandArgdefaults = [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
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 String -> 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 String -> WithContext -> DiffAlgorithm -> Any)
forall a.
OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  (Maybe Bool -> Maybe String -> WithContext -> DiffAlgorithm -> a)
revertBasicOpts
    , commandDefaults :: [DarcsFlag]
commandDefaults = OptSpec
  DarcsOptDescr
  DarcsFlag
  [DarcsFlag]
  (Maybe Bool
   -> Maybe String
   -> WithContext
   -> DiffAlgorithm
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> UseIndex
   -> UMask
   -> UseCache
   -> HooksConfig
   -> [DarcsFlag])
-> [DarcsFlag]
forall (d :: * -> *) f b. OptSpec d f [f] b -> [f]
defaultFlags OptSpec
  DarcsOptDescr
  DarcsFlag
  [DarcsFlag]
  (Maybe Bool
   -> Maybe String
   -> WithContext
   -> DiffAlgorithm
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> UseIndex
   -> UMask
   -> UseCache
   -> HooksConfig
   -> [DarcsFlag])
forall a.
DarcsOption
  a
  (Maybe Bool
   -> Maybe String
   -> WithContext
   -> DiffAlgorithm
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> UseIndex
   -> UMask
   -> UseCache
   -> HooksConfig
   -> a)
revertOpts
    , commandCheckOptions :: [DarcsFlag] -> [String]
commandCheckOptions = OptSpec
  DarcsOptDescr
  DarcsFlag
  Any
  (Maybe Bool
   -> Maybe String
   -> WithContext
   -> DiffAlgorithm
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> UseIndex
   -> UMask
   -> UseCache
   -> HooksConfig
   -> Any)
-> [DarcsFlag] -> [String]
forall (d :: * -> *) f a b. OptSpec d f a b -> [f] -> [String]
ocheck OptSpec
  DarcsOptDescr
  DarcsFlag
  Any
  (Maybe Bool
   -> Maybe String
   -> WithContext
   -> DiffAlgorithm
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> UseIndex
   -> UMask
   -> UseCache
   -> HooksConfig
   -> Any)
forall a.
DarcsOption
  a
  (Maybe Bool
   -> Maybe String
   -> WithContext
   -> DiffAlgorithm
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> UseIndex
   -> UMask
   -> UseCache
   -> HooksConfig
   -> a)
revertOpts
    , commandParseOptions :: [DarcsFlag] -> [DarcsFlag]
commandParseOptions = OptSpec
  DarcsOptDescr
  DarcsFlag
  [DarcsFlag]
  (Maybe Bool
   -> Maybe String
   -> WithContext
   -> DiffAlgorithm
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> UseIndex
   -> UMask
   -> UseCache
   -> HooksConfig
   -> [DarcsFlag])
-> [DarcsFlag] -> [DarcsFlag]
forall (d :: * -> *) f b. OptSpec d f [f] b -> [f] -> [f]
onormalise OptSpec
  DarcsOptDescr
  DarcsFlag
  [DarcsFlag]
  (Maybe Bool
   -> Maybe String
   -> WithContext
   -> DiffAlgorithm
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> UseIndex
   -> UMask
   -> UseCache
   -> HooksConfig
   -> [DarcsFlag])
forall a.
DarcsOption
  a
  (Maybe Bool
   -> Maybe String
   -> WithContext
   -> DiffAlgorithm
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> UseIndex
   -> UMask
   -> UseCache
   -> HooksConfig
   -> a)
revertOpts
    }
  where
    revertBasicOpts :: OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  (Maybe Bool -> Maybe String -> WithContext -> DiffAlgorithm -> a)
revertBasicOpts
      = PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe String -> WithContext -> DiffAlgorithm -> a)
  (Maybe Bool)
PrimDarcsOption (Maybe Bool)
O.interactive -- True
      PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe String -> WithContext -> DiffAlgorithm -> a)
  (Maybe Bool)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (WithContext -> DiffAlgorithm -> a)
     (Maybe String -> WithContext -> DiffAlgorithm -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (WithContext -> DiffAlgorithm -> a)
     (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)
  (Maybe Bool -> Maybe String -> WithContext -> DiffAlgorithm -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (DiffAlgorithm -> a)
     (WithContext -> DiffAlgorithm -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (DiffAlgorithm -> a)
     (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)
  (Maybe Bool -> Maybe String -> WithContext -> DiffAlgorithm -> a)
-> OptSpec DarcsOptDescr DarcsFlag a (DiffAlgorithm -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     a
     (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
    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 String
   -> WithContext
   -> DiffAlgorithm
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> UseIndex
   -> UMask
   -> UseCache
   -> HooksConfig
   -> a)
revertOpts = OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> UseIndex
   -> UMask
   -> UseCache
   -> HooksConfig
   -> a)
  (Maybe Bool
   -> Maybe String
   -> WithContext
   -> DiffAlgorithm
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> UseIndex
   -> UMask
   -> UseCache
   -> HooksConfig
   -> a)
forall a.
OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  (Maybe Bool -> Maybe String -> WithContext -> DiffAlgorithm -> a)
revertBasicOpts OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> UseIndex
   -> UMask
   -> UseCache
   -> HooksConfig
   -> a)
  (Maybe Bool
   -> Maybe String
   -> WithContext
   -> DiffAlgorithm
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> UseIndex
   -> UMask
   -> UseCache
   -> HooksConfig
   -> a)
-> DarcsOption
     (UseCache -> HooksConfig -> a)
     (UseIndex -> UMask -> UseCache -> HooksConfig -> a)
-> DarcsOption
     a
     (Maybe Bool
      -> Maybe String
      -> WithContext
      -> DiffAlgorithm
      -> Maybe StdCmdAction
      -> Bool
      -> Bool
      -> Verbosity
      -> Bool
      -> UseIndex
      -> 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)
  (UseIndex -> UMask -> UseCache -> HooksConfig -> a)
forall a.
OptSpec DarcsOptDescr DarcsFlag a (UseIndex -> UMask -> a)
revertAdvancedOpts

revertCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
revertCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
revertCmd fps :: (AbsolutePath, AbsolutePath)
fps opts :: [DarcsFlag]
opts args :: [String]
args =
 DryRun -> UseCache -> UpdateWorking -> UMask -> RepoJob () -> IO ()
forall a.
DryRun -> UseCache -> UpdateWorking -> UMask -> RepoJob a -> IO a
withRepoLock (PrimDarcsOption DryRun
dryRun PrimDarcsOption DryRun -> [DarcsFlag] -> DryRun
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (PrimDarcsOption UseCache
useCache PrimDarcsOption UseCache -> [DarcsFlag] -> UseCache
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) UpdateWorking
YesUpdateWorking (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 :: Repository rt p wR wU wR
repository -> do
  Maybe [SubPath]
files <- if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
args then Maybe [SubPath] -> IO (Maybe [SubPath])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [SubPath]
forall a. Maybe a
Nothing
    else [SubPath] -> Maybe [SubPath]
forall a. a -> Maybe a
Just ([SubPath] -> Maybe [SubPath])
-> ([SubPath] -> [SubPath]) -> [SubPath] -> Maybe [SubPath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SubPath] -> [SubPath]
forall a. Ord a => [a] -> [a]
sort ([SubPath] -> Maybe [SubPath])
-> IO [SubPath] -> IO (Maybe [SubPath])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AbsolutePath, AbsolutePath) -> [String] -> IO [SubPath]
fixSubPaths (AbsolutePath, AbsolutePath)
fps [String]
args
  Verbosity -> Maybe [SubPath] -> String -> IO ()
announceFiles (PrimDarcsOption Verbosity
verbosity PrimDarcsOption Verbosity -> [DarcsFlag] -> Verbosity
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) Maybe [SubPath]
files "Reverting changes in"
  FL (PrimOf p) wR wU
changes <- (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 {- always ScanKnown here -})
    LookForMoves
O.NoLookForMoves LookForReplaces
O.NoLookForReplaces Repository rt p wR wU wR
repository Maybe [SubPath]
files
  let pre_changed_files :: Maybe [String]
pre_changed_files = FL (PrimOf p) wU wR -> [String] -> [String]
forall (p :: * -> * -> *) wX wY.
(Apply p, ApplyState p ~ Tree) =>
p wX wY -> [String] -> [String]
effectOnFilePaths (FL (PrimOf p) wR wU -> FL (PrimOf p) wU wR
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert FL (PrimOf p) wR wU
changes) ([String] -> [String])
-> ([SubPath] -> [String]) -> [SubPath] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SubPath -> String) -> [SubPath] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map SubPath -> String
forall a. FilePathLike a => a -> String
toFilePath ([SubPath] -> [String]) -> Maybe [SubPath] -> Maybe [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [SubPath]
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 touching_changes :: FL (PrimOf p) wR wX
touching_changes <- Sealed (FL (PrimOf p) wR) -> IO (Sealed (FL (PrimOf p) wR))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [String] -> FL (PrimOf p) wR wU -> Sealed (FL (PrimOf p) wR)
forall (p :: * -> * -> *) wX wY.
(Apply p, Commute p, PatchInspect p, ApplyState p ~ Tree) =>
Maybe [String] -> FL p wX wY -> Sealed (FL p wX)
chooseTouching Maybe [String]
pre_changed_files FL (PrimOf p) wR wU
changes)
  case FL (PrimOf p) wR wX
touching_changes of
    NilFL -> [DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
opts "There are no changes to revert!"
    _ -> do
      let context :: PatchSelectionContext (PrimOf p)
context = WhichChanges
-> String
-> PatchSelectionOptions
-> Maybe (Splitter (PrimOf p))
-> Maybe [String]
-> Maybe (Tree IO)
-> PatchSelectionContext (PrimOf p)
forall (prim :: * -> * -> *).
WhichChanges
-> String
-> PatchSelectionOptions
-> Maybe (Splitter prim)
-> Maybe [String]
-> Maybe (Tree IO)
-> PatchSelectionContext prim
selectionContextPrim
                          WhichChanges
Last "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 (PrimDarcsOption DiffAlgorithm
diffAlgorithm PrimDarcsOption DiffAlgorithm -> [DarcsFlag] -> DiffAlgorithm
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)))
                          Maybe [String]
pre_changed_files (Tree IO -> Maybe (Tree IO)
forall a. a -> Maybe a
Just Tree IO
recorded)
      (norevert :: FL (PrimOf p) wR wZ
norevert:>p :: FL (PrimOf p) wZ wU
p) <- FL (PrimOf p) wR wU
-> PatchSelectionContext (PrimOf p)
-> IO ((:>) (FL (PrimOf p)) (FL (PrimOf p)) wR wU)
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) wR wU
changes PatchSelectionContext (PrimOf p)
context
      if FL (PrimOf p) wZ wU -> Bool
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Bool
nullFL FL (PrimOf p) wZ wU
p
       then [DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
opts (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ "If you don't want to revert after all, that's fine with me!"
       else do
                 Repository rt p wR wU wR
-> UpdateWorking -> FL (PrimOf p) wU wZ -> IO ()
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT wY.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT
-> UpdateWorking -> FL (PrimOf p) wU wY -> IO ()
addToPending Repository rt p wR wU wR
repository UpdateWorking
YesUpdateWorking (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 (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert FL (PrimOf p) wZ wU
p
                 String -> IO ()
debugMessage "About to write the unrevert file."
                 case (:>) (FL (PrimOf p)) (FL (PrimOf p)) wR wU
-> Maybe ((:>) (FL (PrimOf p)) (FL (PrimOf p)) wR wU)
forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
commute (FL (PrimOf p) wR wZ
norevertFL (PrimOf p) wR wZ
-> FL (PrimOf p) wZ wU
-> (:>) (FL (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
p) of
                   Just (p' :: FL (PrimOf p) wR wZ
p':>_) -> 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 FL (PrimOf p) wR wZ
p' Tree IO
recorded FL (PrimOf p) wR wR
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
                   Nothing -> Repository rt p wR wU wR
-> FL (PrimOf p) wR wU -> 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 (FL (PrimOf p) wR wZ
norevertFL (PrimOf p) wR wZ -> FL (PrimOf p) wZ wU -> FL (PrimOf p) wR wU
forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+FL (PrimOf p) wZ wU
p) Tree IO
recorded FL (PrimOf p) wR wR
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
                 String -> IO ()
debugMessage "About to apply to the working directory."
                 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) wZ wU -> FL (PrimOf p) wU wZ
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert FL (PrimOf p) wZ wU
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 ("Unable to apply inverse patch!" String -> String -> String
forall a. [a] -> [a] -> [a]
++ IOException -> String
forall a. Show a => a -> String
show IOException
e)
                 () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      [DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
opts "Finished reverting."