1 % Copyright (C) 2002-2005 David Roundy 2 % 3 % This program is free software; you can redistribute it and/or modify 4 % it under the terms of the GNU General Public License as published by 5 % the Free Software Foundation; either version 2, or (at your option) 6 % any later version. 7 % 8 % This program is distributed in the hope that it will be useful, 9 % but WITHOUT ANY WARRANTY; without even the implied warranty of 10 % MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 % GNU General Public License for more details. 12 % 13 % You should have received a copy of the GNU General Public License 14 % along with this program; see the file COPYING. If not, write to 15 % the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 16 % Boston, MA 02110-1301, USA. 17 18 \darcsCommand{pull} 19 \begin{code} 20 {-# OPTIONS_GHC -cpp #-} 21 {-# LANGUAGE CPP #-} 22 23 module Darcs.Commands.Pull ( pull ) where 24 import System.Exit ( ExitCode(..), exitWith ) 25 import Workaround ( getCurrentDirectory ) 26 import Control.Monad ( when ) 27 import Data.List ( nub ) 28 29 import Darcs.Commands ( DarcsCommand(..), loggers ) 30 import Darcs.CommandsAux ( check_paths ) 31 import Darcs.Arguments ( DarcsFlag( Verbose, Quiet, DryRun, MarkConflicts, XMLOutput, 32 Intersection, Complement, AllowConflicts, NoAllowConflicts ), 33 nocompress, ignoretimes, definePatches, 34 deps_sel, pull_conflict_options, use_external_merge, 35 match_several, fixUrl, 36 all_interactive, repo_combinator, 37 print_dry_run_message_and_exit, 38 test, dry_run, 39 set_default, summary, working_repo_dir, remote_repo, 40 set_scripts_executable, nolinks, 41 network_options, umask_option, allow_unrelated_repos, restrict_paths 42 ) 43 import Darcs.Repository ( Repository, SealedPatchSet, identifyRepositoryFor, withGutsOf, 44 amInRepository, withRepoLock, ($-), tentativelyMergePatches, 45 sync_repo, finalizeRepositoryChanges, applyToWorking, 46 read_repo, checkUnrelatedRepos ) 47 import Darcs.Hopefully ( info ) 48 import Darcs.Patch ( RepoPatch, description ) 49 import Darcs.Ordered ( (:>)(..), (:\/:)(..), RL(..), unsafeUnRL, concatRL, 50 mapFL, nullFL, reverseRL, mapRL ) 51 import Darcs.Patch.Permutations ( partitionFL ) 52 import Darcs.SlurpDirectory ( wait_a_moment ) 53 import Darcs.Repository.Prefs ( add_to_preflist, defaultrepo, set_defaultrepo, get_preflist ) 54 import Darcs.Repository.Motd (show_motd ) 55 import Darcs.Patch.Depends ( get_common_and_uncommon, 56 patchset_intersection, patchset_union ) 57 import Darcs.SelectChanges ( with_selected_changes ) 58 import Darcs.Utils ( clarify_errors, formatPath ) 59 import Darcs.Sealed ( Sealed(..), seal ) 60 import Printer ( putDocLn, vcat, ($$), text ) 61 import Darcs.Gorsvet( invalidateIndex ) 62 #include "impossible.h" 63 64 pull_description :: String 65 pull_description = 66 "Copy and apply patches from another repository to this one." 67 68 pull_help :: String 69 pull_help = 70 "Pull is used to bring changes made in another repository into the current\n"++ 71 "repository (that is, either the one in the current directory, or the one\n"++ 72 "specified with the --repodir option). Pull allows you to bring over all or\n"++ 73 "some of the patches that are in that repository but not in this one. Pull\n"++ 74 "accepts arguments, which are URLs from which to pull, and when called\n"++ 75 "without an argument, pull will use the repository from which you have most\n"++ 76 "recently either pushed or pulled.\n" 77 78 pull :: DarcsCommand 79 pull = DarcsCommand {command_name = "pull", 80 command_help = pull_help, 81 command_description = pull_description, 82 command_extra_args = -1, 83 command_extra_arg_help = ["[REPOSITORY]..."], 84 command_command = pull_cmd, 85 command_prereq = amInRepository, 86 command_get_arg_possibilities = get_preflist "repos", 87 command_argdefaults = defaultrepo, 88 command_advanced_options = [repo_combinator, 89 nocompress, nolinks, 90 ignoretimes, 91 remote_repo, 92 set_scripts_executable, 93 umask_option, 94 restrict_paths] ++ 95 network_options, 96 command_basic_options = [match_several, 97 all_interactive, 98 pull_conflict_options, 99 use_external_merge, 100 test]++dry_run++[summary, 101 deps_sel, 102 set_default, 103 working_repo_dir, 104 allow_unrelated_repos]} 105 106 pull_cmd :: [DarcsFlag] -> [String] -> IO () 107 108 pull_cmd opts unfixedrepodirs@(_:_) = 109 let (logMessage, _, logDocLn) = loggers opts 110 putInfo = if (Quiet `elem` opts || XMLOutput `elem` opts) then \_ -> return () else logDocLn 111 putVerbose = if Verbose `elem` opts then putDocLn else \_ -> return () 112 in withRepoLock opts $- \repository -> do 113 here <- getCurrentDirectory 114 repodirs <- (nub . filter (/= here)) `fmap` mapM (fixUrl opts) unfixedrepodirs 115 -- Test to make sure we aren't trying to pull from the current repo 116 when (null repodirs) $ 117 fail "Can't pull from current repository!" 118 (Sealed them, Sealed compl) <- read_repos repository opts repodirs 119 old_default <- get_preflist "defaultrepo" 120 set_defaultrepo (head repodirs) opts 121 mapM_ (add_to_preflist "repos") repodirs 122 when (old_default == repodirs) $ 123 let pulling = if DryRun `elem` opts then "Would pull" else "Pulling" 124 in putInfo $ text $ pulling++" from "++concatMap formatPath repodirs++"..." 125 mapM_ (show_motd opts) repodirs 126 us <- read_repo repository 127 (common, us' :\/: them'') <- return $ get_common_and_uncommon (us, them) 128 (_ , _ :\/: compl') <- return $ get_common_and_uncommon (us, compl) 129 checkUnrelatedRepos opts common us them 130 let avoided = mapRL info (concatRL compl') 131 ps :> _ <- return $ partitionFL (not . (`elem` avoided) . info) $ reverseRL $ concatRL them'' 132 do when (Verbose `elem` opts) $ 133 do case us' of 134 (x@(_:<:_):<:_) -> putDocLn $ text "We have the following new (to them) patches:" 135 $$ (vcat $ mapRL description x) 136 _ -> return () 137 when (not $ nullFL ps) $ putDocLn $ text "They have the following patches to pull:" 138 $$ (vcat $ mapFL description ps) 139 when (nullFL ps) $ do putInfo $ text "No remote changes to pull in!" 140 definePatches ps 141 exitWith ExitSuccess 142 with_selected_changes "pull" opts ps $ 143 \ (to_be_pulled:>_) -> do 144 print_dry_run_message_and_exit "pull" opts to_be_pulled 145 definePatches to_be_pulled 146 when (nullFL to_be_pulled) $ do 147 logMessage "You don't want to pull any patches, and that's fine with me!" 148 exitWith ExitSuccess 149 check_paths opts to_be_pulled 150 putVerbose $ text "Getting and merging the following patches:" 151 putVerbose $ vcat $ mapFL description to_be_pulled 152 let merge_opts | NoAllowConflicts `elem` opts = opts 153 | AllowConflicts `elem` opts = opts 154 | otherwise = MarkConflicts : opts 155 Sealed pw <- tentativelyMergePatches repository "pull" merge_opts 156 (reverseRL $ head $ unsafeUnRL us') to_be_pulled 157 invalidateIndex repository 158 withGutsOf repository $ do finalizeRepositoryChanges repository 159 -- so work will be more recent than rec: 160 revertable $ do wait_a_moment 161 applyToWorking repository opts pw 162 sync_repo repository 163 putInfo $ text "Finished pulling and applying." 164 where revertable x = x `clarify_errors` unlines 165 ["Error applying patch to the working directory.","", 166 "This may have left your working directory an inconsistent", 167 "but recoverable state. If you had no un-recorded changes", 168 "by using 'darcs revert' you should be able to make your", 169 "working directory consistent again."] 170 pull_cmd _ [] = fail "No default repository to pull from, please specify one" 171 172 {- Read in the specified pull-from repositories. Perform 173 Intersection, Union, or Complement read. In patch-theory terms 174 (stated in set algebra, where + is union and & is intersection 175 and \ is complement): 176 177 Union = ((R1 + R2 + ... + Rn) \ Rc) 178 Intersection = ((R1 & R2 & ... & Rn) \ Rc) 179 Complement = (R1 \ Rc) \ ((R2 + R3 + ... + Rn) \ Rc) 180 181 where Rc = local repo 182 R1 = 1st specified pull repo 183 R2, R3, Rn = other specified pull repo 184 185 Since Rc is not provided here yet, the result of read_repos is a 186 tuple: the first patchset(s) to be complemented against Rc and then 187 the second patchset(s) to be complemented against Rc. 188 -} 189 190 read_repos :: RepoPatch p => Repository p -> [DarcsFlag] -> [String] -> IO (SealedPatchSet p,SealedPatchSet p) 191 read_repos _ _ [] = impossible 192 read_repos to_repo opts us = 193 do rs <- mapM (\u -> do r <- identifyRepositoryFor to_repo u 194 ps <- read_repo r 195 return $ seal ps) us 196 return $ if Intersection `elem` opts 197 then (patchset_intersection rs, seal NilRL) 198 else if Complement `elem` opts 199 then (head rs, patchset_union $ tail rs) 200 else (patchset_union rs, seal NilRL) 201 202 \end{code} 203 204 \begin{options} 205 --intersection, --union [DEFAULT], --complement 206 \end{options} 207 208 If you provide more than one repository as an argument to pull, darcs' 209 behavior is determined by the presence of the \verb!--complement!, 210 \verb!--intersection!, and \verb!--union! flags. 211 212 \begin{itemize} 213 214 \item The default (\verb!--union!) behavior is to pull any patches 215 that are in any of the specified repositories ($ R_1 \bigcup R_2 216 \bigcup R_3 \ldots$). 217 218 \item If you instead specify the \verb!--intersection! flag, darcs 219 will only pull those patches which are present in all source 220 repositories ($ R_1 \bigcap R_2 \bigcap R_3 \ldots$). 221 222 \item If you specify the \verb!--complement! flag, darcs will only 223 pull elements in the first repository that do not exist in any of the 224 remaining repositories\footnote{The first thing darcs will do is 225 remove duplicates, keeping only the first specification. This is 226 noticeable for the complement operation, since mathematically $ S 227 \backslash S \rightarrow \emptyset $, one would expect that 228 ``\texttt{darcs pull --complement repo1 repo1}'' would result in no 229 pulls, but the duplicate elimination removes the second 230 \texttt{repo1}, reducing the above to effectively ``\texttt{darcs pull 231 repo1}''. The expected functionality could be seen via 232 ``\texttt{darcs get -a repo1 repo2; darcs pull --complement repo1 233 repo2}'', but there are easier ways of doing nothing!} ($ R_1 234 \backslash (R_2 \bigcup R_3 \bigcup \ldots$)). 235 236 \end{itemize} 237 238 239 \begin{options} 240 --external-merge 241 \end{options} 242 243 You can use an external interactive merge tool to resolve conflicts with the 244 flag \verb!--external-merge!. For more details see 245 subsection~\ref{resolution}. 246 247 \begin{options} 248 --matches, --patches, --tags, --no-deps 249 \end{options} 250 251 The \verb!--patches!, \verb!--matches!, \verb!--tags!, and \verb!--no-deps! 252 options can be used to select which patches to pull, as described in 253 subsection~\ref{selecting}. 254 255 \begin{options} 256 --no-test, --test 257 \end{options} 258 259 If you specify the \verb!--test! option, pull will run the test (if a test 260 exists) on a scratch copy of the repository contents prior to actually performing 261 the pull. If the test fails, the pull will be aborted. 262 263 \begin{options} 264 --verbose 265 \end{options} 266 267 Adding the \verb!--verbose! option causes another section to appear in the 268 output which also displays a summary of patches that you have and the remote 269 repository lacks. Thus, the following syntax can be used to show you all the patch 270 differences between two repositories: 271 272 \begin{verbatim} 273 darcs pull --dry-run --verbose 274 \end{verbatim}