% Copyright (C) 2007 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 tags} \begin{code}
module Darcs.Commands.ShowTags ( showTags ) where
import Darcs.Arguments ( DarcsFlag(..), workingRepoDir )
import Darcs.Commands ( DarcsCommand(..), nodefaults )
import Darcs.Hopefully ( info )
import Darcs.Repository ( amInRepository, read_repo, withRepository, ($-) ) import Darcs.Patch.Info ( pi_tag ) import Darcs.Witnesses.Ordered ( mapRL, concatRL ) import System.IO ( stderr, hPutStrLn ) -- import Printer ( renderPS ) showTagsDescription :: String showTagsDescription = "Show all tags in the repository." showTagsHelp :: String showTagsHelp = "The tags command writes a list of all tags in the repository to standard\n"++ "output.\n" ++ "\n" ++ "Tab characters (ASCII character 9) in tag names are changed to spaces\n" ++ "for better interoperability with shell tools. A warning is printed if\n" ++ "this happens." showTags :: DarcsCommand showTags = DarcsCommand { commandName = "tags", commandHelp = showTagsHelp, commandDescription = showTagsDescription, commandExtraArgs = 0, commandExtraArgHelp = [], commandCommand = tagsCmd, commandPrereq = amInRepository, commandGetArgPossibilities = return [], commandArgdefaults = nodefaults, commandAdvancedOptions = [], commandBasicOptions = [workingRepoDir] } tagsCmd :: [DarcsFlag] -> [String] -> IO () tagsCmd opts _ = withRepository opts$- \repository -> do
sequence_ $mapRL process$ concatRL patches
case pi_tag $info hp of Just t -> do t' <- normalize t t False putStrLn t' Nothing -> return () normalize :: String -> String -> Bool -> IO String normalize _ [] _ = return [] normalize t (x : xs) flag = if x == '\t' then do if flag then return () else hPutStrLn stderr ("warning: tag with TAB character: " ++ t) rest <- (normalize t xs True) return$ ' ' : rest