1 % Copyright (C) 2003-2004 David Roundy 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{tag} 19 \begin{code} 20 module Darcs.Commands.Tag ( tag ) where 21 import Control.Monad ( when ) 22 23 import Darcs.Commands ( DarcsCommand(DarcsCommand, command_name, command_help, 24 command_description, command_extra_args, 25 command_extra_arg_help, command_command, command_prereq, 26 command_get_arg_possibilities, command_argdefaults, 27 command_advanced_options, command_basic_options), 28 nodefaults ) 29 import Darcs.Arguments ( nocompress, umask_option, patchname_option, author, 30 pipe_interactive, ask_long_comment, 31 working_repo_dir, get_author ) 32 import Darcs.Hopefully ( n2pia ) 33 import Darcs.Repository ( amInRepository, withRepoLock, ($-), read_repo, 34 tentativelyAddPatch, finalizeRepositoryChanges, 35 ) 36 import Darcs.Patch ( infopatch, identity, adddeps ) 37 import Darcs.Patch.Info ( patchinfo ) 38 import Darcs.Patch.Depends ( get_tags_right ) 39 import Darcs.Commands.Record ( get_date, get_log ) 40 import Darcs.Ordered ( FL(..) ) 41 import Darcs.Lock ( world_readable_temp ) 42 import Darcs.Flags ( DarcsFlag(..) ) 43 import System.IO ( hPutStr, stderr ) 44 45 tag_description :: String 46 tag_description = "Name the current repository state for future reference." 47 48 tag_help :: String 49 tag_help = 50 "The `darcs tag' command names the current repository state, so that it\n" ++ 51 "can easily be referred to later. Every `important' state should be\n" ++ 52 "tagged; in particular it is good practice to tag each stable release\n" ++ 53 "with a number or codename. Advice on release numbering can be found\n" ++ 54 "at http://producingoss.com/en/development-cycle.html.\n" ++ 55 "\n" ++ 56 "To reproduce the state of a repository `R' as at tag `t', use the\n" ++ 57 "command `darcs get --tag t R'. The command `darcs show tags' lists\n" ++ 58 "all tags in the current repository.\n" ++ 59 "\n" ++ 60 "Tagging also provides significant performance benefits: when Darcs\n" ++ 61 "reaches a shared tag that depends on all antecedent patches, it can\n" ++ 62 "simply stop processing.\n" ++ 63 "\n" ++ 64 "Like normal patches, a tag has a name, an author, a timestamp and an\n" ++ 65 "optional long description, but it does not change the working tree.\n" ++ 66 "A tag can have any name, but it is generally best to pick a naming\n" ++ 67 "scheme and stick to it.\n" ++ 68 "\n" ++ 69 "The `darcs tag' command accepts the --pipe option, which behaves as\n" ++ 70 "described in `darcs record'.\n" 71 72 tag :: DarcsCommand 73 tag = DarcsCommand {command_name = "tag", 74 command_help = tag_help, 75 command_description = tag_description, 76 command_extra_args = -1, 77 command_extra_arg_help = ["[TAGNAME]"], 78 command_command = tag_cmd, 79 command_prereq = amInRepository, 80 command_get_arg_possibilities = return [], 81 command_argdefaults = nodefaults, 82 command_advanced_options = [nocompress,umask_option], 83 command_basic_options = [patchname_option, author, 84 pipe_interactive, 85 ask_long_comment, 86 working_repo_dir]} 87 88 tag_cmd :: [DarcsFlag] -> [String] -> IO () 89 tag_cmd opts args = withRepoLock opts $- \repository -> do 90 date <- get_date opts 91 the_author <- get_author opts 92 deps <- get_tags_right `fmap` read_repo repository 93 (name, long_comment) <- get_name_log opts args 94 myinfo <- patchinfo date name the_author long_comment 95 let mypatch = infopatch myinfo identity 96 tentativelyAddPatch repository opts $ n2pia $ adddeps mypatch deps 97 finalizeRepositoryChanges repository 98 putStrLn $ "Finished tagging patch '"++name++"'" 99 where get_name_log :: [DarcsFlag] -> [String] -> IO (String, [String]) 100 get_name_log o a = do let o2 = if null a then o else (add_patch_name o (unwords a)) 101 (name, comment, _) <- get_log o2 Nothing (world_readable_temp "darcs-tag") NilFL 102 when (length name < 2) $ hPutStr stderr $ 103 "Do you really want to tag '" 104 ++name++"'? If not type: darcs obliterate --last=1\n" 105 return ("TAG " ++ name, comment) 106 add_patch_name :: [DarcsFlag] -> String -> [DarcsFlag] 107 add_patch_name o a| has_patch_name o = o 108 | otherwise = [PatchName a] ++ o 109 has_patch_name (PatchName _:_) = True 110 has_patch_name (_:fs) = has_patch_name fs 111 has_patch_name [] = False 112 113 -- This may be useful for developers, but users don't care about 114 -- internals: 115 -- 116 -- A tagged version automatically depends on all patches in the 117 -- repository. This allows you to later reproduce precisely that 118 -- version. The tag does this by depending on all patches in the 119 -- repository, except for those which are depended upon by other tags 120 -- already in the repository. In the common case of a sequential 121 -- series of tags, this means that the tag depends on all patches 122 -- since the last tag, plus that tag itself. 123 \end{code}