% 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
      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}