{-# OPTIONS_GHC -fno-warn-orphans #-}
module Darcs.Patch.Prim.V1.Coalesce
    ()
    where

import Darcs.Prelude

import Control.Arrow ( second )
import Data.Maybe ( fromMaybe )
import Data.Map ( elems, fromListWith, mapWithKey )

import qualified Data.ByteString as B (ByteString, empty)

import System.FilePath ( (</>) )

import Darcs.Patch.Prim.Class ( PrimCanonize(..) )
import Darcs.Patch.Prim.V1.Commute ()
import Darcs.Patch.Prim.V1.Core
    ( Prim(..), FilePatchType(..), DirPatchType(..)
    , comparePrim, isIdentity
    )
import Darcs.Patch.Prim.V1.Show ()
import Darcs.Patch.Witnesses.Eq ( Eq2(..), EqCheck(..) )
import Darcs.Patch.Witnesses.Ordered
    ( FL(..), RL(..), (:>)(..)
    , reverseRL, mapFL, mapFL_FL
    , concatFL, lengthFL, (+>+) )
import Darcs.Patch.Witnesses.Sealed
    ( unseal, Sealed2(..), unseal2
    , Gap(..), unFreeLeft
    )
import Darcs.Patch.Witnesses.Unsafe ( unsafeCoerceP, unsafeCoercePEnd )
import Darcs.Patch.Invert ( Invert(..), dropInverses )
import Darcs.Patch.Commute ( Commute(..) )

import Darcs.Util.Diff ( getChanges )
import qualified Darcs.Util.Diff as D ( DiffAlgorithm )
import Darcs.Util.Global ( darcsdir )
import Darcs.Util.Path ( AnchoredPath, floatPath )

mapPrimFL :: (forall wX wY . FL Prim wX wY -> FL Prim wX wY)
             -> FL Prim wW wZ -> FL Prim wW wZ
mapPrimFL :: (forall wX wY. FL Prim wX wY -> FL Prim wX wY)
-> FL Prim wW wZ -> FL Prim wW wZ
mapPrimFL forall wX wY. FL Prim wX wY -> FL Prim wX wY
f FL Prim wW wZ
x =
-- an optimisation; break the list up into independent sublists
-- and apply f to each of them
     case (Sealed2 Prim -> Maybe (AnchoredPath, Sealed2 Simple))
-> [Sealed2 Prim] -> Maybe [(AnchoredPath, Sealed2 Simple)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Sealed2 Prim -> Maybe (AnchoredPath, Sealed2 Simple)
toSimpleSealed ([Sealed2 Prim] -> Maybe [(AnchoredPath, Sealed2 Simple)])
-> [Sealed2 Prim] -> Maybe [(AnchoredPath, Sealed2 Simple)]
forall a b. (a -> b) -> a -> b
$ (forall wW wZ. Prim wW wZ -> Sealed2 Prim)
-> FL Prim wW wZ -> [Sealed2 Prim]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL forall wW wZ. Prim wW wZ -> Sealed2 Prim
forall (a :: * -> * -> *) wX wY. a wX wY -> Sealed2 a
Sealed2 FL Prim wW wZ
x of
     Just [(AnchoredPath, Sealed2 Simple)]
sx -> FL (FL Prim) wW wZ -> FL Prim wW wZ
forall (a :: * -> * -> *) wX wZ. FL (FL a) wX wZ -> FL a wX wZ
concatFL (FL (FL Prim) wW wZ -> FL Prim wW wZ)
-> FL (FL Prim) wW wZ -> FL Prim wW wZ
forall a b. (a -> b) -> a -> b
$ [Sealed2 (FL Prim)] -> FL (FL Prim) wW wZ
forall (p :: * -> * -> *) wA wB. [Sealed2 p] -> FL p wA wB
unsealList ([Sealed2 (FL Prim)] -> FL (FL Prim) wW wZ)
-> [Sealed2 (FL Prim)] -> FL (FL Prim) wW wZ
forall a b. (a -> b) -> a -> b
$ Map AnchoredPath (Sealed2 (FL Prim)) -> [Sealed2 (FL Prim)]
forall k a. Map k a -> [a]
elems (Map AnchoredPath (Sealed2 (FL Prim)) -> [Sealed2 (FL Prim)])
-> Map AnchoredPath (Sealed2 (FL Prim)) -> [Sealed2 (FL Prim)]
forall a b. (a -> b) -> a -> b
$
                (AnchoredPath
 -> ([Sealed2 Simple] -> [Sealed2 Simple]) -> Sealed2 (FL Prim))
-> Map AnchoredPath ([Sealed2 Simple] -> [Sealed2 Simple])
-> Map AnchoredPath (Sealed2 (FL Prim))
forall k a b. (k -> a -> b) -> Map k a -> Map k b
mapWithKey (\ AnchoredPath
k [Sealed2 Simple] -> [Sealed2 Simple]
p -> FL Prim Any Any -> Sealed2 (FL Prim)
forall (a :: * -> * -> *) wX wY. a wX wY -> Sealed2 a
Sealed2 (FL Prim Any Any -> FL Prim Any Any
forall wX wY. FL Prim wX wY -> FL Prim wX wY
f (AnchoredPath -> FL Simple Any Any -> FL Prim Any Any
forall wX wY. AnchoredPath -> FL Simple wX wY -> FL Prim wX wY
fromSimples AnchoredPath
k ([Sealed2 Simple] -> FL Simple Any Any
forall (p :: * -> * -> *) wA wB. [Sealed2 p] -> FL p wA wB
unsealList ([Sealed2 Simple] -> [Sealed2 Simple]
p []))))) (Map AnchoredPath ([Sealed2 Simple] -> [Sealed2 Simple])
 -> Map AnchoredPath (Sealed2 (FL Prim)))
-> Map AnchoredPath ([Sealed2 Simple] -> [Sealed2 Simple])
-> Map AnchoredPath (Sealed2 (FL Prim))
forall a b. (a -> b) -> a -> b
$
                (([Sealed2 Simple] -> [Sealed2 Simple])
 -> ([Sealed2 Simple] -> [Sealed2 Simple])
 -> [Sealed2 Simple]
 -> [Sealed2 Simple])
-> [(AnchoredPath, [Sealed2 Simple] -> [Sealed2 Simple])]
-> Map AnchoredPath ([Sealed2 Simple] -> [Sealed2 Simple])
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
fromListWith ((([Sealed2 Simple] -> [Sealed2 Simple])
 -> ([Sealed2 Simple] -> [Sealed2 Simple])
 -> [Sealed2 Simple]
 -> [Sealed2 Simple])
-> ([Sealed2 Simple] -> [Sealed2 Simple])
-> ([Sealed2 Simple] -> [Sealed2 Simple])
-> [Sealed2 Simple]
-> [Sealed2 Simple]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ([Sealed2 Simple] -> [Sealed2 Simple])
-> ([Sealed2 Simple] -> [Sealed2 Simple])
-> [Sealed2 Simple]
-> [Sealed2 Simple]
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)) ([(AnchoredPath, [Sealed2 Simple] -> [Sealed2 Simple])]
 -> Map AnchoredPath ([Sealed2 Simple] -> [Sealed2 Simple]))
-> [(AnchoredPath, [Sealed2 Simple] -> [Sealed2 Simple])]
-> Map AnchoredPath ([Sealed2 Simple] -> [Sealed2 Simple])
forall a b. (a -> b) -> a -> b
$
                ((AnchoredPath, Sealed2 Simple)
 -> (AnchoredPath, [Sealed2 Simple] -> [Sealed2 Simple]))
-> [(AnchoredPath, Sealed2 Simple)]
-> [(AnchoredPath, [Sealed2 Simple] -> [Sealed2 Simple])]
forall a b. (a -> b) -> [a] -> [b]
map (\ (AnchoredPath
a,Sealed2 Simple
b) -> (AnchoredPath
a,(Sealed2 Simple
bSealed2 Simple -> [Sealed2 Simple] -> [Sealed2 Simple]
forall a. a -> [a] -> [a]
:))) [(AnchoredPath, Sealed2 Simple)]
sx
     Maybe [(AnchoredPath, Sealed2 Simple)]
Nothing -> FL Prim wW wZ -> FL Prim wW wZ
forall wX wY. FL Prim wX wY -> FL Prim wX wY
f FL Prim wW wZ
x
  where
        unsealList :: [Sealed2 p] -> FL p wA wB
        unsealList :: [Sealed2 p] -> FL p wA wB
unsealList = (Sealed2 p -> FL p wA wB -> FL p wA wB)
-> FL p wA wB -> [Sealed2 p] -> FL p wA wB
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (p wA wA -> FL p wA wB -> FL p wA wB
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
(:>:) (p wA wA -> FL p wA wB -> FL p wA wB)
-> (Sealed2 p -> p wA wA) -> Sealed2 p -> FL p wA wB -> FL p wA wB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall wX wY. p wX wY -> p wA wA) -> Sealed2 p -> p wA wA
forall (a :: * -> * -> *) b.
(forall wX wY. a wX wY -> b) -> Sealed2 a -> b
unseal2 forall wX wY. p wX wY -> p wA wA
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP) (FL p Any Any -> FL p wA wB
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP FL p Any Any
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL)

        toSimpleSealed :: Sealed2 Prim -> Maybe (AnchoredPath, Sealed2 Simple)
        toSimpleSealed :: Sealed2 Prim -> Maybe (AnchoredPath, Sealed2 Simple)
