--  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.Unrecord
    ( unrecord
    , unpull
    , obliterate
    ) where

import Control.Monad ( when, void )
import Data.Maybe( fromJust, isJust )
import Darcs.Util.Tree( Tree )
import System.Exit ( exitSuccess )

import Darcs.Prelude

import Darcs.Patch ( RepoPatch, invert, commute, effect )
import Darcs.Patch.Apply( ApplyState )
import Darcs.Patch.Bundle ( makeBundle, minContext )
import Darcs.Patch.Depends ( removeFromPatchSet )
import Darcs.Patch.PatchInfoAnd ( hopefully, patchDesc )
import Darcs.Patch.Set ( PatchSet, Origin )
import Darcs.Patch.Witnesses.Sealed ( Sealed(..) )
import Darcs.Patch.Witnesses.Ordered ( (:>)(..), mapFL_FL, nullFL, FL(..) )
import Darcs.Util.Path( useAbsoluteOrStd, AbsolutePath, toFilePath, doesPathExist )
import Darcs.Util.SignalHandler ( catchInterrupt, withSignalsBlocked )
import Darcs.Repository
    ( PatchInfoAnd
    , RepoJob(..)
    , applyToWorking
    , finalizeRepositoryChanges
    , invalidateIndex
    , readRepo
    , tentativelyAddToPending
    , tentativelyRemovePatches
    , unrecordedChanges
    , withRepoLock
    )
import Darcs.Repository.Flags( UseIndex(..), ScanKnown(..), UpdatePending(..), DryRun(NoDryRun) )
import Darcs.Util.Lock( writeDocBinFile )
import Darcs.UI.Commands ( DarcsCommand(..), withStdOpts, nodefaults, commandAlias
                         , putVerbose
                         , setEnvDarcsPatches, amInHashedRepository
                         , putInfo, putFinished )
import Darcs.UI.Commands.Util
    ( getUniqueDPatchName
    , printDryRunMessageAndExit
    , preselectPatches
    , historyEditHelp
    )
import Darcs.UI.Completion ( noArgs )
import Darcs.UI.Flags
    ( DarcsFlag, changesReverse, compress, verbosity, getOutput
    , useCache, dryRun, umask, minimize
    , diffAlgorithm, xmlOutput, isInteractive, selectDeps )
import Darcs.UI.Options ( (^), odesc, ocheck, defaultFlags, parseFlags, (?) )
import qualified Darcs.UI.Options.All as O
import Darcs.UI.SelectChanges ( WhichChanges(..),
                                selectionConfig, runSelection )
import qualified Darcs.UI.SelectChanges as S ( PatchSelectionOptions (..) )
import Darcs.Util.English ( presentParticiple )
import Darcs.Util.Printer ( Doc, formatWords, text, putDoc, sentence, (<+>), ($+$) )
import Darcs.Util.Progress ( debugMessage )

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 :: String
-> String
-> Doc
-> String
-> Int
-> [String]
-> ((AbsolutePath, AbsolutePath)
    -> [DarcsFlag] -> [String] -> IO ())
-> ([DarcsFlag] -> IO (Either String ()))
-> ((AbsolutePath, AbsolutePath)
    -> [DarcsFlag] -> [String] -> IO [String])
-> ([DarcsFlag] -> AbsolutePath -> [String] -> IO [String])
-> [DarcsOptDescr DarcsFlag]
-> [DarcsOptDescr DarcsFlag]
-> [DarcsFlag]
-> ([DarcsFlag] -> [String])
-> DarcsCommand
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
    , commandAdvancedOptions :: [DarcsOptDescr DarcsFlag]
commandAdvancedOptions = OptSpec
  DarcsOptDescr DarcsFlag Any (Compression -> UMask -> Bool -> Any)
-> [DarcsOptDescr DarcsFlag]
forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc OptSpec
  DarcsOptDescr DarcsFlag Any (Compression -> UMask -> Bool -> Any)
forall a.
OptSpec
  DarcsOptDescr DarcsFlag a (Compression -> UMask -> Bool -> a)
unrecordAdvancedOpts
    , commandBasicOptions :: [DarcsOptDescr DarcsFlag]
