%  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.Ordered ( mapRL, concatRL )
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."

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}