% 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}

    {-# OPTIONS_GHC -cpp -fglasgow-exts -fno-warn-orphans #-}
    {-# LANGUAGE CPP #-}
    -- , TypeOperators #-}

    #include "gadts.h"

    module Darcs.Patch.Commute ( fromPrims,
                                 modernizePatch,
    #ifndef GADT_WITNESSES
                                 merge, elegantMerge,
                                 merger, unravel,
    #endif
                                 public_unravel, mangle_unravelled,
                                 CommuteFunction, Perhaps(..),
                                 -- for other commutes:
                                 toMaybe,
                               )
           where

    import Control.Monad ( MonadPlus, mplus, msum, mzero )

    import Darcs.Patch.FileName ( FileName, fn2fp, fp2fn )
    import Darcs.Patch.Info ( invert_name, idpatchinfo )
    import Darcs.Patch.Patchy ( Commute(..), Invert(..), toFwdCommute, toRevCommute )
    import Darcs.Patch.Core ( Patch(..), Named(..),
    #ifndef GADT_WITNESSES
                              flattenFL,
                              isMerger,
    #endif
                              merger_undo,
                              join_patchesFL )
    import Darcs.Patch.Prim ( Prim(..), FromPrims(..),
                              Conflict(..), Effect(..),
                              is_filepatch, sortCoalesceFL,
    #ifndef GADT_WITNESSES
                              FilePatchType(..), DirPatchType(..),
    #else
                              FilePatchType(Hunk),
    #endif
                              primIsHunk, modernizePrim )
    import qualified Data.ByteString.Char8 as BC (pack, last)
    import qualified Data.ByteString       as B (null, ByteString)
    import Data.Maybe ( isJust )
    import Data.List ( intersperse, sort )
    #ifndef GADT_WITNESSES
    import Darcs.Patch.Permutations ( head_permutationsRL, head_permutationsFL )
    import Printer ( text, vcat, ($$) )
    import Darcs.Patch.Patchy ( invertRL )
    import Darcs.Patch.Show ( showPatch_ )
    import Data.List ( nubBy )
    import Darcs.Witnesses.Sealed ( unsafeUnseal )
    #endif
    import Darcs.Utils ( nubsort )
    #include "impossible.h"
    import Darcs.Witnesses.Sealed ( Sealed(..), mapSeal )
    import Darcs.Witnesses.Ordered ( mapFL, mapFL_FL, unsafeCoerceP,
                                 FL(..), RL(..),
                                 (:/\:)(..), (:<)(..), (:\/:)(..), (:>)(..),
    #ifndef GADT_WITNESSES
                                 lengthFL, mapRL,
    #endif
                                 reverseFL, reverseRL, concatFL,
                                 MyEq, unsafeCompare
                               )

    --import Darcs.ColorPrinter ( traceDoc )
    --import Printer ( greenText )

\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. \newcommand{\commutex}{\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 commutex, 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 commutex's results % can't be affected by commuting another thingamabopper. \begin{code}

    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

    #ifndef GADT_WITNESSES
    clever_commute :: CommuteFunction -> CommuteFunction
    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
    #endif

    speedy_commute :: CommuteFunction
    speedy_commute (p1 :< p2) -- Deal with common case quickly!
        | p1_modifies /= Nothing && p2_modifies /= Nothing &&
          p1_modifies /= p2_modifies = Succeeded (unsafeCoerceP p2 :< unsafeCoerceP p1)
        | otherwise = Unknown
        where p1_modifies = is_filepatch_merger p1
              p2_modifies = is_filepatch_merger p2

    instance Commute p => Commute (Named p) where
        commute (NamedP n1 d1 p1 :> NamedP n2 d2 p2) =
            if n2 `elem` d1 || n1 `elem` d2
            then Nothing
            else do (p2' :> p1') <- commute (p1 :> p2)
                    return (NamedP n2 d2 p2' :> NamedP n1 d1 p1')
        merge (NamedP n1 d1 p1 :\/: NamedP n2 d2 p2)
            = case merge (p1 :\/: p2) of
              (p2' :/\: p1') -> NamedP n2 d2 p2' :/\: NamedP n1 d1 p1'
        listTouchedFiles (NamedP _ _ p) = listTouchedFiles p
        hunkMatches f (NamedP _ _ p) = hunkMatches f p

    instance Conflict p => Conflict (Named p) where
        listConflictedFiles (NamedP _ _ p) = listConflictedFiles p
        resolveConflicts (NamedP _ _ p) = resolveConflicts p

    everything_else_commute :: MaybeCommute -> CommuteFunction
    everything_else_commute c x = eec x
        where
        eec :: CommuteFunction
        eec (PP px :< PP py) = toPerhaps $ do x' :> y' <- commute (py :> px)
                                              return (PP y' :< PP x')
        eec (ComP NilFL :< p1) = Succeeded (unsafeCoerceP p1 :< (ComP NilFL))
        eec (p2 :< ComP NilFL) = Succeeded (ComP NilFL :< unsafeCoerceP 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 :< reverseFL patches)
                           return (ComP (reverseRL patches') :< patch2')
            where ccr :: FORALL(x y) (Patch :< RL Patch) C(x y) -> Maybe ((RL Patch :< Patch) C(x y))
                  ccr (p2 :< NilRL) = seq p2 $ return (NilRL :< p2)
                  ccr (p2 :< p:<:ps) = do (p' :< p2') <- c (p2 :< p)
                                          (ps' :< p2'') <- ccr (p2' :< ps)
                                          return (p':<:ps' :< p2'')
        eec _xx =
            msum [
    #ifndef GADT_WITNESSES
                  clever_commute commute_recursive_merger       _xx
                 ,clever_commute other_commute_recursive_merger _xx
    #endif
                 ]

    {-
    Note that it must be true that

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

    and

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

    #ifndef GADT_WITNESSES
    merger_commute :: (Patch :< Patch) -> Perhaps (Patch :< Patch)
    merger_commute (Merger _ _ p1 p2 :< pA)
        | unsafeCompare pA p1 = Succeeded (merger "0.0" p2 p1 :< p2)
        | unsafeCompare pA (invert (merger "0.0" p2 p1)) = Failed
    merger_commute (Merger _ _
                    (Merger _ _ c b)
                    (Merger _ _ c' a) :<
                    Merger _ _ b' c'')
        | unsafeCompare b' b && unsafeCompare c c' && unsafeCompare c c'' =
            Succeeded (merger "0.0" (merger "0.0" b a) (merger "0.0" b c) :<
                       merger "0.0" b a)
    merger_commute _ = Unknown
    #endif

    instance Commute Patch where
        merge (y :\/: z) =
    #ifndef GADT_WITNESSES
            case actual_merge (y:\/:z) of
            y' -> case commute (z :> y') of
                             Nothing -> bugDoc $ text "merge_patches bug"
                                        $$ showPatch_ y
                                       $$ showPatch_ z
                                       $$ showPatch_ y'
                             Just (_ :> z') -> z' :/\: y'
    #else
            case elegantMerge (y:\/:z) of
            Just (z' :/\: y') -> z' :/\: y'
            Nothing -> undefined
    #endif
        commute x = toMaybe $ msum
                      [toFwdCommute speedy_commute x,
    #ifndef GADT_WITNESSES
                       toFwdCommute (clever_commute merger_commute) x,
    #endif
                       toFwdCommute (everything_else_commute (toRevCommute commute)) x
                      ]
        -- Recurse on everything, these are potentially spoofed patches
        listTouchedFiles (ComP ps) = nubsort $ concat $ mapFL listTouchedFiles ps
        listTouchedFiles (Merger _ _ p1 p2) = nubsort $ listTouchedFiles p1
                                                ++ listTouchedFiles p2
        listTouchedFiles c@(Regrem _ _ _ _) = listTouchedFiles $ invert c
        listTouchedFiles (PP p) = listTouchedFiles p

        hunkMatches f (ComP ps) = or $ mapFL (hunkMatches f) ps
        hunkMatches f (Merger _ _ p1 p2) = hunkMatches f p1 || hunkMatches f p2
        hunkMatches f c@(Regrem _ _ _ _) = hunkMatches f $ invert c
        hunkMatches f (PP p) = hunkMatches f p

    commute_no_merger :: MaybeCommute
    commute_no_merger x =
    #ifndef GADT_WITNESSES
        toMaybe $ msum [speedy_commute x,
                        everything_else_commute commute_no_merger x]
    #else
        bug "commute_no_merger undefined when compiled with GADTs" x
    #endif

    is_filepatch_merger :: Patch C(x y) -> Maybe FileName
    is_filepatch_merger (PP p) = is_filepatch p
    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 (Regrem und unw p1 p2)
        = is_filepatch_merger (Merger und unw p1 p2)
    is_filepatch_merger (ComP _) = Nothing

    #ifndef GADT_WITNESSES
    commute_recursive_merger :: (Patch :< Patch) -> Perhaps (Patch :< Patch)
    commute_recursive_merger (p@(Merger _ _ p1 p2) :< pA) = toPerhaps $
      do (_ :> pA') <- commute (pA :> undo)
         commute (pA' :> invert undo)
         (_ :> pAmid) <- commute (pA :> invert p1)
         (p1' :> pAx) <- commute (pAmid :> p1)
         assert (pAx `unsafeCompare` pA)
         (p2' :> _) <- commute (pAmid :> p2)
         (p2o :> _) <- commute (invert pAmid :> p2')
         assert (p2o `unsafeCompare` p2)
         let p' = if unsafeCompare p1' p1 && unsafeCompare p2' p2
                  then p
                  else merger "0.0" p1' p2'
             undo' = merger_undo p'
         (pAo :> _) <- commute (undo' :> pA')
         assert (pAo `unsafeCompare` pA)
         return (pA' :< p')
        where undo = merger_undo p
    commute_recursive_merger _ = Unknown

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

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

    type CommuteFunction = FORALL(x y) (Patch :< Patch) C(x y) -> Perhaps ((Patch :< Patch) C(x y))
    type MaybeCommute = FORALL(x y) (Patch :< Patch) C(x y) -> Maybe ((Patch :< Patch) C(x y))

\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 \commutex {P_1}' P_2. \] \end{dfn} Note that the sequential patches resulting from a merge are \emph{required} to commutex. 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?).}. \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 \commutex P_1' P_2 $ if and only if $ P_1'^{ -1} P_2' \commutex P_2 P_1^{ -1} $, provided both commutations succeed. If either commutex 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}

    elegantMerge :: (Patch :\/: Patch) C(x y)
                  -> Maybe ((Patch :/\: Patch) C(x y))
    elegantMerge (p1 :\/: p2) = do
      p1' :> ip2' <- commute (invert p2 :> p1)
      p1o :> _    <- commute (p2 :> p1')
      if unsafeCompare p1o p1 -- should be a redundant check
        then return $ invert ip2' :/\: p1'
        else 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}

    #ifndef GADT_WITNESSES
    actual_merge :: (Patch :\/: Patch) -> Patch
    actual_merge (ComP the_p1s :\/: ComP the_p2s) =
        join_patchesFL $ mc the_p1s the_p2s
        where mc :: FL Patch -> FL Patch -> FL Patch
              mc NilFL (_:>:_) = NilFL
              mc p1s NilFL = p1s
              mc p1s (p2:>:p2s) = mc (merge_patches_after_patch p1s p2) p2s
    actual_merge (ComP p1s :\/: p2) = seq p2 $
                                  join_patchesFL $ merge_patches_after_patch p1s p2
    actual_merge (p1 :\/: ComP p2s) = seq p1 $ merge_patch_after_patches p1 p2s

    actual_merge (p1 :\/: p2) = case elegantMerge (p1:\/:p2) of
                                Just (_ :/\: p1') -> p1'
                                Nothing -> merger "0.0" p2 p1

    merge_patch_after_patches :: Patch -> FL Patch -> Patch
    merge_patch_after_patches p (p1:>:p1s) =
        merge_patch_after_patches (actual_merge (p:\/:p1)) p1s
    merge_patch_after_patches p NilFL = p

    merge_patches_after_patch :: FL Patch -> Patch -> FL Patch
    merge_patches_after_patch p2s p =
        case commute (join_patchesFL p2s :> merge_patch_after_patches p p2s) of
        Just (_ :> ComP p2s') -> p2s'
        _ -> impossible
    #endif

\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 \commutex 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}

    #ifndef GADT_WITNESSES
    unwind :: Patch -> RL Patch -- Recreates a patch history in reverse.
    unwind (Merger _ unwindings _ _) = unwindings
    unwind p = p :<: NilRL;

    true_unwind :: Patch -> RL 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 -> RL Patch -> RL Patch -> RL Patch
    reconcile_unwindings _ NilRL p2s = p2s
    reconcile_unwindings _ p1s NilRL = p1s
    reconcile_unwindings p (p1:<:p1s) p2s =
        case [(p1s', p2s')|
              p1s'@(hp1s':<:_) <- head_permutationsRL (p1:<:p1s),
              p2s'@(hp2s':<:_) <- head_permutationsRL p2s,
              hp1s' `unsafeCompare` hp2s'] of
        ((p1':<:p1s', _:<:p2s'):_) ->
            p1' :<: reconcile_unwindings p p1s' p2s'
        [] -> case reverseFL `fmap` put_before p1 (reverseRL p2s) of
              Just p2s' -> p1 :<: reconcile_unwindings p p1s p2s'
              Nothing ->
                  case fmap reverseFL $ put_before (headRL p2s) $
                       reverseRL (p1:<:p1s) of
                  Just p1s' -> case p2s of
                               hp2s:<:tp2s -> hp2s :<:
                                              reconcile_unwindings p p1s' tp2s
                               NilRL -> impossible
                  Nothing ->
                      bugDoc $ text "in function reconcile_unwindings"
                            $$ text "Original patch:"
                            $$ showPatch_ p
        _ -> bug "in reconcile_unwindings"

    put_before :: Patch -> FL Patch -> Maybe (FL Patch)
    put_before p1 (p2:>:p2s) =
        do p1' :> p2' <- commute (p2 :> invert p1)
           commute (p2' :> p1)
           (p2' :>:) `fmap` put_before p1' p2s
    put_before _ NilFL = Just NilFL
    #endif

\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}

    instance Conflict Patch where
      commute_no_conflicts (x:>y) = do x' :< y' <- commute_no_merger (y :< x)
                                       return (y':>x')
    #ifndef GADT_WITNESSES
      resolveConflicts patch = rcs NilFL $ reverseFL $ flattenFL patch
        where rcs :: FL Patch C(w y) -> RL Patch C(x y) -> [[Sealed (FL Prim C(w))]]
              rcs _ NilRL = []
              rcs passedby (p@(Merger _ _ _ _):<:ps) =
                  case commute_no_merger (join_patchesFL passedby:<p) of
                  Just (p'@(Merger _ _ p1 p2):<_) ->
                      (map Sealed $ nubBy unsafeCompare $ effect (glump09 p1 p2) : unravel p')
                      : rcs (p :>: passedby) ps
                  Nothing -> rcs (p :>: passedby) ps
                  _ -> impossible
              rcs passedby (p:<:ps) = seq passedby $
                                      rcs (p :>: passedby) ps
    #else
      resolveConflicts = bug "haven't defined resolveConflicts with type witnesses."
    #endif

    public_unravel :: Patch C(x y) -> [Sealed (FL Prim C(y))]
    #ifdef GADT_WITNESSES
    public_unravel = bug "Haven't implemented public_unravel with type witnesses."
    #else
    public_unravel p = map Sealed $ unravel p
    #endif

    #ifndef GADT_WITNESSES
    unravel :: Patch -> [FL Prim]
    unravel p = nubBy unsafeCompare $
                map (sortCoalesceFL . concatFL . mapFL_FL effect) $
                get_supers $ map reverseRL $ new_ur p $ unwind p

    get_supers :: [FL Patch] -> [FL 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 :: FL Patch -> FL Patch -> Bool
    x `is_superpatch_of` y | lengthFL y > lengthFL x = False
    x `is_superpatch_of` y = x `iso` y
        where iso :: FL Patch -> FL Patch -> Bool
              _ `iso` NilFL = True
              NilFL `iso` _ = False
              a `iso` (b:>:bs) =
                  case filter ((`unsafeCompare` b) . headFL) $
                       head_permutationsFL a of
                  ((_:>:as):_) -> as `iso` bs
                  [] -> False
                  _ -> bug "bug in is_superpatch_of"

    headFL :: FL a -> a
    headFL (x:>:_) = x
    headFL NilFL = bug "bad headFL"

    merger :: String -> Patch -> Patch -> Patch
    merger "0.0" p1 p2 = Merger undoit unwindings p1 p2
        where fake_p = Merger identity NilRL p1 p2
              unwindings = true_unwind fake_p
              p = Merger identity unwindings p1 p2
              undoit =
                  case (isMerger p1, isMerger p2) of
                  (True ,True ) -> join_patchesFL $ invertRL $ tailRL $ unwind p
                                   where tailRL (_:<:t) = t
                                         tailRL _ = impossible
                  (False,False) -> invert p1
                  (True ,False) -> join_patchesFL NilFL
                  (False,True ) -> join_patchesFL (invert p1 :>: merger_undo p2 :>: NilFL)
    merger g _ _ =
        error $ "Cannot handle mergers other than version 0.0\n"++g
        ++ "\nPlease use darcs optimize --modernize with an older darcs."

    glump09 :: Patch -> Patch -> Patch
    glump09 p1 p2 = fromPrims $ unsafeUnseal $ mangle_unravelled $ map Sealed $ unravel $ merger "0.0" p1 p2

    #endif

    mangle_unravelled :: [Sealed (FL Prim C(x))] -> Sealed (FL Prim C(x))
    mangle_unravelled pss = if only_hunks pss
                            then (:>: NilFL) `mapSeal` mangle_unravelled_hunks pss
                            else head pss

    only_hunks :: [Sealed (FL Prim C(x))] -> Bool
    only_hunks [] = False
    only_hunks pss = fn2fp f /= "" && all oh pss
        where f = get_a_filename pss
              oh :: Sealed (FL Prim C(x)) -> Bool
              oh (Sealed (p:>:ps)) = primIsHunk p &&
                                     [fn2fp f] == listTouchedFiles p &&
                                     oh (Sealed ps)
              oh (Sealed NilFL) = True

    apply_hunks :: [Maybe B.ByteString] -> FL Prim C(x y) -> [Maybe B.ByteString]
    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 NilFL = ms
    apply_hunks _ (_:>:_) = impossible

    get_old :: [Maybe B.ByteString] -> [Sealed (FL Prim C(x))] -> [Maybe B.ByteString]
    get_old mls (ps:pss) = get_old (get_hunks_old mls ps) pss
    get_old mls [] = mls

    get_a_filename :: [Sealed (FL Prim C(x))] -> FileName
    get_a_filename ((Sealed (FP f _:>:_)):_) = f
    get_a_filename _ = fp2fn ""

    get_hunks_old :: [Maybe B.ByteString] -> Sealed (FL Prim C(x))
                  -> [Maybe B.ByteString]
    get_hunks_old mls (Sealed ps) =
        apply_hunks (apply_hunks mls ps) (invert ps)

    get_hunks_new :: [Maybe B.ByteString] -> Sealed (FL Prim C(x))
                  -> [Maybe B.ByteString]
    get_hunks_new mls (Sealed ps) = apply_hunks mls ps

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

    make_chunk :: Int -> [Maybe B.ByteString] -> [B.ByteString]
    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 :: [Sealed (FL Prim C(x))] -> Sealed (Prim C(x))
    --mangle_unravelled_hunks [[h1],[h2]] = Deal with simple cases handily?
    mangle_unravelled_hunks pss =
            if null nchs then bug "mangle_unravelled_hunks"
                         else Sealed (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    = BC.pack $ "v v v v v v v" ++ eol_c
              middle = BC.pack $ "*************" ++ eol_c
              bottom = BC.pack $ "^ ^ ^ ^ ^ ^ ^" ++ eol_c
              eol_c  = if any (\ps -> not (B.null ps) && BC.last ps == '\r') old
                       then "\r"
                       else ""

    instance Effect Patch where
        effect p@(Merger _ _ _ _) = sortCoalesceFL $ effect $ merger_undo p
        effect p@(Regrem _ _ _ _) = invert $ effect $ invert p
        effect (ComP ps) = concatFL $ mapFL_FL effect ps
        effect (PP p) = effect p
        isHunk p = do PP p' <- return p
                      isHunk p'

    modernizePatch :: Patch C(x y) -> Patch C(x y)
    modernizePatch p@(Merger _ _ _ _) = fromPrims $ effect p
    modernizePatch p@(Regrem _ _ _ _) = fromPrims $ effect p
    modernizePatch (ComP ps) = ComP $ filtermv $ mapFL_FL modernizePatch ps
        where filtermv :: FL Patch C(x y) -> FL Patch C(x y)
    #ifndef GADT_WITNESSES
              filtermv (PP (Move _ b):>:xs) | hasadd xs = filtermv xs
                  where hasadd (PP (FP b' AddFile):>:_) | b' == b = True
                        hasadd (PP (DP b' AddDir):>:_) | b' == b = True
                        hasadd (PP (FP b' RmFile):>:_) | b' == b = False
                        hasadd (PP (DP b' RmDir):>:_) | b' == b = False
                        hasadd (_:>:z) = hasadd z
                        hasadd NilFL = False
    #endif
              filtermv (x:>:xs) = x :>: filtermv xs
              filtermv NilFL = NilFL

    modernizePatch (PP p) = fromPrims $ modernizePrim p

    instance FromPrims Patch where
        fromPrims (p :>: NilFL) = PP p
        fromPrims ps = join_patchesFL $ mapFL_FL PP ps
        joinPatches = join_patchesFL

    #ifndef GADT_WITNESSES
    new_ur :: Patch -> RL Patch -> [RL Patch]
    new_ur p (Merger _ _ p1 p2 :<: ps) =
       case filter ((`unsafeCompare` p1) . headRL) $ head_permutationsRL 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 (mapRL showPatch_ $ unwind p)

    new_ur op ps =
        case filter (isMerger.headRL) $ head_permutationsRL ps of
        [] -> [ps]
        (ps':_) -> new_ur op ps'

    headRL :: RL a -> a
    headRL (x:<:_) = x
    headRL _ = bug "bad headRL"
    #endif

    instance Invert p => Invert (Named p) where
        invert (NamedP n d p)  = NamedP (invert_name n) (map invert_name d) (invert p)
        identity = NamedP idpatchinfo [] identity

    instance Invert Patch where
        invert (Merger undo unwindings p1 p2)
            = Regrem undo unwindings p1 p2
        invert (Regrem undo unwindings p1 p2)
            = Merger undo unwindings p1 p2
        invert (PP p) = PP (invert p)
        invert (ComP ps)  = ComP $ invert ps
        identity = ComP NilFL

    instance MyEq Patch where
        unsafeCompare = eq_patches
    instance MyEq p => MyEq (Named p) where
        unsafeCompare (NamedP n1 d1 p1) (NamedP n2 d2 p2) =
            n1 == n2 && d1 == d2 && unsafeCompare p1 p2

    eq_patches :: Patch C(x y) -> Patch C(w z) -> Bool
    eq_patches (PP p1) (PP p2) = unsafeCompare p1 p2
    eq_patches (ComP ps1) (ComP ps2)
     = eq_FL eq_patches ps1 ps2
    eq_patches (ComP NilFL) (PP Identity) = True
    eq_patches (PP Identity) (ComP NilFL) = True
    eq_patches (Merger _ _ p1a p1b) (Merger _ _ p2a p2b)
     = eq_patches p1a p2a &&
       eq_patches p1b p2b
    eq_patches (Regrem _ _ p1a p1b) (Regrem _ _ p2a p2b)
     = eq_patches p1a p2a &&
       eq_patches p1b p2b
    eq_patches _ _ = False

    eq_FL :: (FORALL(b c d e) a C(b c) -> a C(d e) -> Bool)
          -> FL a C(x y) -> FL a C(w z) -> Bool
    eq_FL _ NilFL NilFL = True
    eq_FL f (x:>:xs) (y:>:ys) = f x y && eq_FL f xs ys
    eq_FL _ _ _ = False

\end{code}