commandBasicOptions = OptSpec
  DarcsOptDescr
  DarcsFlag
  Any
  ([NotInRemote]
   -> [MatchFlag] -> SelectDeps -> Maybe Bool -> Maybe String -> Any)
-> [DarcsOptDescr DarcsFlag]
forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc OptSpec
  DarcsOptDescr
  DarcsFlag
  Any
  ([NotInRemote]
   -> [MatchFlag] -> SelectDeps -> Maybe Bool -> Maybe String -> Any)
forall a.
OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  ([NotInRemote]
   -> [MatchFlag] -> SelectDeps -> Maybe Bool -> Maybe String -> a)
unrecordBasicOpts
    , commandDefaults :: [DarcsFlag]
commandDefaults = OptSpec
  DarcsOptDescr
  DarcsFlag
  [DarcsFlag]
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> Maybe StdCmdAction
   -> Verbosity
   -> Compression
   -> UMask
   -> Bool
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> [DarcsFlag])
-> [DarcsFlag]
forall (d :: * -> *) f b. OptSpec d f [f] b -> [f]
defaultFlags OptSpec
  DarcsOptDescr
  DarcsFlag
  [DarcsFlag]
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> Maybe StdCmdAction
   -> Verbosity
   -> Compression
   -> UMask
   -> Bool
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> [DarcsFlag])
forall a.
DarcsOption
  a
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> Maybe StdCmdAction
   -> Verbosity
   -> Compression
   -> UMask
   -> Bool
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> a)
unrecordOpts
    , commandCheckOptions :: [DarcsFlag] -> [String]
commandCheckOptions = OptSpec
  DarcsOptDescr
  DarcsFlag
  Any
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> Maybe StdCmdAction
   -> Verbosity
   -> Compression
   -> UMask
   -> Bool
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> Any)
-> [DarcsFlag] -> [String]
forall (d :: * -> *) f a b. OptSpec d f a b -> [f] -> [String]
ocheck OptSpec
  DarcsOptDescr
  DarcsFlag
  Any
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> Maybe StdCmdAction
   -> Verbosity
   -> Compression
   -> UMask
   -> Bool
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> Any)
forall a.
DarcsOption
  a
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> Maybe StdCmdAction
   -> Verbosity
   -> Compression
   -> UMask
   -> Bool
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> a)
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 -- True
      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 (Compression -> UMask -> Bool -> a)
unrecordAdvancedOpts
      = PrimOptSpec
  DarcsOptDescr DarcsFlag (UMask -> Bool -> a) Compression
PrimDarcsOption Compression
O.compress
      PrimOptSpec
  DarcsOptDescr DarcsFlag (UMask -> Bool -> a) Compression
-> OptSpec DarcsOptDescr DarcsFlag (Bool -> a) (UMask -> Bool -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Bool -> a)
     (Compression -> 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 (Bool -> a) (UMask -> Bool -> a)
PrimDarcsOption UMask
O.umask
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Bool -> a)
  (Compression -> UMask -> Bool -> a)
-> OptSpec DarcsOptDescr DarcsFlag a (Bool -> a)
-> OptSpec
     DarcsOptDescr DarcsFlag a (Compression -> 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 :: DarcsOption
  a
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> Maybe StdCmdAction
   -> Verbosity
   -> Compression
   -> UMask
   -> Bool
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> a)
unrecordOpts = OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Verbosity
   -> Compression
   -> UMask
   -> Bool
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> a)
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> Maybe StdCmdAction
   -> Verbosity
   -> Compression
   -> UMask
   -> Bool
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> a)
forall a.
OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  ([NotInRemote]
   -> [MatchFlag] -> SelectDeps -> Maybe Bool -> Maybe String -> a)
unrecordBasicOpts OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Verbosity
   -> Compression
   -> UMask
   -> Bool
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> a)
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> Maybe StdCmdAction
   -> Verbosity
   -> Compression
   -> UMask
   -> Bool
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> a)
-> DarcsOption
     (UseCache -> HooksConfig -> Bool -> Bool -> Bool -> a)
     (Compression
      -> UMask
      -> Bool
      -> UseCache
      -> HooksConfig
      -> Bool
      -> Bool
      -> Bool
      -> a)
