% 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; see the file COPYING. If not, write to % the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, % Boston, MA 02110-1301, USA. \darcsCommand{record} \begin{code}

    {-# LANGUAGE CPP, PatternGuards #-}

    module Darcs.Commands.Record ( record, commit, getDate, getLog, fileExists ) where
    import qualified Ratified( hGetContents )
    import Control.Exception ( handleJust, Exception( ExitException ) )
    import Control.Monad ( filterM, when )
    import System.IO ( stdin )
    import Data.List ( sort, isPrefixOf )
    import System.Exit ( exitWith, exitFailure, ExitCode(..) )
    import System.IO ( hPutStrLn )
    import System.Directory ( doesFileExist, doesDirectoryExist, removeFile )
    import Data.Maybe ( isJust )

    import Darcs.Lock ( readBinFile, writeBinFile, world_readable_temp, appendToFile )
    import Darcs.Hopefully ( info, n2pia )
    import Darcs.Repository ( Repository, amInRepository, withRepoLock, ($-),
                              withGutsOf,
                        read_repo,
                        slurp_recorded,
                        tentativelyAddPatch, finalizeRepositoryChanges
                            , invalidateIndex, unrecordedChanges )
    import Darcs.Patch ( RepoPatch, Patch, Prim, namepatch, summary, anonymous,
                         adddeps, fromPrims )
    import Darcs.Witnesses.Ordered ( FL(..), RL(..), (:>)(..), (+>+),
                                 unsafeUnFL, unsafeCompare,
                                 reverseRL, mapFL, mapFL_FL, nullFL )
    import Darcs.Patch.Info ( PatchInfo )
    import Darcs.Patch.Split ( primSplitter )
    import Darcs.SlurpDirectory ( slurp_hasfile, slurp_hasdir )
    import Darcs.Patch.Choices ( patchChoicesTps, tpPatch,
                                 forceFirst, getChoices, tag )
    import Darcs.SelectChanges ( with_selected_changes_to_files',
                                 with_selected_changes_reversed )
    import Darcs.RepoPath ( FilePathLike, SubPath, sp2fn, toFilePath )
    import Darcs.SlurpDirectory ( Slurpy, empty_slurpy )
    import Darcs.Commands ( DarcsCommand(..), nodefaults, commandStub )
    import Darcs.Arguments ( DarcsFlag( PromptLongComment, NoEditLongComment,
                                        EditLongComment, LogFile, Pipe,
                                        PatchName, AskDeps, All ),
                             fileHelpAuthor,
                             getAuthor, workingRepoDir, lookforadds,
                             fixSubPaths, defineChanges, testByDefault,
                             askLongComment, askdeps, patchSelectFlag,
                             allPipeInteractive, leaveTestDir, notest,
                             author, patchnameOption, umaskOption, ignoretimes,
                             nocompress, rmlogfile, logfile, listRegisteredFiles,
                             setScriptsExecutableOption )
    import Darcs.Flags (willRemoveLogFile)
    import Darcs.Utils ( askUser, promptYorn, edit_file, clarifyErrors )
    import Progress ( debugMessage)
    import Darcs.ProgressPatches( progressFL)
    import IsoDate ( getIsoDateTime, cleanLocalDate )
    import Printer ( hPutDocLn, text, wrap_text, ($$) )
    #include "impossible.h"

    recordDescription :: String
    recordDescription = "Create a patch from unrecorded changes."

    recordHelp :: String
    recordHelp =
     "The `darcs record' command is used to create a patch from changes in\n" ++
     "the working tree.  If you specify a set of files and directories,\n" ++
     "changes to other files will be skipped.\n" ++
     "\n" ++ recordHelp' ++
     "\n" ++ recordHelp''

    record :: DarcsCommand
    record = DarcsCommand {commandName = "record",
                           commandHelp = recordHelp,
                           commandDescription = recordDescription,
                           commandExtraArgs = -1,
                           commandExtraArgHelp = ["[FILE or DIRECTORY]..."],
                           commandCommand = recordCmd,
                           commandPrereq = amInRepository,
                           commandGetArgPossibilities = listRegisteredFiles,
                           commandArgdefaults = nodefaults,
                           commandAdvancedOptions = [logfile, rmlogfile,
                                                       nocompress, ignoretimes,
                                                       umaskOption,
                                                       setScriptsExecutableOption],
                           commandBasicOptions = [patchnameOption, author,
                                                   notest,
                                                   leaveTestDir,
                                                   allPipeInteractive,
                                                   askdeps,
                                                   askLongComment,
                                                   lookforadds,
                                                   workingRepoDir]}

    commitDescription :: String
    commitDescription = "Redirect the user to record, push or send."

    commitHelp :: String
    commitHelp =
     "This command does not do anything.\n"++
     "If you want to save changes locally, use the `darcs record' command.\n"++
     "If you want to save a recorded patch to another repository, use the\n"++
     "`darcs push' or `darcs send' commands instead.\n"

    commit :: DarcsCommand
    commit = commandStub "commit" commitHelp commitDescription record

    fileExists :: Slurpy -> SubPath -> IO Bool
    fileExists s rp =  do file <- doesFileExist fp
                          dir <- doesDirectoryExist fp
                          return (file || dir ||
                                  slurp_hasfile (sp2fn rp) s ||
                                  slurp_hasdir (sp2fn rp) s)
                       where fp = toFilePath rp

    recordCmd :: [DarcsFlag] -> [String] -> IO ()
    recordCmd opts args = do
        checkNameIsNotOption opts
        withRepoLock (testByDefault opts) $- \repository -> do
        rec <- if null args then return empty_slurpy
               else slurp_recorded repository
        files <- sort `fmap` fixSubPaths opts args
        let non_repo_files = if null files && (not $ null args) then args else []
        existing_files <- filterM (fileExists rec) files
        non_existent_files <- filterM (fmap not . fileExists rec) files
        when (not $ null existing_files) $
             putStrLn $ "Recording changes in "++unwords (map show existing_files)++":\n"
        when (not $ null non_existent_files) $
             putStrLn $ "Non existent files or directories: "++unwords (map show non_existent_files)++"\n"
        when (((not $ null non_existent_files) || (not $ null non_repo_files)) && null existing_files) $
             fail "None of the files you specified exist!"
        debugMessage "About to get the unrecorded changes."
        changes <- unrecordedChanges opts repository files
        debugMessage "I've gotten unrecorded."
        case allow_empty_with_askdeps changes of
          Nothing -> do when (Pipe `elem` opts) $ do getDate opts
                                                     return ()
                        if ((not $ null existing_files) || (not $ null non_existent_files))
                           then putStrLn "No changes in selected files or directories!"
                           else putStrLn "No changes!"
          Just ch -> doRecord repository opts existing_files ch
        where allow_empty_with_askdeps NilFL
                  | AskDeps `elem` opts = Just NilFL
                  | otherwise = Nothing
              allow_empty_with_askdeps p = Just p

     -- check that what we treat as the patch name is not accidentally a command
     -- line flag
    checkNameIsNotOption :: [DarcsFlag] -> IO ()
    checkNameIsNotOption opts = do
        let patchNames = [n | PatchName n <- opts]
        when (length patchNames == 1) $ do
            let n = head patchNames
                oneLetterName = length n == 1 || (length n == 2 && head n == '-')
            if (oneLetterName && not (elem All opts))
                then do
                    let keepAsking = do
                        yorn <- promptYorn ("You specified " ++ show n ++ " as the patch name. Is that really what you want?")
                        case yorn of
                            'y' -> return ()
                            'n' -> do
                                       putStrLn "Okay, aborting the record."
                                       exitFailure
                            _   -> keepAsking
                    keepAsking
                else return ()

    doRecord :: RepoPatch p => Repository p -> [DarcsFlag] -> [SubPath] -> FL Prim -> IO ()
    doRecord repository opts files ps = do
        let make_log = world_readable_temp "darcs-record"
        date <- getDate opts
        my_author <- getAuthor opts
        debugMessage "I'm slurping the repository."
        debugMessage "About to select changes..."
        with_selected_changes_to_files' "record" opts (Just primSplitter)
          (map toFilePath files) ps $ \ (chs:>_) ->
          do when (is_empty_but_not_askdeps chs) $
                  do putStrLn "Ok, if you don't want to record anything, that's fine!"
                     exitWith ExitSuccess
             handleJust onlySuccessfulExits (\_ -> return ()) $
                 do deps <- if AskDeps `elem` opts
                            then askAboutDepends repository chs opts
                            else return []
                    when (AskDeps `elem` opts) $ debugMessage "I've asked about dependencies."
                    if nullFL chs && null deps
                      then putStrLn "Ok, if you don't want to record anything, that's fine!"
                      else do defineChanges chs
                              (name, my_log, logf) <- getLog opts Nothing make_log chs
                              doActualRecord repository opts name date
                                     my_author my_log logf deps chs
        where is_empty_but_not_askdeps l
                  | AskDeps `elem` opts = False
                                          -- a "partial tag" patch; see below.
                  | otherwise = nullFL l

    doActualRecord :: RepoPatch p => Repository p -> [DarcsFlag] -> String -> String -> String
                     -> [String] -> Maybe String
                     -> [PatchInfo] -> FL Prim -> IO ()
    doActualRecord repository opts name date my_author my_log logf deps chs =
                  do debugMessage "Writing the patch file..."
                     mypatch <- namepatch date name my_author my_log $
                                fromPrims $ progressFL "Writing changes:" chs
                     tentativelyAddPatch repository opts $ n2pia $ adddeps mypatch deps
                     invalidateIndex repository
                     debugMessage "Applying to pristine..."
                     withGutsOf repository (finalizeRepositoryChanges repository)
                                        `clarifyErrors` failuremessage
                     debugMessage "Syncing timestamps..."
                     when (isJust logf) $ removeFile (fromJust logf)
                     putStrLn $ "Finished recording patch '"++name++"'"
        where failuremessage = "Failed to record patch '"++name++"'" ++
                               case logf of Just lf -> "\nLogfile left in "++lf++"."
                                            Nothing -> ""

    recordHelp' :: String
    recordHelp' =
     "Every patch has a name, an optional description, an author and a date.\n" ++
     "\n" ++
     "The patch name should be a short sentence that concisely describes the\n" ++
     "patch, such as `Add error handling to main event loop.'  You can\n" ++
     "supply it in advance with the -m option, or provide it when prompted.\n" ++
     "\n" ++
     "The patch description is an optional block of free-form text.  It is\n" ++
     "used to supply additional information that doesn't fit in the patch\n" ++
     "name.  For example, it might include a rationale of WHY the change was\n" ++
     "necessary.  By default Darcs asks if you want to add a description;\n" ++
     "the --edit-long-comment and --skip-long-comment can be used to answer\n" ++
     "`yes' or `no' (respectively) to this prompt.  Finally, the --logfile\n" ++
     "option allows you to supply a file that already contains the patch\n" ++
     "name (first line) and patch description (subsequent lines).  This is\n" ++
     "useful if a previous record failed and left a darcs-record-0 file.\n" ++
     "\n" ++
     unlines fileHelpAuthor ++
     "\n" ++
     "The patch date is generated automatically.  It can only be spoofed by\n" ++
     "using the --pipe option.\n"

    getDate :: [DarcsFlag] -> IO String
    getDate opts
     | Pipe `elem` opts = do cleanLocalDate `fmap` askUser "What is the date? "
    getDate _ = getIsoDateTime

    data PName = FlagPatchName String | PriorPatchName String | NoPatchName

    getLog :: [DarcsFlag] -> Maybe (String, [String]) -> IO String -> FL Prim ->
               IO (String, [String], Maybe String)
    getLog opts m_old make_log chs = gl opts
        where patchname_specified = patchname_helper opts
              patchname_helper (PatchName n:_) | take 4 n == "TAG " = FlagPatchName $ '.':n
                                               | otherwise          = FlagPatchName n
              patchname_helper (_:fs) = patchname_helper fs
              patchname_helper [] = case m_old of Just (p,_) -> PriorPatchName p
                                                  Nothing    -> NoPatchName
              default_log = case m_old of
                              Nothing    -> []
                              Just (_,l) -> l
              gl (Pipe:_) = do p <- case patchname_specified of
                                      FlagPatchName p  -> return p
                                      PriorPatchName p -> return p
                                      NoPatchName      -> prompt_patchname False
                               putStrLn "What is the log?"
                               thelog <- lines `fmap` Ratified.hGetContents stdin
                               return (p, thelog, Nothing)
              gl (LogFile f:fs) =
                  do -- round 1 (patchname)
                     mlp <- lines `fmap` readBinFile f `catch` (\_ -> return [])
                     firstname <- case (patchname_specified, mlp) of
                                    (FlagPatchName  p, []) -> return p
                                    (_, p:_)               -> return p -- logfile trumps prior!
                                    (PriorPatchName p, []) -> return p
                                    (NoPatchName, [])      -> prompt_patchname True
                     -- round 2
                     append_info f firstname
                     when (EditLongComment `elem` fs) $ do edit_file f
                                                           return ()
                     (name, thelog, _) <- read_long_comment f firstname
                     let toRemove = if willRemoveLogFile opts
                            then Just $ toFilePath f
                            else Nothing
                     return (name, thelog, toRemove)
              gl (EditLongComment:_) =
                      case patchname_specified of
                        FlagPatchName  p -> actually_get_log p
                        PriorPatchName p -> actually_get_log p
                        NoPatchName      -> prompt_patchname True >>= actually_get_log
              gl (NoEditLongComment:_) =
                      case patchname_specified of
                        FlagPatchName  p
                            | Just ("",_) <- m_old ->
                                           return (p, default_log, Nothing) -- rollback -m
                        FlagPatchName  p -> return (p, default_log, Nothing) -- record (or amend) -m
                        PriorPatchName p -> return (p, default_log, Nothing) -- amend
                        NoPatchName      -> do p <- prompt_patchname True -- record
                                               return (p, [], Nothing)
              gl (PromptLongComment:fs) =
                      case patchname_specified of
                        FlagPatchName p -> prompt_long_comment p -- record (or amend) -m
                        _               -> gl fs
              gl (_:fs) = gl fs
              gl [] = case patchname_specified of
                        FlagPatchName  p -> return (p, default_log, Nothing)  -- record (or amend) -m
                        PriorPatchName "" -> prompt_patchname True >>= prompt_long_comment
                        PriorPatchName p -> return (p, default_log, Nothing)
                        NoPatchName -> prompt_patchname True >>= prompt_long_comment
              prompt_patchname retry =
                do n <- askUser "What is the patch name? "
                   if n == "" || take 4 n == "TAG "
                      then if retry then prompt_patchname retry
                                    else fail "Bad patch name!"
                      else return n
              prompt_long_comment oldname =
                do yorn <- promptYorn "Do you want to add a long comment?"
                   if yorn == 'y' then actually_get_log oldname
                                  else return (oldname, [], Nothing)
              actually_get_log p = do logf <- make_log
                                      writeBinFile logf $ unlines $ p : default_log
                                      append_info logf p
                                      edit_file logf
                                      read_long_comment logf p
              read_long_comment :: FilePathLike p => p -> String -> IO (String, [String], Maybe p)
              read_long_comment f oldname =
                  do t <- (lines.filter (/='\r')) `fmap` readBinFile f
                     case t of [] -> return (oldname, [], Just f)
                               (n:ls) -> return (n, takeWhile
                                                 (not.(eod `isPrefixOf`)) ls,
                                                 Just f)
              append_info f oldname =
                  do fc <- readBinFile f
                     appendToFile f $ \h ->
                         do case fc of
                              _ | null (lines fc) -> hPutStrLn h oldname
                                | last fc /= '\n' -> hPutStrLn h ""
                                | otherwise       -> return ()
                            hPutDocLn h $ text eod
                                $$ text ""
                                $$ wrap_text 75
                                   ("Place the long patch description above the "++
                                    eod++
                                    " marker.  The first line of this file "++
                                    "will be the patch name.")
                                $$ text ""
                                $$ text "This patch contains the following changes:"
                                $$ text ""
                                $$ summary (fromPrims chs :: Patch)

    eod :: String
    eod = "***END OF DESCRIPTION***"

\end{code} \begin{options} --ask-deps \end{options} 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 repository. 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. It is possible to record a patch which has no actual changes but which has specific dependencies. This type of patch can be thought of as a ``partial tag''. The \verb!darcs tag! command will record a patch with no actual changes but which depends on the entire current inventory of the repository. The \verb!darcs record --ask-deps! with no selected changes will record a patch that depends on only those patches selected via the \verb!--ask-deps! operation, resulting in a patch which describes a set of patches; the presence of this primary patch in a repository implies the presence of (at least) the depended-upon patches. \begin{code}

    askAboutDepends :: RepoPatch p => Repository p -> FL Prim -> [DarcsFlag] -> IO [PatchInfo]
    askAboutDepends repository pa' opts = do
      pps <- read_repo repository
      pa <- n2pia `fmap` anonymous (fromPrims pa')
      let ps = (reverseRL $ headRL pps)+>+(pa:>:NilFL)
          (pc, tps) = patchChoicesTps ps
          ta = case filter ((pa `unsafeCompare`) . tpPatch) $ unsafeUnFL tps of
                    [tp] -> tag tp
                    [] -> error "askAboutDepends: []"
                    _ -> error "askAboutDepends: many"
          ps' = mapFL_FL tpPatch $ middle_choice $ forceFirst ta pc
      with_selected_changes_reversed "depend on" (filter askdep_allowed opts) Nothing ps'
                 $ \(deps:>_) -> return $ mapFL info deps
     where headRL (x:<:_) = x
           headRL NilRL = impossible
           askdep_allowed = not . patchSelectFlag
           middle_choice p = mc where (_ :> mc :> _) = getChoices p

    onlySuccessfulExits :: Exception -> Maybe ()
    onlySuccessfulExits (ExitException ExitSuccess) = Just ()
    onlySuccessfulExits _ = Nothing

    recordHelp'' :: String
    recordHelp'' =
     "If a test command has been defined with `darcs setpref', attempting to\n" ++
     "record a patch will cause the test command to be run in a clean copy\n" ++
     "of the working tree (that is, including only recorded changes).  If\n" ++
     "the test fails, the record operation will be aborted.\n" ++
     "\n" ++
     "The --set-scripts-executable option causes scripts to be made\n" ++
     "executable in the clean copy of the working tree, prior to running the\n" ++
     "test.  See `darcs get' for an explanation of the script heuristic.\n" ++
     "\n" ++
     "If your test command is tediously slow (e.g. `make all') and you are\n" ++
     "recording several patches in a row, you may wish to use --no-test to\n" ++
     "skip all but the final test.\n"

\end{code} \begin{options} --pipe \end{options} If you run record with the \verb!--pipe! option, you will be prompted for the patch date, author, and the long comment. The long comment will extend until the end of file or stdin is reached (ctrl-D on Unixy systems, ctrl-Z on systems running a Microsoft OS). This interface is intended for scripting darcs, in particular for writing repository conversion scripts. The prompts are intended mostly as a useful guide (since scripts won't need them), to help you understand the format in which to provide the input. Here's an example of what the \verb!--pipe! prompts look like: \begin{verbatim} What is the date? Mon Nov 15 13:38:01 EST 2004 Who is the author? David Roundy What is the log? One or more comment lines \end{verbatim} \begin{options} --interactive \end{options} By default, \verb!record! works interactively. Probably the only thing you need to know about using this is that you can press \verb!?! at the prompt to be shown a list of the rest of the options and what they do. The rest should be clear from there. Here's a ``screenshot'' to demonstrate: \begin{verbatim} hunk ./hello.pl +2 +#!/usr/bin/perl +print "Hello World!\n"; Shall I record this patch? (2/2) [ynWsfqadjk], or ? for help: ? How to use record... y: record this patch n: don't record it w: wait and decide later, defaulting to no s: don't record the rest of the changes to this file f: record the rest of the changes to this file d: record selected patches a: record all the remaining patches q: cancel record j: skip to next patch k: back up to previous patch h or ?: show this help : accept the current default (which is capitalized) \end{verbatim} What you can't see in that ``screenshot'' is that \verb!darcs! will also try to use color in your terminal to make the output even easier to read.