% Copyright (C) 2003-2004 David Roundy % % 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{tag} \begin{code}
module Darcs.Commands.Tag ( tag ) where
import System.Directory ( removeFile )

import Darcs.Commands ( DarcsCommand(..), nodefaults )
import Darcs.Arguments ( nocompress, umaskOption, patchnameOption, author,
workingRepoDir, getAuthor )
import Darcs.Hopefully ( n2pia )
import Darcs.Repository ( amInRepository, withRepoLock, ($-), readRepo, tentativelyAddPatch, finalizeRepositoryChanges, ) import Darcs.Patch ( infopatch, identity, adddeps ) import Darcs.Patch.Info ( patchinfo ) import Darcs.Patch.Depends ( getTagsRight ) import Darcs.Commands.Record ( getDate, getLog ) import Darcs.Witnesses.Ordered ( FL(..) ) import Darcs.Lock ( worldReadableTemp ) import Darcs.Flags ( DarcsFlag(..) ) import System.IO ( hPutStr, stderr ) tagDescription :: String tagDescription = "Name the current repository state for future reference." tagHelp :: String tagHelp = "The darcs tag' command names the current repository state, so that it\n" ++ "can easily be referred to later. Every important' state should be\n" ++ "tagged; in particular it is good practice to tag each stable release\n" ++ "with a number or codename. Advice on release numbering can be found\n" ++ "at http://producingoss.com/en/development-cycle.html.\n" ++ "\n" ++ "To reproduce the state of a repository R' as at tag t', use the\n" ++ "command darcs get --tag t R'. The command darcs show tags' lists\n" ++ "all tags in the current repository.\n" ++ "\n" ++ "Tagging also provides significant performance benefits: when Darcs\n" ++ "reaches a shared tag that depends on all antecedent patches, it can\n" ++ "simply stop processing.\n" ++ "\n" ++ "Like normal patches, a tag has a name, an author, a timestamp and an\n" ++ "optional long description, but it does not change the working tree.\n" ++ "A tag can have any name, but it is generally best to pick a naming\n" ++ "scheme and stick to it.\n" ++ "\n" ++ "The darcs tag' command accepts the --pipe option, which behaves as\n" ++ "described in darcs record'.\n" tag :: DarcsCommand tag = DarcsCommand {commandProgramName = "darcs", commandName = "tag", commandHelp = tagHelp, commandDescription = tagDescription, commandExtraArgs = -1, commandExtraArgHelp = ["[TAGNAME]"], commandCommand = tagCmd, commandPrereq = amInRepository, commandGetArgPossibilities = return [], commandArgdefaults = nodefaults, commandAdvancedOptions = [nocompress,umaskOption], commandBasicOptions = [patchnameOption, author, pipeInteractive, askLongComment, workingRepoDir]} tagCmd :: [DarcsFlag] -> [String] -> IO () tagCmd opts args = withRepoLock opts$- \repository -> do
date <- getDate opts
the_author <- getAuthor opts
deps <- getTagsRight fmap readRepo repository
(name, long_comment, mlogf)  <- get_name_log opts args
myinfo <- patchinfo date name the_author long_comment
let mypatch = infopatch myinfo identity
tentativelyAddPatch repository opts $n2pia$ adddeps mypatch deps
finalizeRepositoryChanges repository
maybe (return ()) removeFile mlogf
putStrLn $"Finished tagging patch '"++name++"'" where get_name_log :: [DarcsFlag] -> [String] -> IO (String, [String], Maybe String) get_name_log o a = do let o2 = if null a then o else (add_patch_name o (unwords a)) (name, comment, mlogf) <- getLog o2 Nothing (worldReadableTemp "darcs-tag") NilFL when (length name < 2)$ hPutStr stderr \$
"Do you really want to tag '"
++name++"'? If not type: darcs obliterate --last=1\n"
return ("TAG " ++ name, comment, mlogf)
add_patch_name :: [DarcsFlag] -> String -> [DarcsFlag]
add_patch_name o a| has_patch_name o = o
| otherwise = [PatchName a] ++ o
has_patch_name (PatchName _:_) = True
has_patch_name (_:fs) = has_patch_name fs
has_patch_name [] = False

-- This may be useful for developers, but users don't care about
-- internals:
--
-- A tagged version automatically depends on all patches in the
-- repository.  This allows you to later reproduce precisely that
-- version.  The tag does this by depending on all patches in the
-- repository, except for those which are depended upon by other tags
-- already in the repository.  In the common case of a sequential
-- series of tags, this means that the tag depends on all patches
-- since the last tag, plus that tag itself.

\end{code}