--  Copyright (C) 2005 Florian Weimer
--
--  This program is free software; you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation; either version 2, or (at your option)
--  any later version.
--
--  This program is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--  GNU General Public License for more details.
--
--  You should have received a copy of the GNU General Public License
--  along with this program; see the file COPYING.  If not, write to
--  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
--  Boston, MA 02110-1301, USA.

module Darcs.UI.Commands.ShowFiles ( showFiles ) where

import Darcs.Prelude

import Darcs.Patch.Match ( patchSetMatch )
import Darcs.Repository ( RepoJob(..), withRepository )
import Darcs.Repository.Match ( getPristineUpToMatch )
import Darcs.Repository.State ( readPristine, readPristineAndPending )
import Darcs.UI.Commands
    ( DarcsCommand(..)
    , amInRepository
    , nodefaults
    , withStdOpts
    )
import Darcs.UI.Completion ( knownFileArgs )
import Darcs.UI.Flags ( DarcsFlag, pathsFromArgs, useCache )
import Darcs.UI.Options ( oid, parseFlags, (?), (^) )
import qualified Darcs.UI.Options.All as O
import Darcs.Util.Path
    ( AbsolutePath
    , AnchoredPath
    , anchoredRoot
    , displayPath
    , isPrefix
    )
import Darcs.Util.Printer ( Doc, text )
import Darcs.Util.Tree ( Tree, TreeItem(..), expand, list )

showFilesDescription :: String
showFilesDescription :: String
showFilesDescription = String
"Show version-controlled files in the working tree."

showFilesHelp :: Doc
showFilesHelp :: Doc
showFilesHelp = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$
 String
"The `darcs show files` command lists those files and directories in\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 String
"the working tree that are under version control.  This command is\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 String
"primarily for scripting purposes; end users will probably want `darcs\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 String
"whatsnew --summary`.\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 String
"A file is \"pending\" if it has been added but not recorded.  By\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 String
"default, pending files (and directories) are listed; the `--no-pending`\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 String
"option prevents this.\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 String
"By default `darcs show files` lists both files and directories, but the\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 String
"`--no-files` and `--no-directories` flags modify this behaviour.\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 String
"By default entries are one-per-line (i.e. newline separated).  This\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 String
"can cause problems if the files themselves contain newlines or other\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 String
"control characters.  To get around this, the `--null` option uses the\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 String
"null character instead.  The script interpreting output from this\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 String
"command needs to understand this idiom; `xargs -0` is such a command.\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 String
"For example, to list version-controlled files by size:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 String
"\n" String -> String -> String
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
    , commandOptions :: CommandOptions
