%  Copyright (C) 2002-2003 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.


\begin{code}
module PatchCommute ( merge, elegant_merge, submerge_in_dir,
                      old_elegant_merge, new_elegant_merge,
                      really_eq_patches, eq_patches, eq_list,
                      compare_patches, compare_list,
                      merger, merger_equivalent, glump, unravel,
                      modernize_patch,
                      resolve_conflicts, reorder_and_coalesce, canonize,
                      commute, list_touched_files, list_conflicted_files,
                      force_commute, try_to_shrink, subcommutes,
                      helper_force_commute, -- FIXME remove this!
                      CommuteFunction, Perhaps(..),
                      -- for PatchApply
                      applyBinary, try_tok_internal, movedirfilename )
       where

import Prelude hiding ( pi )
import Control.Monad ( liftM, liftM2, when,
                       MonadPlus, mplus, msum, mzero )
import Data.Maybe ( isNothing )

import FastPackedString ( PackedString, packString, lastPS, nullPS,
                          substrPS,
                          breakPS, concatPS, unlinesPS, linesPS, )
import FileName ( FileName, fn2fp, fp2fn, norm_path )
import Printer ( errorDoc, vcat, text, ($$) )
import PatchCore ( Patch(..), DirPatchType(..), FilePatchType(..),
                   nubAdjBy,
                   is_merger, invert, join_patches, null_patch, is_null_patch,
                   flatten, flatten_to_primitives, merger_undo, n_fn )
import PatchShow ( showPatch )
import Data.List ( intersperse, sort, sortBy, nubBy )
import Data.Maybe ( isJust, catMaybes )
import SlurpDirectory ( FileContents )
import Lcs ( getChanges )
import RegChars ( regChars )
import DarcsUtils ( bugDoc, nubsort )
#include "impossible.h"
\end{code}
 
\section{Commuting patches}

\subsection{Composite patches}

Composite patches are made up of a series of patches intended to be applied
sequentially.  They are represented by a list of patches, with the first
patch in the list being applied first.
\begin{code}
commute_split :: (Patch, Patch) -> Perhaps (Patch, Patch)
commute_split (Split patches, patch) =
    toPerhaps $ do (p1, ps) <- cs (patches, patch)
                   case sort_coalesce_composite ps of
                            [p] -> return (p1, p)
                            ps' -> return (p1, Split ps')
    where cs ([], p1) = return (p1, [])
          cs (p:ps, p1) = do (p1', p') <- commute (p, p1)
                             (p1'', ps') <- cs (ps, p1')
                             return (p1'', p':ps')
commute_split _ = Unknown
\end{code}

\begin{code}
try_to_shrink :: [Patch] -> [Patch]
try_to_shrink psold =
    let ps = sort_coalesce_composite psold
        ps_shrunk = shrink_a_bit ps
                    in
    if length ps_shrunk < length ps
    then try_to_shrink ps_shrunk
    else ps_shrunk

shrink_a_bit :: [Patch] -> [Patch]
shrink_a_bit [] = []
shrink_a_bit (p:ps) =
    case try_one [] p ps of
    Nothing -> p : shrink_a_bit ps
    Just ps' -> ps'

