%  Copyright (C) 2002-2005 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 pull}
\begin{code}
module Darcs.Commands.Pull ( pull, merge_with_us_and_pending,
              check_unrecorded_conflicts,
            ) where
import System ( ExitCode(..), exitWith )
import Control.Monad ( when )
import Data.Maybe ( catMaybes )

import Darcs.Hopefully ( hopefully )
import Darcs.SignalHandler ( withSignalsBlocked )
import Darcs.Commands ( DarcsCommand(..), loggers )
import Darcs.CommandsAux ( check_paths )
import Darcs.Arguments ( DarcsFlag( Test, Verbose, Quiet, DryRun,
                                   Intersection, Complement ),
                        want_external_merge, nocompress, ignoretimes,
                        no_deps, use_external_merge,
                        match_several, fix_filepaths,
                        all_gui_interactive, repo_combinator,
                        print_dry_run_message_and_exit,
                        any_verbosity, test, dry_run,
                        set_default, summary, working_repo_dir,
                        set_scripts_executable,
                        ssh_cm, umask_option,
                      )
import Darcs.Repository ( PatchSet, identifyRepository,
                    amInRepository, withRepoLock,
                    slurp_recorded, slurp_recorded_and_unrecorded,
                    read_repo, absolute_dir, get_unrecorded_unsorted,
                    read_pending, sync_repo,
                    tentativelyAddPatch, tentativelyAddToPending, finalizeRepositoryChanges,
                    applyToWorking,
                  )
import Darcs.Patch ( Patch, join_patches, merge, patch2patchinfo,
               unjoin_patches, list_touched_files,
               list_conflicted_files,
             )
import Darcs.Patch.Info ( human_friendly, showPatchInfo )
import Darcs.SlurpDirectory ( wait_a_moment )
import Darcs.Repository.Prefs ( add_to_preflist, defaultrepo, set_defaultrepo, get_preflist )
import Darcs.Repository.Motd (show_motd )
import Darcs.Patch.Depends ( get_common_and_uncommon,
                 patchset_intersection, patchset_union, patchset_complement )
import Darcs.Resolution ( standard_resolution, external_resolution )
import Darcs.SelectChanges ( with_selected_changes )
import Darcs.Utils ( clarify_errors, nubsort, formatPath, promptChar )
import Darcs.Test ( test_patch )
import Printer ( Doc, putDocLn, vcat, ($$), text )
#include "impossible.h"
\end{code}
\begin{code}
pull_description :: String
pull_description =
 "Copy and apply patches from another repository to this one."
\end{code}

\options{pull}

\haskell{pull_help}
\begin{code}
pull_help :: String
pull_help =
 "Pull is used to bring changes made in another repository into the current\n"++
 "repository (that is, either the one in the current directory, or the one\n"++
 "specified with the --repodir option). Pull allows you to bring over all or\n"++
 "some of the patches that are in that repository but not in this one. Pull\n"++
 "accepts arguments, which are URLs from which to pull, and when called\n"++
 "without an argument, pull will use the repository from which you have most\n"++
 "recently either pushed or pulled.\n"
\end{code}
\begin{code}
pull :: DarcsCommand
pull = DarcsCommand {command_name = "pull",
                     command_help = pull_help,
                     command_description = pull_description,
                     command_extra_args = -1,
                     command_extra_arg_help = ["[REPOSITORY]..."],
                     command_command = pull_cmd,
                     command_prereq = amInRepository,
                     command_get_arg_possibilities = get_preflist "repos",
                     command_argdefaults = defaultrepo,
                     command_darcsoptions = [match_several,
                                             all_gui_interactive,
                                             repo_combinator,
                                             use_external_merge,nocompress,
                                             test, dry_run, summary,
                                             any_verbosity,
                                             ignoretimes,no_deps,
                                             set_default,
                                             working_repo_dir,
                                             set_scripts_executable,
                                             ssh_cm,
                                             umask_option]}
\end{code}
\begin{code}
pull_cmd :: [DarcsFlag] -> [String] -> IO ()

