--  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
    , getLastPatches
    , matchingHead
    ) where

import Prelude ()
import Darcs.Prelude

import Prelude hiding ( (^) )

import Control.Exception ( catch, IOException )
import Control.Monad ( when )
import Data.Maybe( isJust )
import Darcs.Util.Tree( Tree )
import System.Exit ( exitSuccess )

import Darcs.Patch ( IsRepoType, RepoPatch, invert, commute, effect )
import Darcs.Patch.Apply( ApplyState )
import Darcs.Patch.Bundle ( makeBundleN, contextPatches, minContext )
import Darcs.Patch.Depends ( findCommonWithThem, patchSetUnion )
import Darcs.Patch.Match ( firstMatch, matchFirstPatchset, matchAPatch, MatchFlag )
import Darcs.Patch.PatchInfoAnd ( hopefully, patchDesc )
import Darcs.Patch.Set ( PatchSet(..), Tagged(..), appendPSFL, Origin,
                         SealedPatchSet )
import Darcs.Patch.Witnesses.Sealed ( Sealed(..), seal )
import Darcs.Patch.Witnesses.Ordered ( RL(..), (:>)(..), (+<+), mapFL_FL,
                                       nullFL, reverseRL, mapRL, FL(..) )
import Darcs.Util.Path( useAbsoluteOrStd, AbsolutePath, toFilePath, doesPathExist )
import Darcs.Util.SignalHandler ( catchInterrupt )
import Darcs.Repository ( PatchInfoAnd, withRepoLock, RepoJob(..), Repository,
                          tentativelyRemovePatches, finalizeRepositoryChanges,
                          tentativelyAddToPending, applyToWorking, readRepo,
                          invalidateIndex, unrecordedChanges,
                          identifyRepositoryFor )
import Darcs.Repository.Flags( UseIndex(..), ScanKnown(..), UpdateWorking(..), DryRun(NoDryRun) )
import Darcs.Util.Lock( writeDocBinFile )
import Darcs.Repository.Prefs ( getDefaultRepoPath )
import Darcs.UI.Commands ( DarcsCommand(..), withStdOpts, nodefaults, commandAlias
                         , putVerbose
                         , setEnvDarcsPatches, amInHashedRepository
                         , putInfo )
import Darcs.UI.Commands.Util ( getUniqueDPatchName, printDryRunMessageAndExit )
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, onormalise, defaultFlags, parseFlags, (?) )
import Darcs.UI.Options.All ( notInRemoteFlagName )
import qualified Darcs.UI.Options.All as O
import Darcs.UI.SelectChanges ( WhichChanges(..),
                                selectionContext, runSelection )
import qualified Darcs.UI.SelectChanges as S ( PatchSelectionOptions (..) )
import Darcs.Util.English ( presentParticiple )
import Darcs.Util.Printer ( text, putDoc, vcat, (<+>), ($$) )
import Darcs.Util.Progress ( debugMessage )

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

unrecordHelp :: String
unrecordHelp :: String
unrecordHelp = [String] -> String
unlines
 [ "Unrecord does the opposite of record: it deletes patches from"
 , "the repository, without changing the working tree."
 , "Deleting patches from the repository makes active changes again"
 , "which you may record or revert later."
 , "Beware that you should not use this command if there is a"
 , "possibility that another user may have already pulled the patch."
 ]

unrecord :: DarcsCommand [DarcsFlag]
unrecord :: DarcsCommand [DarcsFlag]
unrecord = DarcsCommand :: forall parsedFlags.
String
-> String
-> String
-> String
-> Int
-> [String]
-> ((AbsolutePath, AbsolutePath)
    -> parsedFlags -> [String] -> IO ())
-> ([DarcsFlag] -> IO (Either String ()))
-> ((AbsolutePath, AbsolutePath)
    -> [DarcsFlag] -> [String] -> IO [String])
-> ([DarcsFlag] -> AbsolutePath -> [String] -> IO [String])
-> [DarcsOptDescr DarcsFlag]
-> [DarcsOptDescr DarcsFlag]
-> [DarcsFlag]
-> ([DarcsFlag] -> [String])
-> ([DarcsFlag] -> parsedFlags)
-> DarcsCommand parsedFlags
DarcsCommand
    { commandProgramName :: String
commandProgramName = "darcs"
    , commandName :: String
commandName = "unrecord"
    , commandHelp :: String
commandHelp = String
unrecordHelp
    , commandDescription :: String
commandDescription = String
unrecordDescription
    , commandExtraArgs :: Int
commandExtraArgs = 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
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> Compression
   -> UMask
   -> Bool
   -> UseCache
   -> HooksConfig
   -> [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
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> Compression
   -> UMask
   -> Bool
   -> UseCache
   -> HooksConfig
   -> [DarcsFlag])
forall a.
DarcsOption
  a
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> Compression
   -> UMask
   -> Bool
   -> UseCache
   -> HooksConfig
   -> a)
unrecordOpts
    , commandCheckOptions :: [DarcsFlag] -> [String]
commandCheckOptions = OptSpec
  DarcsOptDescr
  DarcsFlag
  Any
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> Compression
   -> UMask
   -> Bool
   -> UseCache
   -> HooksConfig
   -> 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
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> Compression
   -> UMask
   -> Bool
   -> UseCache
   -> HooksConfig
   -> Any)
forall a.
DarcsOption
  a
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> Compression
   -> UMask
   -> Bool
   -> UseCache
   -> HooksConfig
   -> a)
unrecordOpts
    , commandParseOptions :: [DarcsFlag] -> [DarcsFlag]
commandParseOptions = OptSpec
  DarcsOptDescr
  DarcsFlag
  [DarcsFlag]
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> Compression
   -> UMask
   -> Bool
   -> UseCache
   -> HooksConfig
   -> [DarcsFlag])
-> [DarcsFlag] -> [DarcsFlag]
forall (d :: * -> *) f b. OptSpec d f [f] b -> [f] -> [f]
onormalise OptSpec
  DarcsOptDescr
  DarcsFlag
  [DarcsFlag]
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> Compression
   -> UMask
   -> Bool
   -> UseCache
   -> HooksConfig
   -> [DarcsFlag])
