src/Darcs/Commands/Record.lhs

   1 %  Copyright (C) 2002-2003 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 \subsection{darcs record}
  19 \label{record}
  20 \begin{code}
  21 {-# OPTIONS_GHC -cpp -fglasgow-exts #-}
  22 {-# LANGUAGE CPP, PatternGuards #-}
  23
  24 module Darcs.Commands.Record ( record, commit, get_date, get_log, file_exists ) where
  25 import Control.Exception ( handleJust, Exception( ExitException ) )
  26 import Control.Monad ( filterM, when )
  27 import System.IO ( hGetContents, stdin )
  28 import Data.List ( sort, isPrefixOf )
  29 import System.Exit ( exitFailure, ExitCode(..) )
  30 import System.IO ( hPutStrLn )
  31 import System.Directory ( doesFileExist, doesDirectoryExist, removeFile )
  32 import Data.Maybe ( isJust )
  33
  34 import Darcs.Lock ( readBinFile, writeBinFile, world_readable_temp, appendToFile, removeFileMayNotExist )
  35 import Darcs.Hopefully ( info, n2pia )
  36 import Darcs.Repository ( Repository, amInRepository, withRepoLock, ($-),
  37                           get_unrecorded, get_unrecorded_unsorted, withGutsOf,
  38                     sync_repo, read_repo,
  39                     slurp_recorded,
  40                     tentativelyAddPatch, finalizeRepositoryChanges,
  41                   )
  42 import Darcs.Patch ( RepoPatch, Patch, Prim, namepatch, summary, anonymous,
  43                      adddeps, fromPrims )
  44 import Darcs.Ordered ( FL(..), RL(..), (:>)(..), (+>+),
  45                              unsafeUnFL, unsafeCompare,
  46                              reverseRL, mapFL, mapFL_FL, nullFL )
  47 import Darcs.Patch.Info ( PatchInfo )
  48 import Darcs.SlurpDirectory ( slurp_hasfile, slurp_hasdir )
  49 import Darcs.Patch.Choices ( patch_choices_tps, tp_patch,
  50                              force_first, get_choices, tag )
  51 import Darcs.SelectChanges ( with_selected_changes_to_files',
  52                              with_selected_changes_reversed )
  53 import Darcs.RepoPath ( FilePathLike, SubPath, sp2fn, toFilePath )
  54 import Darcs.SlurpDirectory ( Slurpy, empty_slurpy )
  55 import Darcs.Commands ( DarcsCommand(..), nodefaults, loggers, command_stub )
  56 import Darcs.Arguments ( DarcsFlag( PromptLongComment, Test, NoTest, NoEditLongComment,
  57                                     EditLongComment, RmLogFile, LogFile, Pipe,
  58                                     PatchName, AskDeps, All ),
  59                          get_author, working_repo_dir, lookforadds,
  60                          fixSubPaths, defineChanges,
  61                          ask_long_comment, askdeps, patch_select_flag,
  62                          all_pipe_interactive, leave_test_dir, notest,
  63                          author, patchname_option, umask_option, ignoretimes,
  64                          nocompress, rmlogfile, logfile, list_registered_files,
  65                          set_scripts_executable )
  66 import Darcs.Utils ( askUser, promptYorn, edit_file, clarify_errors )
  67 import Darcs.Progress ( debugMessage, progressFL )
  68 import IsoDate ( getIsoDateTime, cleanLocalDate )
  69 import Printer ( hPutDocLn, text, wrap_text, ($$), renderString )
  70 #include "impossible.h"
  71 \end{code}
  72 \begin{code}
  73 record_description :: String
  74 record_description =
  75  "Save changes in the working copy to the repository as a patch."
  76 \end{code}
  77
  78 \options{record}
  79
  80 If you provide one or more files or directories as additional arguments
  81 to record, you will only be prompted to changes in those files or
  82 directories.
  83 \begin{code}
  84 record_help :: String
  85 record_help = renderString $ wrap_text 80 $
  86  "Record is used to name a set of changes and record the patch to the "++
  87  "repository."
  88 \end{code}
  89 \begin{code}
  90 record :: DarcsCommand
  91 record = DarcsCommand {command_name = "record",
  92                        command_help = record_help,
  93                        command_description = record_description,
  94                        command_extra_args = -1,
  95                        command_extra_arg_help = ["[FILE or DIRECTORY]..."],
  96                        command_command = record_cmd,
  97                        command_prereq = amInRepository,
  98                        command_get_arg_possibilities = list_registered_files,
  99                        command_argdefaults = nodefaults,
 100                        command_advanced_options = [logfile, rmlogfile,
 101                                                    nocompress, ignoretimes,
 102                                                    umask_option,
 103                                                    set_scripts_executable],
 104                        command_basic_options = [patchname_option, author,
 105                                                notest,
 106                                                leave_test_dir,
 107                                                all_pipe_interactive,
 108                                                askdeps,
 109                                                ask_long_comment,
 110                                                lookforadds,
 111                                                working_repo_dir]}
 112 \end{code}
 113 \begin{code}
 114 commit_description :: String
 115 commit_description =
 116  "Does not actually do anything, but offers advice on saving changes"
 117
 118 commit_help :: String
 119 commit_help =
 120  "This command does not do anything.\n"++
 121  "If you want to save changes locally, use the 'darcs record' command.\n"++
 122  "If you want to save a recorded patch to another repository, use the\n"++
 123  "'darcs push' or 'darcs send' commands instead.\n"
 124
 125 commit :: DarcsCommand
 126 commit = command_stub "commit" commit_help commit_description record
 127 \end{code}
 128 \begin{code}
 129 file_exists :: Slurpy -> SubPath -> IO Bool
 130 file_exists s rp = do file <- doesFileExist fp
 131                       dir <- doesDirectoryExist fp
 132                       return (file || dir ||
 133                               slurp_hasfile (sp2fn rp) s ||
 134                               slurp_hasdir (sp2fn rp) s)
 135                    where fp = toFilePath rp
 136
 137 record_cmd :: [DarcsFlag] -> [String] -> IO ()
 138 record_cmd origopts args = do
 139     check_name_is_not_option origopts
 140
 141     let (logMessage,_, _) = loggers opts
 142         opts = if NoTest `elem` origopts then origopts else Test:origopts
 143
 144     withRepoLock opts $- \repository -> do
 145     rec <- if null args then return empty_slurpy
 146            else slurp_recorded repository
 147     files <- sort `fmap` fixSubPaths opts args
 148     let non_repo_files = if null files && (not $ null args) then args else []
 149     existing_files <- filterM (file_exists rec) files
 150     non_existent_files <- filterM (fmap not . file_exists rec) files
 151     when (not $ null existing_files) $
 152          logMessage $ "Recording changes in "++unwords (map show existing_files)++":\n"
 153     when (not $ null non_existent_files) $
 154          logMessage $ "Non existent files or directories: "++unwords (map show non_existent_files)++"\n"
 155     when (((not $ null non_existent_files) || (not $ null non_repo_files)) && null existing_files) $
 156          fail "None of the files you specified exist!"
 157     debugMessage "About to get the unrecorded changes."
 158     changes <- if All `elem` opts then get_unrecorded_unsorted repository
 159                                   else get_unrecorded repository
 160     debugMessage "I've gotten unrecorded."
 161     case allow_empty_with_askdeps changes of
 162       Nothing -> do when (Pipe `elem` opts) $ do get_date opts
 163                                                  return ()
 164                     if ((not $ null existing_files) || (not $ null non_existent_files))
 165                        then logMessage "No changes in selected files or directories!"
 166                        else logMessage "No changes!"
 167       Just ch -> do_record repository opts existing_files ch
 168     where allow_empty_with_askdeps NilFL
 169               | AskDeps `elem` origopts = Just NilFL
 170               | otherwise = Nothing
 171           allow_empty_with_askdeps p = Just p
 172
 173  -- check that what we treat as the patch name is not accidentally a command
 174  -- line flag
 175 check_name_is_not_option :: [DarcsFlag] -> IO ()
 176 check_name_is_not_option opts = do
 177     let (logMessage, _, _) = loggers opts
 178         patchNames = [n | PatchName n <- opts]
 179     when (length patchNames == 1) $ do
 180         let n = head patchNames
 181             oneLetterName = length n == 1 || (length n == 2 && head n == '-')
 182         if (oneLetterName && not (elem All opts))
 183             then do
 184                 let keepAsking = do
 185                     yorn <- promptYorn ("You specified " ++ show n ++ " as the patch name. Is that really what you want?")
 186                     case yorn of
 187                         'y' -> return ()
 188                         'n' -> do
 189                                    logMessage "Okay, aborting the record."
 190                                    exitFailure
 191                         _   -> keepAsking
 192                 keepAsking
 193             else return ()
 194
 195
 196 do_record :: RepoPatch p => Repository p -> [DarcsFlag] -> [SubPath] -> FL Prim -> IO ()
 197 do_record repository opts files ps = do
 198     let make_log = world_readable_temp "darcs-record"
 199     date <- get_date opts
 200     my_author <- get_author opts
 201     debugMessage "I'm slurping the repository."
 202     s <- slurp_recorded repository
 203     debugMessage "About to select changes..."
 204     with_selected_changes_to_files' "record" opts
 205       s (map toFilePath files) ps $ \ (chs:>_) ->
 206       if is_empty_but_not_askdeps chs
 207         then putStrLn "Ok, if you don't want to record anything, that's fine!"
 208         else handleJust only_successful_exits (\_ -> return ()) $
 209              do deps <- if AskDeps `elem` opts
 210                         then ask_about_depends repository chs opts
 211                         else return []
 212                 when (AskDeps `elem` opts) $ debugMessage "I've asked about dependencies."
 213                 if nullFL chs && null deps
 214                   then putStrLn "Ok, if you don't want to record anything, that's fine!"
 215                   else do defineChanges chs
 216                           (name, my_log, logf) <- get_log opts Nothing make_log chs
 217                           do_actual_record repository opts name date
 218                                  my_author my_log logf deps chs
 219     where is_empty_but_not_askdeps l
 220               | AskDeps `elem` opts = False
 221                                       -- a "partial tag" patch; see below.
 222               | otherwise = nullFL l
 223
 224 do_actual_record :: RepoPatch p => Repository p -> [DarcsFlag] -> String -> String -> String
 225                  -> [String] -> Maybe String
 226                  -> [PatchInfo] -> FL Prim -> IO ()
 227 do_actual_record repository opts name date my_author my_log logf deps chs =
 228               do debugMessage "Writing the patch file..."
 229                  mypatch <- namepatch date name my_author my_log $
 230                             fromPrims $ progressFL "Writing changes:" chs
 231                  tentativelyAddPatch repository opts $ n2pia $ adddeps mypatch deps
 232                  debugMessage "Applying to pristine..."
 233                  withGutsOf repository (finalizeRepositoryChanges repository)
 234                                     `clarify_errors` failuremessage
 235                  debugMessage "Syncing timestamps..."
 236                  sync_repo repository
 237                  when (isJust logf) $ removeFile (fromJust logf)
 238                  logMessage $ "Finished recording patch '"++name++"'"
 239     where (logMessage,_,_) = loggers opts
 240           failuremessage = "Failed to record patch '"++name++"'" ++
 241                            case logf of Just lf -> "\nLogfile left in "++lf++"."
 242                                         Nothing -> ""
 243 \end{code}
 244 Each patch is given a name, which typically would consist of a brief
 245 description of the changes.  This name is later used to describe the patch.
 246 The name must fit on one line (i.e.\ cannot have any embedded newlines).  If
 247 you have more to say, stick it in the log.
 248 \begin{code}
 249 \end{code}
 250
 251 The patch is also flagged with the author of the change, taken by default
 252 from the \verb!DARCS_EMAIL! environment variable, and if that doesn't
 253 exist, from the \verb!EMAIL! environment variable.  The date on which the
 254 patch was recorded is also included.  Currently there is no provision for
 255 keeping track of when a patch enters a given repository.
 256 \begin{code}
 257 get_date :: [DarcsFlag] -> IO String
 258 get_date opts
 259  | Pipe `elem` opts = do cleanLocalDate `fmap` askUser "What is the date? "
 260 get_date _ = getIsoDateTime
 261 \end{code}
 262 \label{DARCS_EDITOR}
 263 Finally, each changeset should have a full log (which may be empty).  This
 264 log is for detailed notes which are too lengthy to fit in the name.  If you
 265 answer that you do want to create a comment file, darcs will open an editor
 266 so that you can enter the comment in.  The choice of editor proceeds as
 267 follows.  If one of the \verb!$DARCS_EDITOR!, \verb!$VISUAL! or
 268 \verb!$EDITOR! environment variables is defined, its value is used (with
 269 precedence proceeding in the order listed).  If not, ``vi'', ``emacs'',
 270 ``emacs~-nw'' and ``nano'' are tried in that order.
 271
 272 \begin{options}
 273 --logfile
 274 \end{options}
 275
 276 If you wish, you may specify the patch name and log using the
 277 \verb!--logfile! flag.  If you do so, the first line of the specified file
 278 will be taken to be the patch name, and the remainder will be the ``long
 279 comment''.  This feature can be especially handy if you have a test that
 280 fails several times on the record (thus aborting the record), so you don't
 281 have to type in the long comment multiple times. The file's contents will
 282 override the \verb!--patch-name! option.
 283
 284 \begin{code}
 285 data PName = FlagPatchName String | PriorPatchName String | NoPatchName
 286
 287 get_log :: [DarcsFlag] -> Maybe (String, [String]) -> IO String -> FL Prim ->
 288            IO (String, [String], Maybe String)
 289 get_log opts m_old make_log chs = gl opts
 290     where patchname_specified = patchname_helper opts
 291           patchname_helper (PatchName n:_) | take 4 n == "TAG " = FlagPatchName $ '.':n
 292                                            | otherwise          = FlagPatchName n
 293           patchname_helper (_:fs) = patchname_helper fs
 294           patchname_helper [] = case m_old of Just (p,_) -> PriorPatchName p
 295                                               Nothing    -> NoPatchName
 296           default_log = case m_old of
 297                           Nothing    -> []
 298                           Just (_,l) -> l
 299           gl (Pipe:_) = do p <- case patchname_specified of
 300                                   FlagPatchName p  -> return p
 301                                   PriorPatchName p -> return p
 302                                   NoPatchName      -> prompt_patchname False
 303                            putStrLn "What is the log?"
 304                            thelog <- lines `fmap` hGetContents stdin -- ratify hGetContents: stdin not deleted
 305                            return (p, thelog, Nothing)
 306           gl (LogFile f:fs) =
 307               do -- round 1 (patchname)
 308                  mlp <- lines `fmap` readBinFile f `catch` (\_ -> return [])
 309                  firstname <- case (patchname_specified, mlp) of
 310                                 (FlagPatchName  p, []) -> return p
 311                                 (_, p:_)               -> return p -- logfile trumps prior!
 312                                 (PriorPatchName p, []) -> return p
 313                                 (NoPatchName, [])      -> prompt_patchname True
 314                  -- round 2
 315                  append_info f firstname
 316                  when (EditLongComment `elem` fs) $ do edit_file f
 317                                                        return ()
 318                  (name, thelog, _) <- read_long_comment f firstname
 319                  when (RmLogFile `elem` opts) $ removeFileMayNotExist f
 320                  return (name, thelog, Nothing)
 321           gl (EditLongComment:_) =
 322                   case patchname_specified of
 323                     FlagPatchName  p -> actually_get_log p
 324                     PriorPatchName p -> actually_get_log p
 325                     NoPatchName      -> prompt_patchname True >>= actually_get_log
 326           gl (NoEditLongComment:_) =
 327                   case patchname_specified of
 328                     FlagPatchName  p
 329                         | Just ("",_) <- m_old ->
 330                                        return (p, default_log, Nothing) -- rollback -m
 331                     FlagPatchName  p -> return (p, [], Nothing) -- record (or amend) -m
 332                     PriorPatchName p -> return (p, default_log, Nothing) -- amend
 333                     NoPatchName      -> do p <- prompt_patchname True -- record
 334                                            return (p, [], Nothing)
 335           gl (PromptLongComment:fs) =
 336                   case patchname_specified of
 337                     FlagPatchName p -> prompt_long_comment p -- record (or amend) -m
 338                     _               -> gl fs
 339           gl (_:fs) = gl fs
 340           gl [] = case patchname_specified of
 341                     FlagPatchName  p -> return (p, [], Nothing)  -- record (or amend) -m
 342                     PriorPatchName "" -> prompt_patchname True >>= prompt_long_comment
 343                     PriorPatchName p -> return (p, default_log, Nothing)
 344                     NoPatchName -> prompt_patchname True >>= prompt_long_comment
 345           prompt_patchname retry =
 346             do n <- askUser "What is the patch name? "
 347                if n == "" || take 4 n == "TAG "
 348                   then if retry then prompt_patchname retry
 349                                 else fail "Bad patch name!"
 350                   else return n
 351           prompt_long_comment oldname =
 352             do yorn <- promptYorn "Do you want to add a long comment?"
 353                if yorn == 'y' then actually_get_log oldname
 354                               else return (oldname, [], Nothing)
 355           actually_get_log p = do logf <- make_log
 356                                   writeBinFile logf $ unlines $ p : default_log
 357                                   append_info logf p
 358                                   edit_file logf
 359                                   read_long_comment logf p
 360           read_long_comment :: FilePathLike p => p -> String -> IO (String, [String], Maybe p)
 361           read_long_comment f oldname =
 362               do t <- (lines.filter (/='\r')) `fmap` readBinFile f
 363                  case t of [] -> return (oldname, [], Just f)
 364                            (n:ls) -> return (n, takeWhile
 365                                              (not.(eod `isPrefixOf`)) ls,
 366                                              Just f)
 367           append_info f oldname =
 368               do fc <- readBinFile f
 369                  appendToFile f $ \h ->
 370                      do case fc of
 371                           _ | null (lines fc) -> hPutStrLn h oldname
 372                             | last fc /= '\n' -> hPutStrLn h ""
 373                             | otherwise       -> return ()
 374                         hPutDocLn h $ text eod
 375                             $$ text ""
 376                             $$ wrap_text 75
 377                                ("Place the long patch description above the "++
 378                                 eod++
 379                                 " marker.  The first line of this file "++
 380                                 "will be the patch name.")
 381                             $$ text ""
 382                             $$ text "This patch contains the following changes:"
 383                             $$ text ""
 384                             $$ summary (fromPrims chs :: Patch)
 385
 386 eod :: String
 387 eod = "***END OF DESCRIPTION***"
 388 \end{code}
 389
 390 \begin{options}
 391 --ask-deps
 392 \end{options}
 393
 394 Each patch may depend on any number of previous patches.  If you choose to
 395 make your patch depend on a previous patch, that patch is required to be
 396 applied before your patch can be applied to a repository.  This can be used, for
 397 example, if a piece of code requires a function to be defined, which was
 398 defined in an earlier patch.
 399
 400 If you want to manually define any dependencies for your patch, you can use
 401 the \verb!--ask-deps! flag, and darcs will ask you for the patch's
 402 dependencies.
 403
 404 It is possible to record a patch which has no actual changes but which
 405 has specific dependencies.  This type of patch can be thought of as a
 406 ``partial tag''.  The \verb!darcs tag! command will record a patch
 407 with no actual changes but which depends on the entire current
 408 inventory of the repository.  The \verb!darcs record --ask-deps! with
 409 no selected changes will record a patch that depends on only those
 410 patches selected via the \verb!--ask-deps! operation, resulting in a
 411 patch which describes a set of patches; the presence of this primary
 412 patch in a repository implies the presence of (at least) the
 413 depended-upon patches.
 414
 415 \begin{code}
 416 ask_about_depends :: RepoPatch p => Repository p -> FL Prim -> [DarcsFlag] -> IO [PatchInfo]
 417 ask_about_depends repository pa' opts = do
 418   pps <- read_repo repository
 419   pa <- n2pia `fmap` anonymous (fromPrims pa')
 420   let ps = (reverseRL $ headRL pps)+>+(pa:>:NilFL)
 421       (pc, tps) = patch_choices_tps ps
 422       ta = case filter ((pa `unsafeCompare`) . tp_patch) $ unsafeUnFL tps of
 423                 [tp] -> tag tp
 424                 [] -> error "ask_about_depends: []"
 425                 _ -> error "ask_about_depends: many"
 426       ps' = mapFL_FL tp_patch $ middle_choice $ force_first ta pc
 427   with_selected_changes_reversed "depend on" (filter askdep_allowed opts) empty_slurpy ps'
 428              $ \(deps:>_) -> return $ mapFL info deps
 429  where headRL (x:<:_) = x
 430        headRL NilRL = impossible
 431        askdep_allowed = not . patch_select_flag
 432        middle_choice p = mc where (_ :> mc :> _) = get_choices p
 433
 434
 435 only_successful_exits :: Exception -> Maybe ()
 436 only_successful_exits (ExitException ExitSuccess) = Just ()
 437 only_successful_exits _ = Nothing
 438 \end{code}
 439
 440 \begin{options}
 441 --no-test,  --test
 442 \end{options}
 443
 444 If you configure darcs to run a test suite, darcs will run this test on the
 445 recorded repository to make sure it is valid.  Darcs first creates a pristine
 446 copy of the source tree (in a temporary directory), then it runs the test,
 447 using its return value to decide if the record is valid.  If it is not valid,
 448 the record will be aborted.  This is a handy way to avoid making stupid
 449 mistakes like forgetting to `darcs add' a new file.  It also can be
 450 tediously slow, so there is an option (\verb!--no-test!) to skip the test.
 451
 452 \begin{options}
 453 --set-scripts-executable
 454 \end{options}
 455
 456 If you pass \verb!--set-scripts-executable! to \verb!darcs record!, darcs will set scripts
 457 executable in the test directory before running the test.
 458
 459 \begin{options}
 460 --pipe
 461 \end{options}
 462
 463 If you run record with the \verb!--pipe! option, you will be prompted for
 464 the patch date, author, and the long comment. The long comment will extend
 465 until the end of file or stdin is reached (ctrl-D on Unixy systems, ctrl-Z
 466 on systems running a Microsoft OS).
 467
 468 This interface is intended for scripting darcs, in particular for writing
 469 repository conversion scripts.  The prompts are intended mostly as a useful
 470 guide (since scripts won't need them), to help you understand the format in
 471 which to provide the input. Here's an example of what the \verb!--pipe!
 472 prompts look like:
 473
 474 \begin{verbatim}
 475  What is the date? Mon Nov 15 13:38:01 EST 2004
 476  Who is the author? David Roundy
 477  What is the log? One or more comment lines
 478 \end{verbatim}
 479
 480
 481 \begin{options}
 482 --interactive
 483 \end{options}
 484
 485 By default, \verb!record! works interactively. Probably the only thing you need
 486 to know about using this is that you can press \verb!?! at the prompt to be
 487 shown a list of the rest of the options and what they do. The rest should be
 488 clear from there. Here's a
 489 ``screenshot'' to demonstrate:
 490
 491 \begin{verbatim}
 492 hunk ./hello.pl +2
 493 +#!/usr/bin/perl
 494 +print "Hello World!\n";
 495 Shall I record this patch? (2/2) [ynWsfqadjk], or ? for help: ?
 496 How to use record...
 497 y: record this patch
 498 n: don't record it
 499 w: wait and decide later, defaulting to no
 500
 501 s: don't record the rest of the changes to this file
 502 f: record the rest of the changes to this file
 503
 504 d: record selected patches
 505 a: record all the remaining patches
 506 q: cancel record
 507
 508 j: skip to next patch
 509 k: back up to previous patch
 510 h or ?: show this help
 511
 512 <Space>: accept the current default (which is capitalized)
 513
 514 \end{verbatim}
 515 What you can't see in that ``screenshot'' is that \verb!darcs! will also try to use
 516 color in your terminal to make the output even easier to read.