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

\subsection{darcs record}
\begin{code}
module Record ( record, get_date ) where
import Control.Exception ( handleJust, Exception( ExitException ) )
import Control.Monad ( filterM, liftM, when )
#ifdef HAVEWX
import Graphics.UI.WX hiding ( when, text )
import qualified Graphics.UI.WX ( text )
import Data.IORef
import Repository ( takeRepoGuiLock, releaseRepoGuiLock )
import SelectChanges ( gui_change_selector, selected_patches )
#endif
import IO ( hGetContents, stdin )
import List ( nub, sort, isPrefixOf )
import System
import System.IO ( openBinaryFile, IOMode(AppendMode), hClose, hPutStrLn )
import System.Directory ( doesFileExist, doesDirectoryExist, removeFile )
import Maybe ( isJust )

import SignalHandler ( withSignalsBlocked )
import Lock ( readBinFile, writeBinFile, world_readable_temp )
import Repository ( amInRepository, identifyRepository, withRepoLock,
                    get_unrecorded,
                    with_new_pending, sync_repo, read_repo,
                    slurp_recorded, updateInventory, writePatch,
                    applyToPristine, patchTokenToPatchFile
                  )
import Patch ( Patch, patch2patchinfo, join_patches, flatten,
               namepatch, patch_summary,
               adddeps, eq_patches, null_patch,
               gzReadPatchFileLazily,
             )
import PatchInfo ( PatchInfo, patchinfo )
import SlurpDirectory ( slurp_hasfile, slurp_hasdir )
import FileName ( fp2fn )
import PatchChoices ( patch_choices_tps, tp_patch,
                      force_first, get_middle_choice, )
import SelectChanges ( with_selected_changes_to_files, promptChar,
                       with_selected_changes_reversed,
                     )
import SlurpDirectory ( Slurpy, empty_slurpy )
import DarcsCommands ( DarcsCommand(..), nodefaults, loggers )
import DarcsArguments hiding ( help, files )
import DarcsUtils ( askUser )
import Test ( test_patch )
import IsoDate ( getIsoDateTime, cleanDate )
import Printer ( hPutDocLn, text, wrap_text, ($$), renderString )
#include "impossible.h"
\end{code}
\begin{code}
record_description :: String
record_description =
 "Save changes in the working copy to the repository as a patch."
\end{code}

\options{record}

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 = renderString $ wrap_text 80 $
 "Record is used to name a set of changes and record the patch to the "++
 "repository."
\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 = amInRepository,
                       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,
                                               umask_option]}
\end{code}
\begin{code}
file_exists :: Slurpy -> String -> IO Bool
file_exists s fn = do file <- doesFileExist (fn)
                      dir <- doesDirectoryExist (fn)
                      return (file || dir ||
                              slurp_hasfile (fp2fn fn) s ||
                              slurp_hasdir (fp2fn fn) s)

record_cmd :: [DarcsFlag] -> [String] -> IO ()
record_cmd opts args =
    let (logMessage,_, _) = loggers opts in
    withRepoLock opts $ \repository -> do
    rec <- if null args then return empty_slurpy
           else slurp_recorded repository
    files <- sort `liftM` fix_filepaths_wrt "." opts args
    existing_files <- filterM (file_exists rec) files
    non_existent_files <- filterM (liftM 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) && null existing_files) $
         fail "None of the files you specified exist!"
    when (Verbose `elem` opts) $
         logMessage "About to get the unrecorded changes."
    changes <- if All `elem` opts then
               get_unrecorded repository (AnyOrder:opts)
               else get_unrecorded repository opts
    when (Verbose `elem` opts) $ logMessage "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 ->
#ifdef HAVEWX
                 if Gui `elem` opts
                 then do s <- slurp_recorded repository
                         guiSelectPatches opts s $ flatten ch
                 else
#endif
                         do_record opts existing_files $ flatten ch
    where allow_empty_with_askdeps Nothing
              | AskDeps `elem` opts = Just null_patch
              | otherwise = Nothing
          allow_empty_with_askdeps mp = mp