toSimpleSealed (Sealed2 Prim wX wY
p) = ((AnchoredPath, Simple wX wY) -> (AnchoredPath, Sealed2 Simple))
-> Maybe (AnchoredPath, Simple wX wY)
-> Maybe (AnchoredPath, Sealed2 Simple)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Simple wX wY -> Sealed2 Simple)
-> (AnchoredPath, Simple wX wY) -> (AnchoredPath, Sealed2 Simple)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Simple wX wY -> Sealed2 Simple
forall (a :: * -> * -> *) wX wY. a wX wY -> Sealed2 a
Sealed2) (Prim wX wY -> Maybe (AnchoredPath, Simple wX wY)
forall wX wY. Prim wX wY -> Maybe (AnchoredPath, Simple wX wY)
toSimple Prim wX wY
p)

data Simple wX wY
    = SFP !(FilePatchType wX wY)
    | SDP !(DirPatchType wX wY)
    | SCP String String String
    deriving ( Int -> Simple wX wY -> ShowS
[Simple wX wY] -> ShowS
Simple wX wY -> String
(Int -> Simple wX wY -> ShowS)
-> (Simple wX wY -> String)
-> ([Simple wX wY] -> ShowS)
-> Show (Simple wX wY)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall wX wY. Int -> Simple wX wY -> ShowS
forall wX wY. [Simple wX wY] -> ShowS
forall wX wY. Simple wX wY -> String
showList :: [Simple wX wY] -> ShowS
$cshowList :: forall wX wY. [Simple wX wY] -> ShowS
show :: Simple wX wY -> String
$cshow :: forall wX wY. Simple wX wY -> String
showsPrec :: Int -> Simple wX wY -> ShowS
$cshowsPrec :: forall wX wY. Int -> Simple wX wY -> ShowS
Show )

toSimple :: Prim wX wY -> Maybe (AnchoredPath, Simple wX wY)
toSimple :: Prim wX wY -> Maybe (AnchoredPath, Simple wX wY)
toSimple (FP AnchoredPath
a FilePatchType wX wY
b) = (AnchoredPath, Simple wX wY) -> Maybe (AnchoredPath, Simple wX wY)
forall a. a -> Maybe a
Just (AnchoredPath
a, FilePatchType wX wY -> Simple wX wY
forall wX wY. FilePatchType wX wY -> Simple wX wY
SFP FilePatchType wX wY
b)
toSimple (DP AnchoredPath
a DirPatchType wX wY
AddDir) = (AnchoredPath, Simple wX wY) -> Maybe (AnchoredPath, Simple wX wY)
forall a. a -> Maybe a
Just (AnchoredPath
a, DirPatchType wX wY -> Simple wX wY
forall wX wY. DirPatchType wX wY -> Simple wX wY
SDP DirPatchType wX wY
forall wX wY. DirPatchType wX wY
AddDir)
toSimple (DP AnchoredPath
_ DirPatchType wX wY
RmDir) = Maybe (AnchoredPath, Simple wX wY)
forall a. Maybe a
Nothing -- ordering is trickier with rmdir present
toSimple (Move AnchoredPath
_ AnchoredPath
_) = Maybe (AnchoredPath, Simple wX wY)
forall a. Maybe a
Nothing
toSimple (ChangePref String
a String
b String
c) = (AnchoredPath, Simple wX wY) -> Maybe (AnchoredPath, Simple wX wY)
forall a. a -> Maybe a
Just (String -> AnchoredPath
floatPath (String
darcsdir String -> ShowS
</> String
"prefs" String -> ShowS
</> String
"prefs"), String -> String -> String -> Simple wX wY
forall wX wY. String -> String -> String -> Simple wX wY
SCP String
a String
b String
c)

fromSimple :: AnchoredPath -> Simple wX wY -> Prim wX wY
fromSimple :: AnchoredPath -> Simple wX wY -> Prim wX wY
fromSimple AnchoredPath
a (SFP FilePatchType wX wY
b) = AnchoredPath -> FilePatchType wX wY -> Prim wX wY
forall wX wY. AnchoredPath -> FilePatchType wX wY -> Prim wX wY
FP AnchoredPath
a FilePatchType wX wY
b
fromSimple AnchoredPath
a (SDP DirPatchType wX wY
b) = AnchoredPath -> DirPatchType wX wY -> Prim wX wY
forall wX wY. AnchoredPath -> DirPatchType wX wY -> Prim wX wY
DP AnchoredPath
a DirPatchType wX wY
b
fromSimple AnchoredPath
_ (SCP String
a String
b String
c) = String -> String -> String -> Prim wX wY
forall wX wY. String -> String -> String -> Prim wX wY
ChangePref String
a String
b String
c

fromSimples :: AnchoredPath -> FL Simple wX wY -> FL Prim wX wY
fromSimples :: AnchoredPath -> FL Simple wX wY -> FL Prim wX wY
fromSimples AnchoredPath
a = (forall wW wY. Simple wW wY -> Prim wW wY)
-> FL Simple wX wY -> FL Prim wX wY
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL (AnchoredPath -> Simple wW wY -> Prim wW wY
forall wX wY. AnchoredPath -> Simple wX wY -> Prim wX wY
fromSimple AnchoredPath
a)

tryHarderToShrink :: FL Prim wX wY -> FL Prim wX wY
tryHarderToShrink :: FL Prim wX wY -> FL Prim wX wY
tryHarderToShrink FL Prim wX wY
x = FL Prim wX wY -> FL Prim wX wY
forall wX wY. FL Prim wX wY -> FL Prim wX wY
tryToShrink2 (FL Prim wX wY -> FL Prim wX wY) -> FL Prim wX wY -> FL Prim wX wY
forall a b. (a -> b) -> a -> b
$ FL Prim wX wY -> Maybe (FL Prim wX wY) -> FL Prim wX wY
forall a. a -> Maybe a -> a
fromMaybe FL Prim wX wY
x (FL Prim wX wY -> Maybe (FL Prim wX wY)
forall (p :: * -> * -> *) wX wY.
(Invert p, Eq2 p) =>
FL p wX wY -> Maybe (FL p wX wY)
dropInverses FL Prim wX wY
x)

tryToShrink2 :: FL Prim wX wY -> FL Prim wX wY
tryToShrink2 :: FL Prim wX wY -> FL Prim wX wY
tryToShrink2 FL Prim wX wY
psold =
    let ps :: FL Prim wX wY
