module Darcs.UI.Commands.ShowFiles ( showFiles ) where
import Prelude ()
import Darcs.Prelude
import Darcs.UI.Flags ( DarcsFlag, useCache )
import Darcs.UI.Options ( (^), oid, odesc, ocheck, onormalise
, defaultFlags, parseFlags, (?) )
import qualified Darcs.UI.Options.All as O
import Darcs.UI.Commands ( DarcsCommand(..), withStdOpts, nodefaults, amInRepository )
import Darcs.UI.Completion ( knownFileArgs )
import Darcs.Repository ( Repository, withRepository,
RepoJob(..), repoPatchType )
import Darcs.Patch ( IsRepoType, RepoPatch )
import Darcs.Patch.Apply( ApplyState )
import Darcs.Repository.State ( readRecorded, readRecordedAndPending )
import Darcs.Util.Tree( Tree, TreeItem(..), list, expand )
import Darcs.Util.Tree.Plain( readPlainTree )
import Darcs.Util.Path( anchorPath, AbsolutePath )
import System.FilePath ( splitDirectories )
import Data.List( isPrefixOf )
import Darcs.Patch.Match ( haveNonrangeExplicitMatch )
import Darcs.Repository.Match ( getNonrangeMatch )
import Darcs.Util.Lock ( withDelayedDir )
showFilesDescription :: String
showFilesDescription :: String
showFilesDescription = "Show version-controlled files in the working tree."
showFilesHelp :: String
showFilesHelp :: String
showFilesHelp =
"The `darcs show files` command lists those files and directories in\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"the working tree that are under version control. This command is\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"primarily for scripting purposes; end users will probably want `darcs\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"whatsnew --summary`.\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"A file is \"pending\" if it has been added but not recorded. By\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"default, pending files (and directories) are listed; the `--no-pending`\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"option prevents this.\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"By default `darcs show files` lists both files and directories, but the\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"`--no-files` and `--no-directories` flags modify this behaviour.\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"By default entries are one-per-line (i.e. newline separated). This\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"can cause problems if the files themselves contain newlines or other\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"control characters. To get around this, the `--null` option uses the\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"null character instead. The script interpreting output from this\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"command needs to understand this idiom; `xargs -0` is such a command.\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"For example, to list version-controlled files by size:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
" darcs show files -0 | xargs -0 ls -ldS\n"
showFiles :: DarcsCommand [DarcsFlag]
showFiles :: DarcsCommand [DarcsFlag]
showFiles = 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 = "files"
, commandHelp :: String
commandHelp = String
showFilesHelp
, commandDescription :: String
commandDescription = String
showFilesDescription
, commandExtraArgs :: Int
commandExtraArgs = -1
, commandExtraArgHelp :: [String]
commandExtraArgHelp = ["[FILE or DIRECTORY]..."]
, commandCommand :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
commandCommand = ([DarcsFlag] -> Tree IO -> [String])
-> (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
manifestCmd [DarcsFlag] -> Tree IO -> [String]
forall (m :: * -> *). [DarcsFlag] -> Tree m -> [String]
toListFiles
, commandPrereq :: [DarcsFlag] -> IO (Either String ())
commandPrereq = [DarcsFlag] -> IO (Either String ())
amInRepository
, commandCompleteArgs :: (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
commandCompleteArgs = (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
knownFileArgs
, commandArgdefaults :: [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
commandArgdefaults = [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
nodefaults
, commandAdvancedOptions :: [DarcsOptDescr DarcsFlag]
commandAdvancedOptions = []
, commandBasicOptions :: [DarcsOptDescr DarcsFlag]
commandBasicOptions = OptSpec
DarcsOptDescr
DarcsFlag
Any
(Bool
-> Bool -> Bool -> Bool -> [MatchFlag] -> Maybe String -> Any)
-> [DarcsOptDescr DarcsFlag]
forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc OptSpec
DarcsOptDescr
DarcsFlag
Any
(Bool
-> Bool -> Bool -> Bool -> [MatchFlag] -> Maybe String -> Any)
forall a.
OptSpec
DarcsOptDescr
DarcsFlag
a
(Bool -> Bool -> Bool -> Bool -> [MatchFlag] -> Maybe String -> a)
showFilesBasicOpts
, commandDefaults :: [DarcsFlag]
commandDefaults = OptSpec
DarcsOptDescr
DarcsFlag
[DarcsFlag]
(Bool
-> Bool
-> Bool
-> Bool
-> [MatchFlag]
-> Maybe String
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> UseCache
-> HooksConfig
-> [DarcsFlag])
-> [DarcsFlag]
forall (d :: * -> *) f b. OptSpec d f [f] b -> [f]
defaultFlags OptSpec
DarcsOptDescr
DarcsFlag
[DarcsFlag]
(Bool
-> Bool
-> Bool
-> Bool
-> [MatchFlag]
-> Maybe String
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> UseCache
-> HooksConfig
-> [DarcsFlag])
forall a.
DarcsOption
a
(Bool
-> Bool
-> Bool
-> Bool
-> [MatchFlag]
-> Maybe String
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> UseCache
-> HooksConfig
-> a)
showFilesOpts
, commandCheckOptions :: [DarcsFlag] -> [String]
commandCheckOptions = OptSpec
DarcsOptDescr
DarcsFlag
Any
(Bool
-> Bool
-> Bool
-> Bool
-> [MatchFlag]
-> Maybe String
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> UseCache
-> HooksConfig
-> Any)
-> [DarcsFlag] -> [String]
forall (d :: * -> *) f a b. OptSpec d f a b -> [f] -> [String]
ocheck OptSpec
DarcsOptDescr
DarcsFlag
Any
(Bool
-> Bool
-> Bool
-> Bool
-> [MatchFlag]
-> Maybe String
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> UseCache
-> HooksConfig
-> Any)
forall a.
DarcsOption
a
(Bool
-> Bool
-> Bool
-> Bool
-> [MatchFlag]
-> Maybe String
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> UseCache
-> HooksConfig
-> a)
showFilesOpts
, commandParseOptions :: [DarcsFlag] -> [DarcsFlag]
commandParseOptions = OptSpec
DarcsOptDescr
DarcsFlag
[DarcsFlag]
(Bool
-> Bool
-> Bool
-> Bool
-> [MatchFlag]
-> Maybe String
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> UseCache
-> HooksConfig
-> [DarcsFlag])
-> [DarcsFlag] -> [DarcsFlag]
forall (d :: * -> *) f b. OptSpec d f [f] b -> [f] -> [f]
onormalise OptSpec
DarcsOptDescr
DarcsFlag
[DarcsFlag]
(Bool
-> Bool
-> Bool
-> Bool
-> [MatchFlag]
-> Maybe String
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> UseCache
-> HooksConfig
-> [DarcsFlag])
forall a.
DarcsOption
a
(Bool
-> Bool
-> Bool
-> Bool
-> [MatchFlag]
-> Maybe String
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> UseCache
-> HooksConfig
-> a)
showFilesOpts
}
where
showFilesBasicOpts :: OptSpec
DarcsOptDescr
DarcsFlag
a
(Bool -> Bool -> Bool -> Bool -> [MatchFlag] -> Maybe String -> a)
showFilesBasicOpts
= PrimOptSpec
DarcsOptDescr
DarcsFlag
(Bool -> Bool -> Bool -> [MatchFlag] -> Maybe String -> a)
Bool
PrimDarcsOption Bool
O.files
PrimOptSpec
DarcsOptDescr
DarcsFlag
(Bool -> Bool -> Bool -> [MatchFlag] -> Maybe String -> a)
Bool
-> OptSpec
DarcsOptDescr
DarcsFlag
(Bool -> Bool -> [MatchFlag] -> Maybe String -> a)
(Bool -> Bool -> Bool -> [MatchFlag] -> Maybe String -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(Bool -> Bool -> [MatchFlag] -> Maybe String -> a)
(Bool -> Bool -> Bool -> Bool -> [MatchFlag] -> 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
(Bool -> Bool -> [MatchFlag] -> Maybe String -> a)
(Bool -> Bool -> Bool -> [MatchFlag] -> Maybe String -> a)
PrimDarcsOption Bool
O.directories
OptSpec
DarcsOptDescr
DarcsFlag
(Bool -> Bool -> [MatchFlag] -> Maybe String -> a)
(Bool -> Bool -> Bool -> Bool -> [MatchFlag] -> Maybe String -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(Bool -> [MatchFlag] -> Maybe String -> a)
(Bool -> Bool -> [MatchFlag] -> Maybe String -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(Bool -> [MatchFlag] -> Maybe String -> a)
(Bool -> Bool -> Bool -> Bool -> [MatchFlag] -> 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
(Bool -> [MatchFlag] -> Maybe String -> a)
(Bool -> Bool -> [MatchFlag] -> Maybe String -> a)
PrimDarcsOption Bool
O.pending
OptSpec
DarcsOptDescr
DarcsFlag
(Bool -> [MatchFlag] -> Maybe String -> a)
(Bool -> Bool -> Bool -> Bool -> [MatchFlag] -> Maybe String -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
([MatchFlag] -> Maybe String -> a)
(Bool -> [MatchFlag] -> Maybe String -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
([MatchFlag] -> Maybe String -> a)
(Bool -> Bool -> Bool -> Bool -> [MatchFlag] -> 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
([MatchFlag] -> Maybe String -> a)
(Bool -> [MatchFlag] -> Maybe String -> a)
PrimDarcsOption Bool
O.nullFlag
OptSpec
DarcsOptDescr
DarcsFlag
([MatchFlag] -> Maybe String -> a)
(Bool -> Bool -> Bool -> Bool -> [MatchFlag] -> Maybe String -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(Maybe String -> a)
([MatchFlag] -> Maybe String -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(Maybe String -> a)
(Bool -> Bool -> Bool -> Bool -> [MatchFlag] -> 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)
([MatchFlag] -> Maybe String -> a)
MatchOption
O.matchUpToOne
OptSpec
DarcsOptDescr
DarcsFlag
(Maybe String -> a)
(Bool -> Bool -> Bool -> Bool -> [MatchFlag] -> Maybe String -> a)
-> OptSpec DarcsOptDescr DarcsFlag a (Maybe String -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
a
(Bool -> Bool -> Bool -> Bool -> [MatchFlag] -> 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
showFilesOpts :: DarcsOption
a
(Bool
-> Bool
-> Bool
-> Bool
-> [MatchFlag]
-> Maybe String
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> UseCache
-> HooksConfig
-> a)
showFilesOpts = OptSpec
DarcsOptDescr
DarcsFlag
(Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> UseCache
-> HooksConfig
-> a)
(Bool
-> Bool
-> Bool
-> Bool
-> [MatchFlag]
-> Maybe String
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> UseCache
-> HooksConfig
-> a)
forall a.
OptSpec
DarcsOptDescr
DarcsFlag
a
(Bool -> Bool -> Bool -> Bool -> [MatchFlag] -> Maybe String -> a)
showFilesBasicOpts OptSpec
DarcsOptDescr
DarcsFlag
(Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> UseCache
-> HooksConfig
-> a)
(Bool
-> Bool
-> Bool
-> Bool
-> [MatchFlag]
-> Maybe String
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> UseCache
-> HooksConfig
-> a)
-> DarcsOption
(UseCache -> HooksConfig -> a) (UseCache -> HooksConfig -> a)
-> DarcsOption
a
(Bool
-> Bool
-> Bool
-> Bool
-> [MatchFlag]
-> Maybe String
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> 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) (UseCache -> HooksConfig -> a)
forall (d :: * -> *) f a. OptSpec d f a a
oid
toListFiles :: [DarcsFlag] -> Tree m -> [FilePath]
toListFiles :: [DarcsFlag] -> Tree m -> [String]
toListFiles opts :: [DarcsFlag]
opts = Bool -> Bool -> Tree m -> [String]
forall (m :: * -> *). Bool -> Bool -> Tree m -> [String]
filesDirs (PrimDarcsOption Bool -> [DarcsFlag] -> Bool
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags PrimDarcsOption Bool
O.files [DarcsFlag]
opts) (PrimDarcsOption Bool -> [DarcsFlag] -> Bool
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags PrimDarcsOption Bool
O.directories [DarcsFlag]
opts)
filesDirs :: Bool -> Bool -> Tree m -> [FilePath]
filesDirs :: Bool -> Bool -> Tree m -> [String]
filesDirs False False _ = []
filesDirs False True t :: Tree m
t = "." String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [ String -> AnchoredPath -> String
anchorPath "." AnchoredPath
p | (p :: AnchoredPath
p, SubTree _) <- Tree m -> [(AnchoredPath, TreeItem m)]
forall (m :: * -> *). Tree m -> [(AnchoredPath, TreeItem m)]
list Tree m
t ]
filesDirs True False t :: Tree m
t = [ String -> AnchoredPath -> String
anchorPath "." AnchoredPath
p | (p :: AnchoredPath
p, File _) <- Tree m -> [(AnchoredPath, TreeItem m)]
forall (m :: * -> *). Tree m -> [(AnchoredPath, TreeItem m)]
list Tree m
t ]
filesDirs True True t :: Tree m
t = "." String -> [String] -> [String]
forall a. a -> [a] -> [a]
: ((AnchoredPath, TreeItem m) -> String)
-> [(AnchoredPath, TreeItem m)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> AnchoredPath -> String
anchorPath "." (AnchoredPath -> String)
-> ((AnchoredPath, TreeItem m) -> AnchoredPath)
-> (AnchoredPath, TreeItem m)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AnchoredPath, TreeItem m) -> AnchoredPath
forall a b. (a, b) -> a
fst) (Tree m -> [(AnchoredPath, TreeItem m)]
forall (m :: * -> *). Tree m -> [(AnchoredPath, TreeItem m)]
list Tree m
t)
manifestCmd :: ([DarcsFlag] -> Tree IO -> [FilePath])
-> (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
manifestCmd :: ([DarcsFlag] -> Tree IO -> [String])
-> (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
manifestCmd to_list :: [DarcsFlag] -> Tree IO -> [String]
to_list _ opts :: [DarcsFlag]
opts argList :: [String]
argList =
(String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
output ([String] -> IO ()) -> IO [String] -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ([DarcsFlag] -> Tree IO -> [String])
-> [DarcsFlag] -> [String] -> IO [String]
manifestHelper [DarcsFlag] -> Tree IO -> [String]
to_list [DarcsFlag]
opts [String]
argList
where
output_null :: String -> IO ()
output_null name :: String
name = do { String -> IO ()
putStr String
name ; Char -> IO ()
putChar '\0' }
output :: String -> IO ()
output = if PrimDarcsOption Bool -> [DarcsFlag] -> Bool
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags PrimDarcsOption Bool
O.nullFlag [DarcsFlag]
opts then String -> IO ()
output_null else String -> IO ()
putStrLn
manifestHelper :: ([DarcsFlag] -> Tree IO -> [FilePath]) -> [DarcsFlag] -> [String] -> IO [FilePath]
manifestHelper :: ([DarcsFlag] -> Tree IO -> [String])
-> [DarcsFlag] -> [String] -> IO [String]
manifestHelper to_list :: [DarcsFlag] -> Tree IO -> [String]
to_list opts :: [DarcsFlag]
opts argList :: [String]
argList = do
[String]
list' <- [DarcsFlag] -> Tree IO -> [String]
to_list [DarcsFlag]
opts (Tree IO -> [String]) -> IO (Tree IO) -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` UseCache -> RepoJob (Tree IO) -> IO (Tree IO)
forall a. UseCache -> RepoJob a -> IO a
withRepository (PrimDarcsOption UseCache
useCache PrimDarcsOption UseCache -> [DarcsFlag] -> UseCache
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) ((forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wR -> IO (Tree IO))
-> RepoJob (Tree IO)
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 (Tree IO)
slurp)
case [String]
argList of
[] -> [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String]
list'
prefixes :: [String]
prefixes -> [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> [String] -> [String]
forall (t :: * -> *).
Foldable t =>
t String -> [String] -> [String]
onlysubdirs [String]
prefixes [String]
list')
where
matchFlags :: [MatchFlag]
matchFlags = MatchOption -> [DarcsFlag] -> [MatchFlag]
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags MatchOption
O.matchUpToOne [DarcsFlag]
opts
slurp :: (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree)
=> Repository rt p wR wU wR -> IO (Tree IO)
slurp :: Repository rt p wR wU wR -> IO (Tree IO)
slurp r :: Repository rt p wR wU wR
r = do
let fUpto :: Bool
fUpto = PatchType rt p -> [MatchFlag] -> Bool
forall (rt :: RepoType) (p :: * -> * -> *).
(IsRepoType rt, Matchable p) =>
PatchType rt p -> [MatchFlag] -> Bool
haveNonrangeExplicitMatch (Repository rt p wR wU wR -> PatchType rt p
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> PatchType rt p
repoPatchType Repository rt p wR wU wR
r) [MatchFlag]
matchFlags
fPending :: Bool
fPending = PrimDarcsOption Bool -> [DarcsFlag] -> Bool
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags PrimDarcsOption Bool
O.pending [DarcsFlag]
opts
case (Bool
fUpto,Bool
fPending) of
(True, False) -> [MatchFlag] -> Repository rt p wR wU wR -> IO (Tree IO)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
[MatchFlag] -> Repository rt p wR wU wR -> IO (Tree IO)
slurpUpto [MatchFlag]
matchFlags Repository rt p wR wU wR
r
(True, True) -> String -> IO (Tree IO)
forall a. HasCallStack => String -> a
error "can't mix match and pending flags"
(False,False) -> Tree IO -> IO (Tree IO)
forall (m :: * -> *). Monad m => Tree m -> m (Tree m)
expand (Tree IO -> IO (Tree IO)) -> IO (Tree IO) -> IO (Tree IO)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Repository rt p wR wU wR -> IO (Tree IO)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> IO (Tree IO)
readRecorded Repository rt p wR wU wR
r
(False,True) -> Tree IO -> IO (Tree IO)
forall (m :: * -> *). Monad m => Tree m -> m (Tree m)
expand (Tree IO -> IO (Tree IO)) -> IO (Tree IO) -> IO (Tree IO)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Repository rt p wR wU wR -> IO (Tree IO)
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT -> IO (Tree IO)
readRecordedAndPending Repository rt p wR wU wR
r
isParentDir :: String -> String -> Bool
isParentDir a' :: String
a' b' :: String
b' =
let a :: [String]
a = String -> [String]
splitDirectories String
a'
b :: [String]
b = String -> [String]
splitDirectories String
b'
in ([String]
a [String] -> [String] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [String]
b) Bool -> Bool -> Bool
|| (("." String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
a) [String] -> [String] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [String]
b)
onlysubdirs :: t String -> [String] -> [String]
onlysubdirs dirs :: t String
dirs = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (\p :: String
p -> (String -> Bool) -> t String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> String -> Bool
`isParentDir` String
p) t String
dirs)
slurpUpto :: (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree)
=> [O.MatchFlag] -> Repository rt p wR wU wR -> IO (Tree IO)
slurpUpto :: [MatchFlag] -> Repository rt p wR wU wR -> IO (Tree IO)
slurpUpto matchFlags :: [MatchFlag]
matchFlags r :: Repository rt p wR wU wR
r = String -> (AbsolutePath -> IO (Tree IO)) -> IO (Tree IO)
forall a. String -> (AbsolutePath -> IO a) -> IO a
withDelayedDir "show.files" ((AbsolutePath -> IO (Tree IO)) -> IO (Tree IO))
-> (AbsolutePath -> IO (Tree IO)) -> IO (Tree IO)
forall a b. (a -> b) -> a -> b
$ \_ -> do
Repository rt p wR wU wR -> [MatchFlag] -> IO ()
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
(ApplyMonad (ApplyState p) DefaultIO, IsRepoType rt, RepoPatch p,
ApplyState p ~ Tree) =>
Repository rt p wR wU wT -> [MatchFlag] -> IO ()
getNonrangeMatch Repository rt p wR wU wR
r [MatchFlag]
matchFlags
Tree IO -> IO (Tree IO)
forall (m :: * -> *). Monad m => Tree m -> m (Tree m)
expand (Tree IO -> IO (Tree IO)) -> IO (Tree IO) -> IO (Tree IO)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO (Tree IO)
readPlainTree "."