module Darcs.Commands.ShowTags ( showTags ) where
import Darcs.Arguments ( DarcsFlag(..), possiblyRemoteRepoDir, getRepourl )
import Darcs.Commands ( DarcsCommand(..), nodefaults )
import Darcs.Patch.PatchInfoAnd ( info )
import Darcs.Repository ( findRepository, readRepo, withRepositoryDirectory, RepoJob(..) )
import Darcs.Patch.Info ( piTag )
import Darcs.Patch.Set ( newset2RL )
import Darcs.Witnesses.Ordered ( mapRL )
import Data.Maybe ( fromMaybe )
import System.IO ( stderr, hPutStrLn )
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 {
commandProgramName = "darcs",
commandName = "tags",
commandHelp = showTagsHelp,
commandDescription = showTagsDescription,
commandExtraArgs = 0,
commandExtraArgHelp = [],
commandCommand = tagsCmd,
commandPrereq = findRepository,
commandGetArgPossibilities = return [],
commandArgdefaults = nodefaults,
commandAdvancedOptions = [],
commandBasicOptions = [possiblyRemoteRepoDir] }
tagsCmd :: [DarcsFlag] -> [String] -> IO ()
tagsCmd opts _ =
let repodir = fromMaybe "." (getRepourl opts) in
withRepositoryDirectory opts repodir $ RepoJob $ \repository -> do
patches <- readRepo repository
sequence_ $ mapRL process $ newset2RL patches
where process hp =
case piTag $ 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