module Darcs.UI.Commands.Apply
( apply, applyCmd
, getPatchBundle
) where
import Darcs.Prelude
import System.Exit ( exitSuccess )
import Control.Monad ( unless, when )
import Data.Maybe ( catMaybes )
import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, hopefullyM, info )
import Darcs.UI.Commands
( DarcsCommand(..), withStdOpts
, putInfo
, amInHashedRepository
)
import Darcs.UI.Completion ( fileArgs )
import Darcs.UI.Flags
( DarcsFlag
, changesReverse, verbosity, useCache, dryRun
, reorder, umask
, fixUrl
, withContext
)
import Darcs.UI.Options ( (^), odesc, ocheck, defaultFlags, parseFlags, (?) )
import qualified Darcs.UI.Options.All as O
import Darcs.Repository.Flags ( UpdatePending(..) )
import Darcs.Util.Path ( toFilePath, AbsolutePath )
import Darcs.Repository
( Repository
, SealedPatchSet
, withRepoLock
, readRepo
, filterOutConflicts
)
import Darcs.Patch.Set ( PatchSet, Origin )
import Darcs.Patch ( IsRepoType, RepoPatch )
import Darcs.Patch.Apply( ApplyState )
import Darcs.Patch.Info ( PatchInfo, displayPatchInfo )
import Darcs.Patch.Witnesses.Ordered
( Fork(..), (:>)(..)
, mapFL, nullFL )
import Darcs.Patch.Witnesses.Sealed ( Sealed(Sealed) )
import Darcs.Util.ByteString ( linesPS, unlinesPS, gzReadStdin )
import qualified Data.ByteString as B (ByteString, null, init)
import qualified Data.ByteString.Char8 as BC (last)
import Darcs.Util.Download ( Cachable(Uncachable) )
import Darcs.Util.External ( gzFetchFilePS )
import Darcs.UI.External
( verifyPS
)
import Darcs.UI.Email ( readEmail )
import Darcs.Patch.Depends ( findCommonAndUncommon )
import Darcs.UI.ApplyPatches ( PatchApplier(..), StandardPatchApplier(..), PatchProxy )
import Darcs.UI.SelectChanges
( WhichChanges(..)
, runSelection
, selectionConfig
)
import qualified Darcs.UI.SelectChanges as S
import Darcs.Patch.Bundle ( interpretBundle, parseBundle )
import Darcs.Util.Printer
( Doc, vcat, text
, renderString
, ($$)
, vsep
, formatWords
)
import Darcs.Util.Tree( Tree )
applyDescription :: String
applyDescription :: String
applyDescription = String
"Apply a patch bundle created by `darcs send'."
applyHelp :: Doc
applyHelp :: Doc
applyHelp = [Doc] -> Doc
vsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ ([String] -> Doc) -> [[String]] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map [String] -> Doc
formatWords
[ [ String
"The `darcs apply` command takes a patch bundle and attempts to insert"
, String
"it into the current repository. In addition to invoking it directly"
, String
"on bundles created by `darcs send`, it is used internally by `darcs"
, String
"push` on the remote end of an SSH connection."
]
, [ String
"If no file is supplied, the bundle is read from standard input."
]
, [ String
"If given an email instead of a patch bundle, Darcs will look for the"
, String
"bundle as a MIME attachment to that email. Currently this will fail"
, String
"if the MIME boundary is rewritten, such as in Courier and Mail.app."
]
, [ String
"If gpg(1) is installed, you can use `--verify pubring.gpg` to reject"
, String
"bundles that aren't signed by a key in `pubring.gpg`."
]
, [ String
"If `--test` is supplied and a test is defined (see `darcs setpref`), the"
, String
"bundle will be rejected if the test fails after applying it."
]
, [ String
"A patch bundle may introduce unresolved conflicts with existing"
, String
"patches or with the working tree. By default, Darcs will add conflict"
, String
"markers (see `darcs mark-conflicts`)."
]
, [ String
"The `--external-merge` option lets you resolve these conflicts"
, String
"using an external merge tool. In the option, `%a` is replaced with"
, String
"the common ancestor (merge base), `%1` with the first version, `%2`"
, String
"with the second version, and `%o` with the path where your resolved"
, String
"content should go. For example, to use the xxdiff visual merge tool"
, String
"you'd specify: `--external-merge='xxdiff -m -O -M %o %1 %a %2'`"
]
, [ String
"The `--allow-conflicts` option will skip conflict marking; this is"
, String
"useful when you want to treat a repository as just a bunch of patches,"
, String
"such as using `darcs pull --union` to download of your co-workers"
, String
"patches before going offline."
]
, [ String
"This can mess up unrecorded changes in the working tree, forcing you"
, String
"to resolve the conflict immediately. To simply reject bundles that"
, String
"introduce unresolved conflicts, using the `--dont-allow-conflicts`"
, String
"option. Making this the default in push-based workflows is strongly"
, String
"recommended."
]
, [ String
"Unlike most Darcs commands, `darcs apply` defaults to `--all`. Use the"
, String
"`--interactive` option to pick which patches to apply from a bundle."
]
]
stdindefault :: a -> [String] -> IO [String]
stdindefault :: a -> [String] -> IO [String]
stdindefault a
_ [] = [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String
"-"]
stdindefault a
_ [String]
x = [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String]
x
apply :: DarcsCommand
apply :: DarcsCommand
apply = DarcsCommand :: String
-> String
-> Doc
-> String
-> Int
-> [String]
-> ((AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO ())
-> ([DarcsFlag] -> IO (Either String ()))
-> ((AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String])
-> ([DarcsFlag] -> AbsolutePath -> [String] -> IO [String])
-> [DarcsOptDescr DarcsFlag]
-> [DarcsOptDescr DarcsFlag]
-> [DarcsFlag]
-> ([DarcsFlag] -> [String])
-> DarcsCommand
DarcsCommand
{ commandProgramName :: String
commandProgramName = String
"darcs"
, commandName :: String
commandName = String
"apply"
, commandHelp :: Doc
commandHelp = Doc
applyHelp
, commandDescription :: String
commandDescription = String
applyDescription
, commandExtraArgs :: Int
commandExtraArgs = Int
1
, commandExtraArgHelp :: [String]
commandExtraArgHelp = [String
"<PATCHFILE>"]
, commandCommand :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
commandCommand = StandardPatchApplier
-> (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
forall pa.
PatchApplier pa =>
pa
-> (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
applyCmd StandardPatchApplier
StandardPatchApplier
, 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]
fileArgs
, commandArgdefaults :: [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
commandArgdefaults = (AbsolutePath -> [String] -> IO [String])
-> [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
forall a b. a -> b -> a
const AbsolutePath -> [String] -> IO [String]
forall a. a -> [String] -> IO [String]
stdindefault
, commandAdvancedOptions :: [DarcsOptDescr DarcsFlag]
commandAdvancedOptions = OptSpec
DarcsOptDescr
DarcsFlag
Any
(UseIndex
-> Compression
-> SetScriptsExecutable
-> UMask
-> Bool
-> WantGuiPause
-> Any)
-> [DarcsOptDescr DarcsFlag]
forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc OptSpec
DarcsOptDescr
DarcsFlag
Any
(UseIndex
-> Compression
-> SetScriptsExecutable
-> UMask
-> Bool
-> WantGuiPause
-> Any)
forall a.
OptSpec
DarcsOptDescr
DarcsFlag
a
(UseIndex
-> Compression
-> SetScriptsExecutable
-> UMask
-> Bool
-> WantGuiPause
-> a)
applyAdvancedOpts
, commandBasicOptions :: [DarcsOptDescr DarcsFlag]
commandBasicOptions = OptSpec
DarcsOptDescr
DarcsFlag
Any
(Verify
-> Reorder
-> Maybe Bool
-> DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> Any)
-> [DarcsOptDescr DarcsFlag]
forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc OptSpec
DarcsOptDescr
DarcsFlag
Any
(Verify
-> Reorder
-> Maybe Bool
-> DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> Any)
forall a.
OptSpec
DarcsOptDescr
DarcsFlag
a
(Verify
-> Reorder
-> Maybe Bool
-> DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> a)
applyBasicOpts
, commandDefaults :: [DarcsFlag]
commandDefaults = OptSpec
DarcsOptDescr
DarcsFlag
[DarcsFlag]
(Verify
-> Reorder
-> Maybe Bool
-> DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Verbosity
-> UseIndex
-> Compression
-> SetScriptsExecutable
-> UMask
-> Bool
-> WantGuiPause
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> [DarcsFlag])
-> [DarcsFlag]
forall (d :: * -> *) f b. OptSpec d f [f] b -> [f]
defaultFlags OptSpec
DarcsOptDescr
DarcsFlag
[DarcsFlag]
(Verify
-> Reorder
-> Maybe Bool
-> DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Verbosity
-> UseIndex
-> Compression
-> SetScriptsExecutable
-> UMask
-> Bool
-> WantGuiPause
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> [DarcsFlag])
forall a.
DarcsOption
a
(Verify
-> Reorder
-> Maybe Bool
-> DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Verbosity
-> UseIndex
-> Compression
-> SetScriptsExecutable
-> UMask
-> Bool
-> WantGuiPause
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
applyOpts
, commandCheckOptions :: [DarcsFlag] -> [String]
commandCheckOptions = OptSpec
DarcsOptDescr
DarcsFlag
Any
(Verify
-> Reorder
-> Maybe Bool
-> DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Verbosity
-> UseIndex
-> Compression
-> SetScriptsExecutable
-> UMask
-> Bool
-> WantGuiPause
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> Any)
-> [DarcsFlag] -> [String]
forall (d :: * -> *) f a b. OptSpec d f a b -> [f] -> [String]
ocheck OptSpec
DarcsOptDescr
DarcsFlag
Any
(Verify
-> Reorder
-> Maybe Bool
-> DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Verbosity
-> UseIndex
-> Compression
-> SetScriptsExecutable
-> UMask
-> Bool
-> WantGuiPause
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> Any)
forall a.
DarcsOption
a
(Verify
-> Reorder
-> Maybe Bool
-> DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Verbosity
-> UseIndex
-> Compression
-> SetScriptsExecutable
-> UMask
-> Bool
-> WantGuiPause
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
applyOpts
}
where
applyBasicOpts :: OptSpec
DarcsOptDescr
DarcsFlag
a
(Verify
-> Reorder
-> Maybe Bool
-> DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> a)
applyBasicOpts
= PrimOptSpec
DarcsOptDescr
DarcsFlag
(Reorder
-> Maybe Bool
-> DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> a)
Verify
PrimDarcsOption Verify
O.verify
PrimOptSpec
DarcsOptDescr
DarcsFlag
(Reorder
-> Maybe Bool
-> DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> a)
Verify
-> OptSpec
DarcsOptDescr
DarcsFlag
(Maybe Bool
-> DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> a)
(Reorder
-> Maybe Bool
-> DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(Maybe Bool
-> DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> a)
(Verify
-> Reorder
-> Maybe Bool
-> DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
DarcsOptDescr
DarcsFlag
(Maybe Bool
-> DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> a)
(Reorder
-> Maybe Bool
-> DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> a)
PrimDarcsOption Reorder
O.reorder
OptSpec
DarcsOptDescr
DarcsFlag
(Maybe Bool
-> DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> a)
(Verify
-> Reorder
-> Maybe Bool
-> DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> a)
(Maybe Bool
-> DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> a)
(Verify
-> Reorder
-> Maybe Bool
-> DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
DarcsOptDescr
DarcsFlag
(DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> a)
(Maybe Bool
-> DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> a)
PrimDarcsOption (Maybe Bool)
O.interactive
OptSpec
DarcsOptDescr
DarcsFlag
(DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> a)
(Verify
-> Reorder
-> Maybe Bool
-> DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
([MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> a)
(DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
([MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> a)
(Verify
-> Reorder
-> Maybe Bool
-> DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
DarcsOptDescr
DarcsFlag
([MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> a)
(DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> a)
forall a. DarcsOption a (DryRun -> XmlOutput -> a)
O.dryRunXml
OptSpec
DarcsOptDescr
DarcsFlag
([MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> a)
(Verify
-> Reorder
-> Maybe Bool
-> DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> a)
([MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> a)
(Verify
-> Reorder
-> Maybe Bool
-> DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
DarcsOptDescr
DarcsFlag
(Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> a)
([MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> a)
MatchOption
O.matchSeveral
OptSpec
DarcsOptDescr
DarcsFlag
(Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> a)
(Verify
-> Reorder
-> Maybe Bool
-> DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(ExternalMerge
-> RunTest -> LeaveTestDir -> Maybe String -> DiffAlgorithm -> a)
(Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(ExternalMerge
-> RunTest -> LeaveTestDir -> Maybe String -> DiffAlgorithm -> a)
(Verify
-> Reorder
-> Maybe Bool
-> DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
DarcsOptDescr
DarcsFlag
(ExternalMerge
-> RunTest -> LeaveTestDir -> Maybe String -> DiffAlgorithm -> a)
(Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> a)
PrimDarcsOption (Maybe AllowConflicts)
O.conflictsNo
OptSpec
DarcsOptDescr
DarcsFlag
(ExternalMerge
-> RunTest -> LeaveTestDir -> Maybe String -> DiffAlgorithm -> a)
(Verify
-> Reorder
-> Maybe Bool
-> DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(RunTest -> LeaveTestDir -> Maybe String -> DiffAlgorithm -> a)
(ExternalMerge
-> RunTest -> LeaveTestDir -> Maybe String -> DiffAlgorithm -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(RunTest -> LeaveTestDir -> Maybe String -> DiffAlgorithm -> a)
(Verify
-> Reorder
-> Maybe Bool
-> DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
DarcsOptDescr
DarcsFlag
(RunTest -> LeaveTestDir -> Maybe String -> DiffAlgorithm -> a)
(ExternalMerge
-> RunTest -> LeaveTestDir -> Maybe String -> DiffAlgorithm -> a)
PrimDarcsOption ExternalMerge
O.externalMerge
OptSpec
DarcsOptDescr
DarcsFlag
(RunTest -> LeaveTestDir -> Maybe String -> DiffAlgorithm -> a)
(Verify
-> Reorder
-> Maybe Bool
-> DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(LeaveTestDir -> Maybe String -> DiffAlgorithm -> a)
(RunTest -> LeaveTestDir -> Maybe String -> DiffAlgorithm -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(LeaveTestDir -> Maybe String -> DiffAlgorithm -> a)
(Verify
-> Reorder
-> Maybe Bool
-> DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
DarcsOptDescr
DarcsFlag
(LeaveTestDir -> Maybe String -> DiffAlgorithm -> a)
(RunTest -> LeaveTestDir -> Maybe String -> DiffAlgorithm -> a)
PrimDarcsOption RunTest
O.runTest
OptSpec
DarcsOptDescr
DarcsFlag
(LeaveTestDir -> Maybe String -> DiffAlgorithm -> a)
(Verify
-> Reorder
-> Maybe Bool
-> DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(Maybe String -> DiffAlgorithm -> a)
(LeaveTestDir -> Maybe String -> DiffAlgorithm -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(Maybe String -> DiffAlgorithm -> a)
(Verify
-> Reorder
-> Maybe Bool
-> DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
DarcsOptDescr
DarcsFlag
(Maybe String -> DiffAlgorithm -> a)
(LeaveTestDir -> Maybe String -> DiffAlgorithm -> a)
PrimDarcsOption LeaveTestDir
O.leaveTestDir
OptSpec
DarcsOptDescr
DarcsFlag
(Maybe String -> DiffAlgorithm -> a)
(Verify
-> Reorder
-> Maybe Bool
-> DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(DiffAlgorithm -> a)
(Maybe String -> DiffAlgorithm -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(DiffAlgorithm -> a)
(Verify
-> Reorder
-> Maybe Bool
-> DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
DarcsOptDescr
DarcsFlag
(DiffAlgorithm -> a)
(Maybe String -> DiffAlgorithm -> a)
PrimDarcsOption (Maybe String)
O.repoDir
OptSpec
DarcsOptDescr
DarcsFlag
(DiffAlgorithm -> a)
(Verify
-> Reorder
-> Maybe Bool
-> DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> a)
-> OptSpec DarcsOptDescr DarcsFlag a (DiffAlgorithm -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
a
(Verify
-> Reorder
-> Maybe Bool
-> DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec DarcsOptDescr DarcsFlag a (DiffAlgorithm -> a)
PrimDarcsOption DiffAlgorithm
O.diffAlgorithm
applyAdvancedOpts :: OptSpec
DarcsOptDescr
DarcsFlag
a
(UseIndex
-> Compression
-> SetScriptsExecutable
-> UMask
-> Bool
-> WantGuiPause
-> a)
applyAdvancedOpts
= PrimOptSpec
DarcsOptDescr
DarcsFlag
(Compression
-> SetScriptsExecutable -> UMask -> Bool -> WantGuiPause -> a)
UseIndex
PrimDarcsOption UseIndex
O.useIndex
PrimOptSpec
DarcsOptDescr
DarcsFlag
(Compression
-> SetScriptsExecutable -> UMask -> Bool -> WantGuiPause -> a)
UseIndex
-> OptSpec
DarcsOptDescr
DarcsFlag
(SetScriptsExecutable -> UMask -> Bool -> WantGuiPause -> a)
(Compression
-> SetScriptsExecutable -> UMask -> Bool -> WantGuiPause -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(SetScriptsExecutable -> UMask -> Bool -> WantGuiPause -> a)
(UseIndex
-> Compression
-> SetScriptsExecutable
-> UMask
-> Bool
-> WantGuiPause
-> 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
(SetScriptsExecutable -> UMask -> Bool -> WantGuiPause -> a)
(Compression
-> SetScriptsExecutable -> UMask -> Bool -> WantGuiPause -> a)
PrimDarcsOption Compression
O.compress
OptSpec
DarcsOptDescr
DarcsFlag
(SetScriptsExecutable -> UMask -> Bool -> WantGuiPause -> a)
(UseIndex
-> Compression
-> SetScriptsExecutable
-> UMask
-> Bool
-> WantGuiPause
-> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(UMask -> Bool -> WantGuiPause -> a)
(SetScriptsExecutable -> UMask -> Bool -> WantGuiPause -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(UMask -> Bool -> WantGuiPause -> a)
(UseIndex
-> Compression
-> SetScriptsExecutable
-> UMask
-> Bool
-> WantGuiPause
-> 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 -> WantGuiPause -> a)
(SetScriptsExecutable -> UMask -> Bool -> WantGuiPause -> a)
PrimDarcsOption SetScriptsExecutable
O.setScriptsExecutable
OptSpec
DarcsOptDescr
DarcsFlag
(UMask -> Bool -> WantGuiPause -> a)
(UseIndex
-> Compression
-> SetScriptsExecutable
-> UMask
-> Bool
-> WantGuiPause
-> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(Bool -> WantGuiPause -> a)
(UMask -> Bool -> WantGuiPause -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(Bool -> WantGuiPause -> a)
(UseIndex
-> Compression
-> SetScriptsExecutable
-> UMask
-> Bool
-> WantGuiPause
-> 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 -> WantGuiPause -> a)
(UMask -> Bool -> WantGuiPause -> a)
PrimDarcsOption UMask
O.umask
OptSpec
DarcsOptDescr
DarcsFlag
(Bool -> WantGuiPause -> a)
(UseIndex
-> Compression
-> SetScriptsExecutable
-> UMask
-> Bool
-> WantGuiPause
-> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(WantGuiPause -> a)
(Bool -> WantGuiPause -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(WantGuiPause -> a)
(UseIndex
-> Compression
-> SetScriptsExecutable
-> UMask
-> Bool
-> WantGuiPause
-> 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
(WantGuiPause -> a)
(Bool -> WantGuiPause -> a)
PrimDarcsOption Bool
O.changesReverse
OptSpec
DarcsOptDescr
DarcsFlag
(WantGuiPause -> a)
(UseIndex
-> Compression
-> SetScriptsExecutable
-> UMask
-> Bool
-> WantGuiPause
-> a)
-> OptSpec DarcsOptDescr DarcsFlag a (WantGuiPause -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
a
(UseIndex
-> Compression
-> SetScriptsExecutable
-> UMask
-> Bool
-> WantGuiPause
-> 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 (WantGuiPause -> a)
PrimDarcsOption WantGuiPause
O.pauseForGui
applyOpts :: DarcsOption
a
(Verify
-> Reorder
-> Maybe Bool
-> DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Verbosity
-> UseIndex
-> Compression
-> SetScriptsExecutable
-> UMask
-> Bool
-> WantGuiPause
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
applyOpts = OptSpec
DarcsOptDescr
DarcsFlag
(Maybe StdCmdAction
-> Verbosity
-> UseIndex
-> Compression
-> SetScriptsExecutable
-> UMask
-> Bool
-> WantGuiPause
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
(Verify
-> Reorder
-> Maybe Bool
-> DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Verbosity
-> UseIndex
-> Compression
-> SetScriptsExecutable
-> UMask
-> Bool
-> WantGuiPause
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
forall a.
OptSpec
DarcsOptDescr
DarcsFlag
a
(Verify
-> Reorder
-> Maybe Bool
-> DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> a)
applyBasicOpts OptSpec
DarcsOptDescr
DarcsFlag
(Maybe StdCmdAction
-> Verbosity
-> UseIndex
-> Compression
-> SetScriptsExecutable
-> UMask
-> Bool
-> WantGuiPause
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
(Verify
-> Reorder
-> Maybe Bool
-> DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Verbosity
-> UseIndex
-> Compression
-> SetScriptsExecutable
-> UMask
-> Bool
-> WantGuiPause
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
-> DarcsOption
(UseCache -> HooksConfig -> Bool -> Bool -> Bool -> a)
(UseIndex
-> Compression
-> SetScriptsExecutable
-> UMask
-> Bool
-> WantGuiPause
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
-> DarcsOption
a
(Verify
-> Reorder
-> Maybe Bool
-> DryRun
-> XmlOutput
-> [MatchFlag]
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> LeaveTestDir
-> Maybe String
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Verbosity
-> UseIndex
-> Compression
-> SetScriptsExecutable
-> UMask
-> Bool
-> WantGuiPause
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
forall b c a.
DarcsOption (Maybe StdCmdAction -> Verbosity -> b) c
-> DarcsOption
(UseCache -> HooksConfig -> Bool -> Bool -> Bool -> a) b
-> DarcsOption a c
`withStdOpts` DarcsOption
(UseCache -> HooksConfig -> Bool -> Bool -> Bool -> a)
(UseIndex
-> Compression
-> SetScriptsExecutable
-> UMask
-> Bool
-> WantGuiPause
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
forall a.
OptSpec
DarcsOptDescr
DarcsFlag
a
(UseIndex
-> Compression
-> SetScriptsExecutable
-> UMask
-> Bool
-> WantGuiPause
-> a)
applyAdvancedOpts
applyCmd :: PatchApplier pa
=> pa
-> (AbsolutePath, AbsolutePath)
-> [DarcsFlag]
-> [String]
-> IO ()
applyCmd :: pa
-> (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
applyCmd pa
patchApplier (AbsolutePath
_,AbsolutePath
orig) [DarcsFlag]
opts [String]
args =
DryRun -> UseCache -> UpdatePending -> UMask -> RepoJob () -> IO ()
forall a.
DryRun -> UseCache -> UpdatePending -> UMask -> RepoJob a -> IO a
withRepoLock (PrimDarcsOption DryRun
dryRun PrimDarcsOption DryRun -> [DarcsFlag] -> DryRun
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (PrimDarcsOption UseCache
useCache PrimDarcsOption UseCache -> [DarcsFlag] -> UseCache
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) UpdatePending
YesUpdatePending (PrimDarcsOption UMask
umask PrimDarcsOption UMask -> [DarcsFlag] -> UMask
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (RepoJob () -> IO ()) -> RepoJob () -> IO ()
forall a b. (a -> b) -> a -> b
$
pa
-> (forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
(IsRepoType rt, ApplierRepoTypeConstraint pa rt, RepoPatch p,
ApplyState p ~ Tree) =>
PatchProxy p -> Repository rt p wR wU wR -> IO ())
-> RepoJob ()
forall pa.
PatchApplier pa =>
pa
-> (forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
(IsRepoType rt, ApplierRepoTypeConstraint pa rt, RepoPatch p,
ApplyState p ~ Tree) =>
PatchProxy p -> Repository rt p wR wU wR -> IO ())
-> RepoJob ()
repoJob pa
patchApplier ((forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
(IsRepoType rt, ApplierRepoTypeConstraint pa rt, RepoPatch p,
ApplyState p ~ Tree) =>
PatchProxy p -> Repository rt p wR wU wR -> IO ())
-> RepoJob ())
-> (forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
(IsRepoType rt, ApplierRepoTypeConstraint pa rt, RepoPatch p,
ApplyState p ~ Tree) =>
PatchProxy p -> Repository rt p wR wU wR -> IO ())
-> RepoJob ()
forall a b. (a -> b) -> a -> b
$ \PatchProxy p
patchProxy Repository rt p wR wU wR
repository -> do
ByteString
bundle <- [String] -> IO ByteString
readBundle [String]
args
pa
-> PatchProxy p
-> [DarcsFlag]
-> ByteString
-> Repository rt p wR wU wR
-> IO ()
forall (rt :: RepoType) pa (p :: * -> * -> *) wR wU.
(PatchApplier pa, RepoPatch p, ApplyState p ~ Tree,
ApplierRepoTypeConstraint pa rt, IsRepoType rt) =>
pa
-> PatchProxy p
-> [DarcsFlag]
-> ByteString
-> Repository rt p wR wU wR
-> IO ()
applyCmdCommon pa
patchApplier PatchProxy p
patchProxy [DarcsFlag]
opts ByteString
bundle Repository rt p wR wU wR
repository
where
readBundle :: [String] -> IO ByteString
readBundle [String
"-"] = do
[DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
opts (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"reading patch bundle from stdin..."
IO ByteString
gzReadStdin
readBundle [String
""] = String -> IO ByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Empty filename argument given to apply!"
readBundle [String
unfixed_filename] = do
String
patchesfile <- AbsolutePath -> String -> IO String
fixUrl AbsolutePath
orig String
unfixed_filename
String -> Cachable -> IO ByteString
gzFetchFilePS (String -> String
forall a. FilePathLike a => a -> String
toFilePath String
patchesfile) Cachable
Uncachable
readBundle [String]
_ = String -> IO ByteString
forall a. HasCallStack => String -> a
error String
"impossible case"
applyCmdCommon
:: forall rt pa p wR wU
. ( PatchApplier pa, RepoPatch p, ApplyState p ~ Tree
, ApplierRepoTypeConstraint pa rt, IsRepoType rt
)
=> pa
-> PatchProxy p
-> [DarcsFlag]
-> B.ByteString
-> Repository rt p wR wU wR
-> IO ()
applyCmdCommon :: pa
-> PatchProxy p
-> [DarcsFlag]
-> ByteString
-> Repository rt p wR wU wR
-> IO ()
applyCmdCommon pa
patchApplier PatchProxy p
patchProxy [DarcsFlag]
opts ByteString
bundle Repository rt p wR wU wR
repository = do
PatchSet rt p Origin wR
us <- Repository rt p wR wU wR -> IO (PatchSet rt p Origin wR)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
Repository rt p wR wU wT -> IO (PatchSet rt p Origin wR)
readRepo Repository rt p wR wU wR
repository
Sealed PatchSet rt p Origin wX
them <- (String -> IO (Sealed (PatchSet rt p Origin)))
-> (Sealed (PatchSet rt p Origin)
-> IO (Sealed (PatchSet rt p Origin)))
-> Either String (Sealed (PatchSet rt p Origin))
-> IO (Sealed (PatchSet rt p Origin))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> IO (Sealed (PatchSet rt p Origin))
forall (m :: * -> *) a. MonadFail m => String -> m a
fail Sealed (PatchSet rt p Origin) -> IO (Sealed (PatchSet rt p Origin))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (Sealed (PatchSet rt p Origin))
-> IO (Sealed (PatchSet rt p Origin)))
-> IO (Either String (Sealed (PatchSet rt p Origin)))
-> IO (Sealed (PatchSet rt p Origin))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [DarcsFlag]
-> PatchSet rt p Origin wR
-> ByteString
-> IO (Either String (Sealed (PatchSet rt p Origin)))
forall (p :: * -> * -> *) (rt :: RepoType) wR.
RepoPatch p =>
[DarcsFlag]
-> PatchSet rt p Origin wR
-> ByteString
-> IO (Either String (SealedPatchSet rt p Origin))
getPatchBundle [DarcsFlag]
opts PatchSet rt p Origin wR
us ByteString
bundle
Fork PatchSet rt p Origin wU
common FL (PatchInfoAnd rt p) wU wR
us' FL (PatchInfoAnd rt p) wU wX
them' <- Fork
(PatchSet rt p)
(FL (PatchInfoAnd rt p))
(FL (PatchInfoAnd rt p))
Origin
wR
wX
-> IO
(Fork
(PatchSet rt p)
(FL (PatchInfoAnd rt p))
(FL (PatchInfoAnd rt p))
Origin
wR
wX)
forall (m :: * -> *) a. Monad m => a -> m a
return (Fork
(PatchSet rt p)
(FL (PatchInfoAnd rt p))
(FL (PatchInfoAnd rt p))
Origin
wR
wX
-> IO
(Fork
(PatchSet rt p)
(FL (PatchInfoAnd rt p))
(FL (PatchInfoAnd rt p))
Origin
wR
wX))
-> Fork
(PatchSet rt p)
(FL (PatchInfoAnd rt p))
(FL (PatchInfoAnd rt p))
Origin
wR
wX
-> IO
(Fork
(PatchSet rt p)
(FL (PatchInfoAnd rt p))
(FL (PatchInfoAnd rt p))
Origin
wR
wX)
forall a b. (a -> b) -> a -> b
$ PatchSet rt p Origin wR
-> PatchSet rt p Origin wX
-> Fork
(PatchSet rt p)
(FL (PatchInfoAnd rt p))
(FL (PatchInfoAnd rt p))
Origin
wR
wX
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
Commute p =>
PatchSet rt p Origin wX
-> PatchSet rt p Origin wY
-> Fork
(PatchSet rt p)
(FL (PatchInfoAnd rt p))
(FL (PatchInfoAnd rt p))
Origin
wX
wY
findCommonAndUncommon PatchSet rt p Origin wR
us PatchSet rt p Origin wX
them
let check :: PatchInfoAnd rt p wX wY -> Maybe PatchInfo
check :: PatchInfoAnd rt p wX wY -> Maybe PatchInfo
check PatchInfoAnd rt p wX wY
p = case PatchInfoAnd rt p wX wY -> Maybe (Named p wX wY)
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> Maybe (p wA wB)
hopefullyM PatchInfoAnd rt p wX wY
p of
Maybe (Named p wX wY)
Nothing -> PatchInfo -> Maybe PatchInfo
forall a. a -> Maybe a
Just (PatchInfoAnd rt p wX wY -> PatchInfo
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> PatchInfo
info PatchInfoAnd rt p wX wY
p)
Just Named p wX wY
_ -> Maybe PatchInfo
forall a. Maybe a
Nothing
bad :: [PatchInfo]
bad = [Maybe PatchInfo] -> [PatchInfo]
forall a. [Maybe a] -> [a]
catMaybes ((forall wW wZ. PatchInfoAnd rt p wW wZ -> Maybe PatchInfo)
-> FL (PatchInfoAnd rt p) wU wX -> [Maybe PatchInfo]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL forall wW wZ. PatchInfoAnd rt p wW wZ -> Maybe PatchInfo
check FL (PatchInfoAnd rt p) wU wX
them')
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([PatchInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PatchInfo]
bad) (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
$
Doc -> String
renderString (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$
([Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (PatchInfo -> Doc) -> [PatchInfo] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map PatchInfo -> Doc
displayPatchInfo [PatchInfo]
bad) Doc -> Doc -> Doc
$$ String -> Doc
text String
"" Doc -> Doc -> Doc
$$
String -> Doc
text String
"Cannot apply this bundle. We are missing the above patches."
(Bool
hadConflicts, Sealed FL (PatchInfoAnd rt p) wU wX
their_ps)
<- if PrimDarcsOption (Maybe AllowConflicts)
O.conflictsNo PrimDarcsOption (Maybe AllowConflicts)
-> [DarcsFlag] -> Maybe AllowConflicts
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts Maybe AllowConflicts -> Maybe AllowConflicts -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe AllowConflicts
forall a. Maybe a
Nothing
then Repository rt p wR wU wR
-> FL (PatchInfoAnd rt p) wU wR
-> FL (PatchInfoAnd rt p) wU wX
-> IO (Bool, Sealed (FL (PatchInfoAnd rt p) wU))
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wX wZ.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wR
-> FL (PatchInfoAnd rt p) wX wR
-> FL (PatchInfoAnd rt p) wX wZ
-> IO (Bool, Sealed (FL (PatchInfoAnd rt p) wX))
filterOutConflicts Repository rt p wR wU wR
repository FL (PatchInfoAnd rt p) wU wR
us' FL (PatchInfoAnd rt p) wU wX
them'
else (Bool, Sealed (FL (PatchInfoAnd rt p) wU))
-> IO (Bool, Sealed (FL (PatchInfoAnd rt p) wU))
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, FL (PatchInfoAnd rt p) wU wX -> Sealed (FL (PatchInfoAnd rt p) wU)
forall (a :: * -> *) wX. a wX -> Sealed a
Sealed FL (PatchInfoAnd rt p) wU wX
them')
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
hadConflicts (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
"Skipping some patches which would cause conflicts."
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FL (PatchInfoAnd rt p) wU wX -> Bool
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Bool
nullFL FL (PatchInfoAnd rt p) wU wX
their_ps) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
do if Bool
hadConflicts
then String -> IO ()
putStrLn (String
"All new patches of the bundle cause conflicts. " String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"Nothing to do.") IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
forall a. IO a
exitSuccess
else String -> IO ()
putStrLn (String
"All these patches have already been applied. " String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"Nothing to do.") IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PrimDarcsOption Reorder
reorder PrimDarcsOption Reorder -> [DarcsFlag] -> Reorder
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts Reorder -> Reorder -> Bool
forall a. Eq a => a -> a -> Bool
/= Reorder
O.Reorder) IO ()
forall a. IO a
exitSuccess
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
FirstReversed else WhichChanges
First
selection_config :: SelectionConfig (PatchInfoAnd rt p)
selection_config = WhichChanges
-> String
-> PatchSelectionOptions
-> Maybe (Splitter (PatchInfoAnd rt p))
-> Maybe [AnchoredPath]
-> SelectionConfig (PatchInfoAnd rt p)
forall (p :: * -> * -> *).
Matchable p =>
WhichChanges
-> String
-> PatchSelectionOptions
-> Maybe (Splitter p)
-> Maybe [AnchoredPath]
-> SelectionConfig p
selectionConfig WhichChanges
direction String
"apply" ([DarcsFlag] -> PatchSelectionOptions
patchSelOpts [DarcsFlag]
opts) Maybe (Splitter (PatchInfoAnd rt p))
forall a. Maybe a
Nothing Maybe [AnchoredPath]
forall a. Maybe a
Nothing
(FL (PatchInfoAnd rt p) wU wZ
to_be_applied :> FL (PatchInfoAnd rt p) wZ wX
_) <- FL (PatchInfoAnd rt p) wU wX
-> SelectionConfig (PatchInfoAnd rt p)
-> IO
((:>) (FL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt p)) wU wX)
forall (p :: * -> * -> *) wX wY.
(MatchableRP p, ShowPatch p, ShowContextPatch p,
ApplyState p ~ Tree, ApplyState p ~ ApplyState (PrimOf p)) =>
FL p wX wY -> SelectionConfig p -> IO ((:>) (FL p) (FL p) wX wY)
runSelection FL (PatchInfoAnd rt p) wU wX
their_ps SelectionConfig (PatchInfoAnd rt p)
selection_config
pa
-> PatchProxy p
-> String
-> [DarcsFlag]
-> Repository rt p wR wU wR
-> Fork
(PatchSet rt p)
(FL (PatchInfoAnd rt p))
(FL (PatchInfoAnd rt p))
Origin
wR
wZ
-> IO ()
forall pa (rt :: RepoType) (p :: * -> * -> *) wR wU wZ.
(PatchApplier pa, ApplierRepoTypeConstraint pa rt, IsRepoType rt,
RepoPatch p, ApplyState p ~ Tree) =>
pa
-> PatchProxy p
-> String
-> [DarcsFlag]
-> Repository rt p wR wU wR
-> Fork
(PatchSet rt p)
(FL (PatchInfoAnd rt p))
(FL (PatchInfoAnd rt p))
Origin
wR
wZ
-> IO ()
applyPatches pa
patchApplier PatchProxy p
patchProxy String
"apply" [DarcsFlag]
opts Repository rt p wR wU wR
repository (PatchSet rt p Origin wU
-> FL (PatchInfoAnd rt p) wU wR
-> FL (PatchInfoAnd rt p) wU wZ
-> Fork
(PatchSet rt p)
(FL (PatchInfoAnd rt p))
(FL (PatchInfoAnd rt p))
Origin
wR
wZ
forall (common :: * -> * -> *) (left :: * -> * -> *)
(right :: * -> * -> *) wA wX wY wU.
common wA wU
-> left wU wX -> right wU wY -> Fork common left right wA wX wY
Fork PatchSet rt p Origin wU
common FL (PatchInfoAnd rt p) wU wR
us' FL (PatchInfoAnd rt p) wU wZ
to_be_applied)
getPatchBundle :: RepoPatch p
=> [DarcsFlag]
-> PatchSet rt p Origin wR
-> B.ByteString
-> IO (Either String (SealedPatchSet rt p Origin))
getPatchBundle :: [DarcsFlag]
-> PatchSet rt p Origin wR
-> ByteString
-> IO (Either String (SealedPatchSet rt p Origin))
getPatchBundle [DarcsFlag]
opts PatchSet rt p Origin wR
us ByteString
fps = do
let opt_verify :: Verify
opt_verify = PrimDarcsOption Verify -> [DarcsFlag] -> Verify
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags PrimDarcsOption Verify
O.verify [DarcsFlag]
opts
Maybe ByteString
mps <- Verify -> ByteString -> IO (Maybe ByteString)
verifyPS Verify
opt_verify (ByteString -> IO (Maybe ByteString))
-> ByteString -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
readEmail ByteString
fps
Maybe ByteString
mops <- Verify -> ByteString -> IO (Maybe ByteString)
verifyPS Verify
opt_verify ByteString
fps
case (Maybe ByteString
mps, Maybe ByteString
mops) of
(Maybe ByteString
Nothing, Maybe ByteString
Nothing) ->
Either String (SealedPatchSet rt p Origin)
-> IO (Either String (SealedPatchSet rt p Origin))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (SealedPatchSet rt p Origin)
-> IO (Either String (SealedPatchSet rt p Origin)))
-> Either String (SealedPatchSet rt p Origin)
-> IO (Either String (SealedPatchSet rt p Origin))
forall a b. (a -> b) -> a -> b
$ String -> Either String (SealedPatchSet rt p Origin)
forall a b. a -> Either a b
Left String
"Patch bundle not properly signed, or gpg failed."
(Just ByteString
bundle, Maybe ByteString
Nothing) -> Either String (SealedPatchSet rt p Origin)
-> IO (Either String (SealedPatchSet rt p Origin))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (SealedPatchSet rt p Origin)
-> IO (Either String (SealedPatchSet rt p Origin)))
-> Either String (SealedPatchSet rt p Origin)
-> IO (Either String (SealedPatchSet rt p Origin))
forall a b. (a -> b) -> a -> b
$ PatchSet rt p Origin wR
-> ByteString -> Either String (SealedPatchSet rt p Origin)
forall (p :: * -> * -> *) (rt :: RepoType) wR.
RepoPatch p =>
PatchSet rt p Origin wR
-> ByteString -> Either String (SealedPatchSet rt p Origin)
parseAndInterpretBundle PatchSet rt p Origin wR
us ByteString
bundle
(Maybe ByteString
Nothing, Just ByteString
bundle) -> Either String (SealedPatchSet rt p Origin)
-> IO (Either String (SealedPatchSet rt p Origin))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (SealedPatchSet rt p Origin)
-> IO (Either String (SealedPatchSet rt p Origin)))
-> Either String (SealedPatchSet rt p Origin)
-> IO (Either String (SealedPatchSet rt p Origin))
forall a b. (a -> b) -> a -> b
$ PatchSet rt p Origin wR
-> ByteString -> Either String (SealedPatchSet rt p Origin)
forall (p :: * -> * -> *) (rt :: RepoType) wR.
RepoPatch p =>
PatchSet rt p Origin wR
-> ByteString -> Either String (SealedPatchSet rt p Origin)
parseAndInterpretBundle PatchSet rt p Origin wR
us ByteString
bundle
(Just ByteString
ps1, Just ByteString
ps2) -> case ByteString -> Either String (SealedPatchSet rt p Origin)
careful_scan_bundle ByteString
ps1 of
Left String
_ -> Either String (SealedPatchSet rt p Origin)
-> IO (Either String (SealedPatchSet rt p Origin))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (SealedPatchSet rt p Origin)
-> IO (Either String (SealedPatchSet rt p Origin)))
-> Either String (SealedPatchSet rt p Origin)
-> IO (Either String (SealedPatchSet rt p Origin))
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String (SealedPatchSet rt p Origin)
careful_scan_bundle ByteString
ps2
Right SealedPatchSet rt p Origin
x -> Either String (SealedPatchSet rt p Origin)
-> IO (Either String (SealedPatchSet rt p Origin))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (SealedPatchSet rt p Origin)
-> IO (Either String (SealedPatchSet rt p Origin)))
-> Either String (SealedPatchSet rt p Origin)
-> IO (Either String (SealedPatchSet rt p Origin))
forall a b. (a -> b) -> a -> b
$ SealedPatchSet rt p Origin
-> Either String (SealedPatchSet rt p Origin)
forall a b. b -> Either a b
Right SealedPatchSet rt p Origin
x
where careful_scan_bundle :: ByteString -> Either String (SealedPatchSet rt p Origin)
careful_scan_bundle ByteString
bundle =
case PatchSet rt p Origin wR
-> ByteString -> Either String (SealedPatchSet rt p Origin)
forall (p :: * -> * -> *) (rt :: RepoType) wR.
RepoPatch p =>
PatchSet rt p Origin wR
-> ByteString -> Either String (SealedPatchSet rt p Origin)
parseAndInterpretBundle PatchSet rt p Origin wR
us ByteString
bundle of
Left String
e -> case PatchSet rt p Origin wR
-> ByteString -> Either String (SealedPatchSet rt p Origin)
forall (p :: * -> * -> *) (rt :: RepoType) wR.
RepoPatch p =>
PatchSet rt p Origin wR
-> ByteString -> Either String (SealedPatchSet rt p Origin)
parseAndInterpretBundle PatchSet rt p Origin wR
us (ByteString -> Either String (SealedPatchSet rt p Origin))
-> ByteString -> Either String (SealedPatchSet rt p Origin)
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
stripCrPS ByteString
bundle of
Right SealedPatchSet rt p Origin
x -> SealedPatchSet rt p Origin
-> Either String (SealedPatchSet rt p Origin)
forall a b. b -> Either a b
Right SealedPatchSet rt p Origin
x
Either String (SealedPatchSet rt p Origin)
_ -> String -> Either String (SealedPatchSet rt p Origin)
forall a b. a -> Either a b
Left String
e
Either String (SealedPatchSet rt p Origin)
x -> Either String (SealedPatchSet rt p Origin)
x
stripCrPS :: B.ByteString -> B.ByteString
stripCrPS :: ByteString -> ByteString
stripCrPS ByteString
bundle = [ByteString] -> ByteString
unlinesPS ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> ByteString
stripline ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
linesPS ByteString
bundle
stripline :: ByteString -> ByteString
stripline ByteString
p | ByteString -> Bool
B.null ByteString
p = ByteString
p
| ByteString -> Char
BC.last ByteString
p Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\r' = ByteString -> ByteString
B.init ByteString
p
| Bool
otherwise = ByteString
p
parseAndInterpretBundle :: RepoPatch p
=> PatchSet rt p Origin wR
-> B.ByteString
-> Either String (SealedPatchSet rt p Origin)
parseAndInterpretBundle :: PatchSet rt p Origin wR
-> ByteString -> Either String (SealedPatchSet rt p Origin)
parseAndInterpretBundle PatchSet rt p Origin wR
us ByteString
content = do
Sealed Bundle rt p Any wX
bundle <- ByteString -> Either String (Sealed (Bundle rt p Any))
forall (p :: * -> * -> *) (rt :: RepoType) wX.
RepoPatch p =>
ByteString -> Either String (Sealed (Bundle rt p wX))
parseBundle ByteString
content
PatchSet rt p Origin wX -> SealedPatchSet rt p Origin
forall (a :: * -> *) wX. a wX -> Sealed a
Sealed (PatchSet rt p Origin wX -> SealedPatchSet rt p Origin)
-> Either String (PatchSet rt p Origin wX)
-> Either String (SealedPatchSet rt p Origin)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PatchSet rt p Origin wR
-> Bundle rt p Any wX -> Either String (PatchSet rt p Origin wX)
forall (p :: * -> * -> *) (rt :: RepoType) wT wA wB.
Commute p =>
PatchSet rt p Origin wT
-> Bundle rt p wA wB -> Either String (PatchSet rt p Origin wB)
interpretBundle PatchSet rt p Origin wR
us Bundle rt p Any wX
bundle
patchSelOpts :: [DarcsFlag] -> S.PatchSelectionOptions
patchSelOpts :: [DarcsFlag] -> PatchSelectionOptions
patchSelOpts [DarcsFlag]
flags = PatchSelectionOptions :: Verbosity
-> [MatchFlag]
-> Bool
-> SelectDeps
-> WithSummary
-> WithContext
-> PatchSelectionOptions
S.PatchSelectionOptions
{ verbosity :: Verbosity
S.verbosity = PrimDarcsOption Verbosity
verbosity PrimDarcsOption Verbosity -> [DarcsFlag] -> Verbosity
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
flags
, matchFlags :: [MatchFlag]
S.matchFlags = MatchOption -> [DarcsFlag] -> [MatchFlag]
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags MatchOption
O.matchSeveral [DarcsFlag]
flags
, interactive :: Bool
S.interactive = [DarcsFlag] -> Bool
maybeIsInteractive [DarcsFlag]
flags
, selectDeps :: SelectDeps
S.selectDeps = SelectDeps
O.PromptDeps
, withSummary :: WithSummary
S.withSummary = WithSummary
O.NoSummary
, withContext :: WithContext
S.withContext = PrimDarcsOption WithContext
withContext PrimDarcsOption WithContext -> [DarcsFlag] -> WithContext
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
flags
}
maybeIsInteractive :: [DarcsFlag] -> Bool
maybeIsInteractive :: [DarcsFlag] -> Bool
maybeIsInteractive = Bool -> (Bool -> Bool) -> Maybe Bool -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Bool -> Bool
forall a. a -> a
id (Maybe Bool -> Bool)
-> ([DarcsFlag] -> Maybe Bool) -> [DarcsFlag] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimDarcsOption (Maybe Bool) -> [DarcsFlag] -> Maybe Bool
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags PrimDarcsOption (Maybe Bool)
O.interactive