% 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. \darcsCommand{show files} \begin{code} {-# OPTIONS_GHC -cpp #-} {-# LANGUAGE CPP #-} #include "gadts.h" module Darcs.Commands.ShowFiles ( showFiles , manifestCmd, toListManifest -- for alias ) where import Darcs.Arguments ( DarcsFlag(..), workingRepoDir, files, directories, pending, nullFlag, matchOne ) import Darcs.Commands ( DarcsCommand(..), nodefaults ) import Darcs.Repository ( Repository, amInRepository, slurp_pending, slurp_recorded, withRepository ) import Darcs.Patch ( RepoPatch ) import Darcs.SlurpDirectory ( Slurpy, list_slurpy, list_slurpy_files, list_slurpy_dirs, slurp ) import Data.List( isPrefixOf ) import Darcs.Match ( haveNonrangeMatch, getNonrangeMatch ) import Workaround ( getCurrentDirectory ) import Darcs.Lock ( withDelayedDir ) showFilesDescription :: String showFilesDescription = "Show version-controlled files in the working copy." showFilesHelp :: String showFilesHelp = "The `darcs show files' command lists those files and directories in\n" ++ "the working tree that are under version control. This command is\n" ++ "primarily for scripting purposes; end users will probably want `darcs\n" ++ "whatsnew --summary'.\n" ++ "\n" ++ "A file is `pending' if it has been added but not recorded. By\n" ++ "default, pending files (and directories) are listed; the --no-pending\n" ++ "option prevents this.\n" ++ "\n" ++ "By default `darcs show files' lists both files and directories, but\n" ++ "the alias `darcs show manifest' only lists files. The --files,\n" ++ "--directories, --no-files and --no-directories modify this behaviour.\n" ++ "\n" ++ "By default entries are one-per-line (i.e. newline separated). This\n" ++ "can cause problems if the files themselves contain newlines or other\n" ++ "control characters. To get aroudn this, the --null option uses the\n" ++ "null character instead. The script interpreting output from this\n" ++ "command needs to understand this idiom; `xargs -0' is such a command.\n" ++ "\n" ++ "For example, to list version-controlled files by size:\n" ++ "\n" ++ " darcs show files -0 | xargs -0 ls -ldS\n" showFiles :: DarcsCommand showFiles = DarcsCommand { commandName = "files", commandHelp = showFilesHelp, commandDescription = showFilesDescription, commandExtraArgs = -1, commandExtraArgHelp = ["[FILE or DIRECTORY]..."], commandCommand = manifestCmd toListFiles, commandPrereq = amInRepository, commandGetArgPossibilities = return [], commandArgdefaults = nodefaults, commandAdvancedOptions = [], commandBasicOptions = [files, directories, pending, nullFlag, matchOne, workingRepoDir] } toListFiles, toListManifest :: [DarcsFlag] -> Slurpy -> [FilePath] toListFiles opts = filesDirs (NoFiles `notElem` opts) (NoDirectories `notElem` opts) toListManifest opts = filesDirs (NoFiles `notElem` opts) (Directories `elem` opts) filesDirs :: Bool -> Bool -> Slurpy -> [FilePath] filesDirs False False = \_ -> [] filesDirs False True = list_slurpy_dirs filesDirs True False = list_slurpy_files filesDirs True True = list_slurpy manifestCmd :: ([DarcsFlag] -> Slurpy -> [FilePath]) -> [DarcsFlag] -> [String] -> IO () manifestCmd to_list opts argList = do list <- (to_list opts) `fmap` withRepository opts myslurp case argList of [] -> mapM_ output list prefixes -> mapM_ output (onlysubdirs prefixes list) where myslurp :: RepoPatch p => Repository p C(r u r) -> IO Slurpy myslurp = do let fRevisioned = haveNonrangeMatch opts fPending = Pending `elem` opts fNoPending = NoPending `elem` opts -- this covers all 8 options case (fRevisioned,fPending,fNoPending) of (True,False,_) -> slurp_revision opts (True,True,_) -> error $ "can't mix revisioned and pending flags" (False,False,True) -> slurp_recorded (False,_,False) -> slurp_pending -- pending is default (False,True,True) -> error $ "can't mix pending and no-pending flags" output_null name = do { putStr name ; putChar '\0' } output = if NullFlag `elem` opts then output_null else putStrLn isParentDir a b = a == b || (a ++ "/") `isPrefixOf` b || ("./" ++ a ++ "/") `isPrefixOf` b || "./" ++ a == b onlysubdirs suffixes = filter $ or . mapM isParentDir suffixes slurp_revision :: RepoPatch p => [DarcsFlag] -> Repository p C(r u r) -> IO Slurpy slurp_revision opts r = withDelayedDir "revisioned.showfiles" $ \_ -> do getNonrangeMatch r opts slurp =<< getCurrentDirectory \end{code}