1 %  Copyright (C) 2007 Florian Weimer
    2 %
    3 %  This program is free software; you can redistribute it and/or modify
    4 %  it under the terms of the GNU General Public License as published by
    5 %  the Free Software Foundation; either version 2, or (at your option)
    6 %  any later version.
    7 %
    8 %  This program is distributed in the hope that it will be useful,
    9 %  but WITHOUT ANY WARRANTY; without even the implied warranty of
   10 %  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   11 %  GNU General Public License for more details.
   12 %
   13 %  You should have received a copy of the GNU General Public License
   14 %  along with this program; see the file COPYING.  If not, write to
   15 %  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
   16 %  Boston, MA 02110-1301, USA.
   17 
   18 \darcsCommand{show tags}
   19 \begin{code}
   20 module Darcs.Commands.ShowTags ( show_tags ) where
   21 import Darcs.Arguments ( DarcsFlag(..), working_repo_dir )
   22 import Darcs.Commands ( DarcsCommand(..), nodefaults )
   23 import Darcs.Hopefully ( info )
   24 import Darcs.Repository ( amInRepository, read_repo, withRepository, ($-) )
   25 import Darcs.Patch.Info ( pi_tag )
   26 import Darcs.Ordered ( mapRL, concatRL )
   27 import System.IO ( stderr, hPutStrLn )
   28 -- import Printer ( renderPS )
   29 
   30 show_tags_description :: String
   31 show_tags_description = "Show all tags in the repository."
   32 
   33 show_tags_help :: String
   34 show_tags_help =
   35  "The tags command writes a list of all tags in the repository to standard\n"++
   36  "output.\n" ++
   37  "\n" ++
   38  "Tab characters (ASCII character 9) in tag names are changed to spaces\n" ++
   39  "for better interoperability with shell tools.  A warning is printed if\n" ++
   40  "this happens."
   41 
   42 show_tags :: DarcsCommand
   43 show_tags = DarcsCommand {
   44   command_name = "tags",
   45   command_help = show_tags_help,
   46   command_description = show_tags_description,
   47   command_extra_args = 0,
   48   command_extra_arg_help = [],
   49   command_command = tags_cmd,
   50   command_prereq = amInRepository,
   51   command_get_arg_possibilities = return [],
   52   command_argdefaults = nodefaults,
   53   command_advanced_options = [],
   54   command_basic_options = [working_repo_dir] }
   55 
   56 tags_cmd :: [DarcsFlag] -> [String] -> IO ()
   57 tags_cmd opts _ = withRepository opts $- \repository -> do
   58   patches <- read_repo repository
   59   sequence_ $ mapRL process $ concatRL patches
   60   where process hp =
   61             case pi_tag $ info hp of
   62               Just t -> do
   63                  t' <- normalize t t False
   64                  putStrLn t'
   65               Nothing -> return ()
   66         normalize :: String -> String -> Bool -> IO String
   67         normalize _ [] _ = return []
   68         normalize t (x : xs) flag =
   69             if x == '\t' then do
   70                   if flag
   71                     then return ()
   72                     else hPutStrLn stderr
   73                              ("warning: tag with TAB character: " ++ t)
   74                   rest <- (normalize t xs True)
   75                   return $ ' ' : rest
   76             else do
   77                   rest <- (normalize t xs flag)
   78                   return $ x : rest
   79 
   80 \end{code}