do_record :: [DarcsFlag] -> [FilePath] -> [Patch] -> IO ()
do_record opts files ps = do
    let make_log = world_readable_temp "darcs-record"
    repository <- identifyRepository "."
    date <- get_date opts
    my_author <- get_author opts
    s <- slurp_recorded repository
    with_selected_changes_to_files "record" (filter (\f-> f==Gui || f==All) opts)
      s files ps Nothing $ \ (skipped,chs) ->
      if is_empty_but_not_askdeps chs
        then putStrLn "Ok, if you don't want to record anything, that's fine!"
        else do deps <- if AskDeps `elem` opts
                        then ask_about_depends $ join_patches chs
                        else return []
                when (Verbose `elem` opts && AskDeps `elem` opts) $
                     putStrLn "I've asked about dependencies..."
                firstname <- get_patchname opts
                (name, my_log, logf) <- get_log opts firstname make_log chs
                do_actual_record opts name date
                                 my_author my_log logf 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] -> Maybe String
                 -> [PatchInfo] -> [Patch] -> [Patch] -> IO ()
do_actual_record opts name date my_author my_log logf deps chs skipped =
                let (logMessage,_,_) = loggers opts
                    mypatch = namepatch date name my_author my_log $ join_patches chs
                    myinfo = patchinfo date name my_author my_log
                 in do
                 repository <- identifyRepository "."
                 when (Verbose `elem` opts) $
                     logMessage "Writing the patch file..."
                 (mypatch', token) <-
                     writePatch repository opts $ adddeps mypatch deps
                 want_test <- want_to_do_test opts
                 when want_test $ do
                     let mfp = patchTokenToPatchFile token
                     let logmsg = "Logfile left in " ++ (fromJust logf) ++ "."
                     case mfp of
                         Just fp ->
                             do testproblem <-
                                    (gzReadPatchFileLazily fp >>=
                                     (test_patch opts))
                                when (testproblem /= ExitSuccess) $ do
                                    when (Verbose `elem` opts) $
                                        logMessage "Removing the patch file."
                                    removeFile fp
                                    when (isJust logf) $
                                        logMessage $ logmsg
                                    exitWith $ ExitFailure 1
                                return ()
                         Nothing -> return ()
                 when (Verbose `elem` opts) $
                     logMessage "Applying to current..."
                 withSignalsBlocked $
                   with_new_pending repository (join_patches skipped) $ do
                   applyToPristine repository mypatch'
                   updateInventory repository [(myinfo, token)]
                 when (Verbose `elem` opts) $
                     logMessage "Syncing timestamps..."
                 sync_repo repository
                 when (isJust logf) $ removeFile (fromJust logf)
                 logMessage $ "Finished recording patch '"++name++"'"

#ifdef HAVEWX
guiSelectPatches :: [DarcsFlag] -> Slurpy -> [Patch] -> IO ()
guiSelectPatches opts _ ps = do
    date <- get_date opts
    my_author <- get_author opts
    name <- get_patchname opts
    let start_ = if SubGui `elem` opts then id else start
    start_ $ hello opts my_author date name ps
hello :: [DarcsFlag]
      -> String -> String -> String -> [Patch] -> IO ()
hello opts my_author date name ps = do
    takeRepoGuiLock
    f <- frame [Graphics.UI.WX.text := "Record patch"]
    (ms,mclose) <- default_menubar
    author_text <- textEntry f [Graphics.UI.WX.text := my_author]
    name_text <- textEntry f [Graphics.UI.WX.text := name]
    sp <- panel f []
    log_and_patches <- splitterWindow sp []
    let (init_pc,tps) = patch_choices_tps ps
    pc <- newIORef init_pc
    scrolled <- gui_change_selector False False log_and_patches pc tps
    log_text <- textCtrl log_and_patches [Graphics.UI.WX.text := ""]
    quit <- button f [Graphics.UI.WX.text := "Cancel", on command := close f]
    bs <- get quit bestSize
    set quit [clientSize := bs]
    rec <- button f
           [Graphics.UI.WX.text := "Record",
            on command := do rpc <- readIORef pc
                             let (skipped, chs) =
                                   selected_patches False False [] rpc
                             logt <- get log_text Graphics.UI.WX.text
                             my_log <- case lines logt of
                                       [""] -> return []
                                       lt -> return lt
                             my_a <- get author_text Graphics.UI.WX.text
                             n <- get name_text Graphics.UI.WX.text
                             do_actual_record opts
                                       n date my_a my_log Nothing []
                                       chs skipped
                             close f
                    ]
    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 $ container sp $ fill $ hsplit log_and_patches 5 50 
                               (widget log_text) (widget scrolled),
                               margin 5 $ row 5 [hglue, widget quit,
                                                 widget rec,hspace 20]],
           menuBar := ms, on (menu mclose) := close f,
           clientSize := sz 600 400, -- this is window actual size
           on closing := releaseRepoGuiLock >> propagateEvent
          ]

