% 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 021101301, 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.Ordered ( mapRL, concatRL )
import System.IO ( stderr, hPutStrLn )
\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."
show_tags_help :: String
show_tags_help =
"The tags command writes a list of all tags in the repository to standard\n"++
"output."
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
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}