src/Darcs/Resolution.lhs

   1 %  Copyright (C) 2003,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 \begin{code}
  19 {-# OPTIONS_GHC -cpp #-}
  20 {-# LANGUAGE CPP #-}
  21
  22 #include "gadts.h"
  23
  24 module Darcs.Resolution ( standard_resolution,
  25                           external_resolution,
  26                           patchset_conflict_resolutions,
  27                         ) where
  28
  29 import System.Exit ( ExitCode( ExitSuccess ) )
  30 import System.Directory ( setCurrentDirectory, getCurrentDirectory )
  31 import Data.List ( zip4 )
  32 import Control.Monad ( when )
  33
  34 import Darcs.Patch ( RepoPatch, Prim, joinPatches, resolve_conflicts,
  35                      effect,
  36                      apply_to_filepaths, patchcontents,
  37                      invert, list_conflicted_files, commute )
  38 import Darcs.RepoPath ( toFilePath )
  39 import Darcs.Ordered ( FL(..), RL(..), (:>)(..), (+>+),
  40                              mapFL_FL, reverseRL, lengthFL )
  41
  42 import CommandLine ( parseCmd )
  43 import Darcs.Hopefully ( hopefully )
  44 import Darcs.Utils ( askUser )
  45 import Darcs.SlurpDirectory ( Slurpy, slurp, write_files )
  46 import Darcs.Patch.Set ( PatchSet )
  47 import Darcs.Diff ( unsafeDiff )
  48 import Darcs.Sealed ( Sealed(..) )
  49 import Darcs.Repository.Prefs ( filetype_function )
  50 import Darcs.Flags ( DarcsFlag(LookForAdds) )
  51 import Exec ( exec, Redirect(..) )
  52 import Darcs.Lock ( withTempDir )
  53 import Darcs.External ( cloneTree )
  54 import Darcs.Patch.Apply ( apply_to_slurpy )
  55
  56 --import Darcs.ColorPrinter ( traceDoc )
  57 --import Printer ( greenText, ($$), Doc )
  58 --import Darcs.Patch ( showPatch )
  59 \end{code}
  60
  61 \begin{code}
  62 standard_resolution :: RepoPatch p => p C(x y) -> Sealed (FL Prim C(y))
  63 standard_resolution p = merge_list $ map head $ resolve_conflicts p
  64
  65 merge_list :: [Sealed (FL Prim C(x))] -> Sealed (FL Prim C(x))
  66 merge_list patches = doml NilFL patches
  67     where doml :: FL Prim C(x y) -> [Sealed (FL Prim C(x))] -> Sealed (FL Prim C(x))
  68           doml mp (Sealed p:ps) =
  69               case commute (invert p :> mp) of
  70               Just (mp' :> _) -> doml (effect p +>+ effect mp') ps
  71               Nothing -> doml mp ps -- This shouldn't happen for "good" resolutions.
  72           doml mp [] = Sealed mp
  73 \end{code}
  74
  75 \paragraph{Resolution of conflicts}\label{resolution}
  76
  77 To resolve conflicts using an external tool, you need to specify a command
  78 to use, e.g.
  79 \begin{verbatim}
  80 --external-merge 'opendiff %1 %2 -ancestor %a -merge %o'
  81 \end{verbatim}
  82 The \verb!%1! and \verb!%2!  are replaced with the two versions to be
  83 merged, \verb!%a! is replaced with the common ancestor of the two versions.
  84 Most importantly, \verb!%o! is replaced with the name of the output file
  85 that darcs will require to be created holding the merged version.  The
  86 above example works with the FileMerge.app tool that comes with Apple's
  87 developer tools.  To use xxdiff, you would use
  88 \begin{verbatim}
  89 --external-merge 'xxdiff -m -O -M %o %1 %a %2'
  90 \end{verbatim}
  91 To use \verb!kdiff3!, you can use
  92 \begin{verbatim}
  93 --external-merge 'kdiff3 --output %o %a %1 %2'
  94 \end{verbatim}
  95 To use \verb!tortoiseMerge!, you can use
  96 \begin{verbatim}
  97 --external-merge 'tortoiseMerge /base:"%a" /mine:"%1" /theirs:"%2" /merged:"%o"'
  98 \end{verbatim}
  99 (\verb!tortoiseMerge! is a nice merge tool that comes with TortoiseSVN and works well
 100 on Windows.)
 101
 102 % Fixme: Is it actually a shell command on MS Windows?
 103 Note that the command is split into space-separated words and the first one is
 104 \verb!exec!ed with the rest as arguments---it is not a shell command. In particular,
 105 on Windows this means that the first command path should not contain spaces and
 106 you should make sure the command is in your \verb!PATH!.
 107
 108 The substitution of the \verb!%! escapes is done everywhere. If you need to prevent
 109 substitution you can use a double percentage sign, i.e. \verb!%%a! is substituted with
 110 \verb!%a!. Here is an example script to use the Emacs' Ediff package for merging.
 111 % This is indented so that the leading #s don't confuse the preprocessor.
 112 \begin{verbatim}
 113  #! /bin/sh
 114  # External merge command for darcs, using Emacs Ediff, via server if possible.
 115  # It needs args %1 %2 %a %o, i.e. the external merge command is, say,
 116  # `emerge3 %1 %2 %a %o'.
 117  test $# -eq 4 || exit 1
 118  form="(ediff-merge-files-with-ancestor"
 119  while test $# -gt 0; do
 120      count=$count.
 121      if [ $count = .... ]; then
 122          form=$form\ nil         # Lisp STARTUP-HOOKS arg
 123      fi
 124      case $1 in                  # Worry about quoting -- escape " and \
 125          *[\"\\]* ) form=$form\ \"$(echo $1 | sed -e's/["\\]/\\\0/g')\" ;;
 126          *) form=$form\ \"$1\" ;;
 127      esac
 128      shift
 129  done
 130  form=$form')'
 131  ( emacsclient --eval "$form" || # Emacs 22 server
 132    gnudoit "$form" ||            # XEmacs/Emacs 21 server
 133    emacs --eval "$form" ||       # Relatively slow to start up
 134    xemacs -eval "$form"          # Horribly slow to start up
 135  ) 2>/dev/null
 136 \end{verbatim}
 137 It would be invoked like:
 138 \begin{verbatim}
 139 --external-merge 'emerge3 %1 %2 %a %o'
 140 \end{verbatim}
 141
 142 If you figure out how to use darcs with another merge tool, please let me
 143 know what flags you used so I can mention it here.
 144
 145 Note that if you do use an external merge tool, most likely you will want
 146 to add to your defaults file
 147 (\verb!_darcs/prefs/defaults! or \verb!~/.darcs/prefs!, see \ref{defaults})
 148 a line such as
 149 \begin{verbatim}
 150 ALL external-merge kdiff3 --output %o %a %1 %2
 151 \end{verbatim}
 152 or
 153 \begin{verbatim}
 154 ALL external-merge tortoiseMerge /base:"%a" /mine:"%1" /theirs:"%2" /merged:"%o"
 155 \end{verbatim}
 156
 157 Note that the defaults file does not want quotes around the command.
 158
 159 \begin{code}
 160 external_resolution :: RepoPatch p => Slurpy -> String -> FL Prim C(x y) -> FL Prim C(x z)
 161                     -> p C(y a)
 162                     -> IO (Sealed (FL Prim C(a)))
 163 external_resolution s1 c p1 p2 pmerged = do
 164  sa <- apply_to_slurpy (invert p1) s1
 165  sm <- apply_to_slurpy pmerged s1
 166  s2 <- apply_to_slurpy p2 sa
 167  let nms = list_conflicted_files pmerged
 168      nas = apply_to_filepaths (invert pmerged) nms
 169      n1s = apply_to_filepaths p1 nas
 170      n2s = apply_to_filepaths p2 nas
 171      ns = zip4 nas n1s n2s nms
 172   in do
 173    former_dir <- getCurrentDirectory
 174    withTempDir "version1" $ \absd1 -> do
 175      let d1 = toFilePath absd1
 176      write_files s1 n1s
 177      setCurrentDirectory former_dir
 178      withTempDir "ancestor" $ \absda -> do
 179        let da = toFilePath absda
 180        write_files sa nas
 181        setCurrentDirectory former_dir
 182        withTempDir "merged" $ \absdm -> do
 183          let dm = toFilePath absdm
 184          write_files sm nms
 185          setCurrentDirectory former_dir
 186          withTempDir "cleanmerged" $ \absdc -> do
 187            let dc = toFilePath absdc
 188            cloneTree dm "."
 189            setCurrentDirectory former_dir
 190            withTempDir "version2" $ \absd2 -> do
 191              let d2 = toFilePath absd2
 192              write_files s2 n2s
 193              mapM_ (externally_resolve_file c da d1 d2 dm) ns
 194              sc <- slurp dc
 195              sfixed <- slurp dm
 196              ftf <- filetype_function
 197              case unsafeDiff [LookForAdds] ftf sc sfixed of
 198                di -> lengthFL di `seq` return (Sealed di)
 199                -- The `seq` above forces the two slurpies to be read before
 200                -- we delete their directories.
 201
 202 externally_resolve_file :: String -> String -> String -> String -> String
 203                         -> (FilePath, FilePath, FilePath, FilePath)
 204                         -> IO ()
 205 externally_resolve_file c da d1 d2 dm (fa, f1, f2, fm) = do
 206     putStrLn $ "Merging file "++fm++" by hand."
 207     ec <- run c [('1', d1///f1), ('2', d2///f2), ('a', da///fa), ('o', dm///fm), ('%', "%")]
 208     when (ec /= ExitSuccess) $
 209          putStrLn $ "External merge command exited with " ++ show ec
 210     askUser "Hit return to move on..."
 211     return ()
 212
 213 run :: String -> [(Char,String)] -> IO ExitCode
 214 run c replacements =
 215     case parseCmd replacements c of
 216     Left err     -> fail $ show err
 217     Right (c2,_) -> rr c2
 218     where rr (command:args) = do putStrLn $ "Running command '" ++
 219                                             unwords (command:args) ++ "'"
 220                                  exec command args (Null,Null,Null)
 221           rr [] = return ExitSuccess
 222
 223 (///) :: FilePath -> FilePath -> FilePath
 224 d /// f = d ++ "/" ++ f
 225 \end{code}
 226
 227 \begin{code}
 228 patchset_conflict_resolutions :: RepoPatch p => PatchSet p C(x) -> Sealed (FL Prim C(x))
 229 patchset_conflict_resolutions (NilRL:<:_) = --traceDoc (greenText "no conflicts A") $
 230                                             Sealed NilFL
 231 patchset_conflict_resolutions NilRL = --traceDoc (greenText "no conflicts B") $
 232                                       Sealed NilFL
 233 patchset_conflict_resolutions (xs:<:_)
 234     = --traceDoc (greenText "looking at resolutions" $$
 235       --         (sh $ resolve_conflicts $ joinPatches $
 236       --              mapFL_FL (patchcontents . hopefully) $ reverseRL xs )) $
 237       merge_list $ map head $ resolve_conflicts $ joinPatches $
 238       mapFL_FL (patchcontents . hopefully) $ reverseRL xs
 239     --where sh :: [[Sealed (FL Prim)]] -> Doc
 240     --      sh [] = greenText "no more conflicts"
 241     --      sh (x:ps) = greenText "one conflict" $$ sh1 x $$ sh ps
 242     --      sh1 :: [Sealed (FL Prim)] -> Doc
 243     --      sh1 [] = greenText "end of unravellings"
 244     --      sh1 (Sealed x:ps) = greenText "one unravelling:" $$ showPatch x $$
 245     --                          sh1 ps
 246 \end{code}