ps = FL Prim wX wY -> FL Prim wX wY
forall (prim :: * -> * -> *) wX wY.
PrimCanonize prim =>
FL prim wX wY -> FL prim wX wY
sortCoalesceFL FL Prim wX wY
psold
        ps_shrunk :: FL Prim wX wY
ps_shrunk = FL Prim wX wY -> FL Prim wX wY
forall wX wY. FL Prim wX wY -> FL Prim wX wY
shrinkABit FL Prim wX wY
ps
                    in
    if FL Prim wX wY -> Int
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Int
lengthFL FL Prim wX wY
ps_shrunk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< FL Prim wX wY -> Int
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Int
lengthFL FL Prim wX wY
ps
    then FL Prim wX wY -> FL Prim wX wY
forall wX wY. FL Prim wX wY -> FL Prim wX wY
tryToShrink2 FL Prim wX wY
ps_shrunk
    else FL Prim wX wY
ps_shrunk

-- | @shrinkABit ps@ tries to simplify @ps@ by one patch,
--   the first one we find that coalesces with its neighbour
shrinkABit :: FL Prim wX wY -> FL Prim wX wY
shrinkABit :: FL Prim wX wY -> FL Prim wX wY
shrinkABit FL Prim wX wY
NilFL = FL Prim wX wY
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
shrinkABit (Prim wX wY
p:>:FL Prim wY wY
ps) = FL Prim wX wY -> Maybe (FL Prim wX wY) -> FL Prim wX wY
forall a. a -> Maybe a -> a
fromMaybe (Prim wX wY
p Prim wX wY -> FL Prim wY wY -> FL Prim wX wY
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL Prim wY wY -> FL Prim wY wY
forall wX wY. FL Prim wX wY -> FL Prim wX wY
shrinkABit FL Prim wY wY
ps) (Maybe (FL Prim wX wY) -> FL Prim wX wY)
-> Maybe (FL Prim wX wY) -> FL Prim wX wY
forall a b. (a -> b) -> a -> b
$ RL Prim wX wX
-> Prim wX wY -> FL Prim wY wY -> Maybe (FL Prim wX wY)
forall wW wX wY wZ.
RL Prim wW wX
-> Prim wX wY -> FL Prim wY wZ -> Maybe (FL Prim wW wZ)
tryOne RL Prim wX wX
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL Prim wX wY
p FL Prim wY wY
ps

-- | @tryOne acc p ps@ pushes @p@ as far down @ps@ as we can go
--   until we can either coalesce it with something or it can't
--   go any further.  Returns @Just@ if we manage to get any
--   coalescing out of this
tryOne :: RL Prim wW wX -> Prim wX wY -> FL Prim wY wZ
        -> Maybe (FL Prim wW wZ)
tryOne :: RL Prim wW wX
-> Prim wX wY -> FL Prim wY wZ -> Maybe (FL Prim wW wZ)
tryOne RL Prim wW wX
_ Prim wX wY
_ FL Prim wY wZ
NilFL = Maybe (FL Prim wW wZ)
forall a. Maybe a
Nothing
tryOne RL Prim wW wX
sofar Prim wX wY
p (Prim wY wY
p1:>:FL Prim wY wZ
ps) =
    case Prim wX wY -> Prim wY wY -> Maybe (FL Prim wX wY)
forall wX wY wZ. Prim wX wY -> Prim wY wZ -> Maybe (FL Prim wX wZ)
coalesceOrCancel Prim wX wY
p Prim wY wY
p1 of
    Just FL Prim wX wY
p' -> FL Prim wW wZ -> Maybe (FL Prim wW wZ)
forall a. a -> Maybe a
Just (RL Prim wW wX -> FL Prim wW wX
forall (a :: * -> * -> *) wX wZ. RL a wX wZ -> FL a wX wZ
reverseRL RL Prim wW wX
sofar FL Prim wW wX -> FL Prim wX wZ -> FL Prim wW wZ
forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ FL Prim wX wY
p' FL Prim wX wY -> FL Prim wY wZ -> FL Prim wX wZ
forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ FL Prim wY wZ
ps)
    Maybe (FL Prim wX wY)
Nothing -> case (:>) Prim Prim wX wY -> Maybe ((:>) Prim Prim wX wY)
forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
commute (Prim wX wY
p Prim wX wY -> Prim wY wY -> (:>) Prim Prim wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> Prim wY wY
p1) of
               Maybe ((:>) Prim Prim wX wY)
