--  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 #-}
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}

module Darcs.UI.Commands.Unrecord
    ( unrecord
    , unpull
    , obliterate
    ) where

import Darcs.Prelude

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

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

unrecordDescription :: String
unrecordDescription :: String
unrecordDescription =
  String
"Remove recorded patches without changing the working tree."

unrecordHelp :: Doc
unrecordHelp :: Doc
unrecordHelp = [String] -> Doc
formatWords
  [ String
"Unrecord does the opposite of record: it deletes patches from"
  , String
"the repository without changing the working tree. The changes"
  , String
"are now again visible with `darcs whatsnew` and you can record"
  , String
"or revert them as you please."
  ]
  Doc -> Doc -> Doc
$+$ Doc
historyEditHelp

unrecord :: DarcsCommand
unrecord :: DarcsCommand
unrecord = DarcsCommand
    { commandProgramName :: String
commandProgramName = String
"darcs"
    , commandName :: String
commandName = String
"unrecord"
    , commandHelp :: Doc
commandHelp = Doc
unrecordHelp
    , commandDescription :: String
commandDescription = String
unrecordDescription
    , commandExtraArgs :: Int
commandExtraArgs = Int
0
    , commandExtraArgHelp :: [String]
commandExtraArgHelp = []
    , commandCommand :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
commandCommand = (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
unrecordCmd
    , commandPrereq :: [DarcsFlag] -> IO (Either String ())
commandPrereq = [DarcsFlag] -> IO (Either String ())
amInHashedRepository
    , commandCompleteArgs :: (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
commandCompleteArgs = (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
noArgs
    , commandArgdefaults :: [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
commandArgdefaults = [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
nodefaults
    , commandOptions :: CommandOptions
commandOptions = CommandOptions
unrecordOpts
    }
  where
    unrecordBasicOpts :: OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  ([NotInRemote]
   -> [MatchFlag] -> SelectDeps -> Maybe Bool -> Maybe String -> a)
unrecordBasicOpts
      = PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  ([MatchFlag] -> SelectDeps -> Maybe Bool -> Maybe String -> a)
  [NotInRemote]
PrimDarcsOption [NotInRemote]
O.notInRemote
      PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  ([MatchFlag] -> SelectDeps -> Maybe Bool -> Maybe String -> a)
  [NotInRemote]
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (SelectDeps -> Maybe Bool -> Maybe String -> a)
     ([MatchFlag] -> SelectDeps -> Maybe Bool -> Maybe String -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (SelectDeps -> Maybe Bool -> Maybe String -> a)
     ([NotInRemote]
      -> [MatchFlag] -> SelectDeps -> Maybe Bool -> Maybe String -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (SelectDeps -> Maybe Bool -> Maybe String -> a)
  ([MatchFlag] -> SelectDeps -> Maybe Bool -> Maybe String -> a)
MatchOption
O.matchSeveralOrLast
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (SelectDeps -> Maybe Bool -> Maybe String -> a)
  ([NotInRemote]
   -> [MatchFlag] -> SelectDeps -> Maybe Bool -> Maybe String -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe Bool -> Maybe String -> a)
     (SelectDeps -> Maybe Bool -> Maybe String -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe Bool -> Maybe String -> a)
     ([NotInRemote]
      -> [MatchFlag] -> SelectDeps -> Maybe Bool -> Maybe String -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe Bool -> Maybe String -> a)
  (SelectDeps -> Maybe Bool -> Maybe String -> a)
PrimDarcsOption SelectDeps
O.selectDeps
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe Bool -> Maybe String -> a)
  ([NotInRemote]
   -> [MatchFlag] -> SelectDeps -> Maybe Bool -> Maybe String -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe String -> a)
     (Maybe Bool -> Maybe String -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe String -> a)
     ([NotInRemote]
      -> [MatchFlag] -> SelectDeps -> Maybe Bool -> Maybe String -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe String -> a)
  (Maybe Bool -> Maybe String -> a)
PrimDarcsOption (Maybe Bool)
O.interactive -- 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 (UMask -> Bool -> a)
unrecordAdvancedOpts
      = PrimOptSpec DarcsOptDescr DarcsFlag (Bool -> a) UMask
PrimDarcsOption UMask
O.umask
      PrimOptSpec DarcsOptDescr DarcsFlag (Bool -> a) UMask
-> OptSpec DarcsOptDescr DarcsFlag a (Bool -> a)
-> OptSpec DarcsOptDescr DarcsFlag a (UMask -> Bool -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec DarcsOptDescr DarcsFlag a (Bool -> a)
PrimDarcsOption Bool
O.changesReverse
    unrecordOpts :: CommandOptions
unrecordOpts = OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Verbosity
   -> UMask
   -> Bool
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> Maybe StdCmdAction
   -> Verbosity
   -> UMask
   -> Bool
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
forall {a}.
OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  ([NotInRemote]
   -> [MatchFlag] -> SelectDeps -> Maybe Bool -> Maybe String -> a)
unrecordBasicOpts OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Verbosity
   -> UMask
   -> Bool
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> Maybe StdCmdAction
   -> Verbosity
   -> UMask
   -> Bool
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
-> DarcsOption
     (UseCache
      -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
     (UMask
      -> Bool
      -> UseCache
      -> UseIndex
      -> HooksConfig
      -> Bool
      -> Bool
      -> [DarcsFlag])
-> CommandOptions
forall b c.
DarcsOption (Maybe StdCmdAction -> Verbosity -> b) c
-> DarcsOption
     (UseCache
      -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
     b
-> CommandOptions
`withStdOpts` DarcsOption
  (UseCache
   -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
  (UMask
   -> Bool
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
forall {a}. OptSpec DarcsOptDescr DarcsFlag a (UMask -> Bool -> a)
unrecordAdvancedOpts

unrecordCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
unrecordCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
unrecordCmd (AbsolutePath, AbsolutePath)
_ [DarcsFlag]
opts [String]
_ =
  UseCache -> UMask -> RepoJob 'RW () -> IO ()
forall a. UseCache -> UMask -> RepoJob 'RW a -> IO a
withRepoLock (PrimOptSpec DarcsOptDescr DarcsFlag a UseCache
PrimDarcsOption UseCache
useCache PrimDarcsOption UseCache -> [DarcsFlag] -> UseCache
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (PrimOptSpec DarcsOptDescr DarcsFlag a UMask
PrimDarcsOption UMask
umask PrimDarcsOption UMask -> [DarcsFlag] -> UMask
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (RepoJob 'RW () -> IO ()) -> RepoJob 'RW () -> IO ()
forall a b. (a -> b) -> a -> b
$ TreePatchJob 'RW () -> RepoJob 'RW ()
forall (rt :: AccessType) a. TreePatchJob rt a -> RepoJob rt a
RepoJob (TreePatchJob 'RW () -> RepoJob 'RW ())
-> TreePatchJob 'RW () -> RepoJob 'RW ()
forall a b. (a -> b) -> a -> b
$ \Repository 'RW p wU wR
_repository -> do
    (_ :> removal_candidates) <- [DarcsFlag]
-> Repository 'RW p wU wR
-> IO ((:>) (PatchSet p) (FL (PatchInfoAnd p)) Origin wR)
forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
RepoPatch p =>
[DarcsFlag]
-> Repository rt p wU wR
-> IO ((:>) (PatchSet p) (FL (PatchInfoAnd p)) Origin wR)
preselectPatches [DarcsFlag]
opts Repository 'RW p wU wR
_repository
    let direction = if PrimOptSpec DarcsOptDescr DarcsFlag a Bool
PrimDarcsOption Bool
changesReverse PrimDarcsOption Bool -> [DarcsFlag] -> Bool
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts then WhichChanges
Last else WhichChanges
LastReversed
        selection_config =
          WhichChanges
-> String
-> PatchSelectionOptions
-> Maybe (Splitter (PatchInfoAnd p))
-> Maybe [AnchoredPath]
-> SelectionConfig (PatchInfoAnd p)
forall (p :: * -> * -> *).
Matchable p =>
WhichChanges
-> String
-> PatchSelectionOptions
-> Maybe (Splitter p)
-> Maybe [AnchoredPath]
-> SelectionConfig p
selectionConfig WhichChanges
direction String
"unrecord" ([DarcsFlag] -> PatchSelectionOptions
patchSelOpts [DarcsFlag]
opts) Maybe (Splitter (PatchInfoAnd p))
forall a. Maybe a
Nothing Maybe [AnchoredPath]
forall a. Maybe a
Nothing
    (_ :> to_unrecord) <- runSelection removal_candidates selection_config
    when (nullFL to_unrecord) $ do
      putInfo opts "No patches selected!"
      exitSuccess
    putVerbose opts $
      text "About to write out (potentially) modified patches..."
    setEnvDarcsPatches to_unrecord
    _repository <-
      tentativelyRemovePatches _repository YesUpdatePending to_unrecord
    _ <- finalizeRepositoryChanges _repository (O.dryRun ? opts)
    putInfo opts "Finished unrecording."

unpullDescription :: String
unpullDescription :: String
unpullDescription =
  String
"Opposite of pull; unsafe if patch is not in remote repository."

unpullHelp :: Doc
unpullHelp :: Doc
unpullHelp =
  String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String
"Unpull is an alias for what is nowadays called `obliterate`."

unpull :: DarcsCommand
unpull :: DarcsCommand
unpull =
  (String -> Maybe DarcsCommand -> DarcsCommand -> DarcsCommand
commandAlias String
"unpull" Maybe DarcsCommand
forall a. Maybe a
Nothing DarcsCommand
obliterate)
    { commandHelp = unpullHelp
    , commandDescription = unpullDescription
    , commandCommand = obliterateCmd "unpull"
    }

obliterateDescription :: String
obliterateDescription :: String
obliterateDescription = String
"Delete selected patches from the repository."

obliterateHelp :: Doc
obliterateHelp :: Doc
obliterateHelp = [String] -> Doc
formatWords
  [ String
"Obliterate completely removes recorded patches from your local"
  , String
"repository. The changes will be undone in your working tree and the"
  , String
"patches will not be shown in your changes list anymore. Beware that"
  , String
"you can lose precious code by obliterating!"
  ]
  Doc -> Doc -> Doc
$+$ [String] -> Doc
formatWords
  [ String
"One way to save obliterated patches is to use the -O flag. A patch"
  , String
"bundle will be created locally, that you will be able to apply"
  , String
"later to your repository with `darcs apply`. See `darcs send` for"
  , String
"a more detailed description."
  ]
  Doc -> Doc -> Doc
$+$ Doc
historyEditHelp

obliterate :: DarcsCommand
obliterate :: DarcsCommand
obliterate = DarcsCommand
    { commandProgramName :: String
commandProgramName = String
"darcs"
    , commandName :: String
commandName = String
"obliterate"
    , commandHelp :: Doc
commandHelp = Doc
obliterateHelp
    , commandDescription :: String
commandDescription = String
obliterateDescription
    , commandExtraArgs :: Int
commandExtraArgs = Int
0
    , commandExtraArgHelp :: [String]
commandExtraArgHelp = []
    , commandCommand :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
commandCommand = String
-> (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
obliterateCmd String
"obliterate"
    , commandPrereq :: [DarcsFlag] -> IO (Either String ())
commandPrereq = [DarcsFlag] -> IO (Either String ())
amInHashedRepository
    , commandCompleteArgs :: (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
commandCompleteArgs = (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
noArgs
    , commandArgdefaults :: [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
commandArgdefaults = [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
nodefaults
    , commandOptions :: CommandOptions
commandOptions = CommandOptions
obliterateOpts
    }
  where
    obliterateBasicOpts :: OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> WithSummary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> a)
obliterateBasicOpts
      = PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> WithSummary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> a)
  [NotInRemote]
PrimDarcsOption [NotInRemote]
O.notInRemote
      PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> WithSummary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> a)
  [NotInRemote]
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (SelectDeps
      -> Maybe Bool
      -> Maybe String
      -> WithSummary
      -> Maybe Output
      -> Bool
      -> DiffAlgorithm
      -> DryRun
      -> XmlOutput
      -> a)
     ([MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> Maybe String
      -> WithSummary
      -> Maybe Output
      -> Bool
      -> DiffAlgorithm
      -> DryRun
      -> XmlOutput
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (SelectDeps
      -> Maybe Bool
      -> Maybe String
      -> WithSummary
      -> Maybe Output
      -> Bool
      -> DiffAlgorithm
      -> DryRun
      -> XmlOutput
      -> a)
     ([NotInRemote]
      -> [MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> Maybe String
      -> WithSummary
      -> Maybe Output
      -> Bool
      -> DiffAlgorithm
      -> DryRun
      -> XmlOutput
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> WithSummary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> a)
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> WithSummary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> a)
MatchOption
O.matchSeveralOrLast
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> WithSummary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> a)
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> WithSummary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe Bool
      -> Maybe String
      -> WithSummary
      -> Maybe Output
      -> Bool
      -> DiffAlgorithm
      -> DryRun
      -> XmlOutput
      -> a)
     (SelectDeps
      -> Maybe Bool
      -> Maybe String
      -> WithSummary
      -> Maybe Output
      -> Bool
      -> DiffAlgorithm
      -> DryRun
      -> XmlOutput
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe Bool
      -> Maybe String
      -> WithSummary
      -> Maybe Output
      -> Bool
      -> DiffAlgorithm
      -> DryRun
      -> XmlOutput
      -> a)
     ([NotInRemote]
      -> [MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> Maybe String
      -> WithSummary
      -> Maybe Output
      -> Bool
      -> DiffAlgorithm
      -> DryRun
      -> XmlOutput
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe Bool
   -> Maybe String
   -> WithSummary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> a)
  (SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> WithSummary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> a)
PrimDarcsOption SelectDeps
O.selectDeps
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe Bool
   -> Maybe String
   -> WithSummary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> a)
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> WithSummary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe String
      -> WithSummary
      -> Maybe Output
      -> Bool
      -> DiffAlgorithm
      -> DryRun
      -> XmlOutput
      -> a)
     (Maybe Bool
      -> Maybe String
      -> WithSummary
      -> Maybe Output
      -> Bool
      -> DiffAlgorithm
      -> DryRun
      -> XmlOutput
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe String
      -> WithSummary
      -> Maybe Output
      -> Bool
      -> DiffAlgorithm
      -> DryRun
      -> XmlOutput
      -> a)
     ([NotInRemote]
      -> [MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> Maybe String
      -> WithSummary
      -> Maybe Output
      -> Bool
      -> DiffAlgorithm
      -> DryRun
      -> XmlOutput
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe String
   -> WithSummary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> a)
  (Maybe Bool
   -> Maybe String
   -> WithSummary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> a)
PrimDarcsOption (Maybe Bool)
O.interactive
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe String
   -> WithSummary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> a)
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> WithSummary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (WithSummary
      -> Maybe Output
      -> Bool
      -> DiffAlgorithm
      -> DryRun
      -> XmlOutput
      -> a)
     (Maybe String
      -> WithSummary
      -> Maybe Output
      -> Bool
      -> DiffAlgorithm
      -> DryRun
      -> XmlOutput
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (WithSummary
      -> Maybe Output
      -> Bool
      -> DiffAlgorithm
      -> DryRun
      -> XmlOutput
      -> a)
     ([NotInRemote]
      -> [MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> Maybe String
      -> WithSummary
      -> Maybe Output
      -> Bool
      -> DiffAlgorithm
      -> DryRun
      -> XmlOutput
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (WithSummary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> a)
  (Maybe String
   -> WithSummary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> a)
PrimDarcsOption (Maybe String)
O.repoDir
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (WithSummary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> a)
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> WithSummary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe Output -> Bool -> DiffAlgorithm -> DryRun -> XmlOutput -> a)
     (WithSummary
      -> Maybe Output
      -> Bool
      -> DiffAlgorithm
      -> DryRun
      -> XmlOutput
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe Output -> Bool -> DiffAlgorithm -> DryRun -> XmlOutput -> a)
     ([NotInRemote]
      -> [MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> Maybe String
      -> WithSummary
      -> Maybe Output
      -> Bool
      -> DiffAlgorithm
      -> DryRun
      -> XmlOutput
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe Output -> Bool -> DiffAlgorithm -> DryRun -> XmlOutput -> a)
  (WithSummary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> a)
PrimDarcsOption WithSummary
O.withSummary
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe Output -> Bool -> DiffAlgorithm -> DryRun -> XmlOutput -> a)
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> WithSummary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Bool -> DiffAlgorithm -> DryRun -> XmlOutput -> a)
     (Maybe Output -> Bool -> DiffAlgorithm -> DryRun -> XmlOutput -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Bool -> DiffAlgorithm -> DryRun -> XmlOutput -> a)
     ([NotInRemote]
      -> [MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> Maybe String
      -> WithSummary
      -> Maybe Output
      -> Bool
      -> DiffAlgorithm
      -> DryRun
      -> XmlOutput
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (Bool -> DiffAlgorithm -> DryRun -> XmlOutput -> a)
  (Maybe Output -> Bool -> DiffAlgorithm -> DryRun -> XmlOutput -> a)
PrimDarcsOption (Maybe Output)
O.output
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Bool -> DiffAlgorithm -> DryRun -> XmlOutput -> a)
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> WithSummary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (DiffAlgorithm -> DryRun -> XmlOutput -> a)
     (Bool -> DiffAlgorithm -> DryRun -> XmlOutput -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (DiffAlgorithm -> DryRun -> XmlOutput -> a)
     ([NotInRemote]
      -> [MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> Maybe String
      -> WithSummary
      -> Maybe Output
      -> Bool
      -> DiffAlgorithm
      -> DryRun
      -> XmlOutput
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (DiffAlgorithm -> DryRun -> XmlOutput -> a)
  (Bool -> DiffAlgorithm -> DryRun -> XmlOutput -> a)
PrimDarcsOption Bool
O.minimize
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (DiffAlgorithm -> DryRun -> XmlOutput -> a)
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> WithSummary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (DryRun -> XmlOutput -> a)
     (DiffAlgorithm -> DryRun -> XmlOutput -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (DryRun -> XmlOutput -> a)
     ([NotInRemote]
      -> [MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> Maybe String
      -> WithSummary
      -> Maybe Output
      -> Bool
      -> DiffAlgorithm
      -> DryRun
      -> XmlOutput
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (DryRun -> XmlOutput -> a)
  (DiffAlgorithm -> DryRun -> XmlOutput -> a)
PrimDarcsOption DiffAlgorithm
O.diffAlgorithm
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (DryRun -> XmlOutput -> a)
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> WithSummary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> a)
-> OptSpec DarcsOptDescr DarcsFlag a (DryRun -> XmlOutput -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     a
     ([NotInRemote]
      -> [MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> Maybe String
      -> WithSummary
      -> Maybe Output
      -> Bool
      -> DiffAlgorithm
      -> DryRun
      -> XmlOutput
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec DarcsOptDescr DarcsFlag a (DryRun -> XmlOutput -> a)
forall a. DarcsOption a (DryRun -> XmlOutput -> a)
O.dryRunXml
    obliterateAdvancedOpts :: OptSpec DarcsOptDescr DarcsFlag a (UMask -> Bool -> a)
obliterateAdvancedOpts
      = PrimOptSpec DarcsOptDescr DarcsFlag (Bool -> a) UMask
PrimDarcsOption UMask
O.umask
      PrimOptSpec DarcsOptDescr DarcsFlag (Bool -> a) UMask
-> OptSpec DarcsOptDescr DarcsFlag a (Bool -> a)
-> OptSpec DarcsOptDescr DarcsFlag a (UMask -> Bool -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec DarcsOptDescr DarcsFlag a (Bool -> a)
PrimDarcsOption Bool
O.changesReverse
    obliterateOpts :: CommandOptions
obliterateOpts = OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Verbosity
   -> UMask
   -> Bool
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> WithSummary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> Maybe StdCmdAction
   -> Verbosity
   -> UMask
   -> Bool
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
forall {a}.
OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> WithSummary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> a)
obliterateBasicOpts OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Verbosity
   -> UMask
   -> Bool
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> WithSummary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> Maybe StdCmdAction
   -> Verbosity
   -> UMask
   -> Bool
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
-> DarcsOption
     (UseCache
      -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
     (UMask
      -> Bool
      -> UseCache
      -> UseIndex
      -> HooksConfig
      -> Bool
      -> Bool
      -> [DarcsFlag])
-> CommandOptions
forall b c.
DarcsOption (Maybe StdCmdAction -> Verbosity -> b) c
-> DarcsOption
     (UseCache
      -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
     b
-> CommandOptions
`withStdOpts` DarcsOption
  (UseCache
   -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
  (UMask
   -> Bool
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
forall {a}. OptSpec DarcsOptDescr DarcsFlag a (UMask -> Bool -> a)
obliterateAdvancedOpts

obliterateCmd
  :: String -> (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
obliterateCmd :: String
-> (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
obliterateCmd String
cmdname (AbsolutePath, AbsolutePath)
_ [DarcsFlag]
opts [String]
_ = do
  let verbOpt :: Verbosity
verbOpt = PrimOptSpec DarcsOptDescr DarcsFlag a Verbosity
PrimDarcsOption Verbosity
verbosity PrimDarcsOption Verbosity -> [DarcsFlag] -> Verbosity
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts
  UseCache -> UMask -> RepoJob 'RW () -> IO ()
forall a. UseCache -> UMask -> RepoJob 'RW a -> IO a
withRepoLock (PrimOptSpec DarcsOptDescr DarcsFlag a UseCache
PrimDarcsOption UseCache
useCache PrimDarcsOption UseCache -> [DarcsFlag] -> UseCache
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (PrimOptSpec DarcsOptDescr DarcsFlag a UMask
PrimDarcsOption UMask
umask PrimDarcsOption UMask -> [DarcsFlag] -> UMask
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (RepoJob 'RW () -> IO ()) -> RepoJob 'RW () -> IO ()
forall a b. (a -> b) -> a -> b
$ TreePatchJob 'RW () -> RepoJob 'RW ()
forall (rt :: AccessType) a. TreePatchJob rt a -> RepoJob rt a
RepoJob (TreePatchJob 'RW () -> RepoJob 'RW ())
-> TreePatchJob 'RW () -> RepoJob 'RW ()
forall a b. (a -> b) -> a -> b
$ \Repository 'RW p wU wR
_repository -> do
    unrecorded <- DiffOpts
-> Repository 'RW p wU wR
-> Maybe [AnchoredPath]
-> IO (FL (PrimOf p) wR wU)
forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
(RepoPatch p, ApplyState p ~ Tree) =>
DiffOpts
-> Repository rt p wU wR
-> Maybe [AnchoredPath]
-> IO (FL (PrimOf p) wR wU)
unrecordedChanges ([DarcsFlag] -> DiffOpts
diffingOpts [DarcsFlag]
opts) Repository 'RW p wU wR
_repository Maybe [AnchoredPath]
forall a. Maybe a
Nothing
    (_ :> removal_candidates) <- preselectPatches opts _repository
    let direction = if PrimOptSpec DarcsOptDescr DarcsFlag a Bool
PrimDarcsOption Bool
changesReverse PrimDarcsOption Bool -> [DarcsFlag] -> Bool
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts then WhichChanges
Last else WhichChanges
LastReversed
        selection_config =
          WhichChanges
-> String
-> PatchSelectionOptions
-> Maybe (Splitter (PatchInfoAnd p))
-> Maybe [AnchoredPath]
-> SelectionConfig (PatchInfoAnd p)
forall (p :: * -> * -> *).
Matchable p =>
WhichChanges
-> String
-> PatchSelectionOptions
-> Maybe (Splitter p)
-> Maybe [AnchoredPath]
-> SelectionConfig p
selectionConfig WhichChanges
direction String
cmdname ([DarcsFlag] -> PatchSelectionOptions
patchSelOpts [DarcsFlag]
opts) Maybe (Splitter (PatchInfoAnd p))
forall a. Maybe a
Nothing Maybe [AnchoredPath]
forall a. Maybe a
Nothing
    (_ :> removed) <- runSelection removal_candidates selection_config
    when (nullFL removed) $ do
      putInfo opts "No patches selected!"
      exitSuccess
    case genCommuteWhatWeCanFL (commuterFLId commute) (effect removed :> unrecorded) of
      FL (PrimOf p) wZ wZ
unrecorded' :> FL (PrimOf p) wZ wZ
removed_after_unrecorded :> FL (PrimOf p) wZ wU
to_revert -> do
        effect_removed <-
          case FL (PrimOf p) wZ wU
to_revert of
            FL (PrimOf p) wZ wU
NilFL -> FL (PrimOf p) wZ wU -> IO (FL (PrimOf p) wZ wU)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FL (PrimOf p) wZ wU
FL (PrimOf p) wZ wZ
removed_after_unrecorded
            FL (PrimOf p) wZ wU
_ ->
              if Bool -> [DarcsFlag] -> Bool
isInteractive Bool
True [DarcsFlag]
opts then do
                String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
                  String
"These unrecorded changes conflict with the " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cmdname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":"
                Verbosity -> WithSummary -> FL (PrimOf p) wZ wU -> IO ()
forall (p :: * -> * -> *) wX wY.
ShowPatch p =>
Verbosity -> WithSummary -> p wX wY -> IO ()
printFriendly Verbosity
O.Verbose WithSummary
O.NoSummary FL (PrimOf p) wZ wU
to_revert
                yes <- String -> IO Bool
promptYorn String
"Do you want to revert these unrecorded changes?"
                if yes then
                  return $ removed_after_unrecorded +>+ to_revert
                else do
                  putStrLn $ "Okay, " ++ cmdname ++ " cancelled."
                  exitSuccess
              else
                String -> IO (FL (PrimOf p) wZ wU)
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO (FL (PrimOf p) wZ wU))
-> String -> IO (FL (PrimOf p) wZ wU)
forall a b. (a -> b) -> a -> b
$
                  String
"Can't " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cmdname String -> String -> String
forall a. [a] -> [a] -> [a]
++
                    String
" these patches without reverting some unrecorded changes."
        printDryRunMessageAndExit
          "obliterate" verbOpt (O.withSummary ? opts) (dryRun ? opts)
          (xmlOutput ? opts) (isInteractive True opts) removed
        setEnvDarcsPatches removed
        when (isJust $ getOutput opts (return "")) $
          -- 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.
          readPatches _repository >>= savetoBundle opts removed
        _repository <-
          tentativelyRemovePatches _repository NoUpdatePending removed
        -- rely on sifting to commute out prims not belonging in pending:
        setTentativePending _repository unrecorded'
        withSignalsBlocked $ do
          _repository <- finalizeRepositoryChanges _repository (O.dryRun ? opts)
          debugMessage "Applying patches to working tree..."
          unless (O.yes (O.dryRun ? opts)) $
            void $ applyToWorking _repository verbOpt (invert effect_removed)
        putFinished opts (presentParticiple cmdname)

savetoBundle
  :: (RepoPatch p, ApplyState p ~ Tree)
  => [DarcsFlag]
  -> FL (PatchInfoAnd p) wX wR
  -> PatchSet p Origin wR
  -> IO ()
savetoBundle :: forall (p :: * -> * -> *) wX wR.
(RepoPatch p, ApplyState p ~ Tree) =>
[DarcsFlag]
-> FL (PatchInfoAnd p) wX wR -> PatchSet p Origin wR -> IO ()
savetoBundle [DarcsFlag]
_ FL (PatchInfoAnd p) wX wR
NilFL PatchSet p Origin wR
_ = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
savetoBundle [DarcsFlag]
opts removed :: FL (PatchInfoAnd p) wX wR
removed@(PatchInfoAnd p wX wY
x :>: FL (PatchInfoAnd p) wY wR
_) PatchSet p Origin wR
orig = do
  let kept :: PatchSet p Origin wX
kept = Maybe (PatchSet p Origin wX) -> PatchSet p Origin wX
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (PatchSet p Origin wX) -> PatchSet p Origin wX)
-> Maybe (PatchSet p Origin wX) -> PatchSet p Origin wX
forall a b. (a -> b) -> a -> b
$ FL (PatchInfoAnd p) wX wR
-> PatchSet p Origin wR -> Maybe (PatchSet p Origin wX)
forall (p :: * -> * -> *) wX wY wStart.
(Commute p, Eq2 p) =>
FL (PatchInfoAnd p) wX wY
-> PatchSet p wStart wY -> Maybe (PatchSet p wStart wX)
removeFromPatchSet FL (PatchInfoAnd p) wX wR
removed PatchSet p Origin wR
orig
      genFullBundle :: IO Doc
genFullBundle = Maybe (ApplyState p IO)
-> PatchSet p Origin wX -> FL (Named p) wX wR -> IO Doc
forall (p :: * -> * -> *) wStart wX wY.
(RepoPatch p, ApplyMonadTrans (ApplyState p) IO,
 ObjectId (ObjectIdOfPatch p)) =>
Maybe (ApplyState p IO)
-> PatchSet p wStart wX -> FL (Named p) wX wY -> IO Doc
makeBundle Maybe (ApplyState p IO)
forall a. Maybe a
Nothing PatchSet p Origin wX
kept ((forall wW wY. PatchInfoAnd p wW wY -> Named p wW wY)
-> FL (PatchInfoAnd p) wX wR -> FL (Named p) wX wR
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL PatchInfoAndG (Named p) wW wY -> Named p wW wY
forall wW wY. PatchInfoAnd p wW wY -> Named p wW wY
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> p wA wB
hopefully FL (PatchInfoAnd p) wX wR
removed)
  bundle <-
    if Bool -> Bool
not (PrimOptSpec DarcsOptDescr DarcsFlag a Bool
PrimDarcsOption Bool
minimize PrimDarcsOption Bool -> [DarcsFlag] -> Bool
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
      then IO Doc
genFullBundle
      else do
        [DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
opts
          Doc
"Minimizing context, to generate bundle with full context hit ctrl-C..."
        (case PatchSet p Origin wX
-> FL (PatchInfoAnd p) wX wR
-> Sealed ((:>) (PatchSet p) (FL (PatchInfoAnd p)) Origin)
forall (p :: * -> * -> *) wStart wB wC.
RepoPatch p =>
PatchSet p wStart wB
-> FL (PatchInfoAnd p) wB wC
-> Sealed ((:>) (PatchSet p) (FL (PatchInfoAnd p)) wStart)
minContext PatchSet p Origin wX
kept FL (PatchInfoAnd p) wX wR
removed of
          Sealed (PatchSet p Origin wZ
kept' :> FL (PatchInfoAnd p) wZ wX
removed') ->
            Maybe (ApplyState p IO)
-> PatchSet p Origin wZ -> FL (Named p) wZ wX -> IO Doc
forall (p :: * -> * -> *) wStart wX wY.
(RepoPatch p, ApplyMonadTrans (ApplyState p) IO,
 ObjectId (ObjectIdOfPatch p)) =>
Maybe (ApplyState p IO)
-> PatchSet p wStart wX -> FL (Named p) wX wY -> IO Doc
makeBundle Maybe (Tree IO)
Maybe (ApplyState p IO)
forall a. Maybe a
Nothing PatchSet p Origin wZ
kept' ((forall wW wY. PatchInfoAnd p wW wY -> Named p wW wY)
-> FL (PatchInfoAnd p) wZ wX -> FL (Named p) wZ wX
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL PatchInfoAndG (Named p) wW wY -> Named p wW wY
forall wW wY. PatchInfoAnd p wW wY -> Named p wW wY
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> p wA wB
hopefully FL (PatchInfoAnd p) wZ wX
removed'))
          IO Doc -> IO Doc -> IO Doc
forall a. IO a -> IO a -> IO a
`catchInterrupt` IO Doc
genFullBundle
  let filename = String -> IO String
getUniqueDPatchName (PatchInfoAnd p wX wY -> String
forall (p :: * -> * -> *) wX wY. PatchInfoAnd p wX wY -> String
patchDesc PatchInfoAnd p wX wY
x)
  outname <- fromJust (getOutput opts filename)
  exists <- useAbsoluteOrStd (doesPathExist . toFilePath) (return False) outname
  when exists $
    fail $ "Directory or file named '" ++ (show outname) ++ "' already exists."
  useAbsoluteOrStd writeDocBinFile putDoc outname bundle
  putInfo opts $ sentence $
    useAbsoluteOrStd
      (("Saved patch bundle" <+>) . text . toFilePath)
      (text "stdout")
      outname

patchSelOpts :: [DarcsFlag] -> S.PatchSelectionOptions
patchSelOpts :: [DarcsFlag] -> PatchSelectionOptions
patchSelOpts [DarcsFlag]
flags =
  S.PatchSelectionOptions
    { verbosity :: Verbosity
S.verbosity = PrimOptSpec DarcsOptDescr DarcsFlag a Verbosity
PrimDarcsOption Verbosity
verbosity PrimDarcsOption Verbosity -> [DarcsFlag] -> Verbosity
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
flags
    , matchFlags :: [MatchFlag]
S.matchFlags = PrimOptSpec DarcsOptDescr DarcsFlag a [MatchFlag]
MatchOption
O.matchSeveralOrLast MatchOption -> [DarcsFlag] -> [MatchFlag]
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
flags
    , interactive :: Bool
S.interactive = Bool -> [DarcsFlag] -> Bool
isInteractive Bool
True [DarcsFlag]
flags
    , selectDeps :: SelectDeps
S.selectDeps = PrimOptSpec DarcsOptDescr DarcsFlag a SelectDeps
PrimDarcsOption SelectDeps
selectDeps PrimDarcsOption SelectDeps -> [DarcsFlag] -> SelectDeps
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
flags
    , withSummary :: WithSummary
S.withSummary = PrimOptSpec DarcsOptDescr DarcsFlag a WithSummary
PrimDarcsOption WithSummary
O.withSummary PrimDarcsOption WithSummary -> [DarcsFlag] -> WithSummary
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
flags
    }