% 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. \darcsCommand{pull} \begin{code}

    {-# OPTIONS_GHC -cpp #-}
    {-# LANGUAGE CPP #-}

    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(..), putVerbose, putInfo )
    import Darcs.CommandsAux ( check_paths )
    import Darcs.Arguments ( DarcsFlag( Verbose, DryRun, MarkConflicts,
                                       Intersection, Complement, AllowConflicts,
                                       NoAllowConflicts ),
                             nocompress, ignoretimes, definePatches,
                             depsSel, pullConflictOptions, useExternalMerge,
                             matchSeveral, fixUrl,
                             allInteractive, repoCombinator,
                             printDryRunMessageAndExit,
                             test, dryRun,
                             setDefault, summary, workingRepoDir, remoteRepo,
                             setScriptsExecutableOption, nolinks,
                             networkOptions, umaskOption, allowUnrelatedRepos, restrictPaths
                          )
    import Darcs.Repository ( Repository, SealedPatchSet, identifyRepositoryFor, withGutsOf,
                              amInRepository, withRepoLock, ($-), tentativelyMergePatches,
                              finalizeRepositoryChanges, applyToWorking,
                              read_repo, checkUnrelatedRepos, invalidateIndex )
    import Darcs.Hopefully ( info )
    import Darcs.Patch ( RepoPatch, description )
    import Darcs.Witnesses.Ordered ( (:>)(..), (:\/:)(..), RL(..),
                                 mapFL, nullFL, reverseRL, mapRL )
    import Darcs.Patch.Permutations ( partitionFL )
    import Darcs.Repository.Prefs ( addToPreflist, defaultrepo, setDefaultrepo, getPreflist )
    import Darcs.Repository.Motd (show_motd )
    import Darcs.Patch.Depends ( get_common_and_uncommon,
                                 patchset_intersection, patchset_union )
    import Darcs.SelectChanges ( with_selected_changes, filterOutConflicts )
    import Darcs.Utils ( clarifyErrors, formatPath )
    import Darcs.Witnesses.Sealed ( Sealed(..), seal )
    import Printer ( putDocLn, vcat, ($$), text )
    #include "impossible.h"

    #include "gadts.h"

    pullDescription :: String
    pullDescription =
     "Copy and apply patches from another repository to this one."

    pullHelp :: String
    pullHelp =
     "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 {commandName = "pull",
                         commandHelp = pullHelp,
                         commandDescription = pullDescription,
                         commandExtraArgs = -1,
                         commandExtraArgHelp = ["[REPOSITORY]..."],
                         commandCommand = pullCmd,
                         commandPrereq = amInRepository,
                         commandGetArgPossibilities = getPreflist "repos",
                         commandArgdefaults = defaultrepo,
                         commandAdvancedOptions = [repoCombinator,
                                                     nocompress, nolinks,
                                                     ignoretimes,
                                                     remoteRepo,
                                                     setScriptsExecutableOption,
                                                     umaskOption,
                                                     restrictPaths] ++
                                                    networkOptions,
                         commandBasicOptions = [matchSeveral,
                                                  allInteractive,
                                                  pullConflictOptions,
                                                  useExternalMerge,
                                                  test]++dryRun++[summary,
                                                  depsSel,
                                                  setDefault,
                                                  workingRepoDir,
                                                  allowUnrelatedRepos]}

    pullCmd :: [DarcsFlag] -> [String] -> IO ()
    pullCmd opts unfixedrepodirs@(_:_) = withRepoLock opts $- \repository -> do
      here <- getCurrentDirectory
      repodirs <- (nub . filter (/= here)) `fmap` mapM (fixUrl opts) unfixedrepodirs
      -- 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) <- readRepos repository opts repodirs
      old_default <- getPreflist "defaultrepo"
      setDefaultrepo (head repodirs) opts
      mapM_ (addToPreflist "repos") repodirs
      when (old_default == repodirs) $
          let pulling = if DryRun `elem` opts then "Would pull" else "Pulling"
          in  putInfo opts $ 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 compl'
      ps :> _ <- return $ partitionFL (not . (`elem` avoided) . info) $ reverseRL 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)
         let merge_opts | NoAllowConflicts `elem` opts = opts
                        | AllowConflicts   `elem` opts = opts
                        | otherwise                    = MarkConflicts : opts
         (hadConflicts, Sealed psFiltered) <- filterOutConflicts merge_opts us' repository ps
         when hadConflicts $ putStrLn "Skipping some patches which would cause conflicts."
         when (nullFL psFiltered)
                          $ do putInfo opts $ text "No remote changes to pull in!"
                               definePatches psFiltered
                               exitWith ExitSuccess
         with_selected_changes "pull" opts Nothing psFiltered $
          \ (to_be_pulled:>_) ->
             do
               printDryRunMessageAndExit "pull" opts to_be_pulled
               definePatches to_be_pulled
               when (nullFL to_be_pulled) $ do
                                   putStrLn "You don't want to pull any patches, and that's fine with me!"
                                   exitWith ExitSuccess
               check_paths opts to_be_pulled
               putVerbose opts $ text "Getting and merging the following patches:"
               putVerbose opts $ vcat $ mapFL description to_be_pulled
               Sealed pw <- tentativelyMergePatches repository "pull" merge_opts
                           (reverseRL us') to_be_pulled
               invalidateIndex repository
               withGutsOf repository $ do finalizeRepositoryChanges repository
                                          revertable $ applyToWorking repository opts pw
               putInfo opts $ text "Finished pulling and applying."

    pullCmd _ [] = fail "No default repository to pull from, please specify one"

    revertable :: IO a -> IO a
    revertable x =
        x `clarifyErrors` 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."]

    {- 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 readRepos is a
    tuple: the first patchset(s) to be complemented against Rc and then
    the second patchset(s) to be complemented against Rc.
    -}

    readRepos :: RepoPatch p => Repository p C(r u t) -> [DarcsFlag] -> [String] -> IO (SealedPatchSet p,SealedPatchSet p)
    readRepos _ _ [] = impossible
    readRepos 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} --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}