Nothing -> Maybe (FL Prim wW wZ)
forall a. Maybe a
Nothing
               Just (Prim wX wZ
p1' :> Prim wZ wY
p') -> RL Prim wW wZ
-> Prim wZ wY -> FL Prim wY wZ -> Maybe (FL Prim wW wZ)
forall wW wX wY wZ.
RL Prim wW wX
-> Prim wX wY -> FL Prim wY wZ -> Maybe (FL Prim wW wZ)
tryOne (RL Prim wW wX
sofarRL Prim wW wX -> Prim wX wZ -> RL Prim wW wZ
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<:Prim wX wZ
p1') Prim wZ wY
p' FL Prim wY wZ
ps

-- | The heart of "sortCoalesceFL"
sortCoalesceFL2 :: FL Prim wX wY -> FL Prim wX wY
sortCoalesceFL2 :: FL Prim wX wY -> FL Prim wX wY
sortCoalesceFL2 FL Prim wX wY
NilFL = FL Prim wX wY
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
sortCoalesceFL2 (Prim wX wY
x:>:FL Prim wY wY
xs) | EqCheck wX wY
IsEq <- Prim wX wY -> EqCheck wX wY
forall wX wY. Prim wX wY -> EqCheck wX wY
isIdentity Prim wX wY
x = FL Prim wY wY -> FL Prim wY wY
forall wX wY. FL Prim wX wY -> FL Prim wX wY
sortCoalesceFL2 FL Prim wY wY
xs
sortCoalesceFL2 (Prim wX wY
x:>:FL Prim wY wY
xs) = (FL Prim wX wY -> FL Prim wX wY)
-> (FL Prim wX wY -> FL Prim wX wY)
-> Either (FL Prim wX wY) (FL Prim wX wY)
-> FL Prim wX wY
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FL Prim wX wY -> FL Prim wX wY
forall a. a -> a
id FL Prim wX wY -> FL Prim wX wY
forall a. a -> a
id (Either (FL Prim wX wY) (FL Prim wX wY) -> FL Prim wX wY)
-> Either (FL Prim wX wY) (FL Prim wX wY) -> FL Prim wX wY
forall a b. (a -> b) -> a -> b
$ Prim wX wY
-> FL Prim wY wY -> Either (FL Prim wX wY) (FL Prim wX wY)
forall wX wY wZ.
Prim wX wY
-> FL Prim wY wZ -> Either (FL Prim wX wZ) (FL Prim wX wZ)
pushCoalescePatch Prim wX wY
x (FL Prim wY wY -> Either (FL Prim wX wY) (FL Prim wX wY))
-> FL Prim wY wY -> Either (FL Prim wX wY) (FL Prim wX wY)
forall a b. (a -> b) -> a -> b
$ FL Prim wY wY -> FL Prim wY wY
forall wX wY. FL Prim wX wY -> FL Prim wX wY
sortCoalesceFL2 FL Prim wY wY
xs

-- | 'pushCoalescePatch' @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, pushCoalescePatch 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 pushCoalescePatch is only ever used (and should
--   only ever be used) as an internal function in in
--   sortCoalesceFL2.
pushCoalescePatch :: Prim wX wY -> FL Prim wY wZ
                    -> Either (FL Prim wX wZ) (FL Prim wX wZ)
pushCoalescePatch :: Prim wX wY
-> FL Prim wY wZ -> Either (FL Prim wX wZ) (FL Prim wX wZ)
pushCoalescePatch Prim wX wY
new FL Prim wY wZ
NilFL = FL Prim wX wY -> Either (FL Prim wX wY) (FL Prim wX wZ)
forall a b. a -> Either a b
Left (Prim wX wY
newPrim wX wY -> FL Prim wY wY -> FL Prim wX wY
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>:FL Prim wY wY
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL)
pushCoalescePatch Prim wX wY
new ps :: FL Prim wY wZ
ps@(Prim wY wY
p:>:FL Prim wY wZ
ps')
    = case Prim wX wY -> Prim wY wY -> Maybe (FL Prim wX wY)
forall wX wY wZ. Prim wX wY -> Prim wY wZ -> Maybe (FL Prim wX wZ)
coalesceOrCancel Prim wX wY
new Prim wY wY
p of
      Just (Prim wX wY
new' :>: FL Prim wY wY
NilFL) -> FL Prim wX wZ -> Either (FL Prim wX wZ) (FL Prim wX wZ)
forall a b. b -> Either a b
Right (FL Prim wX wZ -> Either (FL Prim wX wZ) (FL Prim wX wZ))
-> FL Prim wX wZ -> Either (FL Prim wX wZ) (FL Prim wX wZ)
forall a b. (a -> b) -> a -> b
$ (FL Prim wX wZ -> FL Prim wX wZ)
-> (FL Prim wX wZ -> FL Prim wX wZ)
-> Either (FL Prim wX wZ) (FL Prim wX wZ)
-> FL Prim wX wZ
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FL Prim wX wZ -> FL Prim wX wZ
forall a. a -> a
id FL Prim wX wZ -> FL Prim wX wZ
forall a. a -> a
id (Either (FL Prim wX wZ) (FL Prim wX wZ) -> FL Prim wX wZ)
-> Either (FL Prim wX wZ) (FL Prim wX wZ) -> FL Prim wX wZ
forall a b. (a -> b) -> a -> b
$ Prim wX wY
-> FL Prim wY wZ -> Either (FL Prim wX wZ) (FL Prim wX wZ)
forall wX wY wZ.
Prim wX wY
-> FL Prim wY wZ -> Either (FL Prim wX wZ) (FL Prim wX wZ)
pushCoalescePatch Prim wX wY
new' FL Prim wY wZ
FL Prim wY wZ
ps'
      Just FL Prim wX wY
NilFL -> FL Prim wY wZ -> Either (FL Prim wX wZ) (FL Prim wY wZ)
forall a b. b -> Either a b
Right FL Prim wY wZ
ps'
      Just FL Prim wX wY
_ -> String -> Either (FL Prim wX wZ) (FL Prim wX wZ)
forall a. HasCallStack => String -> a
error String
"impossible case" -- coalesce either returns a singleton or empty
      Maybe (FL Prim wX wY)
Nothing -> if Prim wX wY -> Prim wY wY -> Ordering
forall wX wY wW wZ. Prim wX wY -> Prim wW wZ -> Ordering
comparePrim Prim wX wY
new Prim wY wY
p Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT then FL Prim wX wZ -> Either (FL Prim wX wZ) (FL Prim wX wZ)
forall a b. a -> Either a b
Left (Prim wX wY
newPrim wX wY -> FL Prim wY wZ -> FL Prim wX wZ
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>:FL Prim wY wZ
ps)
                            else case (:>) Prim Prim wX wY -> Maybe ((:>) Prim Prim wX wY)
forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
commute (Prim wX wY
new Prim wX wY -> Prim wY wY -> (:>) Prim Prim wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> Prim wY wY
p) of
                                 Just (Prim wX wZ
p' :> Prim wZ wY
new') ->
                                     case Prim wZ wY
-> FL Prim wY wZ -> Either (FL Prim wZ wZ) (FL Prim wZ wZ)
forall wX wY wZ.
Prim wX wY
-> FL Prim wY wZ -> Either (FL Prim wX wZ) (FL Prim wX wZ)
pushCoalescePatch Prim wZ wY
new' FL Prim wY wZ
ps' of
                                     Right FL Prim wZ wZ
r -> FL Prim wX wZ -> Either (FL Prim wX wZ) (FL Prim wX wZ)
forall a b. b -> Either a b
Right (FL Prim wX wZ -> Either (FL Prim wX wZ) (FL Prim wX wZ))
-> FL Prim wX wZ -> Either (FL Prim wX wZ) (FL Prim wX wZ)
forall a b. (a -> b) -> a -> b
$ (FL Prim wX wZ -> FL Prim wX wZ)
-> (FL Prim wX wZ -> FL Prim wX wZ)
-> Either (FL Prim wX wZ) (FL Prim wX wZ)
-> FL Prim wX wZ
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FL Prim wX wZ -> FL Prim wX wZ
forall a. a -> a
id FL Prim wX wZ -> FL Prim wX wZ
forall a. a -> a
id (Either (FL Prim wX wZ) (FL Prim wX wZ) -> FL Prim wX wZ)
-> Either (FL Prim wX wZ) (FL Prim wX wZ) -> FL Prim wX wZ
forall a b. (a -> b) -> a -> b
$
                                                Prim wX wZ
-> FL Prim wZ wZ -> Either (FL Prim wX wZ) (FL Prim wX wZ)
forall wX wY wZ.
Prim wX wY
-> FL Prim wY wZ -> Either (FL Prim wX wZ) (FL Prim wX wZ)
pushCoalescePatch Prim wX wZ
p' FL Prim wZ wZ
r
                                     Left FL Prim wZ wZ
r -> FL Prim wX wZ -> Either (FL Prim wX wZ) (FL Prim wX wZ)
forall a b. a -> Either a b
Left (Prim wX wZ
p' Prim wX wZ -> FL Prim wZ wZ -> FL Prim wX wZ
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL Prim wZ wZ
r)
                                 Maybe ((:>) Prim Prim wX wY)
Nothing -> FL Prim wX wZ -> Either (FL Prim wX wZ) (FL Prim wX wZ)
forall a b. a -> Either a b
Left (Prim wX wY
newPrim wX wY -> FL Prim wY wZ -> FL Prim wX wZ
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>:FL Prim wY wZ
ps)

coalesceOrCancel :: Prim wX wY -> Prim wY wZ -> Maybe (FL Prim wX wZ)
coalesceOrCancel :: Prim wX wY -> Prim wY wZ -> Maybe (FL Prim wX wZ)
coalesceOrCancel Prim wX wY
p1 Prim wY wZ
p2
  | EqCheck wX wZ
IsEq <- Prim wX wY -> Prim wY wX
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert Prim wX wY
p1 Prim wY wX -> Prim wY wZ -> EqCheck wX wZ
forall (p :: * -> * -> *) wA wB wC.
Eq2 p =>
p wA wB -> p wA wC -> EqCheck wB wC
=\/= Prim wY wZ
p2 = FL Prim wX wX -> Maybe (FL Prim wX wX)
forall a. a -> Maybe a
Just FL Prim wX wX
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
  | Bool
otherwise = (Prim wX wZ -> FL Prim wX wZ)
-> Maybe (Prim wX wZ) -> Maybe (FL Prim wX wZ)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Prim wX wZ -> FL Prim wZ wZ -> FL Prim wX wZ
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL Prim wZ wZ
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL) (Maybe (Prim wX wZ) -> Maybe (FL Prim wX wZ))
-> Maybe (Prim wX wZ) -> Maybe (FL Prim wX wZ)
forall a b. (a -> b) -> a -> b
$ Prim wX wY -> Prim wY wZ -> Maybe (Prim wX wZ)
forall wX wY wZ. Prim wX wY -> Prim wY wZ -> Maybe (Prim wX wZ)
coalescePair Prim wX wY
p1 Prim wY wZ
p2

-- | @'coalescePair' p1 p2@ tries to combine @p1@ and @p2@ into a single
--   patch. 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.
coalescePair :: Prim wX wY -> Prim wY wZ -> Maybe (Prim wX wZ)
coalescePair :: Prim wX wY -> Prim wY wZ -> Maybe (Prim wX wZ)
coalescePair (FP AnchoredPath
f1 FilePatchType wX wY
p1) (FP AnchoredPath
f2 FilePatchType wY wZ
p2)
  | AnchoredPath
f1 AnchoredPath -> AnchoredPath -> Bool
forall a. Eq a => a -> a -> Bool
/= AnchoredPath
f2 = Maybe (Prim wX wZ)
forall a. Maybe a
Nothing
  | Bool
otherwise = AnchoredPath
-> FilePatchType wX wY -> FilePatchType wY wZ -> Maybe (Prim wX wZ)
forall wX wY wZ.
AnchoredPath
-> FilePatchType wX wY -> FilePatchType wY wZ -> Maybe (Prim wX wZ)
coalesceFilePrim AnchoredPath
f1 FilePatchType wX wY
p1 FilePatchType wY wZ
p2
coalescePair (Move AnchoredPath
a AnchoredPath
b) (Move AnchoredPath
b' AnchoredPath
c) | AnchoredPath
b AnchoredPath -> AnchoredPath -> Bool
forall a. Eq a => a -> a -> Bool
== AnchoredPath
b' = Prim wX wZ -> Maybe (Prim wX wZ)
forall a. a -> Maybe a
Just (Prim wX wZ -> Maybe (Prim wX wZ))
-> Prim wX wZ -> Maybe (Prim wX wZ)
forall a b. (a -> b) -> a -> b
$ AnchoredPath -> AnchoredPath -> Prim wX wZ
forall wX wY. AnchoredPath -> AnchoredPath -> Prim wX wY
Move AnchoredPath
a AnchoredPath
c
coalescePair (FP AnchoredPath
a FilePatchType wX wY
AddFile) (Move AnchoredPath
a' AnchoredPath
b) | AnchoredPath
a AnchoredPath -> AnchoredPath -> Bool
forall a. Eq a => a -> a -> Bool
== AnchoredPath
a' = Prim wX wZ -> Maybe (Prim wX wZ)
forall a. a -> Maybe a
Just (Prim wX wZ -> Maybe (Prim wX wZ))
-> Prim wX wZ -> Maybe (Prim wX wZ)
forall a b. (a -> b) -> a -> b
$ AnchoredPath -> FilePatchType wX wZ -> Prim wX wZ
forall wX wY. AnchoredPath -> FilePatchType wX wY -> Prim wX wY
FP AnchoredPath
b FilePatchType wX wZ
forall wX wY. FilePatchType wX wY
AddFile
coalescePair (DP AnchoredPath
a DirPatchType wX wY
AddDir) (Move AnchoredPath
a' AnchoredPath
b) | AnchoredPath
a AnchoredPath -> AnchoredPath -> Bool
forall a. Eq a => a -> a -> Bool
== AnchoredPath
a' = Prim wX wZ -> Maybe (Prim wX wZ)
forall a. a -> Maybe a
Just (Prim wX wZ -> Maybe (Prim wX wZ))
-> Prim wX wZ -> Maybe (Prim wX wZ)
forall a b. (a -> b) -> a -> b
$ AnchoredPath -> DirPatchType wX wZ -> Prim wX wZ
forall wX wY. AnchoredPath -> DirPatchType wX wY -> Prim wX wY
DP AnchoredPath
b DirPatchType wX wZ
forall wX wY. DirPatchType wX wY
AddDir
coalescePair (Move AnchoredPath
a AnchoredPath
b) (FP AnchoredPath
b' FilePatchType wY wZ
RmFile) | AnchoredPath
b AnchoredPath -> AnchoredPath -> Bool
forall a. Eq a => a -> a -> Bool
== AnchoredPath
b' = Prim wX wZ -> Maybe (Prim wX wZ)
forall a. a -> Maybe a
Just (Prim wX wZ -> Maybe (Prim wX wZ))
-> Prim wX wZ -> Maybe (Prim wX wZ)
forall a b. (a -> b) -> a -> b
$ AnchoredPath -> FilePatchType wX wZ -> Prim wX wZ
forall wX wY. AnchoredPath -> FilePatchType wX wY -> Prim wX wY
FP AnchoredPath
a FilePatchType wX wZ
forall wX wY. FilePatchType wX wY
RmFile
coalescePair (Move AnchoredPath
a AnchoredPath
b) (DP AnchoredPath
b' DirPatchType wY wZ
RmDir) | AnchoredPath
b AnchoredPath -> AnchoredPath -> Bool
forall a. Eq a => a -> a -> Bool
== AnchoredPath
b' = Prim wX wZ -> Maybe (Prim wX wZ)
forall a. a -> Maybe a
Just (Prim wX wZ -> Maybe (Prim wX wZ))
-> Prim wX wZ -> Maybe (Prim wX wZ)
forall a b. (a -> b) -> a -> b
$ AnchoredPath -> DirPatchType wX wZ -> Prim wX wZ
forall wX wY. AnchoredPath -> DirPatchType wX wY -> Prim wX wY
DP AnchoredPath
a DirPatchType wX wZ
forall wX wY. DirPatchType wX wY
RmDir
{- we don't want to do that, of course:
coalescePair (FP a RmFile) (FP b AddFile) | a == a' = Just $ Move a' b
coalescePair (DP a RmDir) (DP b AddDir) | a == a' = Just $ Move a' b
-}
coalescePair (ChangePref String
p String
a String
b) (ChangePref String
p' String
b' String
c)
  | String
p String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
p' Bool -> Bool -> Bool
&& String
b String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
b' = Prim wX wZ -> Maybe (Prim wX wZ)
forall a. a -> Maybe a
Just (Prim wX wZ -> Maybe (Prim wX wZ))
-> Prim wX wZ -> Maybe (Prim wX wZ)
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> Prim wX wZ
forall wX wY. String -> String -> String -> Prim wX wY
ChangePref String
p String
a String
c
coalescePair Prim wX wY
_ Prim wY wZ
_ = Maybe (Prim wX wZ)
forall a. Maybe a
Nothing

-- | If 'coalescePair' is "addition" then this is "subtraction".
decoalescePair :: Prim wX wZ -> Prim wX wY -> Maybe (Prim wY wZ)
-- These two cases make sense only if we decoalesce;
-- they correspond to the commented two cases for coalesce above
-- and are one reason we need to define this function as a primitive
decoalescePair :: Prim wX wZ -> Prim wX wY -> Maybe (Prim wY wZ)
decoalescePair (Move AnchoredPath
a AnchoredPath
b) (FP AnchoredPath
b' FilePatchType wX wY
AddFile) | AnchoredPath
b AnchoredPath -> AnchoredPath -> Bool
forall a. Eq a => a -> a -> Bool
== AnchoredPath
b' = Prim wY wZ -> Maybe (Prim wY wZ)
forall a. a -> Maybe a
Just (AnchoredPath -> FilePatchType wY wZ -> Prim wY wZ
forall wX wY. AnchoredPath -> FilePatchType wX wY -> Prim wX wY
FP AnchoredPath
a FilePatchType wY wZ
forall wX wY. FilePatchType wX wY
RmFile)
decoalescePair (Move AnchoredPath
a AnchoredPath
b) (DP AnchoredPath
b' DirPatchType wX wY
AddDir) | AnchoredPath
b AnchoredPath -> AnchoredPath -> Bool
forall a. Eq a => a -> a -> Bool
== AnchoredPath
b' = Prim wY wZ -> Maybe (Prim wY wZ)
forall a. a -> Maybe a
Just (AnchoredPath -> DirPatchType wY wZ -> Prim wY wZ
forall wX wY. AnchoredPath -> DirPatchType wX wY -> Prim wX wY
DP AnchoredPath
a DirPatchType wY wZ
forall wX wY. DirPatchType wX wY
RmDir)
decoalescePair (FP AnchoredPath
f1 FilePatchType wX wZ
p1) (FP AnchoredPath
f2 FilePatchType wX wY
p2)
  | AnchoredPath
f1 AnchoredPath -> AnchoredPath -> Bool
forall a. Eq a => a -> a -> Bool
/= AnchoredPath
f2 = Maybe (Prim wY wZ)
forall a. Maybe a
Nothing
  | Bool
otherwise = AnchoredPath
-> FilePatchType wX wZ -> FilePatchType wX wY -> Maybe (Prim wY wZ)
forall wX wZ wY.
AnchoredPath
-> FilePatchType wX wZ -> FilePatchType wX wY -> Maybe (Prim wY wZ)
decoalesceFilePrim AnchoredPath
f1 FilePatchType wX wZ
p1 FilePatchType wX wY
p2
decoalescePair Prim wX wZ
z Prim wX wY
x = Prim wY wX -> Prim wX wZ -> Maybe (Prim wY wZ)
forall wX wY wZ. Prim wX wY -> Prim wY wZ -> Maybe (Prim wX wZ)
coalescePair (Prim wX wY -> Prim wY wX
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert Prim wX wY
x) Prim wX wZ
z

coalesceFilePrim :: AnchoredPath -> FilePatchType wX wY -> FilePatchType wY wZ
                 -> Maybe (Prim wX wZ)
coalesceFilePrim :: AnchoredPath
-> FilePatchType wX wY -> FilePatchType wY wZ -> Maybe (Prim wX wZ)
coalesceFilePrim AnchoredPath
f (Hunk Int
line1 [ByteString]
old1 [ByteString]
new1) (Hunk Int
line2 [ByteString]
old2 [ByteString]
new2)
    = AnchoredPath
-> Int
-> [ByteString]
-> [ByteString]
-> Int
-> [ByteString]
-> [ByteString]
-> Maybe (Prim wX wZ)
forall wX wY.
AnchoredPath
-> Int
-> [ByteString]
-> [ByteString]
-> Int
-> [ByteString]
-> [ByteString]
-> Maybe (Prim wX wY)
coalesceHunk AnchoredPath
f Int
line1 [ByteString]
old1 [ByteString]
new1 Int
line2 [ByteString]
old2 [ByteString]
new2
-- Token replace patches operating right after (or before) AddFile (RmFile)
-- is an identity patch, as far as coalescing is concerned.
-- These two cases make no sense when we decoalesce, which is the second
-- reason decoalesce is defined as a primitive.
coalesceFilePrim AnchoredPath
f (FilePatchType wX wY
AddFile) (TokReplace{}) = Prim wX wZ -> Maybe (Prim wX wZ)
forall a. a -> Maybe a
Just (Prim wX wZ -> Maybe (Prim wX wZ))
-> Prim wX wZ -> Maybe (Prim wX wZ)
forall a b. (a -> b) -> a -> b
$ AnchoredPath -> FilePatchType wX wZ -> Prim wX wZ
forall wX wY. AnchoredPath -> FilePatchType wX wY -> Prim wX wY
FP AnchoredPath
f FilePatchType wX wZ
forall wX wY. FilePatchType wX wY
AddFile
coalesceFilePrim AnchoredPath
f (TokReplace{}) (FilePatchType wY wZ
RmFile) = Prim wX wZ -> Maybe (Prim wX wZ)
forall a. a -> Maybe a
Just (Prim wX wZ -> Maybe (Prim wX wZ))
-> Prim wX wZ -> Maybe (Prim wX wZ)
forall a b. (a -> b) -> a -> b
$ AnchoredPath -> FilePatchType wX wZ -> Prim wX wZ
forall wX wY. AnchoredPath -> FilePatchType wX wY -> Prim wX wY
FP AnchoredPath
f FilePatchType wX wZ
forall wX wY. FilePatchType wX wY
RmFile
coalesceFilePrim AnchoredPath
f (TokReplace String
t1 String
a String
b) (TokReplace String
t2 String
b' String
c)
    | String
t1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
t2 Bool -> Bool -> Bool
&& String
b String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
b' = Prim wX wZ -> Maybe (Prim wX wZ)
forall a. a -> Maybe a
Just (Prim wX wZ -> Maybe (Prim wX wZ))
-> Prim wX wZ -> Maybe (Prim wX wZ)
forall a b. (a -> b) -> a -> b
$ AnchoredPath -> FilePatchType wX wZ -> Prim wX wZ
forall wX wY. AnchoredPath -> FilePatchType wX wY -> Prim wX wY
FP AnchoredPath
f (FilePatchType wX wZ -> Prim wX wZ)
-> FilePatchType wX wZ -> Prim wX wZ
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> FilePatchType wX wZ
forall wX wY. String -> String -> String -> FilePatchType wX wY
TokReplace String
t1 String
a String
c
coalesceFilePrim AnchoredPath
f (Binary ByteString
o ByteString
m') (Binary ByteString
m ByteString
n)
    | ByteString
m ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
m' = Prim wX wZ -> Maybe (Prim wX wZ)
forall a. a -> Maybe a
Just (Prim wX wZ -> Maybe (Prim wX wZ))
-> Prim wX wZ -> Maybe (Prim wX wZ)
forall a b. (a -> b) -> a -> b
$ AnchoredPath -> FilePatchType wX wZ -> Prim wX wZ
forall wX wY. AnchoredPath -> FilePatchType wX wY -> Prim wX wY
FP AnchoredPath
f (FilePatchType wX wZ -> Prim wX wZ)
-> FilePatchType wX wZ -> Prim wX wZ
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> FilePatchType wX wZ
forall wX wY. ByteString -> ByteString -> FilePatchType wX wY
Binary ByteString
o ByteString
n
coalesceFilePrim AnchoredPath
_ FilePatchType wX wY
_ FilePatchType wY wZ
_ = Maybe (Prim wX wZ)
forall a. Maybe a
Nothing

decoalesceFilePrim :: AnchoredPath -> FilePatchType wX wZ -> FilePatchType wX wY
                   -> Maybe (Prim wY wZ)
-- These two cases must fail because the token replace patches that coalesce
-- has eliminated are irretrievably lost.
decoalesceFilePrim :: AnchoredPath
-> FilePatchType wX wZ -> FilePatchType wX wY -> Maybe (Prim wY wZ)
decoalesceFilePrim AnchoredPath
_ (FilePatchType wX wZ
AddFile) (FilePatchType wX wY
RmFile) = Maybe (Prim wY wZ)
forall a. Maybe a
Nothing
decoalesceFilePrim AnchoredPath
_ (FilePatchType wX wZ
RmFile) (TokReplace{}) = Maybe (Prim wY wZ)
forall a. Maybe a
Nothing
decoalesceFilePrim AnchoredPath
f FilePatchType wX wZ
z FilePatchType wX wY
x = AnchoredPath
-> FilePatchType wY wX -> FilePatchType wX wZ -> Maybe (Prim wY wZ)
forall wX wY wZ.
AnchoredPath
-> FilePatchType wX wY -> FilePatchType wY wZ -> Maybe (Prim wX wZ)
coalesceFilePrim AnchoredPath
f (FilePatchType wX wY -> FilePatchType wY wX
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert FilePatchType wX wY
x) FilePatchType wX wZ
z

coalesceHunk :: AnchoredPath
             -> Int -> [B.ByteString] -> [B.ByteString]
             -> Int -> [B.ByteString] -> [B.ByteString]
             -> Maybe (Prim wX wY)
coalesceHunk :: AnchoredPath
-> Int
-> [ByteString]
-> [ByteString]
-> Int
-> [ByteString]
-> [ByteString]
-> Maybe (Prim wX wY)
coalesceHunk AnchoredPath
f Int
line1 [ByteString]
old1 [ByteString]
new1 Int
line2 [ByteString]
old2 [ByteString]
new2
    | Int
line2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
line1 Bool -> Bool -> Bool
&& Int
lengthold2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
lengthnew1 =
        if Int -> [ByteString] -> [ByteString]
forall a. Int -> [a] -> [a]
take Int
lengthold2 [ByteString]
new1 [ByteString] -> [ByteString] -> Bool
forall a. Eq a => a -> a -> Bool
/= [ByteString]
old2
        then Maybe (Prim wX wY)
forall a. Maybe a
Nothing
        else case Int -> [ByteString] -> [ByteString]
forall a. Int -> [a] -> [a]
drop Int
lengthold2 [ByteString]
new1 of
        [ByteString]
extranew -> Prim wX wY -> Maybe (Prim wX wY)
forall a. a -> Maybe a
Just (AnchoredPath -> FilePatchType wX wY -> Prim wX wY
forall wX wY. AnchoredPath -> FilePatchType wX wY -> Prim wX wY
FP AnchoredPath
f (Int -> [ByteString] -> [ByteString] -> FilePatchType wX wY
forall wX wY.
Int -> [ByteString] -> [ByteString] -> FilePatchType wX wY
Hunk Int
line2 [ByteString]
old1 ([ByteString]
new2 [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString]
extranew)))
    | Int
line2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
line1 Bool -> Bool -> Bool
&& Int
lengthold2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
lengthnew1 =
        if Int -> [ByteString] -> [ByteString]
forall a. Int -> [a] -> [a]
take Int
lengthnew1 [ByteString]
old2 [ByteString] -> [ByteString] -> Bool
forall a. Eq a => a -> a -> Bool
/= [ByteString]
new1
        then Maybe (Prim wX wY)
forall a. Maybe a
Nothing
        else case Int -> [ByteString] -> [ByteString]
forall a. Int -> [a] -> [a]
drop Int
lengthnew1 [ByteString]
old2 of
        [ByteString]
extraold -> Prim wX wY -> Maybe (Prim wX wY)
forall a. a -> Maybe a
Just (AnchoredPath -> FilePatchType wX wY -> Prim wX wY
forall wX wY. AnchoredPath -> FilePatchType wX wY -> Prim wX wY
FP AnchoredPath
f (Int -> [ByteString] -> [ByteString] -> FilePatchType wX wY
forall wX wY.
Int -> [ByteString] -> [ByteString] -> FilePatchType wX wY
Hunk Int
line2 ([ByteString]
old1 [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString]
extraold) [ByteString]
new2))
    | Int
line2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
line1 = if [ByteString]
new1 [ByteString] -> [ByteString] -> Bool
forall a. Eq a => a -> a -> Bool
== [ByteString]
old2 then Prim wX wY -> Maybe (Prim wX wY)
forall a. a -> Maybe a
Just (AnchoredPath -> FilePatchType wX wY -> Prim wX wY
forall wX wY. AnchoredPath -> FilePatchType wX wY -> Prim wX wY
FP AnchoredPath
f (Int -> [ByteString] -> [ByteString] -> FilePatchType wX wY
forall wX wY.
Int -> [ByteString] -> [ByteString] -> FilePatchType wX wY
Hunk Int
line2 [ByteString]
old1 [ByteString]
new2))
                       else Maybe (Prim wX wY)
forall a. Maybe a
Nothing
    | Int
line2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
line1 Bool -> Bool -> Bool
&& Int
lengthold2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
line1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
line2 =
        case Int -> [ByteString] -> [ByteString]
forall a. Int -> [a] -> [a]
take (Int
line1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
line2) [ByteString]
old2 of
        [ByteString]
extra-> AnchoredPath
-> Int
-> [ByteString]
-> [ByteString]
-> Int
-> [ByteString]
-> [ByteString]
-> Maybe (Prim wX wY)
forall wX wY.
AnchoredPath
-> Int
-> [ByteString]
-> [ByteString]
-> Int
-> [ByteString]
-> [ByteString]
-> Maybe (Prim wX wY)
coalesceHunk AnchoredPath
f Int
line2 ([ByteString]
extra [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString]
old1) ([ByteString]
extra [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString]
new1) Int
line2 [ByteString]
old2 [ByteString]
new2
    | Int
line2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
line1 Bool -> Bool -> Bool
&& Int
lengthnew1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
line2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
line1 =
        case Int -> [ByteString] -> [ByteString]
forall a. Int -> [a] -> [a]
take (Int
line2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
line1) [ByteString]
new1 of
        [ByteString]
extra-> AnchoredPath
-> Int
-> [ByteString]
-> [ByteString]
-> Int
-> [ByteString]
-> [ByteString]
-> Maybe (Prim wX wY)
forall wX wY.
AnchoredPath
-> Int
-> [ByteString]
-> [ByteString]
-> Int
-> [ByteString]
-> [ByteString]
-> Maybe (Prim wX wY)
coalesceHunk AnchoredPath
f Int
line1 [ByteString]
old1 [ByteString]
new1 Int
line1 ([ByteString]
extra [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString]
old2) ([ByteString]
extra [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString]
new2)
    | Bool
otherwise = Maybe (Prim wX wY)
forall a. Maybe a
Nothing
    where lengthold2 :: Int
lengthold2 = [ByteString] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
old2
          lengthnew1 :: Int
lengthnew1 = [ByteString] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
new1

canonizeHunk :: Gap w
             => D.DiffAlgorithm -> AnchoredPath -> Int -> [B.ByteString] -> [B.ByteString]
             -> w (FL Prim)
canonizeHunk :: DiffAlgorithm
-> AnchoredPath
-> Int
-> [ByteString]
-> [ByteString]
-> w (FL Prim)
canonizeHunk DiffAlgorithm
_ AnchoredPath
f Int
line [ByteString]
old [ByteString]
new
    | [ByteString] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ByteString]
old Bool -> Bool -> Bool
|| [ByteString] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ByteString]
new Bool -> Bool -> Bool
|| [ByteString]
old [ByteString] -> [ByteString] -> Bool
forall a. Eq a => a -> a -> Bool
== [ByteString
B.empty] Bool -> Bool -> Bool
|| [ByteString]
new [ByteString] -> [ByteString] -> Bool
forall a. Eq a => a -> a -> Bool
== [ByteString
B.empty]
        = (forall wX wY. FL Prim wX wY) -> w (FL Prim)
forall (w :: (* -> * -> *) -> *) (p :: * -> * -> *).
Gap w =>
(forall wX wY. p wX wY) -> w p
freeGap (AnchoredPath -> FilePatchType wX wY -> Prim wX wY
forall wX wY. AnchoredPath -> FilePatchType wX wY -> Prim wX wY
FP AnchoredPath
f (Int -> [ByteString] -> [ByteString] -> FilePatchType wX wY
forall wX wY.
Int -> [ByteString] -> [ByteString] -> FilePatchType wX wY
Hunk Int
line [ByteString]
old [ByteString]
new) Prim wX wY -> FL Prim wY wY -> FL Prim wX wY
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL Prim wY wY
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL)
canonizeHunk DiffAlgorithm
da AnchoredPath
f Int
line [ByteString]
old [ByteString]
new = AnchoredPath
-> Int -> [(Int, [ByteString], [ByteString])] -> w (FL Prim)
forall (w :: (* -> * -> *) -> *).
Gap w =>
AnchoredPath
-> Int -> [(Int, [ByteString], [ByteString])] -> w (FL Prim)
makeHoley AnchoredPath
f Int
line ([(Int, [ByteString], [ByteString])] -> w (FL Prim))
-> [(Int, [ByteString], [ByteString])] -> w (FL Prim)
forall a b. (a -> b) -> a -> b
$ DiffAlgorithm
-> [ByteString]
-> [ByteString]
-> [(Int, [ByteString], [ByteString])]
getChanges DiffAlgorithm
da [ByteString]
old [ByteString]
new

makeHoley :: Gap w
          => AnchoredPath -> Int -> [(Int,[B.ByteString], [B.ByteString])]
          -> w (FL Prim)
makeHoley :: AnchoredPath
-> Int -> [(Int, [ByteString], [ByteString])] -> w (FL Prim)
makeHoley AnchoredPath
f Int
line =
    ((Int, [ByteString], [ByteString]) -> w (FL Prim) -> w (FL Prim))
-> w (FL Prim)
-> [(Int, [ByteString], [ByteString])]
-> w (FL Prim)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((forall wX wY wZ. Prim wX wY -> FL Prim wY wZ -> FL Prim wX wZ)
-> w Prim -> w (FL Prim) -> w (FL Prim)
forall (w :: (* -> * -> *) -> *) (p :: * -> * -> *)
       (q :: * -> * -> *) (r :: * -> * -> *).
Gap w =>
(forall wX wY wZ. p wX wY -> q wY wZ -> r wX wZ)
-> w p -> w q -> w r
joinGap forall wX wY wZ. Prim wX wY -> FL Prim wY wZ -> FL Prim wX wZ
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
(:>:) (w Prim -> w (FL Prim) -> w (FL Prim))
-> ((Int, [ByteString], [ByteString]) -> w Prim)
-> (Int, [ByteString], [ByteString])
-> w (FL Prim)
-> w (FL Prim)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(Int
l,[ByteString]
o,[ByteString]
n) -> (forall wX wY. Prim wX wY) -> w Prim
forall (w :: (* -> * -> *) -> *) (p :: * -> * -> *).
Gap w =>
(forall wX wY. p wX wY) -> w p
freeGap (AnchoredPath -> FilePatchType wX wY -> Prim wX wY
forall wX wY. AnchoredPath -> FilePatchType wX wY -> Prim wX wY
FP AnchoredPath
f (Int -> [ByteString] -> [ByteString] -> FilePatchType wX wY
forall wX wY.
Int -> [ByteString] -> [ByteString] -> FilePatchType wX wY
Hunk (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
line) [ByteString]
o [ByteString]
n)))) ((forall wX. FL Prim wX wX) -> w (FL Prim)
forall (w :: (* -> * -> *) -> *) (p :: * -> * -> *).
Gap w =>
(forall wX. p wX wX) -> w p
emptyGap forall wX. FL Prim wX wX
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL)