-> DarcsOption
     a
     ([NotInRemote]
      -> [MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> Maybe String
      -> Maybe StdCmdAction
      -> Verbosity
      -> Compression
      -> UMask
      -> Bool
      -> 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)
  (Compression
   -> UMask
   -> Bool
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> a)
forall a.
OptSpec
  DarcsOptDescr DarcsFlag a (Compression -> UMask -> Bool -> a)
unrecordAdvancedOpts

unrecordCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
unrecordCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
unrecordCmd (AbsolutePath, AbsolutePath)
_ [DarcsFlag]
opts [String]
_ =
    DryRun -> UseCache -> UpdatePending -> UMask -> RepoJob () -> IO ()
forall a.
DryRun -> UseCache -> UpdatePending -> 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) UpdatePending
YesUpdatePending (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
            (PatchSet rt p Origin wZ
_ :> FL (PatchInfoAnd rt p) wZ wR
removal_candidates) <- [DarcsFlag]
-> Repository rt p wR wU wR
-> IO ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wR)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
[DarcsFlag]
-> Repository rt p wR wU wT
-> IO ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wR)
preselectPatches [DarcsFlag]
opts Repository rt p wR wU wR
_repository
            let direction :: WhichChanges
direction = if 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 rt p)
selection_config =
                  WhichChanges
-> String
-> PatchSelectionOptions
-> Maybe (Splitter (PatchInfoAnd rt p))
-> Maybe [AnchoredPath]
-> SelectionConfig (PatchInfoAnd rt 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 rt p))
forall a. Maybe a
Nothing Maybe [AnchoredPath]
forall a. Maybe a
Nothing
            (FL (PatchInfoAnd rt p) wZ wZ
_ :> FL (PatchInfoAnd rt p) wZ wR
to_unrecord) <- FL (PatchInfoAnd rt p) wZ wR
-> SelectionConfig (PatchInfoAnd rt p)
-> IO
     ((:>) (FL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt 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 rt p) wZ wR
removal_candidates SelectionConfig (PatchInfoAnd rt p)
selection_config
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FL (PatchInfoAnd rt p) wZ wR -> Bool
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Bool
nullFL FL (PatchInfoAnd rt 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 rt p) wZ wR -> IO ()
forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
RepoPatch p =>
FL (PatchInfoAnd rt p) wX wY -> IO ()
setEnvDarcsPatches FL (PatchInfoAnd rt p) wZ wR
to_unrecord
            Repository rt p wR wU wR -> IO ()
forall t. t -> IO ()
invalidateIndex Repository rt p wR wU wR
_repository
            Repository rt p wR wU wZ
_repository <- Repository rt p wR wU wR
-> Compression
-> UpdatePending
-> FL (PatchInfoAnd rt p) wZ wR
-> IO (Repository rt p wR wU wZ)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wX.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT
-> Compression
-> UpdatePending
-> FL (PatchInfoAnd rt p) wX wT
-> IO (Repository rt p wR wU wX)
tentativelyRemovePatches Repository rt p wR wU wR
_repository (PrimDarcsOption Compression
compress PrimDarcsOption Compression -> [DarcsFlag] -> Compression
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
                     UpdatePending
YesUpdatePending FL (PatchInfoAnd rt p) wZ wR
to_unrecord
            Repository rt p wZ wU wZ
_ <- Repository rt p wR wU wZ
-> UpdatePending -> Compression -> IO (Repository rt p wZ wU wZ)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT
-> UpdatePending -> Compression -> IO (Repository rt p wT wU wT)
finalizeRepositoryChanges Repository rt p wR wU wZ
_repository UpdatePending
YesUpdatePending (PrimDarcsOption Compression
compress PrimDarcsOption Compression -> [DarcsFlag] -> Compression
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 :: Doc
commandHelp = Doc
unpullHelp
             , commandDescription :: String
commandDescription = String
unpullDescription
             , commandCommand :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
commandCommand = (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
unpullCmd
             }

unpullCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
unpullCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
unpullCmd = String
-> (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
genericObliterateCmd String
"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 :: String
-> String
-> Doc
-> String
-> Int
-> [String]
-> ((AbsolutePath, AbsolutePath)
    -> [DarcsFlag] -> [String] -> IO ())
-> ([DarcsFlag] -> IO (Either String ()))
-> ((AbsolutePath, AbsolutePath)
    -> [DarcsFlag] -> [String] -> IO [String])
-> ([DarcsFlag] -> AbsolutePath -> [String] -> IO [String])
-> [DarcsOptDescr DarcsFlag]
-> [DarcsOptDescr DarcsFlag]
-> [DarcsFlag]
-> ([DarcsFlag] -> [String])
-> DarcsCommand
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 = (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
obliterateCmd
    , 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
  (Compression -> UseIndex -> UMask -> Bool -> Any)
-> [DarcsOptDescr DarcsFlag]
forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc OptSpec
  DarcsOptDescr
  DarcsFlag
  Any
  (Compression -> UseIndex -> UMask -> Bool -> Any)
forall a.
OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  (Compression -> UseIndex -> UMask -> Bool -> a)
obliterateAdvancedOpts
    , commandBasicOptions :: [DarcsOptDescr DarcsFlag]
commandBasicOptions = OptSpec
  DarcsOptDescr
  DarcsFlag
  Any
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> WithSummary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> Any)
-> [DarcsOptDescr DarcsFlag]
forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc OptSpec
  DarcsOptDescr
  DarcsFlag
  Any
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> WithSummary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> Any)
forall a.
OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> WithSummary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> a)
obliterateBasicOpts
    , commandDefaults :: [DarcsFlag]
commandDefaults = OptSpec
  DarcsOptDescr
  DarcsFlag
  [DarcsFlag]
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> WithSummary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> Maybe StdCmdAction
   -> Verbosity
   -> Compression
   -> UseIndex
   -> UMask
   -> Bool
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> [DarcsFlag])
-> [DarcsFlag]
forall (d :: * -> *) f b. OptSpec d f [f] b -> [f]
defaultFlags OptSpec
  DarcsOptDescr
  DarcsFlag
  [DarcsFlag]
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> WithSummary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> Maybe StdCmdAction
   -> Verbosity
   -> Compression
   -> UseIndex
   -> UMask
   -> Bool
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> [DarcsFlag])
forall a.
DarcsOption
  a
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> WithSummary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> Maybe StdCmdAction
   -> Verbosity
   -> Compression
   -> UseIndex
   -> UMask
   -> Bool
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> a)
obliterateOpts
    , commandCheckOptions :: [DarcsFlag] -> [String]
