% 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 Control.Monad ( when )

    import Darcs.Commands ( DarcsCommand(DarcsCommand, commandName, commandHelp,
                            commandDescription, commandExtraArgs,
                            commandExtraArgHelp, commandCommand, commandPrereq,
                            commandGetArgPossibilities, commandArgdefaults,
                            commandAdvancedOptions, commandBasicOptions),
                            nodefaults )
    import Darcs.Arguments ( nocompress, umaskOption, patchnameOption, author,
                             pipeInteractive, askLongComment,
                             workingRepoDir, getAuthor )
    import Darcs.Hopefully ( n2pia )
    import Darcs.Repository ( amInRepository, withRepoLock, ($-), read_repo,
                        tentativelyAddPatch, finalizeRepositoryChanges,
                      )
    import Darcs.Patch ( infopatch, identity, adddeps )
    import Darcs.Patch.Info ( patchinfo )
    import Darcs.Patch.Depends ( get_tags_right )
    import Darcs.Commands.Record ( getDate, getLog )
    import Darcs.Witnesses.Ordered ( FL(..) )
    import Darcs.Lock ( world_readable_temp )
    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 {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 <- get_tags_right `fmap` read_repo 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 (world_readable_temp "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}