%  Copyright (C) 2002-2004 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 send}
\begin{code}
module Send ( send ) where
import System ( exitWith, ExitCode( ExitSuccess ) )
import System.Directory ( removeFile )
import Monad ( when, unless, liftM )
import Maybe ( catMaybes, isJust, isNothing )

import DarcsCommands ( DarcsCommand(..) )
import DarcsArguments ( DarcsFlag( EditDescription, LogFile, RmLogFile,
                                   Target, Output, Context, DryRun,
                                   Verbose, Quiet
                                 ),
                        edit_file, get_cc, get_author, working_repo_dir,
                        edit_description, logfile, rmlogfile,
                        sign, get_subject,
                        match_several, set_default,
                        output, cc, subject, target, author, sendmail_cmd,
                        ssh_cm,
                        all_gui_interactive, get_sendmail_cmd,
                        print_dry_run_message_and_exit,
                        any_verbosity, unified, summary,
                        from_opt, dry_run, send_to_context,
                      )
import Repository ( PatchSet, Repository,
                    amInRepository, identifyRepository, withRepoLock,
                    read_repo, slurp_recorded, prefsUrl )
import Patch ( Patch, patch_description, apply_to_slurpy,
               invert, join_patches, patch2patchinfo,
             )
import PatchInfo ( human_friendly, just_name )
import RepoPrefs ( defaultrepo, set_defaultrepo, get_preflist )
import External ( signString, sendEmailDoc, fetchFilePS, Cachable(..) )
import FastPackedString ( unpackPS, mmapFilePS )
import Lock ( writeDocBinFile, readDocBinFile, world_readable_temp )
import SelectChanges ( with_selected_changes )
import Depends ( get_common_and_uncommon )
import PatchBundle ( make_bundle, scan_context )
import DarcsUtils ( askUser, catchall, formatPath )
import Email ( make_email )
import Printer ( Doc, vsep, vcat, text, ($$), putDocLn, putDoc )
import FileName ( patch_filename )
import IO
#include "impossible.h"
\end{code}
\begin{code}
send_description :: String
send_description =
 "Send by email a bundle of one or more patches."
\end{code}

\options{send}

\haskell{send_help}
\begin{code}
send_help :: String
send_help =
 "Send is used to prepare a bundle of patches that can be applied to a target\n"++
 "repository.  Send accepts the URL of the repository as an argument.  When\n"++
 "called without an argument, send will use the most recent repository that\n"++
 "was either pushed to, pulled from or sent to.  By default, the patch bundle\n"++
 "is sent by email, although you may save it to a file.\n"
\end{code}

Do not confuse the \verb!--author! options with the return address
that \verb!darcs send! will set for your patch bundle.

For example, if you have two email addresses A and B:
\begin{description}
\item  If you use
\verb!--author A! but your machine is configured to send mail from
address B by default, then the return address on your message will be B.

\item If you use \verb!--from A! and your mail client supports setting the
From: address arbitrarily (some non-Unix-like mail clients, especially,
may not support this), then the return address will be A; if it does
not support this, then the return address will be B.

\item If you supply neither \verb!--from! nor \verb!--author!, then the return
address will be B.
\end{description}

In addition, unless you specify the sendmail command with
\verb!--sendmail-command!, darcs sends email using the default email
command on your computer. This default command is determined by the
\verb!configure! script. Thus, on some non-Unix-like OSes,
\verb!--from! is likely to not work at all.

\begin{code}
send :: DarcsCommand
send = DarcsCommand {command_name = "send",
                     command_help = send_help,
                     command_description = send_description,
                     command_extra_args = 1,
                     command_extra_arg_help = ["[REPOSITORY]"],
                     command_command = send_cmd,
                     command_prereq = amInRepository,
                     command_get_arg_possibilities = get_preflist "repos",
                     command_argdefaults = defaultrepo,
                     command_darcsoptions = [any_verbosity,
                                             match_several,
                                             all_gui_interactive,
                                             from_opt, author,
                                             target,cc,subject,output,sign,
                                             unified, dry_run, summary,
                                             send_to_context,
                                             edit_description,
                                             logfile, rmlogfile,
                                             set_default, working_repo_dir,
                                             ssh_cm,
                                             sendmail_cmd]}