default_menubar :: IO ([Menu ()], MenuItem ())
default_menubar = do
  file <- menuPane [Graphics.UI.WX.text := "&File"]
  mclose <- menuItem file [Graphics.UI.WX.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
    n <- askUser "What is the patch name? "
    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 cleanDate `liftM` askUser "What is the date? "
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.

\begin{options}
--logfile
\end{options}

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.

\begin{code}
get_log :: [DarcsFlag] -> String -> IO String -> [Patch] ->
           IO (String, [String], Maybe String)
get_log opts oldname make_log chs = gl opts
    where patchname_specified (PatchName _:_) = True
          patchname_specified (_:fs) = patchname_specified fs
          patchname_specified [] = False
          gl (Pipe:_) = do putStrLn "What is the log?"
                           thelog <- lines `liftM` hGetContents stdin -- ratify hGetContents: stdin not deleted
                           return (oldname, thelog, Nothing)
          gl (LogFile f:fs) =
              do append_info f
                 when (EditLongComment `elem` fs) $ do edit_file f
                                                       return ()
                 (name, thelog, _) <- read_long_comment f
                 when (RmLogFile `elem` opts) $
                      removeFile f `catch` \_ -> return ()
                 return (name, thelog, Nothing)
          gl (EditLongComment:_) = actually_get_log
          gl (NoEditLongComment:_) = return (oldname, [], Nothing)
          gl (_:fs) = gl fs
          gl [] =
              if patchname_specified opts
              then return (oldname, [], Nothing)
              else do yorn <- promptChar
                              "Do you want to add a long comment?" "yn"
                      if yorn == 'y' then actually_get_log
                                     else return (oldname, [], Nothing)
          actually_get_log = do logf <- make_log
                                writeBinFile logf ""
                                append_info logf
                                edit_file logf
                                read_long_comment logf
          read_long_comment :: FilePath -> IO (String, [String], Maybe String)
          read_long_comment f =
              do t <- (lines.filter (/='\r')) `liftM` readBinFile f
                 case t of [] -> return (oldname, [], Just f)
                           (n:ls) -> return (n, takeWhile
                                             (not.(eod `isPrefixOf`)) ls,
                                             Just f)
          append_info f =
              do ls <- (lines `liftM` readBinFile f)
                 h <- openBinaryFile f AppendMode
                 when (ls == []) $ hPutStrLn h oldname
                 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 ""
                            $$ patch_summary (join_patches chs)
                 hClose h
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.

\begin{code}
ask_about_depends :: Patch -> IO [PatchInfo]
ask_about_depends pa = do
  repository <- identifyRepository "."
  pps <- read_repo repository
  let ps = (map (fromJust.snd) $ reverse $ head pps)++[pa]
      (pc, tps) = patch_choices_tps ps
      tpa = case filter ((pa `eq_patches`) . tp_patch) tps of
                [tp] -> tp
                [] -> error "ask_about_depends: []"
                _ -> error "ask_about_depends: many"
      ps' = map tp_patch $ get_middle_choice $ force_first tpa pc
      in handleJust only_successful_exits (\_ -> return []) $
         with_selected_changes_reversed "depend on" [] empty_slurpy ps' Nothing
             $ \(_,deps) -> return $ map (fromJust.patch2patchinfo) deps

only_successful_exits :: Exception -> Maybe ()
only_successful_exits (ExitException ExitSuccess) = Just ()
only_successful_exits _ = Nothing
\end{code}

\begin{options}
--no-test,  --test
\end{options}

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.

\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}

\begin{options}
--pipe
\end{options}

If you run record with the \verb!--pipe! option, you will be prompted for
the patch date, the author, the patch name, and the long comment.
The long comment will
extend until the end of file of 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.

\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

<Space>: 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.