forall a.
DarcsOption
  a
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> Compression
   -> UMask
   -> Bool
   -> UseCache
   -> HooksConfig
   -> 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
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> Compression
   -> UMask
   -> Bool
   -> UseCache
   -> HooksConfig
   -> a)
unrecordOpts = OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> Compression
   -> UMask
   -> Bool
   -> UseCache
   -> HooksConfig
   -> a)
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> Compression
   -> UMask
   -> Bool
   -> UseCache
   -> HooksConfig
   -> a)
forall a.
OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  ([NotInRemote]
   -> [MatchFlag] -> SelectDeps -> Maybe Bool -> Maybe String -> a)
unrecordBasicOpts OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> Compression
   -> UMask
   -> Bool
   -> UseCache
   -> HooksConfig
   -> a)
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> Compression
   -> UMask
   -> Bool
   -> UseCache
   -> HooksConfig
   -> a)
-> DarcsOption
     (UseCache -> HooksConfig -> a)
     (Compression -> UMask -> Bool -> UseCache -> HooksConfig -> a)
-> DarcsOption
     a
     ([NotInRemote]
      -> [MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> Maybe String
      -> Maybe StdCmdAction
      -> Bool
      -> Bool
      -> Verbosity
      -> Bool
      -> Compression
      -> UMask
      -> Bool
      -> UseCache
      -> HooksConfig
      -> a)
forall b c a.
DarcsOption
  (Maybe StdCmdAction -> Bool -> Bool -> Verbosity -> Bool -> b) c
-> DarcsOption (UseCache -> HooksConfig -> a) b -> DarcsOption a c
`withStdOpts` DarcsOption
  (UseCache -> HooksConfig -> a)
  (Compression -> UMask -> Bool -> UseCache -> HooksConfig -> 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 _ opts :: [DarcsFlag]
opts _ =
    DryRun -> UseCache -> UpdateWorking -> UMask -> RepoJob () -> IO ()
forall a.
DryRun -> UseCache -> UpdateWorking -> UMask -> RepoJob a -> IO a
withRepoLock DryRun
NoDryRun (PrimDarcsOption UseCache
useCache PrimDarcsOption UseCache -> [DarcsFlag] -> UseCache
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) UpdateWorking
YesUpdateWorking (PrimDarcsOption UMask
umask PrimDarcsOption UMask -> [DarcsFlag] -> UMask
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (RepoJob () -> IO ()) -> RepoJob () -> IO ()
forall a b. (a -> b) -> a -> b
$
        (forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
 (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
 Repository rt p wR wU wR -> IO ())
-> RepoJob ()
forall a.
(forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
 (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
 Repository rt p wR wU wR -> IO a)
-> RepoJob a
RepoJob ((forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
  (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
  Repository rt p wR wU wR -> IO ())
 -> RepoJob ())
-> (forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
    (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
    Repository rt p wR wU wR -> IO ())
-> RepoJob ()
forall a b. (a -> b) -> a -> b
$ \repository :: Repository rt p wR wU wR
repository -> do
            (_ :> removal_candidates :: 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
                context :: PatchSelectionContext (PatchInfoAnd rt p)
context = WhichChanges
-> String
-> PatchSelectionOptions
-> Maybe (Splitter (PatchInfoAnd rt p))
-> Maybe [String]
-> PatchSelectionContext (PatchInfoAnd rt p)
forall (rt :: RepoType) (p :: * -> * -> *).
(IsRepoType rt, RepoPatch p) =>
WhichChanges
-> String
-> PatchSelectionOptions
-> Maybe (Splitter (PatchInfoAnd rt p))
-> Maybe [String]
-> PatchSelectionContext (PatchInfoAnd rt p)
selectionContext WhichChanges
direction "unrecord" ([DarcsFlag] -> PatchSelectionOptions
patchSelOpts [DarcsFlag]
opts) Maybe (Splitter (PatchInfoAnd rt p))
forall a. Maybe a
Nothing Maybe [String]
forall a. Maybe a
Nothing
            (_ :> to_unrecord :: FL (PatchInfoAnd rt p) wZ wR
to_unrecord) <- FL (PatchInfoAnd rt p) wZ wR
-> PatchSelectionContext (PatchInfoAnd rt p)
-> IO
     ((:>) (FL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt p)) wZ wR)
forall (p :: * -> * -> *) wX wY.
(Invert p, Commute p, Apply p, PatchInspect p, ShowPatch p,
 ShowContextPatch p, ApplyState p ~ Tree) =>
FL p wX wY
-> PatchSelectionContext p -> IO ((:>) (FL p) (FL p) wX wY)
runSelection FL (PatchInfoAnd rt p) wZ wR
removal_candidates PatchSelectionContext (PatchInfoAnd rt p)
context
            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 "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 "About to write out (potentially) modified patches..."
            FL (PatchInfoAnd rt p) wZ wR -> IO ()
forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
(RepoPatch p, ApplyState p ~ Tree) =>
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 rt p wR wU wR
-> Compression
-> UpdateWorking
-> 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
-> UpdateWorking
-> 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)
                     UpdateWorking
YesUpdateWorking FL (PatchInfoAnd rt p) wZ wR
to_unrecord
            Repository rt p wR wU wR -> UpdateWorking -> Compression -> IO ()
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT -> UpdateWorking -> Compression -> IO ()
finalizeRepositoryChanges Repository rt p wR wU wR
repository UpdateWorking
YesUpdateWorking (PrimDarcsOption Compression
compress PrimDarcsOption Compression -> [DarcsFlag] -> Compression
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
            [DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
opts "Finished unrecording."

getLastPatches :: (IsRepoType rt, RepoPatch p) => [MatchFlag] -> PatchSet rt p Origin wR
               -> (PatchSet rt p :> FL (PatchInfoAnd rt p)) Origin wR
getLastPatches :: [MatchFlag]
-> PatchSet rt p Origin wR
-> (:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wR
getLastPatches matchFlags :: [MatchFlag]
matchFlags ps :: PatchSet rt p Origin wR
ps = case [MatchFlag]
-> PatchSet rt p Origin wR -> SealedPatchSet rt p Origin
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
(IsRepoType rt, Matchable p) =>
[MatchFlag]
-> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
matchFirstPatchset [MatchFlag]
matchFlags PatchSet rt p Origin wR
ps of
                                   Sealed p1s :: PatchSet rt p Origin wX
p1s -> PatchSet rt p Origin wR
-> PatchSet rt p Origin wX
-> (:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wR
forall (p :: * -> * -> *) (rt :: RepoType) wStart wX wY.
Commute p =>
PatchSet rt p wStart wX
-> PatchSet rt p wStart wY
-> (:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) wStart wX
findCommonWithThem PatchSet rt p Origin wR
ps PatchSet rt p Origin wX
p1s

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

unpullHelp :: String
unpullHelp :: String
unpullHelp = [String] -> String
unlines
 [ "Unpull completely removes recorded patches from your local repository."
 , "The changes will be undone in your working tree and the patches"
 , "will not be shown in your changes list anymore. Beware that if the"
 , "patches are not still present in another repository you will lose"
 , "precious code by unpulling!"
 , ""
 , "One way to save unpulled patches is to use the -O flag. A patch"
 , "bundle will be created locally, that you will be able to apply"
 , "later to your repository with `darcs apply`."
 ]

unpull :: DarcsCommand [DarcsFlag]
unpull :: DarcsCommand [DarcsFlag]
unpull = (String
-> Maybe (DarcsCommand [DarcsFlag])
-> DarcsCommand [DarcsFlag]
-> DarcsCommand [DarcsFlag]
forall pf.
String
-> Maybe (DarcsCommand pf) -> DarcsCommand pf -> DarcsCommand pf
commandAlias "unpull" Maybe (DarcsCommand [DarcsFlag])
forall a. Maybe a
Nothing DarcsCommand [DarcsFlag]
obliterate)
             { commandHelp :: String
commandHelp = String
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 "unpull"

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

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

obliterate :: DarcsCommand [DarcsFlag]
obliterate :: DarcsCommand [DarcsFlag]
obliterate = DarcsCommand :: forall parsedFlags.
String
-> String
-> String
-> String
-> Int
-> [String]
-> ((AbsolutePath, AbsolutePath)
    -> parsedFlags -> [String] -> IO ())
-> ([DarcsFlag] -> IO (Either String ()))
-> ((AbsolutePath, AbsolutePath)
    -> [DarcsFlag] -> [String] -> IO [String])
-> ([DarcsFlag] -> AbsolutePath -> [String] -> IO [String])
-> [DarcsOptDescr DarcsFlag]
-> [DarcsOptDescr DarcsFlag]
-> [DarcsFlag]
-> ([DarcsFlag] -> [String])
-> ([DarcsFlag] -> parsedFlags)
-> DarcsCommand parsedFlags
DarcsCommand
    { commandProgramName :: String
commandProgramName = "darcs"
    , commandName :: String
commandName = "obliterate"
    , commandHelp :: String
commandHelp = String
obliterateHelp
    , commandDescription :: String
commandDescription = String
obliterateDescription
    , commandExtraArgs :: Int
commandExtraArgs = 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
   -> Summary
   -> 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
   -> Summary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> Any)
forall a.
OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> Summary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> a)
obliterateBasicOpts
    , commandDefaults :: [DarcsFlag]
commandDefaults = OptSpec
  DarcsOptDescr
  DarcsFlag
  [DarcsFlag]
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> Summary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> Compression
   -> UseIndex
   -> UMask
   -> Bool
   -> UseCache
   -> HooksConfig
   -> [DarcsFlag])
-> [DarcsFlag]
forall (d :: * -> *) f b. OptSpec d f [f] b -> [f]
defaultFlags OptSpec
  DarcsOptDescr
  DarcsFlag
  [DarcsFlag]
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> Summary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> Compression
   -> UseIndex
   -> UMask
   -> Bool
   -> UseCache
   -> HooksConfig
   -> [DarcsFlag])
forall a.
DarcsOption
  a
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> Summary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> Compression
   -> UseIndex
   -> UMask
   -> Bool
   -> UseCache
   -> HooksConfig
   -> a)
obliterateOpts
    , commandCheckOptions :: [DarcsFlag] -> [String]
commandCheckOptions = OptSpec
  DarcsOptDescr
  DarcsFlag
  Any
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> Summary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> Compression
   -> UseIndex
   -> UMask
   -> Bool
   -> UseCache
   -> HooksConfig
   -> 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
   -> Summary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> Compression
   -> UseIndex
   -> UMask
   -> Bool
   -> UseCache
   -> HooksConfig
   -> Any)
forall a.
DarcsOption
  a
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> Summary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> Compression
   -> UseIndex
   -> UMask
   -> Bool
   -> UseCache
   -> HooksConfig
   -> a)
obliterateOpts
    , commandParseOptions :: [DarcsFlag] -> [DarcsFlag]
commandParseOptions = OptSpec
  DarcsOptDescr
  DarcsFlag
  [DarcsFlag]
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> Summary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> Compression
   -> UseIndex
   -> UMask
   -> Bool
   -> UseCache
   -> HooksConfig
   -> [DarcsFlag])
-> [DarcsFlag] -> [DarcsFlag]
forall (d :: * -> *) f b. OptSpec d f [f] b -> [f] -> [f]
onormalise OptSpec
  DarcsOptDescr
  DarcsFlag
  [DarcsFlag]
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> Summary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> Compression
   -> UseIndex
   -> UMask
   -> Bool
   -> UseCache
   -> HooksConfig
   -> [DarcsFlag])
forall a.
DarcsOption
  a
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> Summary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> Compression
   -> UseIndex
   -> UMask
   -> Bool
   -> UseCache
   -> HooksConfig
   -> a)
obliterateOpts
    }
  where
    obliterateBasicOpts :: OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> Summary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> a)