commandCheckOptions = OptSpec
  DarcsOptDescr
  DarcsFlag
  Any
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> WithSummary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> Maybe StdCmdAction
   -> Verbosity
   -> Compression
   -> UseIndex
   -> UMask
   -> Bool
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> Any)
-> [DarcsFlag] -> [String]
forall (d :: * -> *) f a b. OptSpec d f a b -> [f] -> [String]
ocheck OptSpec
  DarcsOptDescr
  DarcsFlag
  Any
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> WithSummary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> Maybe StdCmdAction
   -> Verbosity
   -> Compression
   -> UseIndex
   -> UMask
   -> Bool
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> Any)
forall a.
DarcsOption
  a
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> WithSummary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> Maybe StdCmdAction
   -> Verbosity
   -> Compression
   -> UseIndex
   -> UMask
   -> Bool
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> a)
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
  (Compression -> UseIndex -> UMask -> Bool -> a)
obliterateAdvancedOpts
      = PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  (UseIndex -> UMask -> Bool -> a)
  Compression
PrimDarcsOption Compression
O.compress
      PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  (UseIndex -> UMask -> Bool -> a)
  Compression
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (UMask -> Bool -> a)
     (UseIndex -> UMask -> Bool -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (UMask -> Bool -> a)
     (Compression -> UseIndex -> 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
  (UMask -> Bool -> a)
  (UseIndex -> UMask -> Bool -> a)
PrimDarcsOption UseIndex
O.useIndex
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (UMask -> Bool -> a)
  (Compression -> UseIndex -> UMask -> Bool -> a)
-> OptSpec DarcsOptDescr DarcsFlag (Bool -> a) (UMask -> Bool -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Bool -> a)
     (Compression -> UseIndex -> 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 (Bool -> a) (UMask -> Bool -> a)
PrimDarcsOption UMask
O.umask
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Bool -> a)
  (Compression -> UseIndex -> UMask -> Bool -> a)
-> OptSpec DarcsOptDescr DarcsFlag a (Bool -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     a
     (Compression -> UseIndex -> 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 :: DarcsOption
  a
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> WithSummary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> Maybe StdCmdAction
   -> Verbosity
   -> Compression
   -> UseIndex
   -> UMask
   -> Bool
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> a)
obliterateOpts = OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Verbosity
   -> Compression
   -> UseIndex
   -> UMask
   -> Bool
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> a)
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> WithSummary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> Maybe StdCmdAction
   -> Verbosity
   -> Compression
   -> UseIndex
   -> UMask
   -> Bool
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> a)
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
   -> Compression
   -> UseIndex
   -> UMask
   -> Bool
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> a)
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> WithSummary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> Maybe StdCmdAction
   -> Verbosity
   -> Compression
   -> UseIndex
   -> UMask
   -> Bool
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> a)
-> DarcsOption
     (UseCache -> HooksConfig -> Bool -> Bool -> Bool -> a)
     (Compression
      -> UseIndex
      -> UMask
      -> Bool
      -> UseCache
      -> HooksConfig
      -> Bool
      -> Bool
      -> Bool
      -> a)