pull_cmd opts unfixedrepodirs@(_:_) =
  let (logMessage, logError, logDocLn) = loggers opts
      putInfo = if Quiet `elem` opts then \_ -> return () else logDocLn
      putVerbose = if Verbose `elem` opts then putDocLn else \_ -> return ()
  in withRepoLock opts $ \repository -> do
  -- Test to make sure we aren't trying to pull from the current repo
  let repodirs = fix_filepaths "" opts unfixedrepodirs
  cur_absolute_repo_dir <- absolute_dir "."
  req_absolute_repo_dirs <- mapM absolute_dir repodirs
  when (cur_absolute_repo_dir `elem` req_absolute_repo_dirs) $
        fail "Can't pull from current repository!"
  (them,compl) <- read_repos opts repodirs
  old_default <- defaultrepo "" []
  set_defaultrepo (head repodirs) opts
  mapM_ (add_to_preflist "repos") repodirs
  when (old_default == repodirs) $
      let pulling = if DryRun `elem` opts then "Would pull" else "Pulling"
      in  putInfo $ text $ pulling++" from "++concatMap formatPath repodirs++"..."
  mapM (show_motd opts) repodirs
  us <- read_repo repository
  (_, us', them'') <- return $ get_common_and_uncommon (us, them)
  (_,   _, compl') <- return $ get_common_and_uncommon (us, compl)
  them' <- return (patchset_complement them'' compl')
  do
     putVerbose $ text "We have the following new (to them) patches:"
               $$ (vcat $ map (human_friendly.fst) $ head us')
     putVerbose $ text "They have the following patches to pull:"
               $$ (vcat $ map (human_friendly.fst) $ head them')
     case them' of
         [[]] -> do putInfo $ text "No remote changes to pull in!"
                    exitWith ExitSuccess
         _ -> return ()
     s <- slurp_recorded repository
     let ps = map hopefully $ reverse $ head them'
     with_selected_changes "pull" opts s ps (Just $ length ps) $
      \ (_,to_be_pulled) -> do
      print_dry_run_message_and_exit "pull" opts to_be_pulled
      when (null to_be_pulled) $ do
          logMessage "You don't want to pull any patches, and that's fine with me!"
          exitWith ExitSuccess
      check_paths opts to_be_pulled
      putVerbose $ text "Getting and merging the following patches:"
      putVerbose $ format_patches_inventory to_be_pulled
      (pc,pw) <- merge_with_us_and_pending opts
                 (map hopefully $ reverse $ head us', to_be_pulled)
      standard_resolved_pw <- standard_resolution pw
      have_conflicts <- announce_merge_conflicts logMessage standard_resolved_pw
      have_unrecorded_conflicts <- check_unrecorded_conflicts opts pc
      (_, working) <- slurp_recorded_and_unrecorded repository
      pw_resolved <-
          case (want_external_merge opts, have_conflicts || have_unrecorded_conflicts) of
          (Nothing,_) -> return $ join_patches standard_resolved_pw
          (_,False) -> return $ join_patches standard_resolved_pw
          (Just c, True) -> do pend <- get_unrecorded_unsorted repository
                               join_patches `fmap` external_resolution repository c working
                                    (join_patches $ (++catMaybes [pend]) $
                                     map hopefully $ reverse $ head us')
                                    (join_patches to_be_pulled) pw
      putVerbose $ text "Applying patches to the local directories..."
      when (Test `elem` opts) $
           do testproblem <- test_patch opts pc
              when (testproblem /= ExitSuccess) $ do
                  logError "Error in test..."
                  exitWith $ ExitFailure 1
      mapM_ (tentativelyAddPatch repository opts) $ fromJust $ unjoin_patches pc
      tentativelyAddToPending repository opts pw_resolved
      withSignalsBlocked $ do finalizeRepositoryChanges repository
                              -- so work will be more recent than rec:
                              revertable $
                                do wait_a_moment
                                   applyToWorking repository opts pw_resolved `catch` \e ->
                                       fail ("Error applying patch to working dir:\n" ++ show e)
      sync_repo repository
      putInfo $ text "Finished pulling and applying."
          where revertable x = x `clarify_errors` unlines
                  ["This may have left your working directory an inconsistent",
                   "but recoverable state. If you had no un-recorded changes",
                   "by using 'darcs revert' you should be able to make your",
                   "working directory consistent again."]
pull_cmd _ [] = fail "No default repository to pull from, please specify one"
format_patches_inventory :: [Patch] -> Doc
format_patches_inventory ps =
    vcat $ map (showPatchInfo.fromJust.patch2patchinfo) ps
\end{code}

\begin{code}

{- Read in the specified pull-from repositories.  Perform
Intersection, Union, or Complement read.  In patch-theory terms
(stated in set algebra, where + is union and & is intersection
and \ is complement):

    Union =         ((R1 + R2 + ... + Rn) \ Rc)
    Intersection =  ((R1 & R2 & ... & Rn) \ Rc)
    Complement =    (R1 \ Rc) \ ((R2 + R3 + ... + Rn) \ Rc)

                        where Rc = local repo
                              R1 = 1st specified pull repo
                              R2, R3, Rn = other specified pull repo

Since Rc is not provided here yet, the result of read_repos is a
tuple: the first patchset(s) to be complemented against Rc and then
the second patchset(s) to be complemented against Rc.
-}

read_repos :: [DarcsFlag] -> [String] -> IO (PatchSet,PatchSet)
read_repos _ [] = impossible
read_repos opts us =
    do rs <- mapM (\u -> identifyRepository opts u >>= read_repo) us
       return $ if Intersection `elem` opts
                then (patchset_intersection rs, [])
                else if Complement `elem` opts
                     then (head rs, patchset_union $ tail rs)
                     else (patchset_union rs, [])
\end{code}

\begin{options}
--intersection, --union [DEFAULT], --complement
\end{options}

If you provide more than one repository as an argument to pull, darcs'
behavior is determined by the presence of the \verb!--complement!,
\verb!--intersection!, and \verb!--union!  flags.  

\begin{itemize}

\item The default (\verb!--union!) behavior is to pull any patches
that are in any of the specified repositories ($ R_1 \bigcup R_2
\bigcup R_3 \ldots$).

\item If you instead specify the \verb!--intersection! flag, darcs
will only pull those patches which are present in all source
repositories ($ R_1 \bigcap R_2 \bigcap R_3 \ldots$).

\item If you specify the \verb!--complement! flag, darcs will only
pull elements in the first repository that do not exist in any of the
remaining repositories\footnote{The first thing darcs will do is
remove duplicates, keeping only the first specification.  This is
noticeable for the complement operation, since mathematically $ S
\backslash S \rightarrow \emptyset $, one would expect that
``\texttt{darcs pull --complement repo1 repo1}'' would result in no
pulls, but the duplicate elimination removes the second
\texttt{repo1}, reducing the above to effectively ``\texttt{darcs pull
repo1}''.  The expected functionality could be seen via
``\texttt{darcs get -a repo1 repo2; darcs pull --complement repo1
repo2}'', but there are easier ways of doing nothing!} ($ R_1
\backslash (R_2 \bigcup R_3 \bigcup \ldots$).

\end{itemize}


\begin{options}
--external-merge
\end{options}

You can use an external interactive merge tool to resolve conflicts with the
flag \verb!--external-merge!.  For more details see
subsection~\ref{resolution}.

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

The \verb!--patches!, \verb!--matches!, and \verb!--tags! options can be
used to select which patches to pull, as described in
subsection~\ref{selecting}.  darcs will silently pull along any other patches
upon which the selected patches depend.  So \verb!--patches bugfix! means
``pull all the patches with `bugfix' in their name, along with any patches
they require.''  If you really only want the patches with `bugfix' in their
name, you should use the \verb!--no-deps! option, which makes darcs pull in
only the selected patches which have no dependencies (apart from other
selected patches).

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

If you specify the \verb!--test! option, pull will run the test (if a test
exists) on a scratch copy of the repository contents prior to actually performing
the pull.  If the test fails, the pull will be aborted.

\begin{options}
--verbose
\end{options}

Adding the \verb!--verbose! option causes another section to appear in the
output which also displays a summary of patches that you have and the remote
repository lacks. Thus, the following syntax can be used to show you all the patch
differences between two repositories:

\begin{verbatim}
darcs pull --dry-run --verbose
\end{verbatim}

\begin{code}
merge_with_us_and_pending :: [DarcsFlag] -> ([Patch],[Patch]) ->
                             IO (Patch, Patch)
merge_with_us_and_pending opts (us,them) =
  case (join_patches us, join_patches them) of
  (usp, themp) ->
      case merge (themp, usp) of
      Nothing -> fail "There was a bug in merging... giving up!"
      Just (themp',_) -> do
         past_pending <- merge_with_pending opts themp'
         return (themp', past_pending)
merge_with_pending :: [DarcsFlag] -> Patch -> IO Patch
merge_with_pending opts p = do
  repository <- identifyRepository opts "."
  -- we don't care if it looks pretty...
  pend <- get_unrecorded_unsorted repository
  case pend of
    Nothing -> return p
    Just pendp ->
      case merge (p,pendp) of
      Nothing -> fail "Bug in merging with pending..."
      Just (p',_) -> return p'
\end{code}

\begin{code}
announce_merge_conflicts :: (String -> IO ()) -> [Patch] -> IO Bool
announce_merge_conflicts logMessage resolved_pw =
    case nubsort $ list_touched_files $ join_patches $ tail resolved_pw of
    [] -> return False
    cfs -> do logMessage "We have conflicts in the following files:"
              logMessage $ unwords cfs
              return True

check_unrecorded_conflicts :: [DarcsFlag] -> Patch -> IO Bool
check_unrecorded_conflicts opts pc =
    do repository <- identifyRepository opts "."
       mpend <- read_pending repository
       case mpend of
         Nothing -> return False
         Just pend ->
             case merge (pend, pc) of
             Nothing -> impossible
             Just (pend',_) ->
                 case list_conflicted_files pend' of
                 [] -> return False
                 fs -> do yorn <- promptChar
                                  ("You have conflicting local changes to:\n"
                                   ++ unwords fs++"\nProceed?") "yn"
                          when (yorn /= 'y') $
                               do putStr "Cancelled."
                                  exitWith ExitSuccess
                          return True
\end{code}
