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