{-# LANGUAGE OverloadedStrings #-}
module Darcs.UI.Commands.Pull (
pull, fetch,
pullCmd, StandardPatchApplier,
fetchPatches
) where
import Darcs.Prelude
import System.Exit ( exitSuccess )
import Control.Monad ( when, unless, (>=>) )
import Data.List ( nub )
import Data.Maybe ( fromMaybe )
import Darcs.UI.Commands
( DarcsCommand(..)
, withStdOpts
, putInfo
, putVerbose
, setEnvDarcsPatches
, defaultRepo
, amInHashedRepository
)
import Darcs.UI.Commands.Clone ( otherHelpInheritDefault )
import Darcs.UI.Flags
( DarcsFlag
, fixUrl, getOutput
, changesReverse, verbosity, dryRun, umask, useCache, selectDeps
, remoteRepos, reorder, setDefault
, withContext, hasXmlOutput
, isInteractive, quiet
)
import Darcs.UI.Options ( (^), odesc, ocheck, defaultFlags, parseFlags, (?) )
import qualified Darcs.UI.Options.All as O
import Darcs.Repository.Flags ( UpdatePending (..) )
import Darcs.Repository
( Repository
, identifyRepositoryFor
, ReadingOrWriting(..)
, withRepoLock
, RepoJob(..)
, readRepo
, modifyCache
, mkCache
, cacheEntries
, CacheLoc(..)
, WritableOrNot(..)
, CacheType(..)
, filterOutConflicts
)
import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, info, hopefully, patchDesc )
import Darcs.Patch ( IsRepoType, RepoPatch, description )
import qualified Darcs.Patch.Bundle as Bundle ( makeBundle )
import Darcs.Patch.Apply( ApplyState )
import Darcs.Patch.Set ( PatchSet, Origin, emptyPatchSet, SealedPatchSet )
import Darcs.Patch.Witnesses.Sealed ( Sealed(..), seal )
import Darcs.Patch.Witnesses.Ordered
( (:>)(..), (:\/:)(..), FL(..), Fork(..)
, mapFL, nullFL, mapFL_FL )
import Darcs.Patch.Permutations ( partitionFL )
import Darcs.Repository.Prefs ( addToPreflist, addRepoSource, getPreflist, showMotd )
import Darcs.Patch.Depends ( findUncommon, findCommonAndUncommon,
patchSetIntersection, patchSetUnion )
import Darcs.UI.ApplyPatches ( PatchApplier(..), StandardPatchApplier(..) )
import Darcs.UI.Completion ( prefArgs )
import Darcs.UI.Commands.Util ( checkUnrelatedRepos, getUniqueDPatchName )
import Darcs.UI.SelectChanges
( WhichChanges(..)
, runSelection
, selectionConfig
)
import qualified Darcs.UI.SelectChanges as S ( PatchSelectionOptions (..) )
import Darcs.Util.Printer
( Doc
, ($$)
, ($+$)
, (<+>)
, formatWords
, hsep
, putDoc
, quoted
, text
, vcat
)
import Darcs.Util.Lock ( writeDocBinFile )
import Darcs.Util.Path ( useAbsoluteOrStd, stdOut, AbsolutePath )
import Darcs.Util.Workaround ( getCurrentDirectory )
import Darcs.Util.Tree( Tree )
pullDescription :: String
pullDescription :: String
pullDescription =
String
"Copy and apply patches from another repository to this one."
fetchDescription :: String
fetchDescription :: String
fetchDescription =
String
"Fetch patches from another repository, but don't apply them."
pullHelp :: Doc
pullHelp :: Doc
pullHelp =
[String] -> Doc
formatWords
[ String
"Pull is used to bring patches made in another repository into the current"
, String
"repository (that is, either the one in the current directory, or the one"
, String
"specified with the `--repodir` option). Pull accepts arguments, which are"
, String
"URLs from which to pull, and when called without an argument, pull will"
, String
"use the repository specified at `_darcs/prefs/defaultrepo`."
]
Doc -> Doc -> Doc
$+$ [String] -> Doc
formatWords
[ String
"The default (`--union`) behavior is to pull any patches that are in any of"
, String
"the specified repositories. If you specify the `--intersection` flag, darcs"
, String
"will only pull those patches which are present in all source repositories."
, String
"If you specify the `--complement` flag, darcs will only pull elements in the"
, String
"first repository that do not exist in any of the remaining repositories."
]
Doc -> Doc -> Doc
$+$ [String] -> Doc
formatWords
[ String
"If `--reorder` is supplied, the set of patches that exist only in the current"
, String
"repository is brought at the top of the current history. This will work even"
, String
"if there are no new patches to pull."
]
Doc -> Doc -> Doc
$+$ Doc
otherHelpInheritDefault
Doc -> Doc -> Doc
$+$ [String] -> Doc
formatWords
[ String
"See `darcs help apply` for detailed description of many options."
]
fetchHelp :: Doc
fetchHelp :: Doc
fetchHelp =
[String] -> Doc
formatWords
[ String
"Fetch is similar to `pull` except that it does not apply any patches"
, String
"to the current repository. Instead, it generates a patch bundle that"
, String
"you can apply later with `apply`."
]
Doc -> Doc -> Doc
$+$ [String] -> Doc
formatWords
[ String
"Fetch's behaviour is essentially similar to pull's, so please consult"
, String
"the help of `pull` to know more."
]
fetch :: DarcsCommand
fetch :: DarcsCommand
fetch = DarcsCommand
{ commandProgramName :: String
commandProgramName = String
"darcs"
, commandName :: String
commandName = String
"fetch"
, commandHelp :: Doc
commandHelp = Doc
fetchHelp
, commandDescription :: String
commandDescription = String
fetchDescription
, commandExtraArgs :: Int
commandExtraArgs = -Int
1
, commandExtraArgHelp :: [String]
commandExtraArgHelp = [String
"[REPOSITORY]..."]
, commandCommand :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
commandCommand = (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
fetchCmd
, commandPrereq :: [DarcsFlag] -> IO (Either String ())
commandPrereq = [DarcsFlag] -> IO (Either String ())
amInHashedRepository
, commandCompleteArgs :: (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
commandCompleteArgs = String
-> (AbsolutePath, AbsolutePath)
-> [DarcsFlag]
-> [String]
-> IO [String]
prefArgs String
"repos"
, commandArgdefaults :: [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
commandArgdefaults = [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
defaultRepo
, commandAdvancedOptions :: [DarcsOptDescr DarcsFlag]
commandAdvancedOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc forall {a}.
OptSpec
DarcsOptDescr
DarcsFlag
a
(RepoCombinator -> RemoteRepos -> NetworkOptions -> a)
advancedOpts
, commandBasicOptions :: [DarcsOptDescr DarcsFlag]
commandBasicOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc forall {a}.
OptSpec
DarcsOptDescr
DarcsFlag
a
([MatchFlag]
-> Maybe Bool
-> DryRun
-> WithSummary
-> SelectDeps
-> Maybe Bool
-> InheritDefault
-> Maybe String
-> Maybe Output
-> Bool
-> DiffAlgorithm
-> a)
basicOpts
, commandDefaults :: [DarcsFlag]
commandDefaults = forall (d :: * -> *) f b. OptSpec d f [f] b -> [f]
defaultFlags forall {a}.
DarcsOption
a
([MatchFlag]
-> Maybe Bool
-> DryRun
-> WithSummary
-> SelectDeps
-> Maybe Bool
-> InheritDefault
-> Maybe String
-> Maybe Output
-> Bool
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Verbosity
-> RepoCombinator
-> RemoteRepos
-> NetworkOptions
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
allOpts
, commandCheckOptions :: [DarcsFlag] -> [String]
commandCheckOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [f] -> [String]
ocheck forall {a}.
DarcsOption
a
([MatchFlag]
-> Maybe Bool
-> DryRun
-> WithSummary
-> SelectDeps
-> Maybe Bool
-> InheritDefault
-> Maybe String
-> Maybe Output
-> Bool
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Verbosity
-> RepoCombinator
-> RemoteRepos
-> NetworkOptions
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
allOpts
}
where
basicOpts :: OptSpec
DarcsOptDescr
DarcsFlag
a
([MatchFlag]
-> Maybe Bool
-> DryRun
-> WithSummary
-> SelectDeps
-> Maybe Bool
-> InheritDefault
-> Maybe String
-> Maybe Output
-> Bool
-> DiffAlgorithm
-> a)
basicOpts
= MatchOption
O.matchSeveral
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption (Maybe Bool)
O.interactive
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption DryRun
O.dryRun
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption WithSummary
O.withSummary
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption SelectDeps
O.selectDeps
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption (Maybe Bool)
O.setDefault
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption InheritDefault
O.inheritDefault
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption (Maybe String)
O.repoDir
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption (Maybe Output)
O.output
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption Bool
O.allowUnrelatedRepos
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption DiffAlgorithm
O.diffAlgorithm
advancedOpts :: OptSpec
DarcsOptDescr
DarcsFlag
a
(RepoCombinator -> RemoteRepos -> NetworkOptions -> a)
advancedOpts
= PrimDarcsOption RepoCombinator
O.repoCombinator
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption RemoteRepos
O.remoteRepos
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption NetworkOptions
O.network
allOpts :: DarcsOption
a
([MatchFlag]
-> Maybe Bool
-> DryRun
-> WithSummary
-> SelectDeps
-> Maybe Bool
-> InheritDefault
-> Maybe String
-> Maybe Output
-> Bool
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Verbosity
-> RepoCombinator
-> RemoteRepos
-> NetworkOptions
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
allOpts = forall {a}.
OptSpec
DarcsOptDescr
DarcsFlag
a
([MatchFlag]
-> Maybe Bool
-> DryRun
-> WithSummary
-> SelectDeps
-> Maybe Bool
-> InheritDefault
-> Maybe String
-> Maybe Output
-> Bool
-> DiffAlgorithm
-> a)
basicOpts forall b c a.
DarcsOption (Maybe StdCmdAction -> Verbosity -> b) c
-> DarcsOption
(UseCache -> HooksConfig -> Bool -> Bool -> Bool -> a) b
-> DarcsOption a c
`withStdOpts` forall {a}.
OptSpec
DarcsOptDescr
DarcsFlag
a
(RepoCombinator -> RemoteRepos -> NetworkOptions -> a)
advancedOpts
pull :: DarcsCommand
pull :: DarcsCommand
pull = DarcsCommand
{ commandProgramName :: String
commandProgramName = String
"darcs"
, commandName :: String
commandName = String
"pull"
, commandHelp :: Doc
commandHelp = Doc
pullHelp
, commandDescription :: String
commandDescription = String
pullDescription
, commandExtraArgs :: Int
commandExtraArgs = -Int
1
, commandExtraArgHelp :: [String]
commandExtraArgHelp = [String
"[REPOSITORY]..."]
, commandCommand :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
commandCommand = forall pa.
PatchApplier pa =>
pa
-> (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
pullCmd StandardPatchApplier
StandardPatchApplier
, commandPrereq :: [DarcsFlag] -> IO (Either String ())
commandPrereq = [DarcsFlag] -> IO (Either String ())
amInHashedRepository
, commandCompleteArgs :: (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
commandCompleteArgs = String
-> (AbsolutePath, AbsolutePath)
-> [DarcsFlag]
-> [String]
-> IO [String]
prefArgs String
"repos"
, commandArgdefaults :: [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
commandArgdefaults = [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
defaultRepo
, commandAdvancedOptions :: [DarcsOptDescr DarcsFlag]
commandAdvancedOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc forall {a}.
OptSpec
DarcsOptDescr
DarcsFlag
a
(RepoCombinator
-> Compression
-> UseIndex
-> RemoteRepos
-> SetScriptsExecutable
-> UMask
-> Bool
-> WantGuiPause
-> NetworkOptions
-> a)
advancedOpts
, commandBasicOptions :: [DarcsOptDescr DarcsFlag]
commandBasicOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc forall {a}.
OptSpec
DarcsOptDescr
DarcsFlag
a
([MatchFlag]
-> Reorder
-> Maybe Bool
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> DryRun
-> XmlOutput
-> WithSummary
-> SelectDeps
-> Maybe Bool
-> InheritDefault
-> Maybe String
-> Bool
-> DiffAlgorithm
-> a)
basicOpts
, commandDefaults :: [DarcsFlag]
commandDefaults = forall (d :: * -> *) f b. OptSpec d f [f] b -> [f]
defaultFlags forall {a}.
DarcsOption
a
([MatchFlag]
-> Reorder
-> Maybe Bool
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> DryRun
-> XmlOutput
-> WithSummary
-> SelectDeps
-> Maybe Bool
-> InheritDefault
-> Maybe String
-> Bool
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Verbosity
-> RepoCombinator
-> Compression
-> UseIndex
-> RemoteRepos
-> SetScriptsExecutable
-> UMask
-> Bool
-> WantGuiPause
-> NetworkOptions
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
allOpts
, commandCheckOptions :: [DarcsFlag] -> [String]
commandCheckOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [f] -> [String]
ocheck forall {a}.
DarcsOption
a
([MatchFlag]
-> Reorder
-> Maybe Bool
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> DryRun
-> XmlOutput
-> WithSummary
-> SelectDeps
-> Maybe Bool
-> InheritDefault
-> Maybe String
-> Bool
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Verbosity
-> RepoCombinator
-> Compression
-> UseIndex
-> RemoteRepos
-> SetScriptsExecutable
-> UMask
-> Bool
-> WantGuiPause
-> NetworkOptions
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
allOpts
}
where
basicOpts :: OptSpec
DarcsOptDescr
DarcsFlag
a
([MatchFlag]
-> Reorder
-> Maybe Bool
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> DryRun
-> XmlOutput
-> WithSummary
-> SelectDeps
-> Maybe Bool
-> InheritDefault
-> Maybe String
-> Bool
-> DiffAlgorithm
-> a)
basicOpts
= MatchOption
O.matchSeveral
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption Reorder
O.reorder
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption (Maybe Bool)
O.interactive
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption (Maybe AllowConflicts)
O.conflictsYes
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption ExternalMerge
O.externalMerge
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption RunTest
O.runTest
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ forall a. DarcsOption a (DryRun -> XmlOutput -> a)
O.dryRunXml
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption WithSummary
O.withSummary
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption SelectDeps
O.selectDeps
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption (Maybe Bool)
O.setDefault
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption InheritDefault
O.inheritDefault
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption (Maybe String)
O.repoDir
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption Bool
O.allowUnrelatedRepos
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption DiffAlgorithm
O.diffAlgorithm
advancedOpts :: OptSpec
DarcsOptDescr
DarcsFlag
a
(RepoCombinator
-> Compression
-> UseIndex
-> RemoteRepos
-> SetScriptsExecutable
-> UMask
-> Bool
-> WantGuiPause
-> NetworkOptions
-> a)
advancedOpts
= PrimDarcsOption RepoCombinator
O.repoCombinator
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption Compression
O.compress
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption UseIndex
O.useIndex
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption RemoteRepos
O.remoteRepos
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption SetScriptsExecutable
O.setScriptsExecutable
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption UMask
O.umask
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption Bool
O.changesReverse
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption WantGuiPause
O.pauseForGui
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption NetworkOptions
O.network
allOpts :: DarcsOption
a
([MatchFlag]
-> Reorder
-> Maybe Bool
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> DryRun
-> XmlOutput
-> WithSummary
-> SelectDeps
-> Maybe Bool
-> InheritDefault
-> Maybe String
-> Bool
-> DiffAlgorithm
-> Maybe StdCmdAction
-> Verbosity
-> RepoCombinator
-> Compression
-> UseIndex
-> RemoteRepos
-> SetScriptsExecutable
-> UMask
-> Bool
-> WantGuiPause
-> NetworkOptions
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
allOpts = forall {a}.
OptSpec
DarcsOptDescr
DarcsFlag
a
([MatchFlag]
-> Reorder
-> Maybe Bool
-> Maybe AllowConflicts
-> ExternalMerge
-> RunTest
-> DryRun
-> XmlOutput
-> WithSummary
-> SelectDeps
-> Maybe Bool
-> InheritDefault
-> Maybe String
-> Bool
-> DiffAlgorithm
-> a)
basicOpts forall b c a.
DarcsOption (Maybe StdCmdAction -> Verbosity -> b) c
-> DarcsOption
(UseCache -> HooksConfig -> Bool -> Bool -> Bool -> a) b
-> DarcsOption a c
`withStdOpts` forall {a}.
OptSpec
DarcsOptDescr
DarcsFlag
a
(RepoCombinator
-> Compression
-> UseIndex
-> RemoteRepos
-> SetScriptsExecutable
-> UMask
-> Bool
-> WantGuiPause
-> NetworkOptions
-> a)
advancedOpts
pullCmd
:: PatchApplier pa
=> pa -> (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
pullCmd :: forall pa.
PatchApplier pa =>
pa
-> (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
pullCmd pa
patchApplier (AbsolutePath
_,AbsolutePath
o) [DarcsFlag]
opts [String]
repos =
do
[String]
pullingFrom <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (AbsolutePath -> String -> IO String
fixUrl AbsolutePath
o) [String]
repos
forall a.
DryRun -> UseCache -> UpdatePending -> UMask -> RepoJob a -> IO a
withRepoLock (PrimDarcsOption DryRun
dryRun forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (PrimDarcsOption UseCache
useCache forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) UpdatePending
YesUpdatePending (PrimDarcsOption UMask
umask forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) forall a b. (a -> b) -> a -> b
$
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 a b. (a -> b) -> a -> b
$ \PatchProxy p
patchProxy Repository rt p wR wU wR
initRepo -> do
let repository :: Repository rt p wR wU wR
repository = forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(Cache -> Cache)
-> Repository rt p wR wU wT -> Repository rt p wR wU wT
modifyCache ([String] -> Cache -> Cache
addReposToCache [String]
pullingFrom) Repository rt p wR wU wR
initRepo
Sealed Fork
(PatchSet rt p)
(FL (PatchInfoAnd rt p))
(FL (PatchInfoAnd rt p))
Origin
wR
wX
fork <- forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
AbsolutePath
-> [DarcsFlag]
-> [String]
-> String
-> Repository rt p wR wU wR
-> IO
(Sealed
(Fork
(PatchSet rt p)
(FL (PatchInfoAnd rt p))
(FL (PatchInfoAnd rt p))
Origin
wR))
fetchPatches AbsolutePath
o [DarcsFlag]
opts [String]
repos String
"pull" Repository rt p wR wU wR
repository
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
"pull" [DarcsFlag]
opts Repository rt p wR wU wR
repository Fork
(PatchSet rt p)
(FL (PatchInfoAnd rt p))
(FL (PatchInfoAnd rt p))
Origin
wR
wX
fork
where
addReposToCache :: [String] -> Cache -> Cache
addReposToCache [String]
repos' Cache
cache =
[CacheLoc] -> Cache
mkCache forall a b. (a -> b) -> a -> b
$ [ String -> CacheLoc
toReadOnlyCache String
r | String
r <- [String]
repos' ] forall a. [a] -> [a] -> [a]
++ Cache -> [CacheLoc]
cacheEntries Cache
cache
toReadOnlyCache :: String -> CacheLoc
toReadOnlyCache = CacheType -> WritableOrNot -> String -> CacheLoc
Cache CacheType
Repo WritableOrNot
NotWritable
fetchCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
fetchCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
fetchCmd (AbsolutePath
_,AbsolutePath
o) [DarcsFlag]
opts [String]
repos =
forall a.
DryRun -> UseCache -> UpdatePending -> UMask -> RepoJob a -> IO a
withRepoLock (PrimDarcsOption DryRun
dryRun forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (PrimDarcsOption UseCache
useCache forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) UpdatePending
YesUpdatePending (PrimDarcsOption UMask
umask forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) forall a b. (a -> b) -> a -> b
$ 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 a b. (a -> b) -> a -> b
$
forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
AbsolutePath
-> [DarcsFlag]
-> [String]
-> String
-> Repository rt p wR wU wR
-> IO
(Sealed
(Fork
(PatchSet rt p)
(FL (PatchInfoAnd rt p))
(FL (PatchInfoAnd rt p))
Origin
wR))
fetchPatches AbsolutePath
o [DarcsFlag]
opts [String]
repos String
"fetch" forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (rt :: RepoType) (p :: * -> * -> *) wR.
(RepoPatch p, ApplyState p ~ Tree) =>
[DarcsFlag]
-> Sealed
(Fork
(PatchSet rt p)
(FL (PatchInfoAnd rt p))
(FL (PatchInfoAnd rt p))
Origin
wR)
-> IO ()
makeBundle [DarcsFlag]
opts
fetchPatches :: forall rt p wR wU . (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree)
=> AbsolutePath -> [DarcsFlag] -> [String] -> String
-> Repository rt p wR wU wR
-> IO (Sealed (Fork (PatchSet rt p)
(FL (PatchInfoAnd rt p))
(FL (PatchInfoAnd rt p)) Origin wR))
fetchPatches :: forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
AbsolutePath
-> [DarcsFlag]
-> [String]
-> String
-> Repository rt p wR wU wR
-> IO
(Sealed
(Fork
(PatchSet rt p)
(FL (PatchInfoAnd rt p))
(FL (PatchInfoAnd rt p))
Origin
wR))
fetchPatches AbsolutePath
o [DarcsFlag]
opts unfixedrepodirs :: [String]
unfixedrepodirs@(String
_:[String]
_) String
jobname Repository rt p wR wU wR
repository = do
String
here <- IO String
getCurrentDirectory
[String]
repodirs <- (forall a. Eq a => [a] -> [a]
nub forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= String
here)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (AbsolutePath -> String -> IO String
fixUrl AbsolutePath
o) [String]
unfixedrepodirs
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
repodirs) forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Can't pull from current repository!"
[String]
old_default <- String -> IO [String]
getPreflist String
"defaultrepo"
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([String]
old_default forall a. Eq a => a -> a -> Bool
== [String]
repodirs Bool -> Bool -> Bool
&& Bool -> Bool
not ([DarcsFlag] -> Bool
hasXmlOutput [DarcsFlag]
opts)) forall a b. (a -> b) -> a -> b
$
let pulling :: String
pulling = case PrimDarcsOption DryRun
dryRun forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts of
DryRun
O.YesDryRun -> String
"Would pull"
DryRun
O.NoDryRun -> String
"Pulling"
in [DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
opts forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
pulling Doc -> Doc -> Doc
<+> Doc
"from" Doc -> Doc -> Doc
<+> [Doc] -> Doc
hsep (forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
quoted [String]
repodirs) forall a. Semigroup a => a -> a -> a
<> Doc
"..."
(Sealed PatchSet rt p Origin wX
them, Sealed PatchSet rt p Origin wX
compl) <- forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
Repository rt p wR wU wT
-> [DarcsFlag]
-> [String]
-> IO (SealedPatchSet rt p Origin, SealedPatchSet rt p Origin)
readRepos Repository rt p wR wU wR
repository [DarcsFlag]
opts [String]
repodirs
String
-> DryRun
-> RemoteRepos
-> SetDefault
-> InheritDefault
-> Bool
-> IO ()
addRepoSource (forall a. [a] -> a
head [String]
repodirs) (PrimDarcsOption DryRun
dryRun forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (PrimDarcsOption RemoteRepos
remoteRepos forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
(Bool -> [DarcsFlag] -> SetDefault
setDefault Bool
False [DarcsFlag]
opts) (PrimDarcsOption InheritDefault
O.inheritDefault forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (Bool -> [DarcsFlag] -> Bool
isInteractive Bool
True [DarcsFlag]
opts)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> String -> IO ()
addToPreflist String
"repos") [String]
repodirs
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([DarcsFlag] -> Bool
quiet [DarcsFlag]
opts Bool -> Bool -> Bool
|| [DarcsFlag] -> Bool
hasXmlOutput [DarcsFlag]
opts) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
showMotd [String]
repodirs
PatchSet rt p Origin wR
us <- 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
forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
RepoPatch p =>
Bool -> PatchSet rt p Origin wX -> PatchSet rt p Origin wY -> IO ()
checkUnrelatedRepos (forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags PrimDarcsOption Bool
O.allowUnrelatedRepos [DarcsFlag]
opts) PatchSet rt p Origin wR
us PatchSet rt p Origin wX
them
Fork PatchSet rt p Origin wU
common FL (PatchInfoAnd rt p) wU wR
us' FL (PatchInfoAnd rt p) wU wX
them' <- forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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
FL (PatchInfoAnd rt p) wZ wR
_ :\/: FL (PatchInfoAnd rt p) wZ wX
compl' <- forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
Commute p =>
PatchSet rt p Origin wX
-> PatchSet rt p Origin wY
-> (:\/:) (FL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt p)) wX wY
findUncommon PatchSet rt p Origin wR
us PatchSet rt p Origin wX
compl
let avoided :: [PatchInfo]
avoided = forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> PatchInfo
info FL (PatchInfoAnd rt p) wZ wX
compl'
FL (PatchInfoAnd rt p) wU wZ
ps :> (:>) (FL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt p)) wZ wX
_ <- forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) wX wY.
Commute p =>
(forall wU wV. p wU wV -> Bool)
-> FL p wX wY -> (:>) (FL p) (FL p :> FL p) wX wY
partitionFL (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PatchInfo]
avoided) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> PatchInfo
info) FL (PatchInfoAnd rt p) wU wX
them'
[DarcsFlag] -> Doc -> IO ()
putVerbose [DarcsFlag]
opts forall a b. (a -> b) -> a -> b
$
case FL (PatchInfoAnd rt p) wU wR
us' of
(x :: FL (PatchInfoAnd rt p) wU wR
x@(PatchInfoAnd rt p wU wY
_ :>: FL (PatchInfoAnd rt p) wY wR
_)) ->
String -> Doc
text String
"We have the following new (to them) patches:" Doc -> Doc -> Doc
$$
[Doc] -> Doc
vcat (forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL forall (p :: * -> * -> *) wX wY. ShowPatch p => p wX wY -> Doc
description FL (PatchInfoAnd rt p) wU wR
x)
FL (PatchInfoAnd rt p) wU wR
_ -> forall a. Monoid a => a
mempty
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Bool
nullFL FL (PatchInfoAnd rt p) wU wZ
ps) forall a b. (a -> b) -> a -> b
$ [DarcsFlag] -> Doc -> IO ()
putVerbose [DarcsFlag]
opts forall a b. (a -> b) -> a -> b
$
String -> Doc
text String
"They have the following patches to pull:" Doc -> Doc -> Doc
$$
[Doc] -> Doc
vcat (forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL forall (p :: * -> * -> *) wX wY. ShowPatch p => p wX wY -> Doc
description FL (PatchInfoAnd rt p) wU wZ
ps)
(Bool
hadConflicts, Sealed FL (PatchInfoAnd rt p) wU wX
psFiltered)
<- if PrimDarcsOption (Maybe AllowConflicts)
O.conflictsYes forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts forall a. Eq a => a -> a -> Bool
== forall a. Maybe a
Nothing
then 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 wZ
ps
else forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, forall (a :: * -> *) wX. a wX -> Sealed a
Sealed FL (PatchInfoAnd rt p) wU wZ
ps)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
hadConflicts forall a b. (a -> b) -> a -> b
$ [DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
opts forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"Skipping some patches which would cause conflicts."
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Bool
nullFL FL (PatchInfoAnd rt p) wU wX
psFiltered) forall a b. (a -> b) -> a -> b
$ do [DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
opts forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"No remote patches to pull in!"
forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
RepoPatch p =>
FL (PatchInfoAnd rt p) wX wY -> IO ()
setEnvDarcsPatches FL (PatchInfoAnd rt p) wU wX
psFiltered
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PrimDarcsOption Reorder
reorder forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts forall a. Eq a => a -> a -> Bool
/= Reorder
O.Reorder) forall a. IO a
exitSuccess
let direction :: WhichChanges
direction = if PrimDarcsOption Bool
changesReverse 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 = forall (p :: * -> * -> *).
Matchable p =>
WhichChanges
-> String
-> PatchSelectionOptions
-> Maybe (Splitter p)
-> Maybe [AnchoredPath]
-> SelectionConfig p
selectionConfig WhichChanges
direction String
jobname ([DarcsFlag] -> PatchSelectionOptions
pullPatchSelOpts [DarcsFlag]
opts) forall a. Maybe a
Nothing forall a. Maybe a
Nothing
(FL (PatchInfoAnd rt p) wU wZ
to_be_pulled :> FL (PatchInfoAnd rt p) wZ 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
psFiltered SelectionConfig (PatchInfoAnd rt p)
selection_config
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (a :: * -> *) wX. a wX -> Sealed a
Sealed (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_pulled))
fetchPatches AbsolutePath
_ [DarcsFlag]
_ [] String
jobname Repository rt p wR wU wR
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$
String
"No default repository to " forall a. [a] -> [a] -> [a]
++ String
jobname forall a. [a] -> [a] -> [a]
++ String
" from, please specify one"
makeBundle :: forall rt p wR . (RepoPatch p, ApplyState p ~ Tree)
=> [DarcsFlag]
-> (Sealed (Fork (PatchSet rt p)
(FL (PatchInfoAnd rt p))
(FL (PatchInfoAnd rt p)) Origin wR))
-> IO ()
makeBundle :: forall (rt :: RepoType) (p :: * -> * -> *) wR.
(RepoPatch p, ApplyState p ~ Tree) =>
[DarcsFlag]
-> Sealed
(Fork
(PatchSet rt p)
(FL (PatchInfoAnd rt p))
(FL (PatchInfoAnd rt p))
Origin
wR)
-> IO ()
makeBundle [DarcsFlag]
opts (Sealed (Fork PatchSet rt p Origin wU
common FL (PatchInfoAnd rt p) wU wR
_ FL (PatchInfoAnd rt p) wU wX
to_be_fetched)) =
do
Doc
bundle <- forall (p :: * -> * -> *) (rt :: RepoType) wStart wX wY.
(ApplyState p ~ Tree, RepoPatch p) =>
Maybe (Tree IO)
-> PatchSet rt p wStart wX -> FL (Named p) wX wY -> IO Doc
Bundle.makeBundle forall a. Maybe a
Nothing PatchSet rt p Origin wU
common forall a b. (a -> b) -> a -> b
$
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 (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> p wA wB
hopefully FL (PatchInfoAnd rt p) wU wX
to_be_fetched
String
fname <- case FL (PatchInfoAnd rt p) wU wX
to_be_fetched of
(PatchInfoAnd rt p wU wY
x:>:FL (PatchInfoAnd rt p) wY wX
_)-> String -> IO String
getUniqueDPatchName forall a b. (a -> b) -> a -> b
$ forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
PatchInfoAnd rt p wX wY -> String
patchDesc PatchInfoAnd rt p wU wY
x
FL (PatchInfoAnd rt p) wU wX
_ -> forall a. HasCallStack => String -> a
error String
"impossible case"
let o :: AbsolutePathOrStd
o = forall a. a -> Maybe a -> a
fromMaybe AbsolutePathOrStd
stdOut ([DarcsFlag] -> String -> Maybe AbsolutePathOrStd
getOutput [DarcsFlag]
opts String
fname)
forall a. (AbsolutePath -> a) -> a -> AbsolutePathOrStd -> a
useAbsoluteOrStd forall p. FilePathLike p => p -> Doc -> IO ()
writeDocBinFile Doc -> IO ()
putDoc AbsolutePathOrStd
o Doc
bundle
readRepos :: (IsRepoType rt, RepoPatch p)
=> Repository rt p wR wU wT -> [DarcsFlag] -> [String]
-> IO (SealedPatchSet rt p Origin,SealedPatchSet rt p Origin)
readRepos :: forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
Repository rt p wR wU wT
-> [DarcsFlag]
-> [String]
-> IO (SealedPatchSet rt p Origin, SealedPatchSet rt p Origin)
readRepos Repository rt p wR wU wT
_ [DarcsFlag]
_ [] = forall a. HasCallStack => String -> a
error String
"impossible case"
readRepos Repository rt p wR wU wT
to_repo [DarcsFlag]
opts [String]
us =
do [SealedPatchSet rt p Origin]
rs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\String
u -> do Repository rt p Any Any Any
r <- forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT vR vU vT.
ReadingOrWriting
-> Repository rt p wR wU wT
-> UseCache
-> String
-> IO (Repository rt p vR vU vT)
identifyRepositoryFor ReadingOrWriting
Reading Repository rt p wR wU wT
to_repo (PrimDarcsOption UseCache
useCache forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) String
u
PatchSet rt p Origin Any
ps <- 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
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (a :: * -> *) wX. a wX -> Sealed a
seal PatchSet rt p Origin Any
ps) [String]
us
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags PrimDarcsOption RepoCombinator
O.repoCombinator [DarcsFlag]
opts of
RepoCombinator
O.Intersection -> (forall (p :: * -> * -> *) (rt :: RepoType).
Commute p =>
[SealedPatchSet rt p Origin] -> SealedPatchSet rt p Origin
patchSetIntersection [SealedPatchSet rt p Origin]
rs, forall (a :: * -> *) wX. a wX -> Sealed a
seal forall (rt :: RepoType) (p :: * -> * -> *).
PatchSet rt p Origin Origin
emptyPatchSet)
RepoCombinator
O.Complement -> (forall a. [a] -> a
head [SealedPatchSet rt p Origin]
rs, forall (p :: * -> * -> *) (rt :: RepoType).
(Commute p, Merge p, Eq2 p) =>
[SealedPatchSet rt p Origin] -> SealedPatchSet rt p Origin
patchSetUnion forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
tail [SealedPatchSet rt p Origin]
rs)
RepoCombinator
O.Union -> (forall (p :: * -> * -> *) (rt :: RepoType).
(Commute p, Merge p, Eq2 p) =>
[SealedPatchSet rt p Origin] -> SealedPatchSet rt p Origin
patchSetUnion [SealedPatchSet rt p Origin]
rs, forall (a :: * -> *) wX. a wX -> Sealed a
seal forall (rt :: RepoType) (p :: * -> * -> *).
PatchSet rt p Origin Origin
emptyPatchSet)
pullPatchSelOpts :: [DarcsFlag] -> S.PatchSelectionOptions
pullPatchSelOpts :: [DarcsFlag] -> PatchSelectionOptions
pullPatchSelOpts [DarcsFlag]
flags = S.PatchSelectionOptions
{ verbosity :: Verbosity
S.verbosity = PrimDarcsOption Verbosity
verbosity forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
flags
, matchFlags :: [MatchFlag]
S.matchFlags = forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags MatchOption
O.matchSeveral [DarcsFlag]
flags
, interactive :: Bool
S.interactive = Bool -> [DarcsFlag] -> Bool
isInteractive Bool
True [DarcsFlag]
flags
, selectDeps :: SelectDeps
S.selectDeps = PrimDarcsOption SelectDeps
selectDeps forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
flags
, withSummary :: WithSummary
S.withSummary = PrimDarcsOption WithSummary
O.withSummary forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
flags
, withContext :: WithContext
S.withContext = PrimDarcsOption WithContext
withContext forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
flags
}