%  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 Pull ( pull, merge_with_us_and_pending, save_patches,
              check_unrecorded_conflicts,
            ) where
import System ( ExitCode(..), exitWith )
import Monad ( when, liftM )
import Maybe ( catMaybes )

import SignalHandler ( withSignalsBlocked )
import DarcsCommands ( DarcsCommand(..), loggers )
import DarcsCommandsAux ( check_paths )
import DarcsArguments ( DarcsFlag( AnyOrder, Test, Verbose, Quiet,
                                   Intersection ),
                        want_external_merge, nocompress, ignoretimes,
                        no_deps, use_external_merge,
                        match_several, fix_filepaths,
                        all_gui_interactive, intersection_or_union,
                        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 Repository ( Repository, PatchToken, PatchSet, identifyRepository,
                    amInRepository, withRepoLock,
                    slurp_recorded, slurp_recorded_and_unrecorded,
                    read_repo, absolute_dir, get_unrecorded,
                    with_new_pending, read_pending, sync_repo,
                    applyToWorking,
                    applyToPristine, writePatch, updateInventory,
                  )
import Patch ( Patch, join_patches, merge, patch2patchinfo,
               unjoin_patches, list_touched_files,
               invert, list_conflicted_files, null_patch,
             )
import SelectChanges ( promptChar )
import PatchInfo ( PatchInfo, human_friendly, showPatchInfo )
import SlurpDirectory ( wait_a_moment )
import RepoPrefs ( defaultrepo, set_defaultrepo, get_preflist )
import Motd (show_motd )
import Depends ( get_common_and_uncommon,
                 patchset_intersection, patchset_union )
import Resolution ( standard_resolution, external_resolution )
import SelectChanges ( with_selected_changes )
import DarcsUtils ( clarify_errors, nubsort, formatPath )
import Test ( test_patch )
import Printer ( Doc, putDocLn, errorDoc, 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,
                                             intersection_or_union,
                                             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 <- read_repos opts repodirs
  old_default <- defaultrepo "" []
  set_defaultrepo (head repodirs) opts
  when (old_default == repodirs) $
      putInfo $ text $ "Pulling from "++concatMap formatPath repodirs++"..."
  mapM (show_motd opts) repodirs
  us <- read_repo repository
  case get_common_and_uncommon (us, them) of
    (_, us', them') -> 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 fromJustPatch $ 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 fromJustPatch $ 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 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 repository (AnyOrder:opts)
                               join_patches `liftM` external_resolution c working
                                    (join_patches $ (++catMaybes [pend]) $
                                     map fromJustPatch $ 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
      patchTokens <- save_patches repository opts $ unjoin_patches pc
      mp <- get_unrecorded repository (AnyOrder:opts)
      let newpend = join_patches [invert pc, fromMaybePatch mp, pw_resolved]
      withSignalsBlocked $ with_new_pending repository newpend $ do
          repairable $ applyToPristine repository pc
            `catch` \e ->
                fail ("Error applying patch to recorded.\nRunning 'darcs repair' on the target repository may help.\n" ++ show e)
          updateInventory repository patchTokens
          -- so work will be more recent than rec:
          revertable wait_a_moment
          revertable $ 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 fromMaybePatch Nothing = null_patch
                fromMaybePatch (Just p) = p
                repairable x = x `clarify_errors` unlines
                   ["Your repository is now in an inconsistent state.",
                    "This must be fixed by running darcs repair."]
                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

fromJustPatch :: (PatchInfo, Maybe Patch) -> Patch
fromJustPatch (pinfo, Nothing)
    = errorDoc $ text "Error reading patch:"
              $$ human_friendly pinfo
fromJustPatch (_, Just p) = p
\end{code}

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

\begin{options}
--intersection, --union [default]
\end{options}
If you provide more than one repository as an argument to pull, darcs'
behavior is determined by the presence of the \verb!--intersection! flag.
The default (\verb!--union!) behavior is to pull any patches that are in
any of the specified repositories.  If you instead specify the
\verb!--intersection! flag, darcs will only pull those patches which are
present in all source repositories.

\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}
save_patches :: Repository -> [DarcsFlag] -> Maybe [Patch] ->
                    IO [(PatchInfo, PatchToken)]
save_patches _ _ (Just []) = return []
save_patches _ _ Nothing = return []
save_patches repo opts (Just (p:ps)) =
    do p' <- (liftM ppt2pipt) (writePatch repo opts p)
       ps' <- save_patches repo opts $ Just ps
       return (p':ps')
    where ppt2pipt :: (Patch, PatchToken) -> (PatchInfo, PatchToken)
          ppt2pipt (patch, pt) = (fromJust (patch2patchinfo patch), pt)
\end{code}

\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 "."
  -- we don't care if it looks pretty...
  pend <- get_unrecorded repository (AnyOrder:opts)
  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 :: Patch -> IO Bool
check_unrecorded_conflicts pc =
    do repository <- identifyRepository "."
       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}