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