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