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