instance PrimCanonize Prim where
   tryToShrink :: FL Prim wX wY -> FL Prim wX wY
tryToShrink = (forall wX wY. FL Prim wX wY -> FL Prim wX wY)
-> FL Prim wX wY -> FL Prim wX wY
forall wW wZ.
(forall wX wY. FL Prim wX wY -> FL Prim wX wY)
-> FL Prim wW wZ -> FL Prim wW wZ
mapPrimFL forall wX wY. FL Prim wX wY -> FL Prim wX wY
tryHarderToShrink

   sortCoalesceFL :: FL Prim wX wY -> FL Prim wX wY
sortCoalesceFL = (forall wX wY. FL Prim wX wY -> FL Prim wX wY)
-> FL Prim wX wY -> FL Prim wX wY
forall wW wZ.
(forall wX wY. FL Prim wX wY -> FL Prim wX wY)
-> FL Prim wW wZ -> FL Prim wW wZ
mapPrimFL forall wX wY. FL Prim wX wY -> FL Prim wX wY
sortCoalesceFL2
   canonize :: DiffAlgorithm -> Prim wX wY -> FL Prim wX wY
canonize DiffAlgorithm
_ Prim wX wY
p | EqCheck wX wY
IsEq <- Prim wX wY -> EqCheck wX wY
forall wX wY. Prim wX wY -> EqCheck wX wY
isIdentity Prim wX wY
p = FL Prim wX wY
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
   canonize DiffAlgorithm