-> DarcsOption
     a
     ([NotInRemote]
      -> [MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> Maybe String
      -> WithSummary
      -> Maybe Output
      -> Bool
      -> DiffAlgorithm
      -> DryRun
      -> XmlOutput
      -> Maybe StdCmdAction
      -> Verbosity
      -> Compression
      -> UseIndex
      -> UMask
      -> Bool
      -> 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)
  (Compression
   -> UseIndex
   -> UMask
   -> Bool
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> a)
forall a.
OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  (Compression -> UseIndex -> UMask -> Bool -> a)
obliterateAdvancedOpts

obliterateCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
obliterateCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
obliterateCmd = String
-> (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
genericObliterateCmd String
"obliterate"

-- | genericObliterateCmd is the function that executes the "obliterate" and
-- "unpull" commands. The first argument is the name under which the command is
-- invoked (@unpull@ or @obliterate@).
genericObliterateCmd :: String
                     -> (AbsolutePath, AbsolutePath)
                     -> [DarcsFlag]
                     -> [String]
                     -> IO ()
genericObliterateCmd :: String
-> (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
genericObliterateCmd String
cmdname (AbsolutePath, AbsolutePath)
_ [DarcsFlag]
opts [String]
_ =
    let cacheOpt :: UseCache
cacheOpt = PrimDarcsOption UseCache
useCache PrimDarcsOption UseCache -> [DarcsFlag] -> UseCache
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts
        verbOpt :: Verbosity
verbOpt = PrimDarcsOption Verbosity
verbosity PrimDarcsOption Verbosity -> [DarcsFlag] -> Verbosity
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts
    in DryRun -> UseCache -> UpdatePending -> UMask -> RepoJob () -> IO ()
forall a.
DryRun -> UseCache -> UpdatePending -> 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) UseCache
cacheOpt UpdatePending
YesUpdatePending (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
            -- FIXME we may need to honour --ignore-times here, although this
            -- command does not take that option (yet)
            FL (PrimOf p) wR wU
pend <- (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 (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)
              LookForMoves
O.NoLookForMoves LookForReplaces
O.NoLookForReplaces Repository rt p wR wU wR
_repository Maybe [AnchoredPath]
forall a. Maybe a
Nothing
            (PatchSet rt p Origin wZ
_ :> FL (PatchInfoAnd rt p) wZ wR
removal_candidates) <- [DarcsFlag]
-> Repository rt p wR wU wR
-> IO ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wR)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
[DarcsFlag]
-> Repository rt p wR wU wT
-> IO ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wR)
preselectPatches [DarcsFlag]
opts Repository rt p wR wU wR
_repository

            let direction :: WhichChanges
direction = if 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 rt p)
selection_config =
                  WhichChanges
-> String
-> PatchSelectionOptions
-> Maybe (Splitter (PatchInfoAnd rt p))
-> Maybe [AnchoredPath]
-> SelectionConfig (PatchInfoAnd rt 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 rt p))
forall a. Maybe a
Nothing Maybe [AnchoredPath]
forall a. Maybe a
Nothing
            (FL (PatchInfoAnd rt p) wZ wZ
_ :> FL (PatchInfoAnd rt p) wZ wR
removed) <-
                FL (PatchInfoAnd rt p) wZ wR
