% 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. \subsubsection{darcs show tags} \begin{code} module Darcs.Commands.ShowTags ( show_tags ) where import Darcs.Arguments ( DarcsFlag(..), working_repo_dir ) import Darcs.Commands ( DarcsCommand(..), nodefaults ) import Darcs.Hopefully ( info ) import Darcs.Repository ( amInRepository, read_repo, withRepository, ($-) ) import Darcs.Patch.Info ( pi_tag ) import Darcs.Patch.Ordered ( mapRL, concatRL ) import Darcs.Sealed ( Sealed(..) ) import System.IO ( stderr, hPutStrLn ) -- import Printer ( renderPS ) \end{code} \options{show tags} \haskell{show_tags_help} Tab characters (ASCII character 9) in tag names are changed to spaces for better interoperability with shell tools. A warning is printed if this happens. \begin{code} show_tags_description :: String show_tags_description = "Show all tags in the repository." \end{code} \begin{code} show_tags_help :: String show_tags_help = "The tags command writes a list of all tags in the repository to standard\n"++ "output." \end{code} \begin{code} show_tags :: DarcsCommand show_tags = DarcsCommand { command_name = "tags", command_help = show_tags_help, command_description = show_tags_description, command_extra_args = 0, command_extra_arg_help = [], command_command = tags_cmd, command_prereq = amInRepository, command_get_arg_possibilities = return [], command_argdefaults = nodefaults, command_advanced_options = [], command_basic_options = [working_repo_dir] } tags_cmd :: [DarcsFlag] -> [String] -> IO () tags_cmd opts _ = withRepository opts $- \repository -> do Sealed patches <- read_repo repository sequence_ $ mapRL process $ concatRL patches where process hp = 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 else do rest <- (normalize t xs flag) return $ x : rest \end{code}