commandOptions = CommandOptions
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 :: CommandOptions
showFilesOpts = OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Verbosity
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
  (Bool
   -> Bool
   -> Bool
   -> Bool
   -> [MatchFlag]
   -> Maybe String
   -> Maybe StdCmdAction
   -> Verbosity
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
forall {a}.
OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  (Bool -> Bool -> Bool -> Bool -> [MatchFlag] -> Maybe String -> a)
showFilesBasicOpts OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Verbosity
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
  (Bool
   -> Bool
   -> Bool
   -> Bool
   -> [MatchFlag]
   -> Maybe String
   -> Maybe StdCmdAction
   -> Verbosity
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
-> DarcsOption
     (UseCache
      -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
     (UseCache
      -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
-> CommandOptions
forall b c.
DarcsOption (Maybe StdCmdAction -> Verbosity -> b) c
-> DarcsOption
     (UseCache
      -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
     b
-> CommandOptions
`withStdOpts` DarcsOption
  (UseCache
   -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
  (UseCache
   -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
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
    (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] -> [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 PrimDarcsOption Bool -> [DarcsFlag] -> Bool
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags PrimOptSpec DarcsOptDescr DarcsFlag a Bool
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 =
  (Tree IO -> [String]) -> IO (Tree IO) -> IO [String]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((AnchoredPath -> String) -> [AnchoredPath] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map AnchoredPath -> String
displayPath ([AnchoredPath] -> [String])
-> (Tree IO -> [AnchoredPath]) -> Tree IO -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AnchoredPath] -> [AnchoredPath] -> [AnchoredPath]
onlysubdirs [AnchoredPath]
prefixes ([AnchoredPath] -> [AnchoredPath])
-> (Tree IO -> [AnchoredPath]) -> Tree IO -> [AnchoredPath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree IO -> [AnchoredPath]
listFilesOrDirs) (IO (Tree IO) -> IO [String]) -> IO (Tree IO) -> IO [String]
forall a b. (a -> b) -> a -> b
$
    UseCache -> RepoJob 'RO (Tree IO) -> IO (Tree IO)
forall a. UseCache -> RepoJob 'RO a -> IO a
withRepository (PrimOptSpec DarcsOptDescr DarcsFlag a UseCache
PrimDarcsOption UseCache
useCache PrimDarcsOption UseCache -> [DarcsFlag] -> UseCache
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (RepoJob 'RO (Tree IO) -> IO (Tree IO))
-> RepoJob 'RO (Tree IO) -> IO (Tree IO)
forall a b. (a -> b) -> a -> b
$ TreePatchJob 'RO (Tree IO) -> RepoJob 'RO (Tree IO)
forall (rt :: AccessType) a. TreePatchJob rt a -> RepoJob rt a
RepoJob (TreePatchJob 'RO (Tree IO) -> RepoJob 'RO (Tree IO))
-> TreePatchJob 'RO (Tree IO) -> RepoJob 'RO (Tree IO)
forall a b. (a -> b) -> a -> b
$ \Repository 'RO p wU wR
r -> do
      case ([MatchFlag] -> Maybe PatchSetMatch
patchSetMatch [MatchFlag]
matchFlags, PrimDarcsOption Bool -> [DarcsFlag] -> Bool
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags PrimOptSpec DarcsOptDescr DarcsFlag a Bool
PrimDarcsOption Bool
O.pending [DarcsFlag]
opts) of
        (Maybe PatchSetMatch
Nothing, Bool
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 'RO p wU wR -> IO (Tree IO)
forall (rt :: AccessType) (p :: * -> * -> *) wU wR.
Repository rt p wU wR -> IO (Tree IO)
readPristine Repository 'RO p wU wR
r
        (Maybe PatchSetMatch
Nothing, Bool
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 'RO p wU wR -> IO (Tree IO)
forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wU wR -> IO (Tree IO)
readPristineAndPending Repository 'RO p wU wR
r
        (Just PatchSetMatch
psm, Bool
False) -> Repository 'RO p wU wR -> PatchSetMatch -> IO (Tree IO)
forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wU wR -> PatchSetMatch -> IO (Tree IO)
getPristineUpToMatch Repository 'RO p wU wR
r PatchSetMatch
psm
        (Just PatchSetMatch
_, Bool
True)    -> String -> IO (Tree IO)
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"can't mix match and pending flags"
  where
    matchFlags :: [MatchFlag]
matchFlags = MatchOption -> [DarcsFlag] -> [MatchFlag]
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags PrimOptSpec DarcsOptDescr DarcsFlag a [MatchFlag]
MatchOption
O.matchUpToOne [DarcsFlag]
opts

    onlysubdirs :: [AnchoredPath] -> [AnchoredPath] -> [AnchoredPath]
onlysubdirs [] = [AnchoredPath] -> [AnchoredPath]
forall a. a -> a
id
    onlysubdirs [AnchoredPath]
dirs = (AnchoredPath -> Bool) -> [AnchoredPath] -> [AnchoredPath]
forall a. (a -> Bool) -> [a] -> [a]
filter (\AnchoredPath
p -> (AnchoredPath -> Bool) -> [AnchoredPath] -> Bool
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 =
        Bool -> Bool -> Tree IO -> [AnchoredPath]
forall {m :: * -> *}. Bool -> Bool -> Tree m -> [AnchoredPath]
filesDirs (PrimDarcsOption Bool -> [DarcsFlag] -> Bool
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags PrimOptSpec DarcsOptDescr DarcsFlag a Bool
PrimDarcsOption Bool
O.files [DarcsFlag]
opts) (PrimDarcsOption Bool -> [DarcsFlag] -> Bool
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags PrimOptSpec DarcsOptDescr DarcsFlag a Bool
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 AnchoredPath -> [AnchoredPath] -> [AnchoredPath]
forall a. a -> [a] -> [a]
: [AnchoredPath
p | (AnchoredPath
p, SubTree Tree m
_) <- Tree m -> [(AnchoredPath, TreeItem 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
_) <- Tree m -> [(AnchoredPath, TreeItem m)]
forall (m :: * -> *). Tree m -> [(AnchoredPath, TreeItem m)]
list Tree m
t]
        filesDirs Bool
True Bool
True Tree m
t = AnchoredPath
anchoredRoot AnchoredPath -> [AnchoredPath] -> [AnchoredPath]
forall a. a -> [a] -> [a]
: ((AnchoredPath, TreeItem m) -> AnchoredPath)
-> [(AnchoredPath, TreeItem m)] -> [AnchoredPath]
forall a b. (a -> b) -> [a] -> [b]
map (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)