% Copyright (C) 2002-2003,2007 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 #-}
    {-# LANGUAGE CPP #-}
    -- , MagicHash, TypeOperators, GADTs, PatternGuards #-}

    #include "gadts.h"

    module Darcs.Patch.Prim
           ( Prim(..), IsConflictedPrim(IsC), ConflictState(..), showPrim,
             DirPatchType(..), FilePatchType(..),
             CommuteFunction, Perhaps(..),
             null_patch, nullP, isNullPatch,
             is_identity,
             formatFileName, FileNameFormat(..),
             adddir, addfile, binary, changepref,
             hunk, move, rmdir, rmfile, tokreplace,
             primIsAddfile, primIsHunk, primIsBinary, primIsSetpref,
             isSimilar, primIsAdddir, is_filepatch,
             canonize, tryToShrink, modernizePrim,
             subcommutes, sortCoalesceFL, join, canonizeFL,
             try_tok_internal,
             try_shrinking_inverse,
             n_fn,
             FromPrim(..), FromPrims(..), ToFromPrim(..),
             Conflict(..), Effect(..), commute_no_conflictsFL, commute_no_conflictsRL
           )
           where

    import Prelude hiding ( pi )
    import Control.Monad ( MonadPlus, msum, mzero, mplus )
    import Data.Maybe ( isNothing )
    #ifndef GADT_WITNESSES
    import Data.Map ( elems, fromListWith, mapWithKey )
    #endif

    import ByteStringUtils ( substrPS, fromPS2Hex)
    import qualified Data.ByteString as B (ByteString, length, null, head, take, concat, drop)
    import qualified Data.ByteString.Char8 as BC (break, pack)

    import Darcs.Patch.FileName ( FileName, fn2ps, fn2fp, fp2fn, norm_path,
                                  movedirfilename, encode_white )
    import Darcs.Witnesses.Ordered
    import Darcs.Witnesses.Sealed ( Sealed, unseal )
    import Darcs.Patch.Patchy ( Invert(..), Commute(..), toFwdCommute, toRevCommute )
    import Darcs.Patch.Permutations () -- for Invert instance of FL
    import Darcs.Witnesses.Show
    import Darcs.Utils ( nubsort )
    import Lcs ( getChanges )
    import Darcs.Patch.RegChars ( regChars )
    import Printer ( Doc, vcat, packedString, Color(Cyan,Magenta), lineColor,
                     text, userchunk, invisibleText, invisiblePS, blueText,
                     ($$), (<+>), (<>), prefix, userchunkPS,
                   )
    import GHC.Base (unsafeCoerce#)
    #include "impossible.h"

    data Prim C(x y) where
        Move :: !FileName -> !FileName -> Prim C(x y)
        DP :: !FileName -> !(DirPatchType C(x y)) -> Prim C(x y)
        FP :: !FileName -> !(FilePatchType C(x y)) -> Prim C(x y)
        Split :: FL Prim C(x y) -> Prim C(x y)
        Identity :: Prim C(x x)
        ChangePref :: !String -> !String -> !String -> Prim C(x y)

    data FilePatchType C(x y) = RmFile | AddFile
                              | Hunk !Int [B.ByteString] [B.ByteString]
                              | TokReplace !String !String !String
                              | Binary B.ByteString B.ByteString
                                deriving (Eq,Ord)

    data DirPatchType C(x y) = RmDir | AddDir
                               deriving (Eq,Ord)

    instance MyEq FilePatchType where
        unsafeCompare a b = a == unsafeCoerce# b

    instance MyEq DirPatchType where
        unsafeCompare a b = a == unsafeCoerce# b

    null_patch :: Prim C(x x)
    null_patch = Identity

    isNullPatch :: Prim C(x y) -> Bool
    isNullPatch (FP _ (Binary x y)) = B.null x && B.null y
    isNullPatch (FP _ (Hunk _ [] [])) = True
    isNullPatch Identity = True
    isNullPatch _ = False

    nullP :: Prim C(x y) -> EqCheck C(x y)
    nullP = sloppyIdentity

    is_identity :: Prim C(x y) -> EqCheck C(x y)
    is_identity (FP _ (Binary old new)) | old == new = unsafeCoerce# IsEq
    is_identity (FP _ (Hunk _ old new)) | old == new = unsafeCoerce# IsEq
    is_identity (FP _ (TokReplace _ old new)) | old == new = unsafeCoerce# IsEq
    is_identity (Move old new) | old == new = unsafeCoerce# IsEq
    is_identity Identity = IsEq
    is_identity _ = NotEq

    -- FIXME: The following code needs to be moved.

    -- | Tells you if two patches are in the same category, human-wise.
    -- Currently just returns true if they are filepatches on the same
    -- file.
    isSimilar :: Prim C(x y) -> Prim C(a b) -> Bool
    isSimilar (FP f _) (FP f' _) = f == f'
    isSimilar (DP f _) (DP f' _) = f == f'
    isSimilar _ _ = False

    primIsAddfile :: Prim C(x y) -> Bool
    primIsAddfile (FP _ AddFile) = True
    primIsAddfile _ = False

    primIsAdddir :: Prim C(x y) -> Bool
    primIsAdddir (DP _ AddDir) = True
    primIsAdddir _ = False

    primIsHunk :: Prim C(x y) -> Bool
    primIsHunk (FP _ (Hunk _ _ _)) = True
    primIsHunk _ = False

    primIsBinary :: Prim C(x y) -> Bool
    primIsBinary (FP _ (Binary _ _)) = True
    primIsBinary _ = False

    primIsSetpref :: Prim C(x y) -> Bool
    primIsSetpref (ChangePref _ _ _) = True
    primIsSetpref _ = False

    addfile :: FilePath -> Prim C(x y)
    rmfile :: FilePath -> Prim C(x y)
    adddir :: FilePath -> Prim C(x y)
    rmdir :: FilePath -> Prim C(x y)
    move :: FilePath -> FilePath -> Prim C(x y)
    changepref :: String -> String -> String -> Prim C(x y)
    hunk :: FilePath -> Int -> [B.ByteString] -> [B.ByteString] -> Prim C(x y)
    tokreplace :: FilePath -> String -> String -> String -> Prim C(x y)
    binary :: FilePath -> B.ByteString -> B.ByteString -> Prim C(x y)

    evalargs :: (a -> b -> c) -> a -> b -> c
    evalargs f x y = (f $! x) $! y

    addfile f = FP (fp2fn $ n_fn f) AddFile
    rmfile f = FP (fp2fn $ n_fn f) RmFile
    adddir d = DP (fp2fn $ n_fn d) AddDir
    rmdir d = DP (fp2fn $ n_fn d) RmDir
    move f f' = Move (fp2fn $ n_fn f) (fp2fn $ n_fn f')
    changepref p f t = ChangePref p f t
    hunk f line old new = evalargs FP (fp2fn $ n_fn f) (Hunk line old new)
    tokreplace f tokchars old new =
        evalargs FP (fp2fn $ n_fn f) (TokReplace tokchars old new)
    binary f old new = FP (fp2fn $! n_fn f) $ Binary old new

    n_fn :: FilePath -> FilePath
    n_fn f = "./"++(fn2fp $ norm_path $ fp2fn f)

    instance Invert Prim where
        invert Identity = Identity
        invert (FP f RmFile)  = FP f AddFile
        invert (FP f AddFile)  = FP f RmFile
        invert (FP f (Hunk line old new))  = FP f $ Hunk line new old
        invert (FP f (TokReplace t o n)) = FP f $ TokReplace t n o
        invert (FP f (Binary o n)) = FP f $ Binary n o
        invert (DP d RmDir) = DP d AddDir
        invert (DP d AddDir) = DP d RmDir
        invert (Move f f') = Move f' f
        invert (ChangePref p f t) = ChangePref p t f
        invert (Split ps) = Split $ invert ps
        identity = Identity
        sloppyIdentity Identity = IsEq
        sloppyIdentity _ = NotEq

    instance Show (Prim C(x y)) where
        showsPrec d (Move fn1 fn2) = showParen (d > app_prec) $ showString "Move " .
                                     showsPrec (app_prec + 1) fn1 . showString " " .
                                     showsPrec (app_prec + 1) fn2
        showsPrec d (DP fn dp) = showParen (d > app_prec) $ showString "DP " .
                                 showsPrec (app_prec + 1) fn . showString " " .
                                 showsPrec (app_prec + 1) dp
        showsPrec d (FP fn fp) = showParen (d > app_prec) $ showString "FP " .
                                 showsPrec (app_prec + 1) fn . showString " " .
                                 showsPrec (app_prec + 1) fp
        showsPrec d (Split l) = showParen (d > app_prec) $ showString "Split " .
                                showsPrec (app_prec + 1) l
        showsPrec _ Identity = showString "Identity"
        showsPrec d (ChangePref p f t) = showParen (d > app_prec) $ showString "ChangePref " .
                                         showsPrec (app_prec + 1) p . showString " " .
                                         showsPrec (app_prec + 1) f . showString " " .
                                         showsPrec (app_prec + 1) t

    instance Show2 Prim where
       showsPrec2 = showsPrec

    instance Show (FilePatchType C(x y)) where
        showsPrec _ RmFile = showString "RmFile"
        showsPrec _ AddFile = showString "AddFile"
        showsPrec d (Hunk line old new) | all ((==1) . B.length) old && all ((==1) . B.length) new
            = showParen (d > app_prec) $ showString "Hunk " .
                                          showsPrec (app_prec + 1) line . showString " " .
                                          showsPrecC old . showString " " .
                                          showsPrecC new
           where showsPrecC [] = showString "[]"
                 showsPrecC ss = showParen True $ showString "packStringLetters " . showsPrec (app_prec + 1) (map B.head ss)
        showsPrec d (Hunk line old new) = showParen (d > app_prec) $ showString "Hunk " .
                                          showsPrec (app_prec + 1) line . showString " " .
                                          showsPrec (app_prec + 1) old . showString " " .
                                          showsPrec (app_prec + 1) new
        showsPrec d (TokReplace t old new) = showParen (d > app_prec) $ showString "TokReplace " .
                                             showsPrec (app_prec + 1) t . showString " " .
                                             showsPrec (app_prec + 1) old . showString " " .
                                             showsPrec (app_prec + 1) new
        -- this case may not work usefully
        showsPrec d (Binary old new) = showParen (d > app_prec) $ showString "Binary " .
                                       showsPrec (app_prec + 1) old . showString " " .
                                       showsPrec (app_prec + 1) new

    instance Show (DirPatchType C(x y)) where
        showsPrec _ RmDir = showString "RmDir"
        showsPrec _ AddDir = showString "AddDir"

    {-
    instance Show (Prim C(x y))  where
        show p = renderString (showPrim p) ++ "\n"
    -}

    data FileNameFormat = OldFormat | NewFormat
    formatFileName :: FileNameFormat -> FileName -> Doc
    formatFileName OldFormat = packedString . fn2ps
    formatFileName NewFormat = text . encode_white . fn2fp

    showPrim :: FileNameFormat -> Prim C(a b) -> Doc
    showPrim x (FP f AddFile) = showAddFile x f
    showPrim x (FP f RmFile)  = showRmFile x f
    showPrim x (FP f (Hunk line old new))  = showHunk x f line old new
    showPrim x (FP f (TokReplace t old new))  = showTok x f t old new
    showPrim x (FP f (Binary old new))  = showBinary x f old new
    showPrim x (DP d AddDir) = showAddDir x d
    showPrim x (DP d RmDir)  = showRmDir x d
    showPrim x (Move f f') = showMove x f f'
    showPrim _ (ChangePref p f t) = showChangePref p f t
    showPrim x (Split ps)  = showSplit x ps
    showPrim _ Identity = blueText "{}"

\end{code} \paragraph{Add file} Add an empty file to the tree. \verb!addfile filename! \begin{code}

    showAddFile :: FileNameFormat -> FileName -> Doc
    showAddFile x f = blueText "addfile" <+> formatFileName x f

\end{code} \paragraph{Remove file} Delete a file from the tree. \verb!rmfile filename! \begin{code}

    showRmFile :: FileNameFormat -> FileName -> Doc
    showRmFile x f = blueText "rmfile" <+> formatFileName x f

\end{code} \paragraph{Move} Rename a file or directory. \verb!move oldname newname! \begin{code}

    showMove :: FileNameFormat -> FileName -> FileName -> Doc
    showMove x d d' = blueText "move" <+> formatFileName x d <+> formatFileName x d'

\end{code} \paragraph{Change Pref} Change one of the preference settings. Darcs stores a number of simple string settings. Among these are the name of the test script and the name of the script that must be called prior to packing in a make dist. \begin{verbatim} changepref prefname oldval newval \end{verbatim} \begin{code}

    showChangePref :: String -> String -> String -> Doc
    showChangePref p f t = blueText "changepref" <+> text p
                        $$ userchunk f
                        $$ userchunk t

\end{code} \paragraph{Add dir} Add an empty directory to the tree. \verb!adddir filename! \begin{code}

    showAddDir :: FileNameFormat -> FileName -> Doc
    showAddDir x d = blueText "adddir" <+> formatFileName x d

\end{code} \paragraph{Remove dir} Delete a directory from the tree. \verb!rmdir filename! \begin{code}

    showRmDir :: FileNameFormat -> FileName -> Doc
    showRmDir x d = blueText "rmdir" <+> formatFileName x d

\end{code} \paragraph{Hunk} Replace a hunk (set of contiguous lines) of text with a new hunk. \begin{verbatim} hunk FILE LINE# -LINE ... +LINE ... \end{verbatim} \begin{code}

    showHunk :: FileNameFormat -> FileName -> Int -> [B.ByteString] -> [B.ByteString] -> Doc
    showHunk x f line old new =
               blueText "hunk" <+> formatFileName x f <+> text (show line)
            $$ lineColor Magenta (prefix "-" (vcat $ map userchunkPS old))
            $$ lineColor Cyan    (prefix "+" (vcat $ map userchunkPS new))

\end{code} \paragraph{Token replace} Replace a token with a new token. Note that this format means that whitespace must not be allowed within a token. If you know of a practical application of whitespace within a token, let me know and I may change this. \begin{verbatim} replace FILENAME [REGEX] OLD NEW \end{verbatim} \begin{code}

    showTok :: FileNameFormat -> FileName -> String -> String -> String -> Doc
    showTok x f t o n = blueText "replace" <+> formatFileName x f
                                         <+> text "[" <> userchunk t <> text "]"
                                         <+> userchunk o
                                         <+> userchunk n

\end{code} \paragraph{Binary file modification} Modify a binary file \begin{verbatim} binary FILENAME oldhex *HEXHEXHEX ... newhex *HEXHEXHEX ... \end{verbatim} \begin{code}

    showBinary :: FileNameFormat -> FileName -> B.ByteString -> B.ByteString -> Doc
    showBinary x f o n =
        blueText "binary" <+> formatFileName x f
     $$ invisibleText "oldhex"
     $$ (vcat $ map makeprintable $ break_every 78 $ fromPS2Hex o)
     $$ invisibleText "newhex"
     $$ (vcat $ map makeprintable $ break_every 78 $ fromPS2Hex n)
         where makeprintable ps = invisibleText "*" <> invisiblePS ps

    break_every :: Int -> B.ByteString -> [B.ByteString]
    break_every n ps | B.length ps < n = [ps]
                     | otherwise = B.take n ps : break_every n (B.drop n ps)

\end{code} \paragraph{Split patch [OBSOLETE!]} A split patch is similar to a composite patch but rather than being composed of several patches grouped together, it is created from one patch that has been split apart, typically through a merge or commutation. \begin{verbatim} ( (indented two) ) \end{verbatim} \begin{code}

    showSplit :: FileNameFormat -> FL Prim C(x y) -> Doc
    showSplit x ps = blueText "("
                $$ vcat (mapFL (showPrim x) ps)
                $$ blueText ")"

    commute_split :: CommuteFunction
    commute_split (Split patches :< patch) =
        toPerhaps $ cs (patches :< patch) >>= sc
        where cs :: ((FL Prim) :< Prim) C(x y) -> Maybe ((Prim :< (FL Prim)) C(x y))
              cs (NilFL :< p1) = return (p1 :< NilFL)
              cs (p:>:ps :< p1) = do p' :> p1' <- commute (p1 :> p)
                                     p1'' :< ps' <- cs (ps :< p1')
                                     return (p1'' :< p':>:ps')
              sc :: (Prim :< (FL Prim)) C(x y) -> Maybe ((Prim :< Prim) C(x y))
              sc (p1 :< ps) = scFL $ p1 :< (sortCoalesceFL ps)
                where scFL :: (Prim :< (FL Prim)) C(x y)
                           -> Maybe ((Prim :< Prim) C(x y))
                      scFL (p1' :< (p :>: NilFL)) = return (p1' :< p)
                      scFL (p1' :< ps') = return (p1' :< Split ps')
    commute_split _ = Unknown

    tryToShrink :: FL Prim C(x y) -> FL Prim C(x y)
    tryToShrink = mapPrimFL try_harder_to_shrink

    mapPrimFL :: (FORALL(x y) FL Prim C(x y) -> FL Prim C(x y))
                 -> FL Prim C(w z) -> FL Prim C(w z)
    mapPrimFL f x =
    #ifdef GADT_WITNESSES
                    f x
    #else
    -- an optimisation; break the list up into independent sublists
    -- and apply f to each of them
         case mapM toSimple $ mapFL id x of
         Just sx -> foldr (+>+) NilFL $ elems $
                    mapWithKey (\ k p -> f (fromSimples k (p NilFL))) $
                    fromListWith (flip (.)) $
                    map (\ (a,b) -> (a,(b:>:))) sx
         Nothing -> f x

    data Simple C(x y) = SFP !(FilePatchType C(x y)) | SDP !(DirPatchType C(x y))
                       | SCP String String String
                       deriving ( Show )

    toSimple :: Prim C(x y) -> Maybe (FileName, Simple C(x y))
    toSimple (FP a b) = Just (a, SFP b)
    toSimple (DP a AddDir) = Just (a, SDP AddDir)
    toSimple (DP _ RmDir) = Nothing -- ordering is trickier with rmdir present
    toSimple (Move _ _) = Nothing
    toSimple (Split _) = Nothing
    toSimple Identity = Nothing
    toSimple (ChangePref a b c) = Just (fp2fn "_darcs/prefs/prefs", SCP a b c)

    fromSimple :: FileName -> Simple C(x y) -> Prim C(x y)
    fromSimple a (SFP b) = FP a b
    fromSimple a (SDP b) = DP a b
    fromSimple _ (SCP a b c) = ChangePref a b c

    fromSimples :: FileName -> FL Simple C(x y) -> FL Prim C(x y)
    fromSimples a bs = mapFL_FL (fromSimple a) bs
    #endif

    try_harder_to_shrink :: FL Prim C(x y) -> FL Prim C(x y)
    try_harder_to_shrink x = try_to_shrink2 $ maybe x id (try_shrinking_inverse x)

    try_to_shrink2 :: FL Prim C(x y) -> FL Prim C(x y)
    try_to_shrink2 psold =
        let ps = sortCoalesceFL psold
            ps_shrunk = shrink_a_bit ps
                        in
        if lengthFL ps_shrunk < lengthFL ps
        then try_to_shrink2 ps_shrunk
        else ps_shrunk

    try_shrinking_inverse :: FL Prim C(x y) -> Maybe (FL Prim C(x y))
    try_shrinking_inverse (x:>:y:>:z)
        | IsEq <- invert x =\/= y = Just z
        | otherwise = case try_shrinking_inverse (y:>:z) of
                      Nothing -> Nothing
                      Just yz' -> Just $ case try_shrinking_inverse (x:>:yz') of
                                         Nothing -> x:>:yz'
                                         Just xyz' -> xyz'
    try_shrinking_inverse _ = Nothing

    shrink_a_bit :: FL Prim C(x y) -> FL Prim C(x y)
    shrink_a_bit NilFL = NilFL
    shrink_a_bit (p:>:ps) =
        case try_one NilRL p ps of
        Nothing -> p :>: shrink_a_bit ps
        Just ps' -> ps'

    try_one :: RL Prim C(w x) -> Prim C(x y) -> FL Prim C(y z)
            -> Maybe (FL Prim C(w z))
    try_one _ _ NilFL = Nothing
    try_one sofar p (p1:>:ps) =
        case coalesce (p1 :< p) of
        Just p' -> Just (reverseRL sofar +>+ p':>:NilFL +>+ ps)
        Nothing -> case commute (p :> p1) of
                   Nothing -> Nothing
                   Just (p1' :> p') -> try_one (p1':<:sofar) p' ps

    -- | 'canonizeFL' @ps@ puts a sequence of primitive patches into
    -- canonical form. Even if the patches are just hunk patches,
    -- this is not necessarily the same set of results as you would get
    -- if you applied the sequence to a specific tree and recalculated
    -- a diff.
    --
    -- Note that this process does not preserve the commutation behaviour
    -- of the patches and is therefore not appropriate for use when
    -- working with already recorded patches (unless doing amend-record
    -- or the like).
    canonizeFL :: FL Prim C(x y) -> FL Prim C(x y)
    -- Running canonize twice is apparently necessary to fix issue525;
    -- would be nice to understand why.
    canonizeFL = concatFL . mapFL_FL canonize . sortCoalesceFL .
                 concatFL . mapFL_FL canonize

    -- | 'sortCoalesceFL' @ps@ coalesces as many patches in @ps@ as
    --   possible, sorting the results according to the scheme defined
    --   in 'comparePrim'
    sortCoalesceFL :: FL Prim C(x y) -> FL Prim C(x y)
    sortCoalesceFL = mapPrimFL sort_coalesceFL2

    -- | The heart of "sortCoalesceFL"
    sort_coalesceFL2 :: FL Prim C(x y) -> FL Prim C(x y)
    sort_coalesceFL2 NilFL = NilFL
    sort_coalesceFL2 (x:>:xs) | IsEq <- nullP x = sort_coalesceFL2 xs
    sort_coalesceFL2 (x:>:xs) | IsEq <- is_identity x = sort_coalesceFL2 xs
    sort_coalesceFL2 (x:>:xs) = either id id $ push_coalesce_patch x $ sort_coalesceFL2 xs

    -- | 'push_coalesce_patch' @new ps@ is almost like @new :>: ps@ except
    --   as an alternative to consing, we first try to coalesce @new@ with
    --   the head of @ps@.  If this fails, we try again, using commutation
    --   to push @new@ down the list until we find a place where either
    --   (a) @new@ is @LT@ the next member of the list [see 'comparePrim']
    --   (b) commutation fails or
    --   (c) coalescing succeeds.
    --   The basic principle is to coalesce if we can and cons otherwise.
    --
    --   As an additional optimization, push_coalesce_patch outputs a Left
    --   value if it wasn't able to shrink the patch sequence at all, and
    --   a Right value if it was indeed able to shrink the patch sequence.
    --   This avoids the O(N) calls to lengthFL that were in the older
    --   code.
    --
    --   Also note that push_coalesce_patch is only ever used (and should
    --   only ever be used) as an internal function in in
    --   sort_coalesceFL2.
    push_coalesce_patch :: Prim C(x y) -> FL Prim C(y z)
                        -> Either (FL Prim C(x z)) (FL Prim C(x z))
    push_coalesce_patch new NilFL = Left (new:>:NilFL)
    push_coalesce_patch new ps@(p:>:ps')
        = case coalesce (p :< new) of
          Just new' | IsEq <- nullP new' -> Right ps'
                    | otherwise -> Right $ either id id $ push_coalesce_patch new' ps'
          Nothing -> if comparePrim new p == LT then Left (new:>:ps)
                                else case commute (new :> p) of
                                     Just (p' :> new') ->
                                         case push_coalesce_patch new' ps' of
                                         Right r -> Right $ either id id $
                                                    push_coalesce_patch p' r
                                         Left r -> Left (p' :>: r)
                                     Nothing -> Left (new:>:ps)

    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 :: 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
    --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 :: CommuteFunction
    speedy_commute (p1 :< p2) -- Deal with common case quickly!
        | p1_modifies /= Nothing && p2_modifies /= Nothing &&
          p1_modifies /= p2_modifies = Succeeded (unsafeCoerce# p2 :< unsafeCoerce# p1)
        | otherwise = Unknown
        where p1_modifies = is_filepatch p1
              p2_modifies = is_filepatch p2

    everything_else_commute :: CommuteFunction
    everything_else_commute x = eec x
        where
        eec :: CommuteFunction
        eec (ChangePref p f t :<p1) = Succeeded (unsafeCoerce# p1 :< ChangePref p f t)
        eec (p2 :<ChangePref p f t) = Succeeded (ChangePref p f t :< unsafeCoerce# p2)
        eec (Identity :< p1) = Succeeded (p1 :< Identity)
        eec (p2 :< Identity) = Succeeded (Identity :< p2)
        eec xx =
            msum [
                  clever_commute commute_filedir                xx
                 ,clever_commute commute_split                  xx
                 ]

    {-
    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)
    -}

    instance Commute Prim where
        merge (y :\/: z) =
            case elegantMerge (y:\/:z) of
            Just (z' :/\: y') -> z' :/\: y'
            Nothing -> error "Commute Prim merge"
        commute x = toMaybe $ msum [toFwdCommute speedy_commute x,
                                    toFwdCommute everything_else_commute x
                                   ]
        -- Recurse on everything, these are potentially spoofed patches
        listTouchedFiles (Move f1 f2) = map fn2fp [f1, f2]
        listTouchedFiles (Split ps) = nubsort $ concat $ mapFL listTouchedFiles ps
        listTouchedFiles (FP f _) = [fn2fp f]
        listTouchedFiles (DP d _) = [fn2fp d]
        listTouchedFiles (ChangePref _ _ _) = []
        listTouchedFiles Identity = []

        hunkMatches f (FP _ (Hunk _ remove add)) = anyMatches remove || anyMatches add
            where anyMatches = foldr ((||) . f) False
        hunkMatches _ (FP _ _) = False
        hunkMatches f (Split ps) = or $ mapFL (hunkMatches f) ps
        hunkMatches _ (DP _ _) = False
        hunkMatches _ (ChangePref _ _ _) = False
        hunkMatches _ Identity = False
        hunkMatches _ (Move _ _) = False

    is_filepatch :: Prim C(x y) -> Maybe FileName
    is_filepatch (FP f _) = Just f
    is_filepatch _ = Nothing

    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 ++ "/"

    commute_filedir :: CommuteFunction
    commute_filedir (FP f1 p1 :< FP f2 p2) =
      if f1 /= f2 then Succeeded ( FP f2 (unsafeCoerce# p2) :< FP f1 (unsafeCoerce# 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 (unsafeCoerce# p2) :< DP d1 (unsafeCoerce# p1) )
      else Failed
    commute_filedir (DP d dp :< FP f fp) =
        if not $ is_in_directory d f
        then Succeeded (FP f (unsafeCoerce# fp) :< DP d (unsafeCoerce# dp))
        else Failed

    commute_filedir (Move d d' :< FP f2 p2)
        | f2 == d' = Failed
        | (p2 == AddFile || p2 == RmFile) && d == f2 = Failed
        | otherwise = Succeeded (FP (movedirfilename d d' f2) (unsafeCoerce# p2) :< Move d d')
    commute_filedir (Move d d' :< DP d2 p2)
        | is_superdir d2 d' || is_superdir d2 d = Failed
        | (p2 == AddDir || p2 == RmDir) && d == d2 = Failed
        | d2 == d' = Failed
        | otherwise = Succeeded (DP (movedirfilename d d' d2) (unsafeCoerce# 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

    type CommuteFunction = FORALL(x y) (Prim :< Prim) C(x y) -> Perhaps ((Prim :< Prim) C(x y))
    subcommutes :: [(String, CommuteFunction)]
    subcommutes =
        [("speedy_commute", speedy_commute),
         ("commute_filedir", clever_commute commute_filedir),
         ("commute_filepatches", clever_commute commute_filepatches),
         ("commutex", toPerhaps . toRevCommute commute)
        ]

    elegantMerge :: (Prim :\/: Prim) C(x y)
                  -> Maybe ((Prim :/\: Prim) C(x y))
    elegantMerge (p1 :\/: p2) =
        do p1':>ip2' <- commute (invert p2 :> p1)
           -- The following should be a redundant check
           p1o:>_ <- commute (p2 :> p1')
           IsEq <- return $ p1o =\/= p1
           return (invert ip2' :/\: p1')

\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 :: Prim C(x y) -> FL Prim C(x y)
    canonize (Split ps) = sortCoalesceFL ps
    canonize p | IsEq <- is_identity p = NilFL
    canonize (FP f (Hunk line old new)) = canonizeHunk f line old new
    canonize p = p :>: NilFL

\end{code} 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' @p2 :< p1@ tries to combine @p1@ and @p2@ into a single
    --   patch without intermediary changes.  For example, two hunk patches
    --   modifying adjacent lines can be coalesced into a bigger hunk patch.
    --   Or a patch which moves file A to file B can be coalesced with a
    --   patch that moves file B into file C, yielding a patch that moves
    --   file A to file C.
    coalesce :: (Prim :< Prim) C(x y) -> Maybe (Prim C(x y))
    coalesce (FP f1 _ :< FP f2 _) | f1 /= f2 = Nothing
    coalesce (p2 :< p1) | IsEq <- p2 =\/= invert p1 = Just null_patch
    coalesce (FP f1 p1 :< FP _ p2) = coalesceFilePrim f1 (p1 :< p2) -- f1 = f2
    coalesce (Identity :< p) = Just p
    coalesce (p :< Identity) = Just p
    coalesce (Split NilFL :< p) = Just p
    coalesce (p :< Split NilFL) = Just p
    coalesce (Move a b :< Move b' a') | a == a' = Just $ Move b' b
    coalesce (Move a b :< FP f AddFile) | f == a = Just $ FP b AddFile
    coalesce (Move a b :< DP f AddDir) | f == a = Just $ DP b AddDir
    coalesce (FP f RmFile :< Move a b) | b == f = Just $ FP a RmFile
    coalesce (DP f RmDir :< Move a b) | b == f = Just $ DP a RmDir
    coalesce (ChangePref p f1 t1 :< ChangePref p2 f2 t2) | p == p2 && t2 == f1 = Just $ ChangePref p f2 t1
    coalesce _ = Nothing

    join :: (Prim :> Prim) C(x y) -> Maybe (Prim C(x y))
    join (x :> y) = coalesce (y :< x)

\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. If they happen to modify the same file, we'll have to check whether or not they commutex. \begin{code}

    commute_filepatches :: CommuteFunction
    commute_filepatches (FP f1 p1 :< FP f2 p2) | f1 == f2 = commuteFP f1 (p1 :< p2)
    commute_filepatches _ = Unknown

    commuteFP :: FileName -> (FilePatchType :< FilePatchType) C(x y)
              -> Perhaps ((Prim :< Prim) C(x y))
    commuteFP f (Hunk line1 [] [] :< p2) =
        seq f $ Succeeded (FP f (unsafeCoerceP p2) :< FP f (Hunk line1 [] []))
    commuteFP f (p2 :< Hunk line1 [] []) =
        seq f $ Succeeded (FP f (Hunk line1 [] []) :< FP f (unsafeCoerceP p2))
    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

    coalesceFilePrim :: FileName -> (FilePatchType :< FilePatchType) C(x y)
                      -> Maybe (Prim C(x y))
    coalesceFilePrim f (Hunk line1 old1 new1 :< Hunk line2 old2 new2)
        = coalesceHunk f line1 old1 new1 line2 old2 new2
    -- Token replace patches operating right after (or before) AddFile (RmFile)
    -- is an identity patch, as far as coalescing is concerned.
    coalesceFilePrim f (TokReplace _ _ _ :< AddFile) = Just $ FP f AddFile
    coalesceFilePrim f (RmFile :< TokReplace _ _ _) = Just $ FP f RmFile
    coalesceFilePrim f (TokReplace t1 o1 n1 :< TokReplace t2 o2 n2)
        | t1 == t2 && n2 == o1 = Just $ FP f $ TokReplace t1 o2 n1
    coalesceFilePrim f (Binary m n :< Binary o m')
        | m == m' = Just $ FP f $ Binary o n
    coalesceFilePrim _ _ = Nothing

\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) C(x y)
                -> Maybe ((Prim :< Prim) C(x y))
    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 -> [B.ByteString] -> [B.ByteString]
                 -> Int -> [B.ByteString] -> [B.ByteString]
                 -> Maybe (Prim C(x y))
    coalesceHunk 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-> coalesceHunk f line1 old1 new1 line1 (extra ++ old2) (extra ++ new2)
        | line1 > line2 && lengthnew2 >= line1 - line2 =
            case take (line1 - line2) new2 of
            extra-> coalesceHunk 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
                 -> [B.ByteString] -> [B.ByteString] -> FL Prim C(x y)
    canonizeHunk f line old new
        | null old || null new
            = FP f (Hunk line old new) :>: NilFL
    canonizeHunk f line old new = make_holey f line $ getChanges old new

    make_holey :: FileName -> Int -> [(Int,[B.ByteString], [B.ByteString])]
               -> FL Prim C(x y)
    make_holey f line changes =
        unsafeMap_l2f (\ (l,o,n) -> FP f (Hunk (l+line) o n)) changes

    try_tok_replace :: String -> String -> String
                    -> [B.ByteString] -> Maybe [B.ByteString]
    try_tok_replace t o n mss =
      mapM (fmap B.concat . try_tok_internal t (BC.pack o) (BC.pack n)) mss

    try_tok_internal :: String -> B.ByteString -> B.ByteString
                     -> B.ByteString -> Maybe [B.ByteString]
    try_tok_internal _ o n s | isNothing (substrPS o s) &&
                               isNothing (substrPS n s) = Just [s]
    try_tok_internal t o n s =
        case BC.break (regChars t) s of
        (before,s') ->
            case BC.break (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

    modernizePrim :: Prim C(x y) -> FL Prim C(x y)
    modernizePrim (Split ps) = concatFL $ mapFL_FL modernizePrim ps
    modernizePrim p = p :>: NilFL

    instance MyEq Prim where
        unsafeCompare (Move a b) (Move c d) = a == c && b == d
        unsafeCompare (DP d1 p1) (DP d2 p2)
            = d1 == d2 && p1 `unsafeCompare` p2
        unsafeCompare (FP f1 fp1) (FP f2 fp2)
            = f1 == f2 && fp1 `unsafeCompare` fp2
        unsafeCompare (Split ps1) (Split ps2)
            = eq_FL unsafeCompare ps1 ps2
        unsafeCompare (ChangePref a1 b1 c1) (ChangePref a2 b2 c2)
            = c1 == c2 && b1 == b2 && a1 == a2
        unsafeCompare Identity Identity = True
        unsafeCompare _ _ = False

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

    -- | 'comparePrim' @p1 p2@ is used to provide an arbitrary ordering between
    --   @p1@ and @p2@.  Basically, identical patches are equal and
    --   @Move < DP < FP < Split < Identity < ChangePref@.
    --   Everything else is compared in dictionary order of its arguments.
    comparePrim :: Prim C(x y) -> Prim C(w z) -> Ordering
    comparePrim (Move a b) (Move c d) = compare (a, b) (c, d)
    comparePrim (Move _ _) _ = LT
    comparePrim _ (Move _ _) = GT
    comparePrim (DP d1 p1) (DP d2 p2) = compare (d1, p1) $ unsafeCoerceP (d2, p2)
    comparePrim (DP _ _) _ = LT
    comparePrim _ (DP _ _) = GT
    comparePrim (FP f1 fp1) (FP f2 fp2) = compare (f1, fp1) $ unsafeCoerceP (f2, fp2)
    comparePrim (FP _ _) _ = LT
    comparePrim _ (FP _ _) = GT
    comparePrim (Split ps1) (Split ps2) = compare_FL comparePrim ps1 $ unsafeCoerceP ps2
    comparePrim (Split _) _ = LT
    comparePrim _ (Split _) = GT
    comparePrim Identity Identity = EQ
    comparePrim Identity _ = LT
    comparePrim _ Identity = GT
    comparePrim (ChangePref a1 b1 c1) (ChangePref a2 b2 c2)
     = compare (c1, b1, a1) (c2, b2, a2)

    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

    compare_FL :: (FORALL(b c d e) a C(b c) -> a C(d e) -> Ordering)
               -> FL a C(x y) -> FL a C(w z) -> Ordering
    compare_FL _ NilFL NilFL = EQ
    compare_FL _ NilFL _     = LT
    compare_FL _ _     NilFL = GT
    compare_FL f (x:>:xs) (y:>:ys) = f x y `merge_orders` compare_FL f xs ys

    class FromPrim p where
       fromPrim :: Prim C(x y) -> p C(x y)

    class FromPrim p => ToFromPrim p where
        toPrim :: p C(x y) -> Maybe (Prim C(x y))

    class FromPrims p where
        fromPrims :: FL Prim C(x y) -> p C(x y)
        joinPatches :: FL p C(x y) -> p C(x y)

    instance FromPrim Prim where
        fromPrim = id
    instance ToFromPrim Prim where
        toPrim = Just . id

    instance FromPrim p => FromPrims (FL p) where
        fromPrims = mapFL_FL fromPrim
        joinPatches = concatFL
    instance FromPrim p => FromPrims (RL p) where
        fromPrims = reverseFL . mapFL_FL fromPrim
        joinPatches = concatRL . reverseFL

    class (Invert p, Commute p, Effect p) => Conflict p where
        listConflictedFiles :: p C(x y) -> [FilePath]
        listConflictedFiles p =
            nubsort $ concatMap (unseal listTouchedFiles) $ concat $ resolveConflicts p
        resolveConflicts :: p C(x y) -> [[Sealed (FL Prim C(y))]]
        resolveConflicts _ = []
        -- | If 'commute_no_conflicts' @x :> y@ succeeds, we know that that @x@ commutes
        --   past @y@ without any conflicts.   This function is useful for patch types
        --   for which 'commute' is defined to always succeed; so we need some way to
        --   pick out the specific cases where commutation succeeds without any conflicts.
        --
        --   Consider the commute square with patch names written in capital letters and
        --   repository states written in small letters.
        --
        --   @
        --          X
        --       o-->--a
        --       |     |
        --    Y' v     v Y
        --       |     |
        --       z-->--b
        --          X'
        --   @
        --
        --   The default definition of this function checks that we can mirror the
        --   commutation with patch inverses (written with the negative sign)
        --
        --   @
        --         -X     X
        --       a-->--o-->--a
        --       |     |     |
        --   Y'' v  Y' v     v Y
        --       |     |     |
        --       b-->--z-->--b
        --         (-X)'  X'
        --   @
        --
        --
        --   We check that commuting @X@ and @Y@ succeeds, as does commuting @-X@ and @Y'@.
        --   It also checks that @Y'' == Y@ and that @-(X')@ is the same as @(-X)'@
        commute_no_conflicts :: (p :> p) C(x y) -> Maybe ((p :> p) C(x y))
        commute_no_conflicts (x:>y) =
            do y':>x' <- commute (x:>y)
               y'':>ix'' <- commute (invert x :> y')
               IsEq <- return $ y'' =\/= y
               IsEq <- return $ ix'' =\/= invert x'
               return (y':>x')
        conflictedEffect :: p C(x y) -> [IsConflictedPrim]
        conflictedEffect x = case listConflictedFiles x of
                             [] -> mapFL (IsC Okay) $ effect x
                             _ -> mapFL (IsC Conflicted) $ effect x

    instance Conflict p => Conflict (FL p) where
        listConflictedFiles = nubsort . concat . mapFL listConflictedFiles
        resolveConflicts NilFL = []
        resolveConflicts x = resolveConflicts $ reverseFL x
        commute_no_conflicts (NilFL :> x) = Just (x :> NilFL)
        commute_no_conflicts (x :> NilFL) = Just (NilFL :> x)
        commute_no_conflicts (xs :> ys) = do ys' :> rxs' <- commute_no_conflictsRLFL (reverseFL xs :> ys)
                                             return $ ys' :> reverseRL rxs'
        conflictedEffect = concat . mapFL conflictedEffect

    instance Conflict p => Conflict (RL p) where
        listConflictedFiles = nubsort . concat . mapRL listConflictedFiles
        resolveConflicts x = rcs x NilFL
            where rcs :: RL p C(x y) -> FL p C(y w) -> [[Sealed (FL Prim C(w))]]
                  rcs NilRL _ = []
                  rcs (p:<:ps) passedby | (_:_) <- resolveConflicts p =
                      case commute_no_conflictsFL (p:>passedby) of
                        Just (_:> p') -> resolveConflicts p' ++ rcs ps (p:>:passedby)
                        Nothing -> rcs ps (p:>:passedby)
                  rcs (p:<:ps) passedby = seq passedby $ rcs ps (p:>:passedby)
        commute_no_conflicts (NilRL :> x) = Just (x :> NilRL)
        commute_no_conflicts (x :> NilRL) = Just (NilRL :> x)
        commute_no_conflicts (xs :> ys) = do ys' :> rxs' <- commute_no_conflictsRLFL (xs :> reverseRL ys)
                                             return $ reverseFL ys' :> rxs'
        conflictedEffect = concat . reverse . mapRL conflictedEffect

    data IsConflictedPrim where
        IsC :: !ConflictState -> !(Prim C(x y)) -> IsConflictedPrim
    data ConflictState = Okay | Conflicted | Duplicated deriving ( Eq, Ord, Show, Read)

    -- | Patches whose concrete effect which can be expressed as a list of
    --   primitive patches.
    --
    --   A minimal definition would be either of @effect@ or @effectRL@.
    class Effect p where
        effect :: p C(x y) -> FL Prim C(x y)
        effect = reverseRL . effectRL
        effectRL :: p C(x y) -> RL Prim C(x y)
        effectRL = reverseFL . effect
        isHunk :: p C(x y) -> Maybe (Prim C(x y))
        isHunk _ = Nothing

    instance Effect Prim where
        effect p | IsEq <- sloppyIdentity p = NilFL
                 | otherwise = p :>: NilFL
        effectRL p | IsEq <- sloppyIdentity p = NilRL
                   | otherwise = p :<: NilRL
        isHunk p = if primIsHunk p then Just p else Nothing

    instance Conflict Prim

    instance Effect p => Effect (FL p) where
        effect p = concatFL $ mapFL_FL effect p
        effectRL p = concatRL $ mapRL_RL effectRL $ reverseFL p

    instance Effect p => Effect (RL p) where
        effect p = concatFL $ mapFL_FL effect $ reverseRL p
        effectRL p = concatRL $ mapRL_RL effectRL p

    commute_no_conflictsFL :: Conflict p => (p :> FL p) C(x y) -> Maybe ((FL p :> p) C(x y))
    commute_no_conflictsFL (p :> NilFL) = Just (NilFL :> p)
    commute_no_conflictsFL (q :> p :>: ps) = do p' :> q' <- commute_no_conflicts (q :> p)
                                                ps' :> q'' <- commute_no_conflictsFL (q' :> ps)
                                                return (p' :>: ps' :> q'')

    commute_no_conflictsRL :: Conflict p => (RL p :> p) C(x y) -> Maybe ((p :> RL p) C(x y))
    commute_no_conflictsRL (NilRL :> p) = Just (p :> NilRL)
    commute_no_conflictsRL (p :<: ps :> q) = do q' :> p' <- commute_no_conflicts (p :> q)
                                                q'' :> ps' <- commute_no_conflictsRL (ps :> q')
                                                return (q'' :> p' :<: ps')

    commute_no_conflictsRLFL :: Conflict p => (RL p :> FL p) C(x y) -> Maybe ((FL p :> RL p) C(x y))
    commute_no_conflictsRLFL (NilRL :> ys) = Just (ys :> NilRL)
    commute_no_conflictsRLFL (xs :> NilFL) = Just (NilFL :> xs)
    commute_no_conflictsRLFL (xs :> y :>: ys) = do y' :> xs' <- commute_no_conflictsRL (xs :> y)
                                                   ys' :> xs'' <- commute_no_conflictsRLFL (xs' :> ys)
                                                   return (y' :>: ys' :> xs'')

\end{code}