da (FP AnchoredPath
f (Hunk Int
line [ByteString]
old [ByteString]
new)) = (forall wX. FL Prim wX wX -> FL Prim wX wY)
-> Sealed (FL Prim wX) -> FL Prim wX wY
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal forall wX. FL Prim wX wX -> FL Prim wX wY
forall (a :: * -> * -> *) wX wY1 wY2. a wX wY1 -> a wX wY2
unsafeCoercePEnd (Sealed (FL Prim wX) -> FL Prim wX wY)
-> Sealed (FL Prim wX) -> FL Prim wX wY
forall a b. (a -> b) -> a -> b
$ FreeLeft (FL Prim) -> Sealed (FL Prim wX)
forall (p :: * -> * -> *) wX. FreeLeft p -> Sealed (p wX)
unFreeLeft (FreeLeft (FL Prim) -> Sealed (FL Prim wX))
-> FreeLeft (FL Prim) -> Sealed (FL Prim wX)
forall a b. (a -> b) -> a -> b
$ DiffAlgorithm
-> AnchoredPath
-> Int
-> [ByteString]
-> [ByteString]
-> FreeLeft (FL Prim)
forall (w :: (* -> * -> *) -> *).
Gap w =>
DiffAlgorithm
-> AnchoredPath
-> Int
-> [ByteString]
-> [ByteString]
-> w (FL Prim)
canonizeHunk DiffAlgorithm
da AnchoredPath
f Int
line [ByteString]
old [ByteString]
new
   canonize DiffAlgorithm