obliterateBasicOpts
      = PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> Summary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> a)
  [NotInRemote]
PrimDarcsOption [NotInRemote]
O.notInRemote
      PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> Summary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> a)
  [NotInRemote]
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (SelectDeps
      -> Maybe Bool
      -> Maybe String
      -> Summary
      -> Maybe Output
      -> Bool
      -> DiffAlgorithm
      -> DryRun
      -> XmlOutput
      -> a)
     ([MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> Maybe String
      -> Summary
      -> Maybe Output
      -> Bool
      -> DiffAlgorithm
      -> DryRun
      -> XmlOutput
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (SelectDeps
      -> Maybe Bool
      -> Maybe String
      -> Summary
      -> Maybe Output
      -> Bool
      -> DiffAlgorithm
      -> DryRun
      -> XmlOutput
      -> a)
     ([NotInRemote]
      -> [MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> Maybe String
      -> Summary
      -> 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
   -> Summary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> a)
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> Summary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> a)
MatchOption
O.matchSeveralOrLast
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> Summary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> a)
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> Summary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe Bool
      -> Maybe String
      -> Summary
      -> Maybe Output
      -> Bool
      -> DiffAlgorithm
      -> DryRun
      -> XmlOutput
      -> a)
     (SelectDeps
      -> Maybe Bool
      -> Maybe String
      -> Summary
      -> Maybe Output
      -> Bool
      -> DiffAlgorithm
      -> DryRun
      -> XmlOutput
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe Bool
      -> Maybe String
      -> Summary
      -> Maybe Output
      -> Bool
      -> DiffAlgorithm
      -> DryRun
      -> XmlOutput
      -> a)
     ([NotInRemote]
      -> [MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> Maybe String
      -> Summary
      -> 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
   -> Summary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> a)
  (SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> Summary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> a)
PrimDarcsOption SelectDeps
O.selectDeps
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe Bool
   -> Maybe String
   -> Summary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> a)
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> Summary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe String
      -> Summary
      -> Maybe Output
      -> Bool
      -> DiffAlgorithm
      -> DryRun
      -> XmlOutput
      -> a)
     (Maybe Bool
      -> Maybe String
      -> Summary
      -> Maybe Output
      -> Bool
      -> DiffAlgorithm
      -> DryRun
      -> XmlOutput
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe String
      -> Summary
      -> Maybe Output
      -> Bool
      -> DiffAlgorithm
      -> DryRun
      -> XmlOutput
      -> a)
     ([NotInRemote]
      -> [MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> Maybe String
      -> Summary
      -> 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
   -> Summary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> a)
  (Maybe Bool
   -> Maybe String
   -> Summary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> a)
PrimDarcsOption (Maybe Bool)
O.interactive
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe String
   -> Summary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> a)
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> Summary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Summary
      -> Maybe Output
      -> Bool
      -> DiffAlgorithm
      -> DryRun
      -> XmlOutput
      -> a)
     (Maybe String
      -> Summary
      -> Maybe Output
      -> Bool
      -> DiffAlgorithm
      -> DryRun
      -> XmlOutput
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Summary
      -> Maybe Output
      -> Bool
      -> DiffAlgorithm
      -> DryRun
      -> XmlOutput
      -> a)
     ([NotInRemote]
      -> [MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> Maybe String
      -> Summary
      -> 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
  (Summary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> a)
  (Maybe String
   -> Summary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> a)
PrimDarcsOption (Maybe String)
O.repoDir
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Summary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> a)
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> Summary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe Output -> Bool -> DiffAlgorithm -> DryRun -> XmlOutput -> a)
     (Summary
      -> Maybe Output
      -> Bool
      -> DiffAlgorithm
      -> DryRun
      -> XmlOutput
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe Output -> Bool -> DiffAlgorithm -> DryRun -> XmlOutput -> a)
     ([NotInRemote]
      -> [MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> Maybe String
      -> Summary
      -> 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)
  (Summary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> a)
PrimDarcsOption Summary
O.summary
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe Output -> Bool -> DiffAlgorithm -> DryRun -> XmlOutput -> a)
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> Summary
   -> 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
      -> Summary
      -> 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
   -> Summary
   -> 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
      -> Summary
      -> 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
   -> Summary
   -> 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
      -> Summary
      -> 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
   -> Summary
   -> 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
      -> Summary
      -> 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
   -> Summary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> Compression
   -> UseIndex
   -> UMask
   -> Bool
   -> UseCache
   -> HooksConfig
   -> a)
