% Copyright (C) 2002-2003 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; if not, write to the Free Software Foundation, % Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. \section{darcs record} \begin{code} module Record ( record, get_date ) where import Directory hiding ( getCurrentDirectory ) import Workaround ( getCurrentDirectory ) import Control.Exception ( handleJust, Exception( ExitException ), block ) #ifdef HAVEWX import Graphics.UI.WX hiding ( when ) import Data.IORef import SelectChanges ( gui_change_selector ) import SlurpDirectory ( Slurpy ) import PatchChoices ( get_first_choice, get_last_choice ) #endif import IO ( hGetContents, stdin, stdout, hFlush ) import List ( nub, sort ) import System import Monad ( liftM, when, ) import Lock ( withLock, readBinFile, withTemp ) import Repository ( read_repo, slurp_recorded, get_unrecorded, add_to_inventory, write_patch, sift_for_pending, write_pending, am_in_repo, sync_repo, ) import Patch ( Patch, patch2patchinfo, join_patches, flatten, namepatch, patch_summary, apply_to_slurpy, adddeps, ) import PatchInfo ( PatchInfo, patchinfo ) import PatchChoices ( patch_choices, force_first, get_middle_choice, ) import SelectChanges ( with_selected_changes_to_files, promptChar, with_selected_changes_reversed, ) import SlurpDirectory ( empty_slurpy, slurp_write_dirty, ) import DarcsCommands ( DarcsCommand(..), nodefaults ) import DarcsArguments hiding ( help ) import Test ( test_slurpy ) import IsoDate ( getIsoDateTime, cleanDate ) #include "impossible.h" \end{code} \begin{code} record_description :: String record_description = "Record changes as a named patch." \end{code} \options{record} Record is used to name a set of changes and record the patch to the repository. If you provide one or more files or directories as additional arguments to record, you will only be prompted to changes in those files or directories. \begin{code} record_help :: String record_help = "Record is used to name a set of changes.\n" \end{code} \begin{code} record :: DarcsCommand record = DarcsCommand {command_name = "record", command_help = record_help, command_description = record_description, command_extra_args = -1, command_extra_arg_help = ["[FILE or DIRECTORY]..."], command_command = record_cmd, command_prereq = am_in_repo, command_get_arg_possibilities = list_registered_files, command_argdefaults = nodefaults, command_darcsoptions = [patchname_option, author, logfile, rmlogfile, verbose, notest, leave_test_dir, nocompress, all_gui_pipe_interactive, askdeps, ask_long_comment, ignoretimes, lookforadds, working_repo_dir]} \end{code} \begin{code} record_cmd :: [DarcsFlag] -> [String] -> IO () record_cmd opts args = let files = sort $ map (fix_filepath opts) args in withLock "./_darcs/lock" $ do when (concat files /= "") $ putStr $ "Recording changes in "++unwords (map show files)++":\n\n" when (Verbose `elem` opts) $ putStr "About to get the unrecorded changes.\n" changes <- if All `elem` opts then get_unrecorded (AnyOrder:opts) else get_unrecorded opts when (Verbose `elem` opts) $ putStr "I've gotten unrecorded.\n" case allow_empty_with_askdeps changes of Nothing -> do when (Pipe `elem` opts) $ do get_date opts return () putStr "No changes!\n" Just ch -> #ifdef HAVEWX if Gui `elem` opts then do s <- slurp_recorded "." guiSelectPatches opts s $ flatten ch else #endif do_record opts files $ flatten ch where allow_empty_with_askdeps Nothing | AskDeps `elem` opts = Just $ join_patches [] | otherwise = Nothing allow_empty_with_askdeps mp = mp do_record :: [DarcsFlag] -> [FilePath] -> [Patch] -> IO () do_record opts files ps = do date <- get_date opts my_author <- get_author opts s <- slurp_recorded "." with_selected_changes_to_files "record" (filter (\f-> f==Gui || f==All) opts) s files ps $ \ (skipped,chs) -> if is_empty_but_not_askdeps chs then putStr "Ok, if you don't want to record anything, that's fine!\n" else do deps <- if AskDeps `elem` opts then ask_about_depends $ join_patches chs else return [] when (Verbose `elem` opts && AskDeps `elem` opts) $ putStr "I've asked about dependencies...\n" firstname <- get_patchname opts (name, my_log) <- get_log opts firstname chs do_actual_record opts name date my_author my_log deps chs skipped where is_empty_but_not_askdeps l | AskDeps `elem` opts = False | otherwise = null l do_actual_record :: [DarcsFlag] -> String -> String -> String -> [String] -> [PatchInfo] -> [Patch] -> [Patch] -> IO () do_actual_record opts name date my_author my_log deps chs skipped = let mypatch = namepatch date name my_author my_log $ join_patches chs myinfo = patchinfo date name my_author my_log in do when (Verbose `elem` opts) $ putStr "About to slurp once.\n" recorded <- slurp_recorded "." when (Verbose `elem` opts) $ putStr "About to slurp again.\n" recorded' <- slurp_recorded "." case apply_to_slurpy mypatch recorded of Nothing -> do putStr "Unable to apply patch!\n" exitWith $ ExitFailure 1 Just working -> do when (Verbose `elem` opts) $ putStr "I've applied to slurpy.\n" want_test <- want_to_do_test opts when want_test $ do testproblem <- test_slurpy opts working when (testproblem /= ExitSuccess) $ exitWith $ ExitFailure 1 when (Verbose `elem` opts) $ putStr "Writing the patch file...\n" write_patch opts $ adddeps mypatch deps former_dir <- getCurrentDirectory setCurrentDirectory "_darcs/current" when (Verbose `elem` opts) $ putStr "Applying to current...\n" block $ do case apply_to_slurpy mypatch recorded' of Just s' -> slurp_write_dirty s' Nothing -> do putStr "Bizarre error in recording...\n" exitWith $ ExitFailure 1 setCurrentDirectory former_dir add_to_inventory "." myinfo write_pending $ sift_for_pending $ join_patches skipped sync_repo putStr $ "Finished recording patch '"++name++"'\n" #ifdef HAVEWX guiSelectPatches :: [DarcsFlag] -> Slurpy -> [Patch] -> IO () guiSelectPatches opts _ ps = do date <- get_date opts my_author <- get_author opts name <- get_patchname opts start $ hello opts my_author date name ps hello opts my_author date name ps = do father <- frame [text := "Record patch"] f <- panel father [] (ms,mclose) <- default_menubar author_text <- textEntry f AlignLeft [text := my_author] name_text <- textEntry f AlignLeft [text := name] log_and_patches <- splitterWindow f [] pc <- newIORef $ patch_choices ps scrolled <- gui_change_selector log_and_patches pc log_text <- textCtrl log_and_patches WrapNone [text := ""] quit <- button f [text := "Cancel", on command := close father] bs <- get quit bestSize set quit [clientSize := bs] rec <- button f [text := "Record", on command := do rpc <- readIORef pc logt <- get log_text text my_log <- case lines logt of [""] -> return [] lt -> return lt my_a <- get author_text text n <- get name_text text do_actual_record opts n date my_a my_log [] (get_first_choice rpc) (get_middle_choice rpc++ get_last_choice rpc) close father ] bests <- get rec bestSize set rec [clientSize := bests] set f [layout := column 0 [row 0 [valignCentre $ margin 5 $ label "Author:", hfill $ widget author_text], row 0 [valignCentre $ margin 5 $ label "Patch name:", hfill $ widget name_text], row 0 [margin 5 $ label "Comments:",glue], fill $ hsplit log_and_patches 5 50 (widget log_text) (widget scrolled), margin 5 $ row 5 [hglue, widget quit, widget rec,hspace 20]], clientSize := size 600 400 -- this is window actual size ] set father [menuBar := ms, on (menu mclose) := close father, layout := fill $ widget f] default_menubar = do file <- menuPane [text := "&File"] mclose <- menuItem file [text := "&Quit\tCtrl+Q", help := "Quit darcs"] return ([file],mclose) #endif \end{code} Each patch is given a name, which typically would consist of a brief description of the changes. This name is later used to describe the patch. The name must fit on one line (i.e.\ cannot have any embedded newlines). If you have more to say, stick it in the log. \begin{code} get_patchname :: [DarcsFlag] -> IO String get_patchname (PatchName n:_) | take 4 n == "TAG " = return $ '.':n | otherwise = return n get_patchname [Gui] = return "" get_patchname (Gui:fs) = get_patchname $ nub $ fs ++ [Gui] get_patchname (LogFile f:fs) = do t <- (lines `liftM` readBinFile f) `catch` \_ -> return [] case t of [] -> get_patchname fs (n:_) -> return n get_patchname (_:flags) = get_patchname flags get_patchname [] = do putStr "What is the patch name? " hFlush stdout n <- getLine if n == "" || take 4 n == "TAG " then get_patchname [] else return n \end{code} The patch is also flagged with the author of the change, taken by default from the \verb!DARCS_EMAIL! environment variable, and if that doesn't exist, from the \verb!EMAIL! environment variable. The date on which the patch was recorded is also included. Currently there is no provision for keeping track of when a patch enters a given repository. \begin{code} get_date :: [DarcsFlag] -> IO String get_date opts | Pipe `elem` opts = do putStr "What is the date? " hFlush stdout cleanDate `liftM` getLine get_date _ = getIsoDateTime \end{code} Finally, each changeset should have a full log (which may be empty). This log is for detailed notes which are too lengthy to fit in the name. If you answer that you do want to create a comment file, darcs will open an editor so that you can enter the comment in. The choice of editor proceeds as follows. If one of the \verb!$DARCS_EDITOR!, \verb!$VISUAL! or \verb!$EDITOR! environment variables is defined, its value is used (with precedence proceeding in the order listed). If not, ``vi'', ``emacs'', ``emacs~-nw'' and ``nano'' are tried in that order. There is a problem that shows up with at least some versions of vi which keep them from working properly with darcs. An (ugly) solution to this is to tell vi to use the tty as stdin and stdout: \begin{verbatim} export DARCS_EDITOR="vi /dev/tty" \end{verbatim} If you wish, you may specify the patch name and log using the \verb!--logfile! flag. If you do so, the first line of the specified file will be taken to be the patch name, and the remainder will be the ``long comment''. This feature can be especially handy if you have a test that fails several times on the record (thus aborting the record), so you don't have to type in the long comment multiple times. \begin{code} get_log :: [DarcsFlag] -> String -> [Patch] -> IO (String, [String]) get_log opts oldname chs = gl opts where patchname_specified (PatchName _:_) = True patchname_specified (_:fs) = patchname_specified fs patchname_specified [] = False gl (Pipe:_) = do putStr "What is the log?\n" thelog <- lines `liftM` hGetContents stdin return (oldname, thelog) gl (LogFile f:fs) = do append_info f when (EditLongComment `elem` fs) $ do edit_file f return () answer <- read_long_comment f when (RmLogFile `elem` opts) $ removeFile f `catch` \_ -> return () return answer gl (EditLongComment:_) = actually_get_log gl (NoEditLongComment:_) = return (oldname, []) gl (_:fs) = gl fs gl [] = if patchname_specified opts then return (oldname, []) else do yorn <- promptChar "Do you want to add a long comment?" "yn" if yorn == 'y' then actually_get_log else return (oldname, []) actually_get_log = withTemp $ \f -> do append_info f edit_file f read_long_comment f read_long_comment :: FilePath -> IO (String, [String]) read_long_comment f = do t <- lines `liftM` readBinFile f case t of [] -> impossible (n:ls) -> return (n, takeWhile (/= "***DARCS***") ls) append_info f = do ls <- (lines `liftM` readBinFile f) `catch` \_ -> return [] when (ls == []) $ writeFile f $ oldname ++ "\n" appendFile f $ "***DARCS***\n\n" ++ patch_summary (join_patches chs) \end{code} Each patch may depend on any number of previous patches. If you choose to make your patch depend on a previous patch, that patch is required to be applied before your patch can be applied to a repo. This can be used, for example, if a piece of code requires a function to be defined, which was defined in an earlier patch. If you want to manually define any dependencies for your patch, you can use the \verb!--ask-deps! flag, and darcs will ask you for the patch's dependencies. \begin{code} ask_about_depends :: Patch -> IO [PatchInfo] ask_about_depends pa = do pps <- read_repo "." let ps = (map (fromJust.snd) $ reverse $ head pps)++[pa] ps' = get_middle_choice $ force_first pa $ patch_choices ps in handleJust only_successful_exits (\_ -> return []) $ with_selected_changes_reversed "depend on" [] empty_slurpy ps' $ \(_,deps) -> return $ map (fromJust.patch2patchinfo) deps only_successful_exits :: Exception -> Maybe () only_successful_exits (ExitException ExitSuccess) = Just () only_successful_exits _ = Nothing \end{code} If you configure darcs to run a test suite, darcs will run this test on the recorded repo to make sure it is valid. Darcs first creates a pristine copy of the source tree (in \verb!/tmp!), then it runs the test, using its return value to decide if the record is valid. If it is not valid, the record will be aborted. This is a handy way to avoid making stupid mistakes like forgetting to `darcs add' a new file. It also can be tediously slow, so there is an option (\verb!--no-test!) to skip the test. \begin{code} want_to_do_test :: [DarcsFlag] -> IO Bool want_to_do_test (NoTest:_) = return False want_to_do_test (_:flags) = want_to_do_test flags want_to_do_test [] = return True \end{code} If you run record with the \verb!--pipe! option, you will be prompted for the patch name, patch date and the long comment. The long comment will extend until the end of file of stdin is reached (ctrl-D on unixy systems). This interface is intended for scripting darcs, in particular for writing repository conversion scripts. The prompts are intended mostly as useful guide (since scripts won't need them), to help you understand the format in which to provide the input.