% 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} {-# OPTIONS_GHC -cpp #-} module Darcs.Commands.Pull ( pull ) where import System.Exit ( ExitCode(..), exitWith ) import Control.Monad ( when ) import Darcs.Commands ( DarcsCommand(..), loggers ) import Darcs.CommandsAux ( check_paths ) import Darcs.Arguments ( DarcsFlag( Verbose, Quiet, DryRun, MarkConflicts, XMLOutput, Intersection, Complement, AllowConflicts, NoAllowConflicts ), nocompress, ignoretimes, definePatches, no_deps, pull_conflict_options, use_external_merge, match_several, fix_filepaths, all_interactive, repo_combinator, print_dry_run_message_and_exit, test, dry_run, set_default, summary, working_repo_dir, remote_repo, set_scripts_executable, nolinks, ssh_cm, umask_option, ) import Darcs.RepoPath ( toPath ) import Darcs.Repository ( Repository, SealedPatchSet, identifyRepositoryFor, withGutsOf, amInRepository, withRepoLock, ($-), tentativelyMergePatches, sync_repo, finalizeRepositoryChanges, applyToWorking, slurp_recorded, read_repo ) import Darcs.Hopefully ( info ) import Darcs.Patch ( RepoPatch, description ) import Darcs.Patch.Ordered ( (:>)(..), (:\/:)(..), RL(..), unsafeUnRL, concatRL, mapFL, nullFL, reverseRL, mapRL ) import Darcs.Patch.Permutations ( partitionFL ) 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 ) import Darcs.SelectChanges ( with_selected_changes ) import Darcs.Utils ( clarify_errors, formatPath ) import Darcs.Sealed ( Sealed(..), seal ) import Printer ( 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_advanced_options = [repo_combinator, nocompress, nolinks, ignoretimes, remote_repo, ssh_cm, set_scripts_executable, umask_option], command_basic_options = [match_several, all_interactive, pull_conflict_options, use_external_merge, test]++dry_run++[summary, no_deps, set_default, working_repo_dir]} \end{code} \begin{code} pull_cmd :: [DarcsFlag] -> [String] -> IO () pull_cmd opts unfixedrepodirs@(_:_) = let (logMessage, _, logDocLn) = loggers opts putInfo = if (Quiet `elem` opts || XMLOutput `elem` opts) then \_ -> return () else logDocLn putVerbose = if Verbose `elem` opts then putDocLn else \_ -> return () in withRepoLock opts $- \repository -> do let repodirs = filter (not.null) $ map toPath $ fix_filepaths opts unfixedrepodirs in do -- Test to make sure we aren't trying to pull from the current repo when (null repodirs) $ fail "Can't pull from current repository!" (Sealed them, Sealed compl) <- read_repos repository opts repodirs old_default <- defaultrepo opts "" [] 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 Sealed us <- read_repo repository (_, us' :\/: them'') <- return $ get_common_and_uncommon (us, them) (_, _ :\/: compl') <- return $ get_common_and_uncommon (us, compl) let avoided = mapRL info (concatRL compl') ps :> _ <- return $ partitionFL (not . (`elem` avoided) . info) $ reverseRL $ concatRL them'' do when (Verbose `elem` opts) $ do case us' of (x@(_:<:_):<:_) -> putDocLn $ text "We have the following new (to them) patches:" $$ (vcat $ mapRL description x) _ -> return () when (not $ nullFL ps) $ putDocLn $ text "They have the following patches to pull:" $$ (vcat $ mapFL description ps) when (nullFL ps) $ do putInfo $ text "No remote changes to pull in!" definePatches ps exitWith ExitSuccess s <- slurp_recorded repository with_selected_changes "pull" opts s ps $ \ (to_be_pulled:>_) -> do print_dry_run_message_and_exit "pull" opts to_be_pulled definePatches to_be_pulled when (nullFL 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 $ vcat $ mapFL description to_be_pulled let merge_opts | NoAllowConflicts `elem` opts = opts | AllowConflicts `elem` opts = opts | otherwise = MarkConflicts : opts pw <- tentativelyMergePatches repository "pull" merge_opts (reverseRL $ head $ unsafeUnRL us') to_be_pulled withGutsOf repository $ do finalizeRepositoryChanges repository -- so work will be more recent than rec: revertable $ do wait_a_moment applyToWorking repository opts pw sync_repo repository putInfo $ text "Finished pulling and applying." where revertable x = x `clarify_errors` unlines ["Error applying patch to the working directory.","", "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" \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 :: RepoPatch p => Repository p -> [DarcsFlag] -> [String] -> IO (SealedPatchSet p,SealedPatchSet p) read_repos _ _ [] = impossible read_repos to_repo opts us = do rs <- mapM (\u -> identifyRepositoryFor to_repo u >>= read_repo) us return $ if Intersection `elem` opts then (patchset_intersection rs, seal NilRL) else if Complement `elem` opts then (head rs, patchset_union $ tail rs) else (patchset_union rs, seal NilRL) \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, --patches, --tags, --no-deps \end{options} The \verb!--patches!, \verb!--matches!, \verb!--tags!, and \verb!--no-deps! options can be used to select which patches to pull, as described in subsection~\ref{selecting}. \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}