obliterateOpts = OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> Compression
   -> UseIndex
   -> UMask
   -> Bool
   -> UseCache
   -> HooksConfig
   -> a)
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> Summary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> Compression
   -> UseIndex
   -> UMask
   -> Bool
   -> UseCache
   -> HooksConfig
   -> a)
forall a.
OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> Summary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> a)
obliterateBasicOpts OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> Compression
   -> UseIndex
   -> UMask
   -> Bool
   -> UseCache
   -> HooksConfig
   -> a)
  ([NotInRemote]
   -> [MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Maybe String
   -> Summary
   -> Maybe Output
   -> Bool
   -> DiffAlgorithm
   -> DryRun
   -> XmlOutput
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> Compression
   -> UseIndex
   -> UMask
   -> Bool
   -> UseCache
   -> HooksConfig
   -> a)
-> DarcsOption
     (UseCache -> HooksConfig -> a)
     (Compression
      -> UseIndex -> UMask -> Bool -> UseCache -> HooksConfig -> a)
-> DarcsOption
     a
     ([NotInRemote]
      -> [MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> Maybe String
      -> Summary
      -> Maybe Output
      -> Bool
      -> DiffAlgorithm
      -> DryRun
      -> XmlOutput
      -> Maybe StdCmdAction
      -> Bool
      -> Bool
      -> Verbosity
      -> Bool
      -> Compression
      -> UseIndex
      -> UMask
      -> Bool
      -> UseCache
      -> HooksConfig
      -> a)
forall b c a.
DarcsOption
  (Maybe StdCmdAction -> Bool -> Bool -> Verbosity -> Bool -> b) c
-> DarcsOption (UseCache -> HooksConfig -> a) b -> DarcsOption a c
`withStdOpts` DarcsOption
  (UseCache -> HooksConfig -> a)
  (Compression
   -> UseIndex -> UMask -> Bool -> UseCache -> HooksConfig -> 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 "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 cmdname :: String
cmdname _ opts :: [DarcsFlag]
opts _ =
    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 -> UpdateWorking -> UMask -> RepoJob () -> IO ()
forall a.
DryRun -> UseCache -> UpdateWorking -> UMask -> RepoJob a -> IO a
withRepoLock (PrimDarcsOption DryRun
dryRun PrimDarcsOption DryRun -> [DarcsFlag] -> DryRun
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) UseCache
cacheOpt UpdateWorking
YesUpdateWorking (PrimDarcsOption UMask
umask PrimDarcsOption UMask -> [DarcsFlag] -> UMask
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (RepoJob () -> IO ()) -> RepoJob () -> IO ()
forall a b. (a -> b) -> a -> b
$
        (forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
 (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
 Repository rt p wR wU wR -> IO ())
-> RepoJob ()
forall a.
(forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
 (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
 Repository rt p wR wU wR -> IO a)
-> RepoJob a
RepoJob ((forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
  (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
  Repository rt p wR wU wR -> IO ())
 -> RepoJob ())
-> (forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
    (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
    Repository rt p wR wU wR -> IO ())
-> RepoJob ()
forall a b. (a -> b) -> a -> b
$ \repository :: Repository rt p wR wU wR
repository -> do
            -- 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 [SubPath]
-> IO (FL (PrimOf p) wR wU)
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
(RepoPatch p, ApplyState p ~ Tree) =>
(UseIndex, ScanKnown, DiffAlgorithm)
-> LookForMoves
-> LookForReplaces
-> Repository rt p wR wU wT
-> Maybe [SubPath]
-> IO (FL (PrimOf p) wT wU)
unrecordedChanges (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 [SubPath]
forall a. Maybe a
Nothing
            (auto_kept :: PatchSet rt p Origin wZ
auto_kept :> removal_candidates :: 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
                context :: PatchSelectionContext (PatchInfoAnd rt p)
context = WhichChanges
-> String
-> PatchSelectionOptions
-> Maybe (Splitter (PatchInfoAnd rt p))
-> Maybe [String]
-> PatchSelectionContext (PatchInfoAnd rt p)
forall (rt :: RepoType) (p :: * -> * -> *).
(IsRepoType rt, RepoPatch p) =>
WhichChanges
-> String
-> PatchSelectionOptions
-> Maybe (Splitter (PatchInfoAnd rt p))
-> Maybe [String]
-> PatchSelectionContext (PatchInfoAnd rt p)
selectionContext WhichChanges
direction String
cmdname ([DarcsFlag] -> PatchSelectionOptions
patchSelOpts [DarcsFlag]
opts) Maybe (Splitter (PatchInfoAnd rt p))
forall a. Maybe a
Nothing Maybe [String]
forall a. Maybe a
Nothing
            (kept :: FL (PatchInfoAnd rt p) wZ wZ
kept :> removed :: FL (PatchInfoAnd rt p) wZ wR
removed) <-
                FL (PatchInfoAnd rt p) wZ wR
-> PatchSelectionContext (PatchInfoAnd rt p)
-> IO
     ((:>) (FL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt p)) wZ wR)
forall (p :: * -> * -> *) wX wY.
(Invert p, Commute p, Apply p, PatchInspect p, ShowPatch p,
 ShowContextPatch p, ApplyState p ~ Tree) =>
FL p wX wY
-> PatchSelectionContext p -> IO ((:>) (FL p) (FL p) wX wY)
runSelection FL (PatchInfoAnd rt p) wZ wR
removal_candidates PatchSelectionContext (PatchInfoAnd rt p)
context
            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 "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
                Nothing -> String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Can't " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cmdname
                                  String -> String -> String
forall a. [a] -> [a] -> [a]
++ " patch without reverting some "
                                  String -> String -> String
forall a. [a] -> [a] -> [a]
++ "unrecorded change."
                Just (_ :> p_after_pending :: FL (PrimOf p) wZ wU
p_after_pending) -> do
                    String
-> Verbosity
-> Summary
-> DryRun
-> XmlOutput
-> Bool
-> FL (PatchInfoAnd rt p) wZ wR
-> IO ()
forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
(RepoPatch p, ApplyState p ~ Tree) =>
String
-> Verbosity
-> Summary
-> DryRun
-> XmlOutput
-> Bool
-> FL (PatchInfoAnd rt p) wX wY
-> IO ()
printDryRunMessageAndExit "obliterate"
                      Verbosity
verbOpt
                      (PrimDarcsOption Summary
O.summary PrimDarcsOption Summary -> [DarcsFlag] -> Summary
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, ApplyState p ~ Tree) =>
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 "") (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                        [DarcsFlag]
-> PatchSet rt p Origin wZ -> FL (PatchInfoAnd rt p) wZ wR -> IO ()
forall (p :: * -> * -> *) (rt :: RepoType) wZ wT.
(RepoPatch p, ApplyState p ~ Tree) =>
[DarcsFlag]
-> PatchSet rt p Origin wZ -> FL (PatchInfoAnd rt p) wZ wT -> IO ()
savetoBundle [DarcsFlag]
opts (PatchSet rt p Origin wZ
auto_kept PatchSet rt p Origin wZ
-> FL (PatchInfoAnd rt p) wZ wZ -> PatchSet rt p Origin wZ
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX wY.
PatchSet rt p wStart wX
-> FL (PatchInfoAnd rt p) wX wY -> PatchSet rt p wStart wY
`appendPSFL` FL (PatchInfoAnd rt p) wZ wZ
kept) 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 rt p wR wU wR
-> Compression
-> UpdateWorking
-> 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
-> UpdateWorking
-> 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) UpdateWorking
YesUpdateWorking FL (PatchInfoAnd rt p) wZ wR
removed
                    Repository rt p wR wU wR
-> UpdateWorking -> FL (PrimOf p) wR wZ -> IO ()
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wX wY.
RepoPatch p =>
Repository rt p wR wU wT
-> UpdateWorking -> FL (PrimOf p) wX wY -> IO ()
tentativelyAddToPending Repository rt p wR wU wR
repository
                        UpdateWorking
YesUpdateWorking (FL (PrimOf p) 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
                    Repository rt p wR wU wR -> UpdateWorking -> Compression -> IO ()
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT -> UpdateWorking -> Compression -> IO ()
finalizeRepositoryChanges Repository rt p wR wU wR
repository
                        UpdateWorking
YesUpdateWorking (PrimDarcsOption Compression
compress PrimDarcsOption Compression -> [DarcsFlag] -> Compression
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
                    String -> IO ()
debugMessage "Applying patches to working directory..."
                    Repository rt p wR wZ wR
_ <- Repository rt p wR wU wR
-> Verbosity
-> FL (PrimOf p) wU wZ
-> IO (Repository rt p wR wZ wR)
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT wY.
(ApplyState p ~ Tree, RepoPatch p) =>
Repository rt p wR wU wT
-> Verbosity
-> FL (PrimOf p) wU wY
-> IO (Repository rt p wR wY wT)
applyToWorking Repository rt p wR wU wR
repository 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)
                         IO (Repository rt p wR wZ wR)
-> (IOException -> IO (Repository rt p wR wZ wR))
-> IO (Repository rt p wR wZ wR)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(IOException
e :: IOException) -> String -> IO (Repository rt p wR wZ wR)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO (Repository rt p wR wZ wR))
-> String -> IO (Repository rt p wR wZ wR)
forall a b. (a -> b) -> a -> b
$
                            "Couldn't undo patch in working dir.\n"
                            String -> String -> String
forall a. [a] -> [a] -> [a]
++ IOException -> String
forall a. Show a => a -> String
show IOException
e
                    [DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
opts (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ "Finished" Doc -> Doc -> Doc
<+> String -> Doc
text (String -> String
presentParticiple String
cmdname) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> "."

-- | Get the union of the set of patches in each specified location
remotePatches :: (IsRepoType rt, RepoPatch p)
              => [DarcsFlag]
              -> Repository rt p wX wU wT -> [O.NotInRemote]
              -> IO (SealedPatchSet rt p Origin)
remotePatches :: [DarcsFlag]
-> Repository rt p wX wU wT
-> [NotInRemote]
-> IO (SealedPatchSet rt p Origin)
remotePatches opts :: [DarcsFlag]
opts repository :: Repository rt p wX wU wT
repository nirs :: [NotInRemote]
nirs = do
    [String]
nirsPaths <- (NotInRemote -> IO String) -> [NotInRemote] -> IO [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM NotInRemote -> IO String
getNotInRemotePath [NotInRemote]
nirs
    [DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
opts (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ "Determining patches not in" Doc -> Doc -> Doc
<+> [String] -> Doc
forall (t :: * -> *) p a.
(Foldable t, IsString p, Monoid p) =>
t a -> p
pluralExtra [String]
nirsPaths Doc -> Doc -> Doc
$$
        [String] -> Doc
itemize [String]
nirsPaths
    [SealedPatchSet rt p Origin] -> SealedPatchSet rt p Origin
forall (p :: * -> * -> *) (rt :: RepoType) wStart.
Merge p =>
[SealedPatchSet rt p wStart] -> SealedPatchSet rt p wStart
patchSetUnion ([SealedPatchSet rt p Origin] -> SealedPatchSet rt p Origin)
-> IO [SealedPatchSet rt p Origin]
-> IO (SealedPatchSet rt p Origin)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (String -> IO (SealedPatchSet rt p Origin))
-> [String] -> IO [SealedPatchSet rt p Origin]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO (SealedPatchSet rt p Origin)
readNir [String]
nirsPaths
  where
    pluralExtra :: t a -> p
pluralExtra names :: t a
names = if t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
names Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1 then "any of" else p
forall a. Monoid a => a
mempty
    itemize :: [String] -> Doc
itemize = [Doc] -> Doc
vcat ([Doc] -> Doc) -> ([String] -> [Doc]) -> [String] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Doc
text (String -> Doc) -> (String -> String) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ("  - " String -> String -> String
forall a. [a] -> [a] -> [a]
++))

    readNir :: String -> IO (SealedPatchSet rt p Origin)
readNir n :: String
n = do
        Repository rt p Any Any Any
r <- Repository rt p wX wU wT
-> UseCache -> String -> IO (Repository rt p Any Any Any)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT vR vU vT.
Repository rt p wR wU wT
-> UseCache -> String -> IO (Repository rt p vR vU vT)
identifyRepositoryFor Repository rt p wX wU wT
repository (PrimDarcsOption UseCache
useCache PrimDarcsOption UseCache -> [DarcsFlag] -> UseCache
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) String
n
        PatchSet rt p Origin Any
rps <- Repository rt p Any Any Any -> IO (PatchSet rt p Origin Any)
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 Any Any Any
r
        SealedPatchSet rt p Origin -> IO (SealedPatchSet rt p Origin)
forall (m :: * -> *) a. Monad m => a -> m a
return (SealedPatchSet rt p Origin -> IO (SealedPatchSet rt p Origin))
-> SealedPatchSet rt p Origin -> IO (SealedPatchSet rt p Origin)
forall a b. (a -> b) -> a -> b
$ PatchSet rt p Origin Any -> SealedPatchSet rt p Origin
forall (a :: * -> *) wX. a wX -> Sealed a
seal PatchSet rt p Origin Any
rps

    getNotInRemotePath :: O.NotInRemote -> IO String
    getNotInRemotePath :: NotInRemote -> IO String
getNotInRemotePath (O.NotInRemotePath p :: String
p) = String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
p
    getNotInRemotePath O.NotInDefaultRepo = do
        Maybe String
defaultRepo <- IO (Maybe String)
getDefaultRepoPath
        let err :: IO a
err = String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO a) -> String -> IO a
forall a b. (a -> b) -> a -> b
$ "No default push/pull repo configured, please pass a "
                         String -> String -> String
forall a. [a] -> [a] -> [a]
++ "repo name to --" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
notInRemoteFlagName
        IO String -> (String -> IO String) -> Maybe String -> IO String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO String
forall a. IO a
err String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
defaultRepo

-- | matchingHead returns the repository up to some tag. The tag t is the last
-- tag such that there is a patch after t that is matched by the user's query.
matchingHead :: forall rt p wR
              . (IsRepoType rt, RepoPatch p)
             => [MatchFlag] -> PatchSet rt p Origin wR
             -> (PatchSet rt p :> FL (PatchInfoAnd rt p)) Origin wR
matchingHead :: [MatchFlag]
-> PatchSet rt p Origin wR
-> (:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wR
matchingHead matchFlags :: [MatchFlag]
matchFlags set :: PatchSet rt p Origin wR
set =
    case PatchSet rt p Origin wR
-> (:>) (PatchSet rt p) (RL (PatchInfoAnd rt p)) Origin wR
forall wX.
PatchSet rt p Origin wX
-> (:>) (PatchSet rt p) (RL (PatchInfoAnd rt p)) Origin wX
mh PatchSet rt p Origin wR
set of
        (start :: PatchSet rt p Origin wZ
start :> patches :: RL (PatchInfoAnd rt p) wZ wR
patches) -> PatchSet rt p Origin wZ
start PatchSet rt p Origin wZ
-> FL (PatchInfoAnd rt p) wZ wR
-> (:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wR
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RL (PatchInfoAnd rt p) wZ wR -> FL (PatchInfoAnd rt p) wZ wR
forall (a :: * -> * -> *) wX wZ. RL a wX wZ -> FL a wX wZ
reverseRL RL (PatchInfoAnd rt p) wZ wR
patches
  where
    mh :: forall wX . PatchSet rt p Origin wX
       -> (PatchSet rt p :> RL (PatchInfoAnd rt p)) Origin wX
    mh :: PatchSet rt p Origin wX
-> (:>) (PatchSet rt p) (RL (PatchInfoAnd rt p)) Origin wX
mh s :: PatchSet rt p Origin wX
s@(PatchSet _ x :: RL (PatchInfoAnd rt p) wX wX
x)
        | [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ((forall wW wZ. PatchInfoAnd rt p wW wZ -> Bool)
-> RL (PatchInfoAnd rt p) wX wX -> [Bool]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> RL a wX wY -> [b]
mapRL ([MatchFlag] -> PatchInfoAnd rt p wW wZ -> Bool
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
(IsRepoType rt, Matchable p) =>
[MatchFlag] -> PatchInfoAnd rt p wX wY -> Bool
matchAPatch [MatchFlag]
matchFlags) RL (PatchInfoAnd rt p) wX wX
x) = PatchSet rt p Origin wX
-> (:>) (PatchSet rt p) (RL (PatchInfoAnd rt p)) Origin wX
forall (rt :: RepoType) (p :: * -> * -> *) wX.
PatchSet rt p Origin wX
-> (:>) (PatchSet rt p) (RL (PatchInfoAnd rt p)) Origin wX
contextPatches PatchSet rt p Origin wX
s
    mh (PatchSet (ts :: RL (Tagged rt p) Origin wY
ts :<: Tagged t :: PatchInfoAnd rt p wY wX
t _ ps :: RL (PatchInfoAnd rt p) wY wY
ps) x :: RL (PatchInfoAnd rt p) wX wX
x) =
        case PatchSet rt p Origin wX
-> (:>) (PatchSet rt p) (RL (PatchInfoAnd rt p)) Origin wX
forall wX.
PatchSet rt p Origin wX
-> (:>) (PatchSet rt p) (RL (PatchInfoAnd rt p)) Origin wX
mh (RL (Tagged rt p) Origin wY
-> RL (PatchInfoAnd rt p) wY wX -> PatchSet rt p Origin wX
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX wY.
RL (Tagged rt p) wStart wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p wStart wY
PatchSet RL (Tagged rt p) Origin wY
ts (RL (PatchInfoAnd rt p) wY wY
ps RL (PatchInfoAnd rt p) wY wY
-> PatchInfoAnd rt p wY wX -> RL (PatchInfoAnd rt p) wY wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: PatchInfoAnd rt p wY wX
t)) of
            (start :: PatchSet rt p Origin wZ
start :> patches :: RL (PatchInfoAnd rt p) wZ wX
patches) -> PatchSet rt p Origin wZ
start PatchSet rt p Origin wZ
-> RL (PatchInfoAnd rt p) wZ wX
-> (:>) (PatchSet rt p) (RL (PatchInfoAnd rt p)) Origin wX
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RL (PatchInfoAnd rt p) wZ wX
patches RL (PatchInfoAnd rt p) wZ wX
-> RL (PatchInfoAnd rt p) wX wX -> RL (PatchInfoAnd rt p) wZ wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> RL a wY wZ -> RL a wX wZ
+<+ RL (PatchInfoAnd rt p) wX wX
x
    mh ps :: PatchSet rt p Origin wX
ps = PatchSet rt p Origin wX
ps PatchSet rt p Origin wX
-> RL (PatchInfoAnd rt p) wX wX
-> (:>) (PatchSet rt p) (RL (PatchInfoAnd rt p)) Origin wX
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RL (PatchInfoAnd rt p) wX wX
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL

savetoBundle :: (RepoPatch p, ApplyState p ~ Tree) => [DarcsFlag]
             -> PatchSet rt p Origin wZ -> FL (PatchInfoAnd rt p) wZ wT -> IO ()
savetoBundle :: [DarcsFlag]
-> PatchSet rt p Origin wZ -> FL (PatchInfoAnd rt p) wZ wT -> IO ()
savetoBundle opts :: [DarcsFlag]
opts kept :: PatchSet rt p Origin wZ
kept removed :: FL (PatchInfoAnd rt p) wZ wT
removed@(x :: PatchInfoAnd rt p wZ wY
x :>: _) = do
    let genFullBundle :: IO Doc
genFullBundle = Maybe (Tree IO)
-> PatchSet rt p Origin wZ
-> FL (WrappedNamed rt p) wZ wT
-> IO Doc
forall (p :: * -> * -> *) (rt :: RepoType) wStart wX wY.
(ApplyState p ~ Tree, RepoPatch p) =>
Maybe (Tree IO)
-> PatchSet rt p wStart wX
-> FL (WrappedNamed rt p) wX wY
-> IO Doc
makeBundleN Maybe (Tree IO)
forall a. Maybe a
Nothing PatchSet rt p Origin wZ
kept ((forall wW wY. PatchInfoAnd rt p wW wY -> WrappedNamed rt p wW wY)
-> FL (PatchInfoAnd rt p) wZ wT -> FL (WrappedNamed rt p) wZ wT
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 -> WrappedNamed rt p wW wY
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAnd rt p wA wB -> WrappedNamed rt p wA wB
hopefully FL (PatchInfoAnd rt p) wZ wT
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 "Minimizing context, to generate bundle with full context hit ctrl-C..."
                       ( case PatchSet rt p Origin wZ
-> FL (PatchInfoAnd rt p) wZ wT
-> 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 wZ
kept FL (PatchInfoAnd rt p) wZ wT
removed of
                           Sealed (kept' :: PatchSet rt p Origin wZ
kept' :> removed' :: FL (PatchInfoAnd rt p) wZ wX
removed') -> Maybe (Tree IO)
-> PatchSet rt p Origin wZ
-> FL (WrappedNamed rt 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 (WrappedNamed rt p) wX wY
-> IO Doc
makeBundleN Maybe (Tree IO)
forall a. Maybe a
Nothing PatchSet rt p Origin wZ
kept' ((forall wW wY. PatchInfoAnd rt p wW wY -> WrappedNamed rt p wW wY)
-> FL (PatchInfoAnd rt p) wZ wX -> FL (WrappedNamed rt 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 -> WrappedNamed rt p wW wY
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAnd rt p wA wB -> WrappedNamed rt 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 wZ wY -> String
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
PatchInfoAnd rt p wX wY -> String
patchDesc PatchInfoAnd rt p wZ wY
x)
    let Just outname :: 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
$ "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]
++ "' 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
savetoBundle _ _ NilFL = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

preselectPatches
  :: (IsRepoType rt, RepoPatch p)
  => [DarcsFlag]
  -> Repository rt p wR wU wT
  -> IO ((PatchSet rt p :> FL (PatchInfoAnd rt p)) Origin wR)
preselectPatches :: [DarcsFlag]
-> Repository rt p wR wU wT
-> IO ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wR)
preselectPatches opts :: [DarcsFlag]
opts repo :: Repository rt p wR wU wT
repo = do
  PatchSet rt p Origin wR
allpatches <- Repository rt p wR wU wT -> IO (PatchSet rt p Origin wR)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
Repository rt p wR wU wT -> IO (PatchSet rt p Origin wR)
readRepo Repository rt p wR wU wT
repo
  let matchFlags :: [MatchFlag]
matchFlags = MatchOption -> [DarcsFlag] -> [MatchFlag]
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags MatchOption
O.matchSeveralOrLast [DarcsFlag]
opts
  case PrimDarcsOption [NotInRemote]
O.notInRemote PrimDarcsOption [NotInRemote] -> [DarcsFlag] -> [NotInRemote]
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts of
    [] -> do
      (:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wR
-> IO ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wR)
forall (m :: * -> *) a. Monad m => a -> m a
return ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wR
 -> IO ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wR))
-> (:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wR
-> IO ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wR)
forall a b. (a -> b) -> a -> b
$
        if [MatchFlag] -> Bool
firstMatch [MatchFlag]
matchFlags
          then [MatchFlag]
-> PatchSet rt p Origin wR
-> (:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wR
forall (rt :: RepoType) (p :: * -> * -> *) wR.
(IsRepoType rt, RepoPatch p) =>
[MatchFlag]
-> PatchSet rt p Origin wR
-> (:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wR
getLastPatches [MatchFlag]
matchFlags PatchSet rt p Origin wR
allpatches
          else [MatchFlag]
-> PatchSet rt p Origin wR
-> (:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wR
forall (rt :: RepoType) (p :: * -> * -> *) wR.
(IsRepoType rt, RepoPatch p) =>
[MatchFlag]
-> PatchSet rt p Origin wR
-> (:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wR
matchingHead [MatchFlag]
matchFlags PatchSet rt p Origin wR
allpatches
    -- FIXME what about match options when we have --not-in-remote?
    -- It looks like they are simply ignored.
    nirs :: [NotInRemote]
nirs -> do
      (Sealed thems :: PatchSet rt p Origin wX
thems) <-
        [DarcsFlag]
-> Repository rt p wR wU wT
-> [NotInRemote]
-> IO (Sealed (PatchSet rt p Origin))
forall (rt :: RepoType) (p :: * -> * -> *) wX wU wT.
(IsRepoType rt, RepoPatch p) =>
[DarcsFlag]
-> Repository rt p wX wU wT
-> [NotInRemote]
-> IO (SealedPatchSet rt p Origin)
remotePatches [DarcsFlag]
opts Repository rt p wR wU wT
repo [NotInRemote]
nirs
      (:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wR
-> IO ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wR)
forall (m :: * -> *) a. Monad m => a -> m a
return ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wR
 -> IO ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wR))
-> (:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wR
-> IO ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wR)
forall a b. (a -> b) -> a -> b
$ PatchSet rt p Origin wR
-> PatchSet rt p Origin wX
-> (:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wR
forall (p :: * -> * -> *) (rt :: RepoType) wStart wX wY.
Commute p =>
PatchSet rt p wStart wX
-> PatchSet rt p wStart wY
-> (:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) wStart wX
findCommonWithThem PatchSet rt p Origin wR
allpatches PatchSet rt p Origin wX
thems

patchSelOpts :: [DarcsFlag] -> S.PatchSelectionOptions
patchSelOpts :: [DarcsFlag] -> PatchSelectionOptions
patchSelOpts flags :: [DarcsFlag]
flags = PatchSelectionOptions :: Verbosity
-> [MatchFlag]
-> Bool
-> SelectDeps
-> Summary
-> WithContext
-> PatchSelectionOptions
S.PatchSelectionOptions
    { verbosity :: Verbosity
S.verbosity = PrimDarcsOption Verbosity
verbosity PrimDarcsOption Verbosity -> [DarcsFlag] -> Verbosity
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
flags
    , matchFlags :: [MatchFlag]
S.matchFlags = 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
    , summary :: Summary
S.summary = PrimDarcsOption Summary
O.summary PrimDarcsOption Summary -> [DarcsFlag] -> Summary
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
flags
    , withContext :: WithContext
S.withContext = WithContext
O.NoContext
    }