src/Darcs/Commands/Pull.lhs

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