\end{code}
\begin{code}
send_cmd :: [DarcsFlag] -> [String] -> IO ()
send_cmd input_opts [repodir] = do
  context_ps <- the_context input_opts
  case context_ps of
    Just them -> send_to_them input_opts "CONTEXT" them
    Nothing -> do
        repo <- identifyRepository repodir
        them <- read_repo repo
        old_default <- defaultrepo "" []
        set_defaultrepo repodir input_opts
        when (old_default == [repodir] && not (Quiet `elem` input_opts)) $
             putStrLn $ "Creating patch to "++formatPath repodir++"..."
        opts <- decide_on_behavior input_opts repo
        send_to_them opts repodir them
    where the_context [] = return Nothing
          the_context (Context foo:_)
              = (Just . scan_context )`liftM` mmapFilePS foo
          the_context (_:fs) = the_context fs
send_cmd _ _ = impossible

send_to_them :: [DarcsFlag] -> String -> PatchSet -> IO ()
send_to_them opts their_name them =
  let am_verbose = Verbose `elem` opts
      am_quiet = Quiet `elem` opts
      putVerbose s = when am_verbose $ putDocLn s
      putInfo s = when (not am_quiet) $ putStrLn s
  in
  withRepoLock opts $ \repo -> do
  us <- read_repo repo
  case get_common_and_uncommon (us, them) of
    (common, us', _) -> do
     putVerbose $ text "We have the following patches to send:"
               $$ (vcat $ map (human_friendly.fst) $ head us')
     case us' of
         [[]] -> do putInfo "No recorded local changes to send!"
                    exitWith ExitSuccess
         _ -> return ()
     s <- slurp_recorded repo
     let our_ps = map (fromJust.snd) $ reverse $ head us'
     with_selected_changes "send" opts s our_ps (Just $ length our_ps) $
      \ (_,to_be_sent) -> do
      print_dry_run_message_and_exit "send" opts to_be_sent
      when (null to_be_sent) $ do
          putInfo "You don't want to send any patches, and that's fine with me!"
          exitWith ExitSuccess
      bundle <- signString opts $ make_bundle opts
                (fromJust $ apply_to_slurpy
                 (invert $ join_patches $ reverse $
                  map (fromJust.snd) $ head us') s)
                common to_be_sent
      if wants_output opts
         then do fname <- get_output opts
                 case fname of
                    "-"   -> putDoc bundle
                    _     -> writeDocBinFile fname bundle
         else let
           auto_subject [p]  = "darcs patch: " ++ trim (patch_desc p) 57
           auto_subject (p:ps) = "darcs patch: " ++ trim (patch_desc p) 43 ++
                            " (and " ++ show (length ps) ++ " more)"
           auto_subject _ = error "Tried to get a name from empty patch list."
           trim st n = if length st <= n then st
                       else take (n-3) st ++ "..."
           patch_desc p = case patch2patchinfo p of
                          Just pinf -> just_name pinf
                          Nothing -> ""
           in do
           thetargets <- get_targets opts
           from <- get_author opts
           let thesubject = case get_subject opts of
                            Nothing -> auto_subject to_be_sent
                            Just subj -> subj
           (mailcontents, mailfile) <- get_description opts to_be_sent
           let body = make_email their_name (Just mailcontents) bundle
                        (Just (patch_filename $ patch_desc $ head to_be_sent))
               contentAndBundle = Just (mailcontents, bundle)
           (sendEmailDoc from (lt thetargets) (thesubject) (get_cc opts)
                          (get_sendmail_cmd opts) contentAndBundle body)
                          `catch` \e -> let
                              msg = "Email body left in " in do
                              when (isJust mailfile) $
                                  putStrLn $ msg ++ (fromJust mailfile) ++ "."
                              fail $ ioeGetErrorString e
           when (isJust mailfile) $
                case get_fileopt opts of
                    Just _  -> when (RmLogFile `elem` opts) $
                                    remove_log mailfile
                    Nothing -> remove_log mailfile
           putInfo $ "Successfully sent patch bundle to: "++lt thetargets++"."
               where lt [t] = t
                     lt [t,""] = t
                     lt (t:ts) = t++" , "++lt ts
                     lt [] = ""
                     where remove_log l = (removeFile $ fromJust l)
                                              `catch` \_ -> return ()
\end{code}

\begin{options}
--unified
\end{options}

If you want to create patches having context, you can use the
\verb!--unified! option, which creates output vaguely reminiscent of
\verb!diff -u!. This format is still darcs-specific and should not
be expected to apply cleanly by \verb!patch!.

\begin{options}
--output, --to, --cc
\end{options}

The \verb!--output! and \verb!--to! flags determine what darcs does with
the patch bundle after creating it.  If you provide an \verb!--output!
argument, the patch bundle is saved to that file.  If you give one or more
\verb!--to! arguments, the bundle of patches is emailed to those addresses.

If you don't provide either a \verb!--output! or a \verb!--to! flag, darcs
will look at the contents of the \verb!_darcs/prefs/email! file in the
target repository (if it exists), and send the patch by email to that
address.  In this case, you may use the \verb!--cc! option to specify
additional recipients without overriding the default repository email
address.

If there is no email address associated with the repository, darcs will
prompt you for an email address.

\begin{options}
--subject
\end{options}

Use the \verb!--subject! flag to set the subject of the e-mail to be sent.
If you don't provide a subject on the command line, darcs will make one up
based on names of the patches in the patch bundle.


\begin{code}
decide_on_behavior :: [DarcsFlag] -> Repository -> IO [DarcsFlag]
decide_on_behavior opts remote_repo =
    case the_targets of
    [] ->
          if wants_output opts
          then return opts
          else
          do email_defaults <- who_to_email
             case email_defaults of
               [] -> return opts
               emails -> do announce_recipients emails
                            return $ map Target emails ++ opts
    ts -> do announce_recipients ts
             return opts
    where the_targets = collect_targets opts
          who_to_email =
              do email <- (unpackPS `liftM`
                           fetchFilePS (prefsUrl remote_repo++"/email")
                                       (MaxAge 600))
                          `catchall` return ""
                 if '@' `elem` email then return $ lines email
                                     else return []
          putInfoLn s = unless (Quiet `elem` opts) $ putStrLn s
          announce_recipients emails =
            if DryRun `elem` opts
            then putInfoLn $ "Patch bundle would be sent to: "++unwords emails
            else when (the_targets == []) $
                 putInfoLn $ "Patch bundle will be sent to: "++unwords emails
\end{code}

\begin{code}
wants_output :: [DarcsFlag] -> Bool
wants_output (Output _:_) = True
wants_output (_:flags) = wants_output flags
wants_output [] = False
get_output :: [DarcsFlag] -> IO String
get_output (Output a:_) = return a
get_output (_:flags) = get_output flags
get_output [] = bug "in Send: called get_output when wants_output is false."
\end{code}

\begin{code}
get_targets :: [DarcsFlag] -> IO [String]
get_targets flags =
    case collect_targets flags of
    [] -> do liftM (:[]) $ askUser "What is the target email address? "
    ts -> return $ ts

collect_targets :: [DarcsFlag] -> [String]
collect_targets flags =  
    catMaybes $ map towhom flags
    where towhom (Target t) = Just t
          towhom _ = Nothing
\end{code}

\begin{options}
--matches, --patches, --tags
\end{options}

The \verb!--patches!, \verb!--matches!, and \verb!--tags! options can be
used to select which patches to send, as described in
subsection~\ref{selecting}.  darcs will silently send along any other patches
upon which the selected patches depend.

\begin{options}
--edit-description
\end{options}

If you want to include a description or explanation along with the bundle
of patches, you need to specify the \verb!--edit-description! flag, which
will cause darcs to open up an editor with which you can compose a message
to go along with your patches.

\begin{options}
--sendmail-command
\end{options}

If you want to use a command different from the default one for sending email,
you need to specify a command line with the \verb!--sendmail-command! option. The
command line can contain some format specifiers which are replaced by the actual
values. Accepted format specifiers are \verb!%s! for subject, \verb!%t! for to,
\verb!%c! for cc, \verb!%b! for the body of the mail, \verb!%f! for from, \verb!%a!
for the patch bundle and the same specifiers in uppercase for the URL-encoded values.
Additionally you can add \verb!%<! to the end of the command line if the command
expects the complete email message on standard input. E.g.\ the command lines for evolution
and msmtp look like this:

\begin{verbatim}
evolution "mailto:%T?subject=%S&attach=%A&cc=%C&body=%B"
msmtp %t %<
\end{verbatim}

\begin{code}
get_description :: [DarcsFlag] -> [Patch] -> IO (Doc, Maybe String)
get_description opts patches =
    case get_filename of
        Just f -> do file <- f
                     when (EditDescription `elem` opts) $ do
                       when (isNothing $ get_fileopt opts) $
                            writeDocBinFile file patchdesc
                       edit_file file
                       return ()
                     doc <- readDocBinFile file
                     return (doc, Just file)
        Nothing -> return (patchdesc, Nothing)
    where patchdesc = vsep $ map patch_description patches
          get_filename = case get_fileopt opts of
                                Just f -> Just f
                                Nothing -> if EditDescription `elem` opts
                                              then Just tempfile
                                              else Nothing
          tempfile = world_readable_temp "darcs-temp-mail"

get_fileopt :: [DarcsFlag] -> Maybe (IO String)
get_fileopt (LogFile f:_) = Just $ return f
get_fileopt (_:flags) = get_fileopt flags
get_fileopt [] = Nothing
\end{code}