% Copyright (C) 20022005 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 021101301, USA.
\subsection{darcs pull}
\begin{code}
module Darcs.Commands.Pull ( pull ) where
import System.Exit ( ExitCode(..), exitWith )
import Workaround ( getCurrentDirectory )
import Control.Monad ( when )
import Data.List ( nub )
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,
deps_sel, pull_conflict_options, use_external_merge,
match_several, fixUrl,
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,
network_options, umask_option, allow_unrelated_repos
)
import Darcs.Repository ( Repository, SealedPatchSet, identifyRepositoryFor, withGutsOf,
amInRepository, withRepoLock, ($-), tentativelyMergePatches,
sync_repo, finalizeRepositoryChanges, applyToWorking,
slurp_recorded, read_repo, checkUnrelatedRepos )
import Darcs.Hopefully ( info )
import Darcs.Patch ( RepoPatch, description )
import Darcs.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"
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"
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,
set_scripts_executable,
umask_option] ++
network_options,
command_basic_options = [match_several,
all_interactive,
pull_conflict_options,
use_external_merge,
test]++dry_run++[summary,
deps_sel,
set_default,
working_repo_dir,
allow_unrelated_repos]}
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
here <- getCurrentDirectory
repodirs <- (nub . filter (/= here)) `fmap` mapM (fixUrl opts) unfixedrepodirs
when (null repodirs) $
fail "Can't pull from current repository!"
(Sealed them, Sealed compl) <- read_repos repository opts repodirs
old_default <- get_preflist "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
(common, us' :\/: them'') <- return $ get_common_and_uncommon (us, them)
(_ , _ :\/: compl') <- return $ get_common_and_uncommon (us, compl)
checkUnrelatedRepos opts common us them
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
Sealed pw <- tentativelyMergePatches repository "pull" merge_opts
(reverseRL $ head $ unsafeUnRL us') to_be_pulled
withGutsOf repository $ do finalizeRepositoryChanges repository
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"
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 -> do r <- identifyRepositoryFor to_repo u
ps <- read_repo r
return $ seal ps) 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}
\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
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
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!--externalmerge!. For more details see
subsection~\ref{resolution}.
\begin{options}
\end{options}
The \verb!--patches!, \verb!--matches!, \verb!--tags!, and \verb!--nodeps!
options can be used to select which patches to pull, as described in
subsection~\ref{selecting}.
\begin{options}
\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
\end{verbatim}