_ Prim wX wY
p = Prim wX wY
p Prim wX wY -> FL Prim wY wY -> FL Prim wX wY
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL Prim wY wY
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
   -- Note: it is important to first coalesce and then canonize, since
   -- coalescing can produce non-cononical hunks (while hunks resulting
   -- from canonizing a single hunk cannot be coalesced). See issue525,
   -- in particular msg20270 for details.
   canonizeFL :: DiffAlgorithm -> FL Prim wX wY -> FL Prim wX wY
canonizeFL DiffAlgorithm
da = FL (FL Prim) wX wY -> FL Prim wX wY
forall (a :: * -> * -> *) wX wZ. FL (FL a) wX wZ -> FL a wX wZ
concatFL (FL (FL Prim) wX wY -> FL Prim wX wY)
-> (FL Prim wX wY -> FL (FL Prim) wX wY)
-> FL Prim wX wY
-> FL Prim wX wY
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall wW wY. Prim wW wY -> FL Prim wW wY)
-> FL Prim wX wY -> FL (FL Prim) wX wY
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL (DiffAlgorithm -> Prim wW wY -> FL Prim wW wY
forall (prim :: * -> * -> *) wX wY.
PrimCanonize prim =>
DiffAlgorithm -> prim wX wY -> FL prim wX wY
canonize DiffAlgorithm
da) (FL Prim wX wY -> FL (FL Prim) wX wY)
-> (FL Prim wX wY -> FL Prim wX wY)
-> FL Prim wX wY
-> FL (FL Prim) wX wY
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FL Prim wX wY -> FL Prim wX wY
forall (prim :: * -> * -> *) wX wY.
PrimCanonize prim =>
FL prim wX wY -> FL prim wX wY
sortCoalesceFL
   coalesce :: (:>) Prim Prim wX wY -> Maybe (FL Prim wX wY)
coalesce (Prim wX wZ
p1 :> Prim wZ wY
p2) = Prim wX wZ -> Prim wZ wY -> Maybe (FL Prim wX wY)
forall wX wY wZ. Prim wX wY -> Prim wY wZ -> Maybe (FL Prim wX wZ)
coalesceOrCancel Prim wX wZ
p1 Prim wZ wY
p2
   primCoalesce :: Prim wX wY -> Prim wY wZ -> Maybe (Prim wX wZ)
primCoalesce = Prim wX wY -> Prim wY wZ -> Maybe (Prim wX wZ)
forall wX wY wZ. Prim wX wY -> Prim wY wZ -> Maybe (Prim wX wZ)
coalescePair
   primDecoalesce :: Prim wX wZ -> Prim wX wY -> Maybe (Prim wY wZ)
primDecoalesce = Prim wX wZ -> Prim wX wY -> Maybe (Prim wY wZ)
forall wX wZ wY. Prim wX wZ -> Prim wX wY -> Maybe (Prim wY wZ)
decoalescePair