1--  Copyright (C) 2005 Florian Weimer
2--
3--  This program is free software; you can redistribute it and/or modify
4--  it under the terms of the GNU General Public License as published by
5--  the Free Software Foundation; either version 2, or (at your option)
6--  any later version.
7--
8--  This program is distributed in the hope that it will be useful,
9--  but WITHOUT ANY WARRANTY; without even the implied warranty of
10--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
11--  GNU General Public License for more details.
12--
13--  You should have received a copy of the GNU General Public License
14--  along with this program; see the file COPYING.  If not, write to
15--  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
16--  Boston, MA 02110-1301, USA.
17
18module Darcs.UI.Commands.ShowFiles ( showFiles ) where
19
20import Darcs.Prelude
21import Data.Maybe ( fromJust, isJust )
22
23import Darcs.Patch ( IsRepoType, RepoPatch )
24import Darcs.Patch.Apply ( ApplyState )
25import Darcs.Patch.Match ( PatchSetMatch, patchSetMatch )
26import Darcs.Repository ( RepoJob(..), Repository, withRepository )
27import Darcs.Repository.Match ( getRecordedUpToMatch )
28import Darcs.Repository.State ( readRecorded, readRecordedAndPending )
29import Darcs.UI.Commands
30    ( DarcsCommand(..)
31    , amInRepository
32    , nodefaults
33    , withStdOpts
34    )
35import Darcs.UI.Completion ( knownFileArgs )
36import Darcs.UI.Flags ( DarcsFlag, pathsFromArgs, useCache )
37import Darcs.UI.Options ( defaultFlags, ocheck, odesc, oid, parseFlags, (?), (^) )
38import qualified Darcs.UI.Options.All as O
39import Darcs.Util.Lock ( withDelayedDir )
40import Darcs.Util.Path
41    ( AbsolutePath
42    , AnchoredPath
43    , anchoredRoot
44    , displayPath
45    , isPrefix
46    )
47import Darcs.Util.Printer ( Doc, text )
48import Darcs.Util.Tree ( Tree, TreeItem(..), expand, list )
49import Darcs.Util.Tree.Plain ( readPlainTree )
50
51showFilesDescription :: String
52showFilesDescription = "Show version-controlled files in the working tree."
53
54showFilesHelp :: Doc
55showFilesHelp = text $
56 "The `darcs show files` command lists those files and directories in\n" ++
57 "the working tree that are under version control.  This command is\n" ++
58 "primarily for scripting purposes; end users will probably want `darcs\n" ++
59 "whatsnew --summary`.\n" ++
60 "\n" ++
61 "A file is \"pending\" if it has been added but not recorded.  By\n" ++
62 "default, pending files (and directories) are listed; the `--no-pending`\n" ++
63 "option prevents this.\n" ++
64 "\n" ++
65 "By default `darcs show files` lists both files and directories, but the\n" ++
66 "`--no-files` and `--no-directories` flags modify this behaviour.\n" ++
67 "\n" ++
68 "By default entries are one-per-line (i.e. newline separated).  This\n" ++
69 "can cause problems if the files themselves contain newlines or other\n" ++
70 "control characters.  To get around this, the `--null` option uses the\n" ++
71 "null character instead.  The script interpreting output from this\n" ++
72 "command needs to understand this idiom; `xargs -0` is such a command.\n" ++
73 "\n" ++
74 "For example, to list version-controlled files by size:\n" ++
75 "\n" ++
76 "    darcs show files -0 | xargs -0 ls -ldS\n"
77
78showFiles :: DarcsCommand
79showFiles = DarcsCommand
80    { commandProgramName = "darcs"
81    , commandName = "files"
82    , commandHelp = showFilesHelp
83    , commandDescription = showFilesDescription
84    , commandExtraArgs = -1
85    , commandExtraArgHelp = ["[FILE or DIRECTORY]..."]
86    , commandCommand = manifestCmd
87    , commandPrereq = amInRepository
88    , commandCompleteArgs = knownFileArgs
89    , commandArgdefaults = nodefaults
90    , commandAdvancedOptions = []
91    , commandBasicOptions = odesc showFilesBasicOpts
92    , commandDefaults = defaultFlags showFilesOpts
93    , commandCheckOptions = ocheck showFilesOpts
94    }
95  where
96    showFilesBasicOpts
97      = O.files
98      ^ O.directories
99      ^ O.pending
100      ^ O.nullFlag
101      ^ O.matchUpToOne
102      ^ O.repoDir
103    showFilesOpts = showFilesBasicOpts `withStdOpts` oid
104
105manifestCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
106manifestCmd fps opts args = do
107    paths <- pathsFromArgs fps args
108    mapM_ output =<< manifestHelper opts paths
109  where
110    output_null name = do { putStr name ; putChar '\0' }
111    output = if parseFlags O.nullFlag opts then output_null else putStrLn
112
113manifestHelper :: [DarcsFlag] -> [AnchoredPath] -> IO [FilePath]
114manifestHelper opts prefixes =
115  fmap (map displayPath . onlysubdirs prefixes . listFilesOrDirs) $
116    withRepository (useCache ? opts) $ RepoJob $ \r -> do
117      let mpsm = patchSetMatch matchFlags
118          fUpto = isJust mpsm
119          fPending = parseFlags O.pending opts
120      -- this covers all 4 possibilities
121      case (fUpto,fPending) of
122        (True, False) -> slurpUpto (fromJust mpsm) r
123        (True, True)  -> fail "can't mix match and pending flags"
124        (False,False) -> expand =<< readRecorded r
125        (False,True)  -> expand =<< readRecordedAndPending r -- pending is default
126  where
127    matchFlags = parseFlags O.matchUpToOne opts
128
129    onlysubdirs [] = id
130    onlysubdirs dirs = filter (\p -> any (`isPrefix` p) dirs)
131
132    listFilesOrDirs :: Tree IO -> [AnchoredPath]
133    listFilesOrDirs =
134        filesDirs (parseFlags O.files opts) (parseFlags O.directories opts)
135      where
136        filesDirs False False _ = []
137        filesDirs False True t = anchoredRoot : [p | (p, SubTree _) <- list t]
138        filesDirs True False t = [p | (p, File _) <- list t]
139        filesDirs True True t = anchoredRoot : map fst (list t)
140
141slurpUpto :: (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree)
142          => PatchSetMatch -> Repository rt p wR wU wR -> IO (Tree IO)
143slurpUpto psm r = withDelayedDir "show.files" $ \_ -> do
144  getRecordedUpToMatch r psm
145  -- note: it is important that we expand the tree from inside the
146  -- withDelayedDir action, else it has no effect.
147  expand =<< readPlainTree "."
148