-> SelectionConfig (PatchInfoAnd rt p)
-> IO
     ((:>) (FL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt 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 rt p) wZ wR
removal_candidates SelectionConfig (PatchInfoAnd rt p)
selection_config
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FL (PatchInfoAnd rt p) wZ wR -> Bool
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Bool
nullFL FL (PatchInfoAnd rt 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 (:>) (FL (PrimOf p)) (FL (PrimOf p)) wZ wU
-> Maybe ((:>) (FL (PrimOf p)) (FL (PrimOf p)) wZ wU)
forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
commute (FL (PatchInfoAnd rt p) wZ wR
-> FL (PrimOf (FL (PatchInfoAnd rt p))) wZ wR
forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect FL (PatchInfoAnd rt 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
pend) of
                Maybe ((:>) (FL (PrimOf p)) (FL (PrimOf p)) wZ wU)
Nothing -> String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Can't " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cmdname
                                  String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" patch without reverting some "
                                  String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"unrecorded change."
                Just (FL (PrimOf p) wZ wZ
_ :> FL (PrimOf p) wZ wU
p_after_pending) -> do
                    String
-> Verbosity
-> WithSummary
-> DryRun
-> XmlOutput
-> Bool
-> FL (PatchInfoAnd rt p) wZ wR
-> IO ()
forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
RepoPatch p =>
String
-> Verbosity
-> WithSummary
-> DryRun
-> XmlOutput
-> Bool
-> FL (PatchInfoAnd rt p) wX wY
-> IO ()
printDryRunMessageAndExit String
"obliterate"
                      Verbosity
verbOpt
                      (PrimDarcsOption WithSummary
O.withSummary PrimDarcsOption WithSummary -> [DarcsFlag] -> WithSummary
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
                      (PrimDarcsOption DryRun
dryRun PrimDarcsOption DryRun -> [DarcsFlag] -> DryRun
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
                      (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 rt p) wZ wR
removed
                    FL (PatchInfoAnd rt p) wZ wR -> IO ()
forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
RepoPatch p =>
FL (PatchInfoAnd rt p) wX wY -> IO ()
setEnvDarcsPatches FL (PatchInfoAnd rt p) wZ wR
removed
                    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe AbsolutePathOrStd -> Bool
forall a. Maybe a -> Bool
isJust (Maybe AbsolutePathOrStd -> Bool)
-> Maybe AbsolutePathOrStd -> Bool
forall a b. (a -> b) -> a -> b
$ [DarcsFlag] -> String -> Maybe AbsolutePathOrStd
getOutput [DarcsFlag]
opts String
"") (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                        -- The call to preselectPatches above may have
                        -- unwrapped the latest clean tag. If we don't want to
                        -- remove it, we lost information about that tag being
                        -- clean, so we have to access it's inventory. To avoid
                        -- that, and thus preserve laziness, we re-read our
                        -- original patchset and use that to create the context
                        -- for the bundle.
                        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 IO (PatchSet rt p Origin wR)
-> (PatchSet rt p Origin wR -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [DarcsFlag]
-> FL (PatchInfoAnd rt p) wZ wR -> PatchSet rt p Origin wR -> IO ()
forall (p :: * -> * -> *) (rt :: RepoType) wX wR.
(RepoPatch p, ApplyState p ~ Tree) =>
[DarcsFlag]
-> FL (PatchInfoAnd rt p) wX wR -> PatchSet rt p Origin wR -> IO ()
savetoBundle [DarcsFlag]
opts FL (PatchInfoAnd rt p) wZ wR
removed
                    Repository rt p wR wU wR -> IO ()
forall t. t -> IO ()
invalidateIndex Repository rt p wR wU wR
_repository
                    Repository rt p wR wU wZ
_repository <- Repository rt p wR wU wR
-> Compression
-> UpdatePending
-> FL (PatchInfoAnd rt p) wZ wR
-> IO (Repository rt p wR wU wZ)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wX.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT
-> Compression
-> UpdatePending
-> FL (PatchInfoAnd rt p) wX wT
-> IO (Repository rt p wR wU wX)
tentativelyRemovePatches Repository rt p wR wU wR
_repository
                        (PrimDarcsOption Compression
compress PrimDarcsOption Compression -> [DarcsFlag] -> Compression
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) UpdatePending
YesUpdatePending FL (PatchInfoAnd rt p) wZ wR
removed
                    Repository rt p wR wU wZ -> FL (PrimOf p) wR wZ -> IO ()
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wX wY.
RepoPatch p =>
Repository rt p wR wU wT -> FL (PrimOf p) wX wY -> IO ()
tentativelyAddToPending Repository rt p wR wU wZ
_repository (FL (PrimOf p) wR wZ -> IO ()) -> FL (PrimOf p) wR wZ -> IO ()
forall a b. (a -> b) -> a -> b
$ FL (PrimOf p) wZ wR -> FL (PrimOf p) wR wZ
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert (FL (PrimOf p) wZ wR -> FL (PrimOf p) wR wZ)
-> FL (PrimOf p) wZ wR -> FL (PrimOf p) wR wZ
forall a b. (a -> b) -> a -> b
$ FL (PatchInfoAnd rt p) wZ wR
-> FL (PrimOf (FL (PatchInfoAnd rt p))) wZ wR
forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect FL (PatchInfoAnd rt p) wZ wR
removed
                    IO () -> IO ()
forall a. IO a -> IO a
withSignalsBlocked (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                        Repository rt p wZ wU wZ
_repository <- Repository rt p wR wU wZ
-> UpdatePending -> Compression -> IO (Repository rt p wZ wU wZ)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT
-> UpdatePending -> Compression -> IO (Repository rt p wT wU wT)
finalizeRepositoryChanges Repository rt p wR wU wZ
_repository
                                        UpdatePending
YesUpdatePending (PrimDarcsOption Compression
compress PrimDarcsOption Compression -> [DarcsFlag] -> Compression
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
                        String -> IO ()
debugMessage String
"Applying patches to working tree..."
                        IO (Repository rt p wZ wZ wZ) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Repository rt p wZ wZ wZ) -> IO ())
-> IO (Repository rt p wZ wZ wZ) -> IO ()
forall a b. (a -> b) -> a -> b
$ Repository rt p wZ wU wZ
-> Verbosity
-> FL (PrimOf p) wU wZ
-> IO (Repository rt p wZ wZ wZ)
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 wZ wU wZ
_repository Verbosity
verbOpt (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_after_pending)
                    [DarcsFlag] -> String -> IO ()
putFinished [DarcsFlag]
opts (String -> String
presentParticiple String
cmdname)

savetoBundle :: (RepoPatch p, ApplyState p ~ Tree)
             => [DarcsFlag]
             -> FL (PatchInfoAnd rt p) wX wR
             -> PatchSet rt p Origin wR
             -> IO ()
savetoBundle :: [DarcsFlag]
-> FL (PatchInfoAnd rt p) wX wR -> PatchSet rt p Origin wR -> IO ()
savetoBundle [DarcsFlag]
_ FL (PatchInfoAnd rt p) wX wR
NilFL PatchSet rt p Origin wR
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
savetoBundle [DarcsFlag]
opts removed :: FL (PatchInfoAnd rt p) wX wR
removed@(PatchInfoAnd rt p wX wY
x :>: FL (PatchInfoAnd rt p) wY wR
_) PatchSet rt p Origin wR
orig = do
    let kept :: PatchSet rt p Origin wX
kept = Maybe (PatchSet rt p Origin wX) -> PatchSet rt p Origin wX
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (PatchSet rt p Origin wX) -> PatchSet rt p Origin wX)
-> Maybe (PatchSet rt p Origin wX) -> PatchSet rt p Origin wX
forall a b. (a -> b) -> a -> b
$ FL (PatchInfoAnd rt p) wX wR
-> PatchSet rt p Origin wR -> Maybe (PatchSet rt p Origin wX)
forall (p :: * -> * -> *) (rt :: RepoType) wX wY wStart.
(Commute p, Eq2 p) =>
FL (PatchInfoAnd rt p) wX wY
-> PatchSet rt p wStart wY -> Maybe (PatchSet rt p wStart wX)
removeFromPatchSet FL (PatchInfoAnd rt p) wX wR
removed PatchSet rt p Origin wR
orig
        genFullBundle :: IO Doc
genFullBundle = Maybe (Tree IO)
-> PatchSet rt p Origin wX -> FL (Named p) wX wR -> IO Doc
forall (p :: * -> * -> *) (rt :: RepoType) wStart wX wY.
(ApplyState p ~ Tree, RepoPatch p) =>
Maybe (Tree IO)
-> PatchSet rt p wStart wX -> FL (Named p) wX wY -> IO Doc
makeBundle Maybe (Tree IO)
forall a. Maybe a
Nothing PatchSet rt p Origin wX
kept ((forall wW wY. PatchInfoAnd rt p wW wY -> Named p wW wY)
-> FL (PatchInfoAnd rt 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 forall wW wY. PatchInfoAnd rt p wW wY -> Named p wW wY
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> p wA wB
hopefully FL (PatchInfoAnd rt p) wX wR
removed)
    Doc
bundle <- if Bool -> Bool
not (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 rt p Origin wX
-> FL (PatchInfoAnd rt p) wX wR
-> Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin)
forall (p :: * -> * -> *) (rt :: RepoType) wStart wB wC.
RepoPatch p =>
PatchSet rt p wStart wB
-> FL (PatchInfoAnd rt p) wB wC
-> Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) wStart)
minContext PatchSet rt p Origin wX
kept FL (PatchInfoAnd rt p) wX wR
removed of
                           Sealed (PatchSet rt p Origin wZ
kept' :> FL (PatchInfoAnd rt p) wZ wX
removed') -> Maybe (Tree IO)
-> PatchSet rt p Origin wZ -> FL (Named p) wZ wX -> IO Doc
forall (p :: * -> * -> *) (rt :: RepoType) wStart wX wY.
(ApplyState p ~ Tree, RepoPatch p) =>
Maybe (Tree IO)
-> PatchSet rt p wStart wX -> FL (Named p) wX wY -> IO Doc
makeBundle Maybe (Tree IO)
forall a. Maybe a
Nothing PatchSet rt p Origin wZ
kept' ((forall wW wY. PatchInfoAnd rt p wW wY -> Named p wW wY)
-> FL (PatchInfoAnd rt 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 forall wW wY. PatchInfoAnd rt p wW wY -> Named p wW wY
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> p wA wB
hopefully FL (PatchInfoAnd rt p) wZ wX
removed') )
                      IO Doc -> IO Doc -> IO Doc
forall a. IO a -> IO a -> IO a
`catchInterrupt` IO Doc
genFullBundle
    String
filename <- String -> IO String
getUniqueDPatchName (PatchInfoAnd rt p wX wY -> String
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
PatchInfoAnd rt p wX wY -> String
patchDesc PatchInfoAnd rt p wX wY
x)
    let Just AbsolutePathOrStd
outname = [DarcsFlag] -> String -> Maybe AbsolutePathOrStd
getOutput [DarcsFlag]
opts 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 (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 (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 = PatchSelectionOptions :: Verbosity
-> [MatchFlag]
-> Bool
-> SelectDeps
-> WithSummary
-> 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 = MatchOption -> [DarcsFlag] -> [MatchFlag]
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags MatchOption
O.matchSeveralOrLast [DarcsFlag]
flags
    , interactive :: Bool
S.interactive = Bool -> [DarcsFlag] -> Bool
isInteractive Bool
True [DarcsFlag]
flags
    , selectDeps :: SelectDeps
S.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 = PrimDarcsOption WithSummary
O.withSummary PrimDarcsOption WithSummary -> [DarcsFlag] -> WithSummary
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
flags
    , withContext :: WithContext
S.withContext = WithContext
O.NoContext
    }