%  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
%  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.

\subsection{darcs record}
{-# OPTIONS_GHC -cpp -fglasgow-exts #-}
{-# LANGUAGE CPP, PatternGuards #-}

module Darcs.Commands.Record ( record, commit, get_date, get_log, file_exists ) where
import Control.Exception ( handleJust, Exception( ExitException ) )
import Control.Monad ( filterM, when )
import System.IO ( hGetContents, stdin )
import Data.List ( sort, isPrefixOf )
import System.Exit ( 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, removeFileMayNotExist )
import Darcs.Hopefully ( info, n2pia )
import Darcs.Repository ( Repository, amInRepository, withRepoLock, ($-),
                          get_unrecorded, get_unrecorded_unsorted, withGutsOf,
                    sync_repo, read_repo,
                    tentativelyAddPatch, finalizeRepositoryChanges,
import Darcs.Patch ( RepoPatch, Patch, Prim, namepatch, summary, anonymous,
                     adddeps, fromPrims )
import Darcs.Ordered ( FL(..), RL(..), (:>)(..), (+>+),
                             unsafeUnFL, unsafeCompare,
                             reverseRL, mapFL, mapFL_FL, nullFL )
import Darcs.Patch.Info ( PatchInfo )
import Darcs.SlurpDirectory ( slurp_hasfile, slurp_hasdir )
import Darcs.Patch.Choices ( patch_choices_tps, tp_patch,
                             force_first, get_choices, 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, loggers, command_stub )
import Darcs.Arguments ( DarcsFlag( PromptLongComment, NoEditLongComment,
                                    EditLongComment, RmLogFile, LogFile, Pipe,
                                    PatchName, AskDeps, All ),
                         get_author, working_repo_dir, lookforadds,
                         fixSubPaths, defineChanges, testByDefault,
                         ask_long_comment, askdeps, patch_select_flag,
                         all_pipe_interactive, leave_test_dir, notest,
                         author, patchname_option, umask_option, ignoretimes,
                         nocompress, rmlogfile, logfile, list_registered_files,
                         set_scripts_executable )
import Darcs.Utils ( askUser, promptYorn, edit_file, clarify_errors )
import Progress ( debugMessage)
import Darcs.ProgressPatches( progressFL)
import IsoDate ( getIsoDateTime, cleanLocalDate )
import Printer ( hPutDocLn, text, wrap_text, ($$), renderString )
#include "impossible.h"

record_description :: String
record_description =
 "Save changes in the working copy to the repository as a patch."


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
record_help :: String
record_help = renderString $ wrap_text 80 $
 "Record is used to name a set of changes and record the patch to the "++

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 = amInRepository,
                       command_get_arg_possibilities = list_registered_files,
                       command_argdefaults = nodefaults,
                       command_advanced_options = [logfile, rmlogfile,
                                                   nocompress, ignoretimes,
                       command_basic_options = [patchname_option, author,

commit_description :: String
commit_description =
 "Does not actually do anything, but offers advice on saving changes"

commit_help :: String
commit_help =
 "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 = command_stub "commit" commit_help commit_description record

file_exists :: Slurpy -> SubPath -> IO Bool
file_exists 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

record_cmd :: [DarcsFlag] -> [String] -> IO ()
record_cmd opts args = do
    check_name_is_not_option opts
    let (logMessage,_, _) = loggers 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 (file_exists rec) files
    non_existent_files <- filterM (fmap not . file_exists rec) files
    when (not $ null existing_files) $
         logMessage $ "Recording changes in "++unwords (map show existing_files)++":\n"
    when (not $ null non_existent_files) $
         logMessage $ "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 <- if All `elem` opts then get_unrecorded_unsorted repository
                                  else get_unrecorded repository
    debugMessage "I've gotten unrecorded."
    case allow_empty_with_askdeps changes of
      Nothing -> do when (Pipe `elem` opts) $ do get_date opts
                                                 return ()
                    if ((not $ null existing_files) || (not $ null non_existent_files))
                       then logMessage "No changes in selected files or directories!"
                       else logMessage "No changes!"
      Just ch -> do_record 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
check_name_is_not_option :: [DarcsFlag] -> IO ()
check_name_is_not_option opts = do
    let (logMessage, _, _) = loggers opts
        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
                                   logMessage "Okay, aborting the record."
                        _   -> keepAsking
            else return ()

do_record :: RepoPatch p => Repository p -> [DarcsFlag] -> [SubPath] -> FL Prim -> IO ()
do_record repository opts files ps = do
    let make_log = world_readable_temp "darcs-record"
    date <- get_date opts
    my_author <- get_author opts
    debugMessage "I'm slurping the repository."
    s <- slurp_recorded repository
    debugMessage "About to select changes..."
    with_selected_changes_to_files' "record" opts
      s (map toFilePath files) ps $ \ (chs:>_) ->
      if is_empty_but_not_askdeps chs
        then putStrLn "Ok, if you don't want to record anything, that's fine!"
        else handleJust only_successful_exits (\_ -> return ()) $
             do deps <- if AskDeps `elem` opts
                        then ask_about_depends 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) <- get_log opts Nothing make_log chs
                          do_actual_record 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

do_actual_record :: RepoPatch p => Repository p -> [DarcsFlag] -> String -> String -> String
                 -> [String] -> Maybe String
                 -> [PatchInfo] -> FL Prim -> IO ()
do_actual_record 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
                 debugMessage "Applying to pristine..."
                 withGutsOf repository (finalizeRepositoryChanges repository)
                                    `clarify_errors` failuremessage
                 debugMessage "Syncing timestamps..."
                 sync_repo repository
                 when (isJust logf) $ removeFile (fromJust logf)
                 logMessage $ "Finished recording patch '"++name++"'"
    where (logMessage,_,_) = loggers opts
          failuremessage = "Failed to record patch '"++name++"'" ++
                           case logf of Just lf -> "\nLogfile left in "++lf++"."
                                        Nothing -> ""
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.

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.
get_date :: [DarcsFlag] -> IO String
get_date opts
 | Pipe `elem` opts = do cleanLocalDate `fmap` askUser "What is the date? "
get_date _ = getIsoDateTime
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.


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. The file's contents will
override the \verb!--patch-name! option.

data PName = FlagPatchName String | PriorPatchName String | NoPatchName

get_log :: [DarcsFlag] -> Maybe (String, [String]) -> IO String -> FL Prim ->
           IO (String, [String], Maybe String)
get_log 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` hGetContents stdin -- ratify hGetContents: stdin not deleted
                           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
                 when (RmLogFile `elem` opts) $ removeFileMayNotExist f
                 return (name, thelog, Nothing)
          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, [], 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, [], 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 "++
                                " 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***"


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

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.

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

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

--no-test,  --test

If you configure darcs to run a test suite, darcs will run this test on the
recorded repository to make sure it is valid.  Darcs first creates a pristine
copy of the source tree (in a temporary directory), 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.


If you pass \verb!--set-scripts-executable! to \verb!darcs record!, darcs will set scripts
executable in the test directory before running the test.


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:

 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


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:

hunk ./hello.pl +2
+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

<Space>: accept the current default (which is capitalized)

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.