try_one :: [Patch] -> Patch -> [Patch] -> Maybe [Patch]
try_one _ _ [] = Nothing
try_one sofar p (p1:ps) =
    case coalesce (p1, p) of
    Just p' -> Just (reverse sofar ++ [p'] ++ ps)
    Nothing -> case commute (p1, p) of
               Nothing -> Nothing
               Just (p', p1') -> try_one (p1':sofar) p' ps

reorder_and_coalesce :: Patch -> Patch
reorder_and_coalesce (NamedP n d p) = NamedP n d $ reorder_and_coalesce p
reorder_and_coalesce (ComP patches) = ComP $ sort_coalesce_composite patches
reorder_and_coalesce p =p

sort_coalesce_composite :: [Patch] -> [Patch]
sort_coalesce_composite [] = []
sort_coalesce_composite (x:xs) | is_null_patch x = sort_coalesce_composite xs
sort_coalesce_composite (x:xs) = push_coalesce_patch x (sort_coalesce_composite xs)

push_coalesce_patch :: Patch -> [Patch] -> [Patch]
push_coalesce_patch new [] = [new]
push_coalesce_patch new ps@(p:ps')
    = case coalesce (p, new) of
      Just new' | is_null_patch new' -> ps'
                | otherwise -> push_coalesce_patch new' ps'
      Nothing -> if compare_patches new p == LT then new:ps
                            else case commute (p, new) of
                                 Just (new', p') ->
                                     case push_coalesce_patch new' ps' of
                                     r | length r < 1 + length ps'
                                           -> push_coalesce_patch p' r
                                     r -> p' : r
                                 Nothing -> new:ps

canonizeComposite :: [Patch] -> Maybe Patch
canonizeComposite patches =
    simplify_composite $ sort_coalesce_composite $ catMaybes $ map canonize patches
    where simplify_composite :: [Patch] -> Maybe Patch
          simplify_composite [] = Nothing
          simplify_composite [p] = canonize p
          simplify_composite ps = Just $ ComP ps
\end{code}

\newcommand{\commute}{\longleftrightarrow}
\newcommand{\commutes}{\longleftrightarrow}

The first way (of only two) to change the context of a patch is by
commutation, which is the process of changing the order of two sequential
patches.
\begin{dfn}
The commutation of patches $P_1$ and $P_2$ is represented by
\[ P_2 P_1 \commutes {P_1}' {P_2}'. \]
Here $P_1'$ is intended to describe the same change as $P_1$, with the
only difference being that $P_1'$ is applied after $P_2'$ rather than
before $P_2$.
\end{dfn}
The above definition is obviously rather vague, the reason being that what
is the ``same change'' has not been defined, and we simply assume (and
hope) that the code's view of what is the ``same change'' will match those
of its human users.  The `$\commutes$' operator should be read as something
like the $==$ operator in C, indicating that the right hand side performs
identical changes to the left hand side, but the two patches are in
reversed order.  When read in this manner, it is clear that commutation
must be a reversible process, and indeed this means that commutation
\emph{can} fail, and must fail in certain cases.  For example, the creation
and deletion of the same file cannot be commuted.  When two patches fail to
commute, it is said that the second patch depends on the first, meaning
that it must have the first patch in its context (remembering that the
context of a patch is a set of patches, which is how we represent a tree).
\footnote{The fact that commutation can fail makes a huge difference in the
whole patch formalism.  It may be possible to create a formalism in which
commutation always succeeds, with the result of what would otherwise be a
commutation that fails being something like a virtual particle (which can
violate conservation of energy), and it may be that such a formalism would
allow strict mathematical proofs (whereas those used in the current
formalism are mostly only hand waving ``physicist'' proofs).  However, I'm
not sure how you'd deal with a request to delete a file that has not yet
been created, for example.  Obviously you'd need to create some kind of
antifile, which would annihilate with the file when that file finally got
created, but I'm not entirely sure how I'd go about doing this.
$\ddot\frown$ So I'm sticking with my hand waving formalism.}

%I should add that one using the inversion relationship of sequential
%patches, one can avoid having to provide redundant definitions of
%commutation.

% There is another interesting property which is that a commute's results
% can't be affected by commuting another thingamabopper.

\begin{code}
is_in_directory :: FileName -> FileName -> Bool
is_in_directory d f = iid (fn2fp d) (fn2fp f)
    where iid (cd:cds) (cf:cfs)
              | cd /= cf = False
              | otherwise = iid cds cfs
          iid [] ('/':_) = True
          iid [] [] = True -- Count directory itself as being in directory...
          iid _ _ = False

data Perhaps a = Unknown | Failed | Succeeded a

instance  Monad Perhaps where
    (Succeeded x) >>= k =  k x
    Failed   >>= _      =  Failed
    Unknown  >>= _      =  Unknown
    Failed   >> _       =  Failed
    (Succeeded _) >> k  =  k
    Unknown  >> k       =  k
    return              =  Succeeded
    fail _              =  Unknown

instance  MonadPlus Perhaps where
    mzero                 = Unknown
    Unknown `mplus` ys    = ys
    Failed  `mplus` _     = Failed
    (Succeeded x) `mplus` _ = Succeeded x

toMaybe :: Perhaps a -> Maybe a
toMaybe (Succeeded x) = Just x
toMaybe _ = Nothing

toPerhaps :: Maybe a -> Perhaps a
toPerhaps (Just x) = Succeeded x
toPerhaps Nothing = Failed

clever_commute :: ((Patch, Patch) -> Perhaps (Patch, Patch)) ->
                (Patch, Patch) -> Perhaps (Patch, Patch)
clever_commute c (p1,p2) =
    case c (p1, p2) of
    Succeeded x -> Succeeded x
    Failed -> Failed
    Unknown -> case c (invert p2,invert p1) of
               Succeeded (p1', p2') -> Succeeded (invert p2', invert p1')
               Failed -> Failed
               Unknown -> Unknown
--clever_commute c (p1,p2) = c (p1,p2) `mplus`
--    (case c (invert p2,invert p1) of
--     Succeeded (p1', p2') -> Succeeded (invert p2', invert p1')
--     Failed -> Failed
--     Unknown -> Unknown)

speedy_commute :: (Patch,Patch) -> Perhaps (Patch,Patch)
speedy_commute (p1, p2) -- Deal with common case quickly!
    | p1_modifies /= Nothing && p2_modifies /= Nothing &&
      p1_modifies /= p2_modifies = Succeeded (p2, p1)
    | otherwise = Unknown
    where p1_modifies = is_filepatch_merger p1
          p2_modifies = is_filepatch_merger p2

everything_else_commute :: ((Patch,Patch) -> Maybe (Patch,Patch))
                        -> (Patch,Patch) -> Perhaps (Patch,Patch)
everything_else_commute c x = eec x
    where
    eec (NamedP n1 d1 p1, NamedP n2 d2 p2) =
        if n2 `elem` d1 || n1 `elem` d2
        then Failed
        else toPerhaps $ do (p2', p1') <- c (p1, p2)
                            return (NamedP n2 d2 p2', NamedP n1 d1 p1')
    eec (ChangePref p f t,p1) = Succeeded (p1,ChangePref p f t)
    eec (p2,ChangePref p f t) = Succeeded (ChangePref p f t,p2)
    eec (ComP [], p1) = Succeeded (p1, ComP [])
    eec (p2, ComP []) = Succeeded (ComP [], p2)
    eec (ComP (p:ps), p1) = toPerhaps $ do
                            (p1', p') <- c (p, p1)
                            (p1'', ComP ps') <- c (ComP ps, p1')
                            return (p1'', ComP $ p':ps')
    eec (patch2, ComP patches) =
        toPerhaps $ do (patches', patch2') <- ccr (patch2, reverse patches)
                       return (ComP $ reverse patches', patch2')
        where ccr (p2, []) = seq p2 $ return ([], p2)
              ccr (p2, p:ps) = do (p', p2') <- c (p2, p)
                                  (ps', p2'') <- ccr (p2', ps)
                                  return (p':ps', p2'')
    eec (NamedP n2 d2 p2, p1) = toPerhaps $ do (p1',p2') <- c (p2,p1)
                                               return (p1', NamedP n2 d2 p2')
    eec (p2, NamedP n1 d1 p1) = toPerhaps $ do (p1',p2') <- c (p2,p1)
                                               return (NamedP n1 d1 p1', p2')
    eec (p2,p1) =
        msum [clever_commute commute_nameconflict           (p2, p1),
              clever_commute commute_filedir                (p2, p1),
              clever_commute commute_split                  (p2, p1),
              clever_commute simple_commute_conflict        (p2, p1),
              clever_commute harder_commute_conflict        (p2, p1),
              clever_commute commute_recursive_merger       (p2, p1),
              clever_commute other_commute_recursive_merger (p2, p1)]

{-
Note that it must be true that

commute (A^-1 A, P) = Just (P, A'^-1 A')

and

if commute (A, B) == Just (B', A')
then commute (B^-1, A^-1) == Just (A'^-1, B'^-1)
-}

merger_commute :: (Patch,Patch) -> Perhaps (Patch,Patch)
merger_commute (Merger True g _ _ p1 p2, pA)
    | eq_patches pA p1 = Succeeded (merger g p2 p1, p2)
    | eq_patches pA (invert (merger g p2 p1)) = Failed
merger_commute (Merger True "0.0" _ _
                (Merger True "0.0" _ _ c b)
                (Merger True "0.0" _ _ c' a),
                Merger True "0.0" _ _ b' c'')
    | eq_patches b' b && eq_patches c c' && eq_patches c c'' =
        Succeeded (merger "0.0" (merger "0.0" b a) (merger "0.0" b c),
                   merger "0.0" b a)
merger_commute _ = Unknown

commute :: (Patch,Patch) -> Maybe (Patch,Patch)
commute x = toMaybe $ msum [speedy_commute x,
                            clever_commute simple_unforce x,
                            clever_commute repeated_unforce x,
                            clever_commute merger_commute x,
                            everything_else_commute commute x
                           ]

commute_no_merger :: (Patch,Patch) -> Maybe (Patch,Patch)
commute_no_merger x =
    toMaybe $ msum [speedy_commute x,
                    everything_else_commute commute_no_merger x]

force_commute :: (Patch, Patch) -> (Patch, Patch)
force_commute z =
    case msum [speedy_commute z,
               clever_commute simple_unforce z,
               clever_commute repeated_unforce z,
               clever_commute merger_commute z,
               everything_else_commute (Just . force_commute) z] of
    Succeeded x -> x
    Failed -> case msum [clever_commute repeated_force z,
                         simple_force z] of
              Succeeded x -> x
              _ -> impossible
    Unknown -> -- FIXME this Unknown shouldn't ever happen! Eventually I
               -- should make this an "impossible" and then track down the
               -- errors.
               case msum [clever_commute repeated_force z,
                          simple_force z] of
               Succeeded x -> x
               _ -> impossible

-- Handle commutation of simple single conflicts...
simple_unforce :: (Patch,Patch) -> Perhaps (Patch,Patch)
simple_unforce (Conflictor False [a] [b], p)
    | a `eq_patches` p = Succeeded (Conflictor False [b] [a], b)
simple_unforce (Conflictor True [a] [ib], Conflictor False [ib'] [a'])
    | a `eq_patches` a' && ib `eq_patches` ib' = Succeeded (a, invert ib)
simple_unforce _ = Unknown

simple_force :: (Patch,Patch) -> Perhaps (Patch,Patch)
simple_force (a, b) = Succeeded (Conflictor True [a] [invert b],
                                 Conflictor False [invert b] [a])

-- repeated_force requires clever_commute
repeated_force :: (Patch,Patch) -> Perhaps (Patch,Patch)
repeated_force (Conflictor False _ _, Conflictor _ _ _) = Unknown
repeated_force (Conflictor False a [b], p) =
    Succeeded (Conflictor True [b] aip, Conflictor False aip [b])
        where aip = a ++ [invert p]
repeated_force _ = Unknown

-- Handle commutation of repeated (but simple) conflicts...
-- (requires clever_commute)
repeated_unforce :: (Patch,Patch) -> Perhaps (Patch,Patch)
repeated_unforce (Conflictor False ap@(_:_:_) [b], p)
    | last_patch_can_be p ap = -- FIXME: inefficient
        case filter (eq_patches (invert p) . head) $
             all_head_permutations $ map invert $ reverse ap of
        ((_:ia):_) -> Succeeded
                      (Conflictor False [b] ap,
                       Conflictor False (map invert $ reverse ia) [b])
        _ -> impossible
repeated_unforce (Conflictor True [b] aip@(_:_:_),
                  Conflictor False aip' [b'])
    | b' `eq_patches` b && aip' `same_length` aip =
        case filter (eq_patches (invert ip) . head) $
             all_head_permutations $ map invert $ reverse aip' of
        [] -> Unknown
        ((_:a):_) | map invert (reverse a) `eq_patchsequence` init aip ->
                      Succeeded (Conflictor False
                                 (map invert $ reverse a) [b'], invert ip)
                  | otherwise -> Unknown
        _ -> impossible
    where ip = last aip
          [] `same_length` [] = True
          (_:x) `same_length` (_:y) = x `same_length` y
          _ `same_length` _ = False
-- The following pattern is needed for commuting with patch and its
-- inverse.
repeated_unforce (Conflictor False [b'] ax, Conflictor False a [b])
    | b' `eq_patches` b && length ax == length a + 1 =
        case filter (eq_patchsequence ia . tail) $
             all_head_permutations $ map invert $ reverse ax of
        [] -> Unknown
        (ax'@(ix:_):_) -> Succeeded (Conflictor False
                                     (map invert $ reverse ax') [b], invert ix)
        _ -> impossible
    where ia = map invert $ reverse a
repeated_unforce _ = Unknown

first_patch_can_be :: Patch -> [Patch] -> Bool
first_patch_can_be _ [] = False
first_patch_can_be x xa =
    case filter (eq_patches x . head) $ all_head_permutations xa of
    [] -> False
    ((_:_):_) -> True
    _ -> impossible

last_patch_can_be :: Patch -> [Patch] -> Bool
last_patch_can_be x ax =
    first_patch_can_be (invert x) $ map invert $ reverse ax

helper_force_commute :: (Patch,Patch) -> (Patch,Patch)
-- Multiple forward force_commute:
helper_force_commute (Conflictor False a [b], p) =
    (Conflictor True [b] aip, Conflictor False aip [b])
        where aip = a ++ [invert p]
-- Multiple backward force_commute:
helper_force_commute (p1@(Conflictor True _ _), p) =
    (Conflictor True [p1] ip, Conflictor False ip [p1])
        where ip = [invert p]
helper_force_commute _ = impossible

is_filepatch_merger :: Patch -> Maybe FileName
is_filepatch_merger (FP f _) = Just f
is_filepatch_merger (Merger _ _ _ _ p1 p2) = do
     f1 <- is_filepatch_merger p1
     f2 <- is_filepatch_merger p2
     if f1 == f2 then return f1 else Nothing
is_filepatch_merger (Conflictor _ a b) = do
     f1 <- is_filepatch_merger $ join_patches a
     f2 <- is_filepatch_merger $ join_patches b
     if f1 == f2 then return f1 else Nothing
is_filepatch_merger _ = Nothing
\end{code}

\begin{code}
simple_commute_conflict :: (Patch, Patch) -> Perhaps (Patch, Patch)
simple_commute_conflict (Conflictor False a [b], p) = toPerhaps $
    do (ja', ip') <- commute_no_merger (invert p, join_patches a)
       (_, b') <- commute_no_merger (b, invert ip')
       commute_no_merger (b', ip') -- FIXME:  Is this necesary?
       (p', _) <- commute_no_merger (invert $ join_patches a, p) -- FIXME REMOVE
       when (not (invert p' `eq_patches` ip')) $ impossible -- FIXME REMOVE
       Just (invert ip', Conflictor False (flatten ja') [b'])
simple_commute_conflict (p', Conflictor False a' [b']) = toPerhaps $
    do (ip, ja) <- commute_no_merger (join_patches a', invert p')
       (_, b) <- commute_no_merger (b', invert p')
       (_, p) <- commute_no_merger (p', invert $ join_patches a') -- FIXME REMOVE
       when (not (invert p `eq_patches` ip)) $ impossible -- FIXME REMOVE
       Just (Conflictor False (flatten ja) [b], invert ip)
simple_commute_conflict _ = Unknown

harder_commute_conflict :: (Patch, Patch) -> Perhaps (Patch, Patch)
harder_commute_conflict (Conflictor False a b, p) = toPerhaps $
    do (_, ja') <- commute_no_merger (join_patches a, p)
       commute_no_merger (ja', invert p)
       (_, jb') <- commute_no_merger (join_patches b, p)
       commute_no_merger (jb', invert p)
       Just (p, Conflictor False (flatten ja') (flatten jb'))
harder_commute_conflict (p, Conflictor False a b) = toPerhaps $
    do (_, ja') <- commute_no_merger (join_patches a, invert p)
       commute_no_merger (ja', p)
       (_, jb') <- commute_no_merger (join_patches b, invert p)
       commute_no_merger (jb', p)
       Just (Conflictor False (flatten ja') (flatten jb'), p)
harder_commute_conflict _ = Unknown

eq_patchsequence :: [Patch] -> [Patch] -> Bool
eq_patchsequence a b
    | length a /= length b = False
    | otherwise = e a b
    where e (x:xs) y =
              case filter (eq_patches x . head) $ all_head_permutations y of
              ((_:ys):_) -> e xs ys
              _ -> False
          e [] [] = True
          e _ _ = impossible
\end{code}

\begin{code}
commute_recursive_merger :: (Patch,Patch) -> Perhaps (Patch,Patch)
commute_recursive_merger (p@(Merger True "0.0" _ _ p1 p2), pA) = toPerhaps $
  do (pA', _) <- commute (undo, pA)
     commute (invert undo, pA')
     (pAmid, _) <- commute (invert p1, pA)
     (pAx, p1') <- commute (p1, pAmid)
     assert (pAx `eq_patches` pA)
     (_,p2') <- commute (p2, pAmid)
     (_, p2o) <- commute (p2', invert pAmid)
     assert (p2o `eq_patches` p2)
     let p' = if eq_patches p1' p1 && eq_patches p2' p2
              then p
              else merger "0.0" p1' p2'
         undo' = merger_undo p'
     (_, pAo) <- commute (pA', undo')
     assert (pAo `eq_patches` pA)
     return (pA', p')
    where undo = merger_undo p
commute_recursive_merger (Merger True _ _ _ _ _, _) = impossible
commute_recursive_merger _ = Unknown

other_commute_recursive_merger :: (Patch,Patch) -> Perhaps (Patch,Patch)
other_commute_recursive_merger (pA', p_old@(Merger True "0.0" _ _ p1' p2')) =
  toPerhaps $
  do (_, pA) <- commute (pA', merger_undo p_old)
     (p1, pAmid) <- commute (pA, p1')
     (pAmido, _) <- commute (invert p1, pA)
     assert (pAmido `eq_patches` pAmid)
     (_, p2) <- commute (p2', invert pAmid)
     (_, p2o') <- commute (p2, pAmid)
     assert (p2o' `eq_patches` p2')
     let p = if p1 `eq_patches` p1' && p2 `eq_patches` p2'
             then p_old
             else merger "0.0" p1 p2
         undo = merger_undo p
     assert (not $ pA `eq_patches` p1) -- special case here...
     (pAo', _) <- commute (undo,pA)
     assert (pAo' `eq_patches` pA')
     return (p, pA)
other_commute_recursive_merger (_, Merger True _ _ _ _ _) = impossible
other_commute_recursive_merger _ = Unknown

assert :: Bool -> Maybe ()
assert False = Nothing
assert True = Just ()

movedirfilename :: FileName -> FileName -> FileName -> FileName
movedirfilename old new name =
    seq new $ fp2fn $ mdfn (fn2fp old) (fn2fp new) (fn2fp name)
    where mdfn d d' f =
              if length f > length d && take (length d+1) f == d ++ "/"
              then d'++drop (length d) f
              else if f == d
                   then d'
                   else f

is_superdir :: FileName -> FileName -> Bool
is_superdir d1 d2 = isd (fn2fp d1) (fn2fp d2)
    where isd s1 s2 =
              length s2 >= length s1 + 1 && take (length s1 + 1) s2 == s1 ++ "/"

make_conflicted :: Patch -> Patch
make_conflicted (FP f AddFile) = FP (conflicted_name f) AddFile
make_conflicted (DP f AddDir ) = DP (conflicted_name f) AddDir
make_conflicted (Move a f) = Move a (conflicted_name f)
make_conflicted _ = impossible
conflicted_name :: FileName -> FileName
conflicted_name f = fp2fn $ fn2fp f ++ "-conflict"

create_conflict_merge :: (Patch,Patch) -> Maybe (Patch,Patch)
create_conflict_merge (Move d d', FP f AddFile)
    | d' == f = Just (Move d $ conflicted_name f, FP f AddFile)
create_conflict_merge (Move d d', DP f AddDir)
    | d' == f = Just (Move d $ conflicted_name f, DP f AddDir)
create_conflict_merge (FP d AddFile, DP f AddDir)
    | d == f = Just (FP (conflicted_name d) AddFile, DP f AddDir)
create_conflict_merge (Move d d', Move f f')
    | d' == f' && d > f = Just (Move (movedirfilename f f' d) $ conflicted_name f',
                                Move f f')
create_conflict_merge (p, Split [Move a b, p2])
    | b == conflicted_name a =
        case create_conflict_merge (p, make_conflicted p2) of
        Nothing -> Nothing
        Just (p',_) -> Just (p', Split [Move a b, p2])
create_conflict_merge _ = Nothing

commute_nameconflict :: (Patch,Patch) -> Perhaps (Patch,Patch)
commute_nameconflict (Move d d', FP f2 AddFile)
    | d == f2 && d' == conflicted_name f2 = Succeeded (FP d' AddFile, ComP [])
    | d' == conflicted_name f2 = Succeeded (Split [Move f2 d', FP f2 AddFile],
                                            Move d f2)
commute_nameconflict (Move d d', DP f2 AddDir)
    | d == f2 && d' == conflicted_name f2 = Succeeded (DP d' AddDir, ComP [])
    | d' == conflicted_name f2 = Succeeded (Split [Move f2 d', DP f2 AddDir],
                                            Move d f2)
commute_nameconflict (Move d d', Move f f')
    | d' == conflicted_name d && d == f'
        = Succeeded (Move f d', ComP [])
    | d' == conflicted_name f' && (movedirfilename f' f d) > f =
        Succeeded (Split [Move f' d', Move (movedirfilename d d' f) f'],
                   Move (movedirfilename f' f d) f')
commute_nameconflict (FP f AddFile, DP d AddDir)
    | f == conflicted_name d = Succeeded (Split [Move d f, DP d AddDir],
                                          FP d AddFile)
commute_nameconflict (DP f AddDir, Split [Move a b, p2])
    | b == conflicted_name a && f == conflicted_name b =
        Succeeded (Split [Move b f, Split [Move a b, p2]], DP b AddDir)
commute_nameconflict (FP f AddFile, Split [Move a b, p2])
    | b == conflicted_name a && f == conflicted_name b =
        Succeeded (Split [Move b f, Split [Move a b, p2]], FP b AddFile)
commute_nameconflict (Move old f, Split [Move a b, p2])
    | b == conflicted_name a && f == conflicted_name b =
        Succeeded (Split [Move b f, Split [Move a b, p2]], Move old b)
commute_nameconflict _ = Unknown

commute_filedir :: (Patch,Patch) -> Perhaps (Patch,Patch)
commute_filedir (FP f1 p1, FP f2 p2) =
  if f1 /= f2 then Succeeded ( FP f2 p2, FP f1 p1 )
  else commuteFP f1 (p1, p2)
commute_filedir (DP d1 p1, DP d2 p2) =
  if (not $ is_in_directory d1 d2) && (not $ is_in_directory d2 d1) &&
     d1 /= d2
  then Succeeded ( DP d2 p2, DP d1 p1 )
  else Failed
commute_filedir (DP d dp, FP f fp) =
    if not $ is_in_directory d f then Succeeded (FP f fp, DP d dp)
    else Failed

commute_filedir (Move d d', FP f2 p2)
    | f2 == d' = Failed
    | p2 == AddFile && d == f2 = Failed
    | otherwise = Succeeded (FP (movedirfilename d d' f2) p2, Move d d')
commute_filedir (Move d d', DP d2 p2)
    | is_superdir d2 d' || is_superdir d2 d = Failed
    | p2 == AddDir && d == d2 = Failed
    | d2 == d' = Failed
    | otherwise = Succeeded (DP (movedirfilename d d' d2) p2, Move d d')
commute_filedir (Move d d', Move f f')
    | f == d' || f' == d = Failed
    | f == d || f' == d' = Failed
    | d `is_superdir` f && f' `is_superdir` d' = Failed
    | otherwise =
        Succeeded (Move (movedirfilename d d' f) (movedirfilename d d' f'),
                   Move (movedirfilename f' f d) (movedirfilename f' f d'))

commute_filedir _ = Unknown
\end{code}

\begin{code}
type CommuteFunction = (Patch, Patch) -> Perhaps (Patch, Patch)
subcommutes :: [(String, CommuteFunction)]
subcommutes =
    [("speedy_commute", speedy_commute),
     ("commute_filedir", clever_commute commute_filedir),
     ("commute_filepatches", clever_commute commute_filepatches),
     ("simple_commute_conflict", clever_commute simple_commute_conflict),
     ("harder_commute_conflict", clever_commute harder_commute_conflict),
     ("simple conflicts", \x -> msum [clever_commute simple_unforce x,
                                      simple_force x]),
     ("repeated conflicts", \x -> msum [
                                        clever_commute repeated_unforce x,
                                        clever_commute repeated_force x]),
     ("force_commute", \x -> Succeeded (force_commute x)),
     ("commute", toPerhaps . commute)
    ]
\end{code}

\paragraph{Merge}
\newcommand{\merge}{\Longrightarrow}
The second way one can change the context of a patch is by a {\bf merge}
operation.  A merge is an operation that takes two parallel patches and
gives a pair of sequential patches.  The merge operation is represented by
the arrow ``\( \merge \)''.
\begin{dfn}\label{merge_dfn}
The result of a merge of two patches, $P_1$ and $P_2$ is one of two patches,
$P_1'$ and $P_2'$, which satisfy the relationship:
\[  P_2 \parallel P_1 \merge {P_2}' P_1 \commute {P_1}' P_2. \]
\end{dfn}
Note that the sequential patches resulting from a merge are \emph{required}
to commute.  This is an important consideration, as without it most of the
manipulations we would like to perform would not be possible.  The other
important fact is that a merge \emph{cannot fail}.  Naively, those two
requirements seem contradictory.  In reality, what it means is that the
result of a merge may be a patch which is much more complex than any we
have yet considered\footnote{Alas, I don't know how to prove that the two
constraints even \emph{can} be satisfied.  The best I have been able to do
is to believe that they can be satisfied, and to be unable to find an case
in which my implementation fails to satisfy them.  These two requirements
are the foundation of the entire theory of patches (have you been counting
how many foundations it has?).}.

\begin{code}
merge :: (Patch, Patch) -> Maybe (Patch, Patch)
\end{code}

\subsection{How merges are actually performed}

The constraint that any two compatible patches (patches which can
successfully be applied to the same tree) can be merged is actually quite
difficult to apply.  The above merge constraints also imply that the result
of a series of merges must be independent of the order of the merges.  So
I'm putting a whole section here for the interested to see what algorithms
I use to actually perform the merges (as this is pretty close to being the
most difficult part of the code).

The first case is that in which the two merges don't actually conflict, but
don't trivially merge either (e.g.\ hunk patches on the same file, where the
line number has to be shifted as they are merged).  This kind of merge can
actually be very elegantly dealt with using only commutation and inversion.

There is a handy little theorem which is immensely useful when trying to
merge two patches.
\begin{thm}\label{merge_thm}
$ P_2' P_1 \commute P_1' P_2 $ if and only if $ P_1'^{ -1}
P_2' \commute P_2 P_1^{ -1} $, provided both commutations succeed.  If
either commute fails, this theorem does not apply.
\end{thm}
This can easily be proven by multiplying both sides of the first
commutation by $P_1'^{ -1}$ on the left, and by $P_1^{ -1}$ on the right.
Besides being used in merging, this theorem is also useful in the recursive
commutations of mergers.  From Theorem~\ref{merge_thm}, we see that the
merge of $P_1$ and $P_2'$ is simply the commutation of $P_2$ with $P_1^{
-1}$ (making sure to do the commutation the right way).  Of course, if this
commutation fails, the patches conflict.  Moreover, one must check that the
merged result actually commutes with $P_1$, as the theorem applies only
when \emph{both} commutations are successful.

\begin{code}

-- Change the following function to switch between testing new Conflictor
-- code, and using the old Merger code.

elegant_merge :: (Patch, Patch) -> Maybe Patch
elegant_merge = old_elegant_merge

new_elegant_merge :: (Patch, Patch) -> Maybe Patch
new_elegant_merge (p1, p2) =
  case force_commute (p1, invert p2) of
  (xa,p1') -> case force_commute (p1', p2) of -- FIXME: safety redundancy here.
             (x,p1o) -> if really_eq_patches p1o p1
                        then Just p1'
                        else errorDoc $ text "Aaack in elegant_merge\n" $$
                             showPatch p1 $$
                             text "\nand also\n" $$ showPatch p2 $$
                             text "\nmerged 1:\n" $$ showPatch p1' $$
                             text "\nmerged 2 commuted:\n" $$ showPatch x $$
                             text "\nreconstituted:\n" $$ showPatch p1o $$
                             text "\nlast but not least:\n" $$ showPatch xa

old_elegant_merge :: (Patch, Patch) -> Maybe Patch
old_elegant_merge (p1, p2) =
  case commute (p1, invert p2) of
  Just (_,p1') -> case commute (p1', p2) of
                  Nothing -> Nothing
                  Just (_,p1o) -> if really_eq_patches p1o p1
                                  then Just p1'
                                  else Nothing
  Nothing -> Nothing
\end{code}

Of course, there are patches that actually conflict, meaning a merge where
the two patches truly cannot both be applied (e.g.\ trying to create a file
and a directory with the same name).  We deal with this case by creating a
special kind of patch to support the merge, which we will call a
``merger''.  Basically, a merger is a patch that contains the two patches
that conflicted, and instructs darcs basically to resolve the conflict.  By
construction a merger will satisfy the commutation property (see
Definition~\ref{merge_dfn}) that characterizes all merges.  Moreover the
merger's properties are what makes the order of merges unimportant (which
is a rather critical property for darcs as a whole).

The job of a merger is basically to undo the two conflicting patches, and
then apply some sort of a ``resolution'' of the two instead.  In the case
of two conflicting hunks, this will look much like what CVS does, where it
inserts both versions into the file.  In general, of course, the two
conflicting patches may both be mergers themselves, in which case the
situation is considerably more complicated.

\begin{code}
list_conflicted_files :: Patch -> [FilePath]
list_conflicted_files p =
    nubsort $ concatMap list_touched_files $ concat $ resolve_conflicts p
list_touched_files :: Patch -> [FilePath]
list_touched_files (NamedP _ _ p) = list_touched_files p
list_touched_files (Move f1 f2) = map fn2fp [f1, f2]
list_touched_files (Split ps) = nubsort $ concatMap list_touched_files ps
list_touched_files (ComP ps) = nubsort $ concatMap list_touched_files ps
list_touched_files (FP f _) = [fn2fp f]
list_touched_files (DP d _) = [fn2fp d]
list_touched_files (Merger _ _ _ _ p1 p2) = nubsort $ list_touched_files p1
                                          ++ list_touched_files p2
list_touched_files _ = []
\end{code}

\begin{code}
merge (p1,p2) = Just (actual_merge (p1,p2), p2)

actual_merge :: (Patch, Patch) -> Patch
actual_merge (NamedP n d p1, p2) = seq p2 $
                                   NamedP n d $ actual_merge (p1, p2)
actual_merge (p1, NamedP _ _ p2) = actual_merge (p1, p2)
actual_merge (ComP the_p1s, ComP the_p2s) =
    join_patches $ mc the_p1s the_p2s
    where mc :: [Patch] -> [Patch] -> [Patch]
          mc [] (_:_) = []
          mc p1s [] = p1s
          mc p1s (p2:p2s) = mc (merge_patches_after_patch p1s p2) p2s
actual_merge (ComP p1s, p2) = seq p2 $
                              join_patches $ merge_patches_after_patch p1s p2
actual_merge (p1, ComP p2s) = seq p1 $ merge_patch_after_patches p1 p2s

actual_merge (p1, p2) = seq p1 $ seq p2 $
    case elegant_merge (p1,p2) of
    Just p1' -> p1'
    Nothing -> case clever_merge create_conflict_merge (p1,p2) of
               Just (p1',_) -> p1'
               Nothing -> merger "0.0" p2 p1

merge_patch_after_patches :: Patch -> [Patch] -> Patch
merge_patch_after_patches p (p1:p1s) =
    case merge (p, p1) of
    Nothing -> impossible
    Just (p',_) -> seq p' $ merge_patch_after_patches p' p1s
merge_patch_after_patches p [] = p

merge_patches_after_patch :: [Patch] -> Patch -> [Patch]
merge_patches_after_patch p2s p =
    case force_commute (merge_patch_after_patches p p2s, join_patches p2s) of
    (ComP p2s', _) -> p2s'
    _ -> impossible

clever_merge :: ((Patch, Patch) -> Maybe (Patch, Patch)) ->
                (Patch, Patch) -> Maybe (Patch, Patch)
clever_merge m (p1,p2) = m (p1,p2) `mplus` (m (p2,p1) >>= commute)
\end{code}

Much of the merger code depends on a routine which recreates from a single
merger the entire sequence of patches which led up to that merger (this is,
of course, assuming that this is the complicated general case of a merger
of mergers of mergers).  This ``unwind'' procedure is rather complicated,
but absolutely critical to the merger code, as without it we wouldn't even
be able to undo the effects of the patches involved in the merger, since we
wouldn't know what patches were all involved in it.

Basically, unwind takes a merger such as
\begin{verbatim}
M( M(A,B), M(A,M(C,D)))
\end{verbatim}
From which it recreates a merge history:
\begin{verbatim}
C
A
M(A,B)
M( M(A,B), M(A,M(C,D)))
\end{verbatim}
(For the curious, yes I can easily unwind this merger in my head [and on
paper can unwind insanely more complex mergers]---that's what comes of
working for a few months on an algorithm.)  Let's start with a simple
unwinding.  The merger \verb!M(A,B)! simply means that two patches
(\verb!A! and \verb!B!) conflicted, and of the two of them \verb!A! is
first in the history.  The last two patches in the unwinding of any merger
are always just this easy.  So this unwinds to:
\begin{verbatim}
A
M(A,B)
\end{verbatim}
What about a merger of mergers? How about \verb!M(A,M(C,D))!.  In this case
we know the two most recent patches are:
\begin{verbatim}
A
M(A,M(C,D))
\end{verbatim}
But obviously the unwinding isn't complete, since we don't yet see where
\verb!C! and \verb!D! came from.  In this case we take the unwinding of
\verb!M(C,D)! and drop its latest patch (which is \verb!M(C,D)! itself) and
place that at the beginning of our patch train:
\begin{verbatim}
C
A
M(A,M(C,D))
\end{verbatim}
As we look at \verb!M( M(A,B), M(A,M(C,D)))!, we consider the unwindings of
each of its subpatches:
\begin{verbatim}
          C
A         A
M(A,B)    M(A,M(C,D))
\end{verbatim}
As we did with \verb!M(A,M(C,D))!, we'll drop the first patch on the
right and insert the first patch on the left.  That moves us up to the two
\verb!A!'s.  Since these agree, we can use just one of them (they
``should'' agree).  That leaves us with the \verb!C! which goes first.

The catch is that things don't always turn out this easily.  There is no
guarantee that the two \verb!A!'s would come out at the same time, and if
they didn't, we'd have to rearrange things until they did.  Or if there was
no way to rearrange things so that they would agree, we have to go on to
plan B, which I will explain now.

Consider the case of \verb!M( M(A,B), M(C,D))!.  We can easily unwind the
two subpatches
\begin{verbatim}
A         C
M(A,B)    M(C,D)
\end{verbatim}
Now we need to reconcile the \verb!A! and \verb!C!.  How do we do this?
Well, as usual, the solution is to use the most wonderful
Theorem~\ref{merge_thm}.  In this case we have to use it in the reverse of
how we used it when merging, since we know that \verb!A! and \verb!C! could
either one be the \emph{last} patch applied before \verb!M(A,B)! or
\verb!M(C,D)!.  So we can find \verb!C'! using
\[
A^{ -1} C \commute C' A'^{ -1}
\]
Giving an unwinding of
\begin{verbatim}
C'
A
M(A,B)
M( M(A,B), M(C,D) )
\end{verbatim}
There is a bit more complexity to the unwinding process (mostly having to
do with cases where you have deeper nesting), but I think the general
principles that are followed are pretty much included in the above
discussion.

\begin{code}
unwind :: Patch -> [Patch] -- Recreates a patch history in reverse.
unwind (Merger _ _ _ unwindings _ _) = unwindings
unwind p = [p];

true_unwind :: Patch -> [Patch] -- Recreates a patch history in reverse.
true_unwind p@(Merger _ _ _ _ p1 p2) =
    case (unwind p1, unwind p2) of
    (_:p1s,_:p2s) -> p : p1 : reconcile_unwindings p p1s p2s
    _ -> impossible
true_unwind _ = impossible

reconcile_unwindings :: Patch -> [Patch] -> [Patch] -> [Patch]
reconcile_unwindings _ [] p2s = p2s
reconcile_unwindings _ p1s [] = p1s
reconcile_unwindings p (p1:p1s) p2s =
    case [(p1s', p2s')|
          p1s' <- all_head_permutations (p1:p1s),
          p2s' <- all_head_permutations p2s,
          head p1s' `eq_patches` head p2s'] of
    ((p1':p1s', _:p2s'):_) -> p1' : reconcile_unwindings p p1s' p2s'
    [] -> case liftM reverse $ put_before p1 $ reverse p2s of
          Just p2s' -> p1 : reconcile_unwindings p p1s p2s'
          Nothing ->
              case liftM reverse $ put_before (head p2s) $ reverse (p1:p1s) of
              Just p1s' -> (head p2s) : reconcile_unwindings p p1s' (tail p2s)
              Nothing ->
                  bugDoc $ text "in function reconcile_unwindings"
                        $$ text "Original patch:"
                        $$ showPatch p
    _ -> bug "in reconcile_unwindings"

put_before :: Patch -> [Patch] -> Maybe [Patch]
put_before p1 (p2:p2s) =
    case commute (invert p1,p2) of
    Nothing -> Nothing
    Just (p2',p1') -> case commute (p1,p2') of
                      Nothing -> Nothing
                      Just _ -> liftM (p2' :) $ put_before p1' p2s
put_before _ [] = Just []

-- NOTE: all_head_permutations accepts a list of patches IN REVERSE
-- ORDER!!!

all_head_permutations :: [Patch] -> [[Patch]]
all_head_permutations [] = []
all_head_permutations [p] = [[p]]
all_head_permutations ps =
  reverse $ map reverse $ nubBy (eq_list eq_patches)
          $ tail_permutations_normal_order $ reverse ps

tail_permutations_normal_order :: [Patch] -> [[Patch]]
tail_permutations_normal_order [] = []
tail_permutations_normal_order (p1:ps) =
    case swap_to_back_n_o (p1:ps) of
    Just ps' -> ps' : map (p1:) (tail_permutations_normal_order ps)
    Nothing -> map (p1:) (tail_permutations_normal_order ps)

swap_to_back_n_o :: [Patch] -> Maybe [Patch]
swap_to_back_n_o [] = Just []
swap_to_back_n_o [p] = Just [p]
swap_to_back_n_o (p1:p2:ps) =
    case commute (p2,p1) of
    Just (p1',p2') ->
        case swap_to_back_n_o (p1':ps) of
        Just ps' -> Just $ p2': ps'
        Nothing -> Nothing
    Nothing -> Nothing
\end{code}

It can sometimes be handy to have a canonical representation of a given
patch.  We achieve this by defining a canonical form for each patch type,
and a function ``{\tt canonize}'' which takes a patch and puts it into
canonical form.  This routine is used by the diff function to create an
optimal patch (based on an LCS algorithm) from a simple hunk describing the
old and new version of a file.
\begin{code}
canonize :: Patch -> Maybe Patch
canonize (NamedP n d p) =
    case canonize p of
    Just p' -> Just $ NamedP n d p'
    Nothing -> Nothing
canonize (Merger True g _ _ p1 p2) =
    liftM2 (merger g) (canonize p1) (canonize p2)
canonize (Merger False g _ _ p1 p2) =
    invert `liftM` liftM2 (merger g) (canonize p1) (canonize p2)
canonize (Split ps) = Just $ Split $ sort_coalesce_composite ps
canonize (ComP ps) = canonizeComposite ps
canonize (FP f (Hunk line old new)) = canonizeHunk f line old new
canonize p@(FP _ (Binary old new)) = if old /= new then Just p
                                     else Just null_patch
canonize p = Just p
\end{code}
Note that canonization may fail, if the patch is internally inconsistent.

A simpler, faster (and more generally useful) cousin of canonize is the
coalescing function.  This takes two sequential patches, and tries to turn
them into one patch.  This function is used to deal with ``split'' patches,
which are created when the commutation of a primitive patch can only be
represented by a composite patch.  In this case the resulting composite
patch must return to the original primitive patch when the commutation is
reversed, which a split patch accomplishes by trying to coalesce its
contents each time it is commuted.

\begin{code}
coalesce :: (Patch, Patch) -> Maybe Patch
coalesce (FP f1 _, FP f2 _) | f1 /= f2 = Nothing
coalesce (p2, p1) | p2 `eq_patches` invert p1 = Just null_patch
coalesce (FP f1 p1, FP _ p2) = coalesceFilePatch f1 (p1, p2) -- f1 = f2
coalesce (ComP [], p) = Just p
coalesce (p, ComP []) = Just p
coalesce (Split [], p) = Just p
coalesce (p, Split []) = Just p
coalesce (Move a b, Move b' a') | a == a' = Just $ Move b' b
coalesce (ChangePref p f1 t1, ChangePref p2 f2 t2) | p == p2 && t2 == f1 = Just $ ChangePref p f2 t1
coalesce _ = Nothing
\end{code}

\subsection{File patches}

A file patch is a patch which only modifies a single
file.  There are some rules which can be made about file patches in
general, which makes them a handy class.
For example, commutation of two filepatches is trivial if they modify
different files.  There is an exception when one of the files has a name
ending with ``-conflict'', in which case it may not commute with a file
having the same name, but without the ``-conflict.''  If they happen to
modify the same file, we'll have to check whether or not they commute.
\begin{code}
commute_filepatches :: (Patch, Patch) -> Perhaps (Patch, Patch)
commute_filepatches (FP f1 p1, FP f2 p2) | f1 == f2 = commuteFP f1 (p1, p2)
commute_filepatches _ = Unknown

commuteFP :: FileName -> (FilePatchType, FilePatchType)
          -> Perhaps (Patch, Patch)
commuteFP f (Hunk line1 old1 new1, Hunk line2 old2 new2) = seq f $
  toPerhaps $ commuteHunk f (Hunk line1 old1 new1, Hunk line2 old2 new2)
commuteFP f (TokReplace t o n, Hunk line2 old2 new2) = seq f $
    case try_tok_replace t o n old2 of
    Nothing -> Failed
    Just old2' ->
      case try_tok_replace t o n new2 of
      Nothing -> Failed
      Just new2' -> Succeeded (FP f $ Hunk line2 old2' new2',
                               FP f $ TokReplace t o n)
commuteFP f (TokReplace t o n, TokReplace t2 o2 n2)
    | seq f $ t /= t2 = Failed
    | o == o2 = Failed
    | n == o2 = Failed
    | o == n2 = Failed
    | n == n2 = Failed
    | otherwise = Succeeded (FP f $ TokReplace t2 o2 n2,
                             FP f $ TokReplace t o n)
commuteFP _ _ = Unknown
\end{code}

\begin{code}
coalesceFilePatch :: FileName -> (FilePatchType, FilePatchType) -> Maybe Patch
coalesceFilePatch f (Hunk line1 old1 new1, Hunk line2 old2 new2)
    = coalesceHunk f line1 old1 new1 line2 old2 new2
coalesceFilePatch _ (AddFile, RmFile)
    = Just (ComP [])
coalesceFilePatch f (TokReplace t1 o1 n1, TokReplace t2 o2 n2)
    | t1 == t2 && n2 == o1 = Just $ FP f $ TokReplace t1 o2 n1
coalesceFilePatch f (Binary m n, Binary o m')
    | m == m' = Just $ FP f $ Binary o n
coalesceFilePatch _ _ = Nothing
\end{code}

There is another handy function, which primarily affects file patches
(although it can also affect other patches, such as rename patches or dir
add/remove patches), which is the submerge-in-directory function.  This
function changes the patch to act on a patch within a subdirectory rather
than in the current directory, and is useful when performing the recursive
diff.

\begin{code}
submerge_in_dir :: FilePath -> Patch -> Patch
submerge_in_dir dir (Move f f') = Move (subfn dir f) (subfn dir f')
submerge_in_dir dir (DP d dp) = DP (subfn dir d) dp
submerge_in_dir dir (FP f fp) = FP (subfn dir f) fp
submerge_in_dir dir (Split ps) = Split $ map (submerge_in_dir $! dir) ps
submerge_in_dir dir (ComP ps) = ComP $ map (submerge_in_dir $! dir) ps
submerge_in_dir dir (NamedP n d p) = NamedP n d (submerge_in_dir dir p)
submerge_in_dir dir (Merger b g undo unwindings p1 p2)
    = Merger b g (sub undo) (map sub unwindings) (sub p1) (sub p2)
    where sub = submerge_in_dir $! dir
submerge_in_dir dir (Conflictor inv a b) = Conflictor inv (sub a) (sub b)
    where sub = map (submerge_in_dir dir)
submerge_in_dir _ p@(ChangePref _ _ _) = p
subfn :: String -> FileName -> FileName
subfn dir f = seq dir $ seq f $ fp2fn $ n_fn $ dir++"/"++ fn2fp (norm_path f)
\end{code}

\subsection{Hunks}

The hunk is the simplest patch that has a commuting pattern in which the
commuted patches differ from the originals (rather than simple success or
failure).  This makes commuting or merging two hunks a tad tedious.
\begin{code}
commuteHunk :: FileName -> (FilePatchType, FilePatchType) -> Maybe (Patch, Patch)
commuteHunk f (Hunk line2 old2 new2, Hunk line1 old1 new1)
  | seq f $ line1 + lengthnew1 < line2 =
      Just (FP f (Hunk line1 old1 new1),
            FP f (Hunk (line2 - lengthnew1 + lengthold1) old2 new2))
  | line2 + lengthold2 < line1 =
      Just (FP f (Hunk (line1+ lengthnew2 - lengthold2) old1 new1),
            FP f (Hunk line2 old2 new2))
  | line1 + lengthnew1 == line2 &&
    lengthold2 /= 0 && lengthold1 /= 0 && lengthnew2 /= 0 && lengthnew1 /= 0 =
      Just (FP f (Hunk line1 old1 new1),
            FP f (Hunk (line2 - lengthnew1 + lengthold1) old2 new2))
  | line2 + lengthold2 == line1 &&
    lengthold2 /= 0 && lengthold1 /= 0 && lengthnew2 /= 0 && lengthnew1 /= 0 =
      Just (FP f (Hunk (line1 + lengthnew2 - lengthold2) old1 new1),
            FP f (Hunk line2 old2 new2))
  | otherwise = seq f Nothing
  where lengthnew1 = length new1
        lengthnew2 = length new2
        lengthold1 = length old1
        lengthold2 = length old2
commuteHunk _ _ = impossible
\end{code}
Hunks, of course, can be coalesced if they have any overlap.  Note that
coalesce code doesn't check if the two patches are conflicting.  If you are
coalescing two conflicting hunks, you've already got a bug somewhere.

\begin{code}
coalesceHunk :: FileName -> Int
             -> [PackedString] -> [PackedString] -> Int
             -> [PackedString] -> [PackedString] -> Maybe Patch
coalesceHunk f line1 old1 new1 line2 old2 new2 =
    docoalesceHunk f line1 old1 new1 line2 old2 new2
    --case commute (FP f (Hunk line1 old1 new1),
    --              FP f (Hunk line2 old2 new2)) of
    --Just (p1,p2) -> Nothing -- They don't coalesce
    --Nothing ->
    --    docoalesceHunk f line1 old1 new1 line2 old2 new2
docoalesceHunk :: FileName
               -> Int -> [PackedString] -> [PackedString]
               -> Int -> [PackedString] -> [PackedString]
               -> Maybe Patch
docoalesceHunk f line1 old1 new1 line2 old2 new2
    | line1 == line2 && lengthold1 < lengthnew2 =
        if take lengthold1 new2 /= old1
        then Nothing
        else case drop lengthold1 new2 of
        extranew -> Just (FP f (Hunk line1 old2 (new1 ++ extranew)))
    | line1 == line2 && lengthold1 > lengthnew2 =
        if take lengthnew2 old1 /= new2
        then Nothing
        else case drop lengthnew2 old1 of
        extraold -> Just (FP f (Hunk line1 (old2 ++ extraold) new1))
    | line1 == line2 = if new2 == old1 then Just (FP f (Hunk line1 old2 new1))
                       else Nothing
    | line1 < line2 && lengthold1 >= line2 - line1 =
        case take (line2 - line1) old1 of
        extra-> docoalesceHunk f line1 old1 new1 line1
                (extra ++ old2) (extra ++ new2)
    | line1 > line2 && lengthnew2 >= line1 - line2 =
        case take (line1 - line2) new2 of
        extra-> docoalesceHunk f line2 (extra ++ old1) (extra ++ new1)
                line2 old2 new2
    | otherwise = Nothing
    where lengthold1 = length old1
          lengthnew2 = length new2
\end{code}

One of the most important pieces of code is the canonization of a hunk,
which is where the ``diff'' algorithm is performed.  This algorithm begins
with chopping off the identical beginnings and endings of the old and new
hunks.  This isn't strictly necessary, but is a good idea, since this
process is $O(n)$, while the primary diff algorithm is something
considerably more painful than that\ldots\ actually the head would be dealt
with all right, but with more space complexity.  I think it's more
efficient to just chop the head and tail off first.

\begin{code}
canonizeHunk :: FileName -> Int
             -> [PackedString] -> [PackedString] -> Maybe Patch
canonizeHunk _ _ o n | o == n = Nothing
canonizeHunk f line old new
    | null old || null new
        = Just $ FP f $ Hunk line old new
canonizeHunk f line old new =
    case make_holey f line $ getChanges old new of
    [p] -> Just p
    [] -> Nothing
    ps -> Just $ join_patches ps

make_holey :: FileName -> Int -> [(Int,[PackedString], [PackedString])]
           -> [Patch]
make_holey f line changes =
    map (\ (l,o,n) -> FP f (Hunk (l+line) o n)) changes
        
applyBinary :: PackedString -> PackedString
            -> FileContents -> Maybe FileContents
applyBinary o n (_,Just c) | c == o = Just (linesPS n, Just n)
applyBinary o n (ls,Nothing)
    | unlinesPS ls == o = Just (linesPS n, Just n)
applyBinary _ _ _ = Nothing
\end{code}

\begin{code}
try_tok_replace :: String -> String -> String
                -> [PackedString] -> Maybe [PackedString]
try_tok_replace t o n mss =
  mapM (liftM concatPS . try_tok_internal t (packString o) (packString n)) mss


try_tok_internal :: String -> PackedString -> PackedString
                 -> PackedString -> Maybe [PackedString]
try_tok_internal _ o n s | isNothing (substrPS o s) &&
                           isNothing (substrPS n s) = Just [s]
try_tok_internal t o n s =
    case breakPS (regChars t) s of
    (before,s') ->
        case breakPS (not . regChars t) s' of
        (tok,after) ->
            case try_tok_internal t o n after of
            Nothing -> Nothing
            Just rest ->
                if tok == o
                then Just $ before : n : rest
                else if tok == n
                     then Nothing
                     else Just $ before : tok : rest
\end{code}
 
\section{Conflicts}

There are a couple of simple constraints on the routine which determines
how to resolve two conflicting patches (which is called `glump').  These
must be satisfied in order that the result of a series of merges is always
independent of their order.  Firstly, the output of glump cannot change
when the order of the two conflicting patches is switched.  If it did, then
commuting the merger could change the resulting patch, which would be bad.
Secondly, the result of the merge of three (or more) conflicting patches
cannot depend on the order in which the merges are performed.

The conflict resolution code (glump) begins by ``unravelling'' the merger
into a set of sequences of patches.  Each sequence of patches corresponds
to one non-conflicted patch that got merged together with the others.  The
result of the unravelling of a series of merges must obviously be
independent of the order in which those merges are performed.  This
unravelling code (which uses the unwind code mentioned above) uses probably
the second most complicated algorithm.  Fortunately, if we can successfully
unravel the merger, almost any function of the unravelled merger satisfies
the two constraints mentioned above that the conflict resolution code must
satisfy.

\begin{code}
unravel :: Patch -> [[Patch]]

resolve_conflicts :: Patch -> [[Patch]]
resolve_conflicts patch = rcs [] $ reverse $ flatten_to_primitives patch
    where rcs a [] = seq a []
          rcs passedby (p@(Merger True "0.0" _ _ _ _):ps) =
              seq passedby $
              case commute_no_merger (join_patches passedby,p) of
              Just (p'@(Merger True "0.0" _ _ p1 p2),_) ->
                  (nubBy eq_patches $ glump "0.9" p1 p2 : map join_patches (unravel p'))
                  : rcs (p : passedby) ps
              Nothing -> rcs (p : passedby) ps
              _ -> impossible
          rcs passedby (p:ps) = seq passedby $ rcs (p : passedby) ps
\end{code}

\begin{code}
unravel p = nubAdjBy (eq_list eq_patches) $
            sortBy (compare_list compare_patches) $
            map (sort_coalesce_composite) $
            map (concatMap (flatten.merger_equivalent)) $
            get_supers $ map reverse $ new_ur p $ unwind p

get_supers :: [[Patch]] -> [[Patch]]
get_supers (x:xs) =
    case filter (not.(x `is_superpatch_of`)) xs of
    xs' -> if or $ map (`is_superpatch_of` x) xs'
           then get_supers xs'
           else x : get_supers xs'
get_supers [] = []
is_superpatch_of :: [Patch] -> [Patch] -> Bool
x `is_superpatch_of` y | length y > length x = False
x `is_superpatch_of` y = x `iso` y
    where iso :: [Patch] -> [Patch] -> Bool
          _ `iso` [] = True
          [] `iso` _ = False
          a `iso` (b:bs) =
              case filter ((`eq_patches` b) . head)
                 $ head_permutations_normal_order a of
              ((_:as):_) -> as `iso` bs
              [] -> False
              _ -> bug "bug in is_superpatch_of"

head_permutations_normal_order :: [Patch] -> [[Patch]]
head_permutations_normal_order [] = []
head_permutations_normal_order (p:ps) =
    (p:ps) : catMaybes (map (swapfirst.(p:)) $
                        head_permutations_normal_order ps)
swapfirst :: [Patch] -> Maybe [Patch]
swapfirst (p1:p2:ps) = case commute (p2,p1) of
                       Just (p1',p2') -> Just $ p2':p1':ps
                       Nothing -> Nothing
swapfirst _ = Nothing

merger :: String -> Patch -> Patch -> Patch
merger g p1 p2 = Merger True g undoit unwindings p1 p2
    where fake_p = Merger True g null_patch [] p1 p2
          unwindings = true_unwind fake_p
          p = Merger True g null_patch unwindings p1 p2
          undoit =
              case (is_merger p1, is_merger p2) of
              (True ,True ) -> join_patches $ map invert $ tail $ unwind p
              (False,False) -> invert p1
              (True ,False) -> unglump p1
              (False,True ) -> join_patches $ [invert p1, merger_undo p2]
          unglump (Merger True g' _ _ p1' p2') = invert $ glump g' p1' p2'
          unglump _ = impossible
\end{code}

\begin{code}
only_hunks :: [[Patch]] -> Bool
only_hunks [] = False
only_hunks pss = fn2fp f /= "" && all oh pss
    where f = get_a_filename pss
          oh (FP f' (Hunk _ _ _):ps) = f == f' && oh ps
          oh (_:_) = False
          oh [] = True

apply_hunks :: [Maybe PackedString] -> [Patch] -> [Maybe PackedString]
apply_hunks ms (FP _ (Hunk l o n):ps) = apply_hunks (rls l ms) ps
    where rls 1 mls = map Just n ++ drop (length o) mls
          rls i (ml:mls) = ml : rls (i-1) mls
          rls _ [] = bug "rls in apply_hunks"
apply_hunks ms [] = ms
apply_hunks _ (_:_) = impossible

get_hunks_old :: [Maybe PackedString] -> [Patch] -> [Maybe PackedString]
get_hunks_old mls ps = apply_hunks (apply_hunks mls ps) (map invert $ reverse ps)
get_old :: [Maybe PackedString] -> [[Patch]] -> [Maybe PackedString]
get_old mls (ps:pss) = get_old (get_hunks_old mls ps) pss
get_old mls [] = mls
get_hunks_new :: [Maybe PackedString] -> [Patch] -> [Maybe PackedString]
get_hunks_new mls ps = apply_hunks mls ps

get_hunkline :: [[Maybe PackedString]] -> Int
get_hunkline = ghl 1
    where ghl :: Int -> [[Maybe PackedString]] -> Int
          ghl n pps =
            if any (isJust . head) pps
            then n
            else ghl (n+1) $ map tail pps

get_a_filename :: [[Patch]] -> FileName
get_a_filename ((FP f _:_):_) = f
get_a_filename _ = fp2fn ""

make_chunk :: Int -> [Maybe PackedString] -> [PackedString]
make_chunk n mls = pull_chunk $ drop (n-1) mls
    where pull_chunk (Just l:mls') = l : pull_chunk mls'
          pull_chunk (Nothing:_) = []
          pull_chunk [] = bug "should this be [] in pull_chunk?"

mangle_unravelled_hunks :: [[Patch]] -> Patch
--mangle_unravelled_hunks [[h1],[h2]] = Deal with simple cases handily?
mangle_unravelled_hunks pss =
        if null nchs then bug "mangle_unravelled_hunks"
                     else FP filename (Hunk l old new)
    where oldf = get_old (repeat Nothing) pss
          newfs = map (get_hunks_new oldf) pss
          l = get_hunkline $ oldf : newfs
          nchs = sort $ map (make_chunk l) newfs
          filename = get_a_filename pss
          old = make_chunk l oldf
          new = [top] ++ concat (intersperse [middle] nchs) ++ [bottom]
          top    = packString $ "v v v v v v v" ++ eol_c
          middle = packString $ "*************" ++ eol_c
          bottom = packString $ "^ ^ ^ ^ ^ ^ ^" ++ eol_c
          eol_c  = if any (\ps -> not (nullPS ps) && lastPS ps == '\r') old
                   then "\r"
                   else ""
\end{code}

\begin{code}
glump :: String -> Patch -> Patch -> Patch
glump "0.1" p1 p2 = case unravel $ merger "0.1" p1 p2 of
                    (ps:_) -> join_patches ps
                    [] -> impossible
glump "a" p1 p2 = glump "0.9" p1 p2
glump "0.0" _ _ = ComP []

glump "0.9" p1 p2 = case unravel $ merger "0.9" p1 p2 of
                    pss -> if only_hunks pss
                           then mangle_unravelled_hunks pss
                           else join_patches $ head pss
glump _ _ _ = impossible
\end{code}

\begin{code}
merger_equivalent :: Patch -> Patch
merger_equivalent p@(Merger True g _ _ p1 p2) =
    join_patches $ sort_coalesce_composite
                     ((flatten $ merger_equivalent $ merger_undo p)++
                      (flatten $ merger_equivalent $ glump g p1 p2))
merger_equivalent p@(Merger False _ _ _ _ _) =
    invert $ merger_equivalent $ invert p
merger_equivalent (Split ps) = Split $ map merger_equivalent ps
merger_equivalent (ComP ps) = ComP $ map merger_equivalent ps
merger_equivalent (NamedP n d p) = NamedP n d $ merger_equivalent p
merger_equivalent (Conflictor False a [_]) =
    merger_equivalent $ invert $ join_patches a
merger_equivalent (Conflictor True a [_]) =
    merger_equivalent $ join_patches a
merger_equivalent (Conflictor _ _ _) = null_patch
merger_equivalent p = p

modernize_patch :: Patch -> Patch
modernize_patch p@(Merger _ "0.9" _ _ _ _) = merger_equivalent p
modernize_patch (NamedP n d p) = NamedP n d $ modernize_patch p
modernize_patch (ComP ps) = ComP $ map modernize_patch ps
modernize_patch (Split ps) = Split $ map modernize_patch ps
modernize_patch p = p
\end{code}

\begin{code}
new_ur :: Patch -> [Patch] -> [[Patch]]
new_ur p (Merger _ _ _ _ p1 p2 : ps) =
   case filter ((`eq_patches` p1) . head) $ all_head_permutations ps of
   ((_:ps'):_) -> new_ur p (p1:ps') ++ new_ur p (p2:ps')
   _ -> bugDoc $ text "in function new_ur"
              $$ text "Original patch:"
              $$ showPatch p
              $$ text "Unwound:"
              $$ vcat (map showPatch $ unwind p)

new_ur op ps =
    case filter (is_merger.head) $ all_head_permutations ps of
    [] -> [ps]
    (ps':_) -> new_ur op ps'
\end{code}

\begin{code}

-- We define equality here, since it requires commutation in the case of
-- Conflictors.

eq_patches_base :: Bool -> Patch -> Patch -> Bool
eq_patches_base really (NamedP n1 _ p1) (NamedP n2 _ p2)
 | really    = n1 == n2 && eq_patches_base really p1 p2
 | otherwise = n1 == n2
eq_patches_base _ (Move a b) (Move c d) = a == c && b == d
eq_patches_base _ (DP d1 p1) (DP d2 p2) = d1 == d2 && p1 == p2 
eq_patches_base _ (FP f1 fp1) (FP f2 fp2) = f1 == f2 && fp1 == fp2
eq_patches_base really (Split ps1) (Split ps2)
 = eq_list (eq_patches_base really) ps1 ps2
eq_patches_base really (ComP ps1) (ComP ps2)
 = eq_list (eq_patches_base really) ps1 ps2
eq_patches_base really (Merger b1 g1 _ _ p1a p1b) (Merger b2 g2 _ _ p2a p2b)
 = b1 == b2 &&
   eq_patches_base really p1a p2a &&
   eq_patches_base really p1b p2b &&
   g1 == g2
eq_patches_base _ (ChangePref a1 b1 c1) (ChangePref a2 b2 c2)
 = c1 == c2 && b1 == b2 && a1 == a2
eq_patches_base _ (Conflictor i a b) (Conflictor i' a' b') =
    i == i' && a `same_patches` a' && b `same_last_eq` b'
eq_patches_base _ _ _ = False

eq_patches :: Patch -> Patch -> Bool
eq_patches = eq_patches_base False

really_eq_patches :: Patch -> Patch -> Bool
really_eq_patches = eq_patches_base True

merge_orders :: Ordering -> Ordering -> Ordering
merge_orders EQ x = x
merge_orders LT _ = LT
merge_orders GT _ = GT

compare_patches :: Patch -> Patch -> Ordering
compare_patches (NamedP n1 _ _) (NamedP n2 _ _) = compare n1 n2
compare_patches (NamedP _ _ _) _ = LT
compare_patches _ (NamedP _ _ _) = GT
compare_patches (Move a b) (Move c d) = compare (a, b) (c, d)
compare_patches (Move _ _) _ = LT
compare_patches _ (Move _ _) = GT
compare_patches (DP d1 p1) (DP d2 p2) = compare (d1, p1) (d2, p2)
compare_patches (DP _ _) _ = LT
compare_patches _ (DP _ _) = GT
compare_patches (FP f1 fp1) (FP f2 fp2) = compare (f1, fp1) (f2, fp2)
compare_patches (FP _ _) _ = LT
compare_patches _ (FP _ _) = GT
compare_patches (Split ps1) (Split ps2) = compare_list compare_patches ps1 ps2
compare_patches (Split _) _ = LT
compare_patches _ (Split _) = GT
compare_patches (ComP ps1) (ComP ps2) = compare_list compare_patches ps1 ps2
compare_patches (ComP _) _ = LT
compare_patches _ (ComP _) = GT
compare_patches (Merger b1 g1 _ _ p1a p1b) (Merger b2 g2 _ _ p2a p2b)
 | b1 == b2 && p1a `eq_patches` p2a && p1b `eq_patches` p2b && g1 == g2 = EQ
compare_patches (Merger b1 g1 p1 ps1 p1a p1b) (Merger b2 g2 p2 ps2 p2a p2b)
 =                compare (b1, g1) (b2, g2)
   `merge_orders` compare_patches p1 p2
   `merge_orders` compare_list compare_patches ps1 ps2
   `merge_orders` compare_patches p1a p2a
   `merge_orders` compare_patches p1b p2b
compare_patches (Merger _ _ _ _ _ _) _ = LT
compare_patches _ (Merger _ _ _ _ _ _) = GT
compare_patches (Conflictor True a b) (Conflictor True a' b')
    | la > la' = LT
    | la < la' = GT
    | lb < lb' = GT
    | lb > lb' = LT
    | otherwise =
        case compare_patches (join_patches a) (join_patches a') of
        LT -> LT
        GT -> GT
        EQ -> compare_patches (join_patches b) (join_patches b')
    where la = length a
          la' = length a'
          lb = length b
          lb' = length b'
compare_patches c1@(Conflictor False _ _) c2@(Conflictor False _ _) =
    compare_patches (invert c2) (invert c1)
compare_patches (Conflictor True _ _) (Conflictor False _ _) = LT
compare_patches (Conflictor False _ _) (Conflictor True _ _) = GT
compare_patches (Conflictor _ _ _) _ = GT
compare_patches _ (Conflictor _ _ _) = LT
compare_patches (ChangePref a1 b1 c1) (ChangePref a2 b2 c2)
 = compare (c1, b1, a1) (c2, b2, a2)

eq_list :: (a -> a -> Bool) -> [a] -> [a] -> Bool
eq_list _ [] [] = True
eq_list f (x:xs) (y:ys) = f x y && eq_list f xs ys
eq_list _ _ _ = False

compare_list :: (a -> a -> Ordering) -> [a] -> [a] -> Ordering
compare_list _ [] [] = EQ
compare_list _ [] _  = LT
compare_list _ _  [] = GT
compare_list f (x:xs) (y:ys) = f x y `merge_orders` compare_list f xs ys

-- The following verifies that the two sequences are permutations of one
-- another
same_patches :: [Patch] -> [Patch] -> Bool
same_patches a b | length a /= length b = False
same_patches [] [] = True
same_patches cs (bb:bs) =
    case filter ((eq_patches bb) .head) $ all_head_permutations cs of
    ((_:cs'):_) -> same_patches cs' bs
    _ -> False
same_patches _ _ = impossible

same_last_eq :: [Patch] -> [Patch] -> Bool
same_last_eq [] [] = bug "Can't take same_last_eq of empty lists."
same_last_eq a b = last a `eq_patches` last b && init a `same_patches` init b
\end{code}
