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

import Prelude ()
import Darcs.Prelude

import Prelude hiding ( pi )
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(..), unsafeUnseal2
    , Gap(..), unFreeLeft
    )
import Darcs.Patch.Witnesses.Unsafe ( unsafeCoerceP, unsafeCoercePEnd )
import Darcs.Patch.Invert ( Invert(..) )
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 ( FileName, fp2fn )

-- | 'coalesceFwd' @p1 :> p2@ 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.
coalesceFwd :: (Prim :> Prim) wX wY -> Maybe (FL Prim wX wY)
coalesceFwd :: (:>) Prim Prim wX wY -> Maybe (FL Prim wX wY)
coalesceFwd (FP f1 :: FileName
f1 _ :> FP f2 :: FileName
f2 _) | FileName
f1 FileName -> FileName -> Bool
forall a. Eq a => a -> a -> Bool
/= FileName
f2 = Maybe (FL Prim wX wY)
forall a. Maybe a
Nothing
coalesceFwd (p1 :: Prim wX wZ
p1 :> p2 :: Prim wZ wY
p2) | EqCheck wX wY
IsEq <- Prim wX wZ -> Prim wZ wX
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert Prim wX wZ
p1 Prim wZ wX -> Prim wZ wY -> EqCheck wX wY
forall (p :: * -> * -> *) wA wB wC.
Eq2 p =>
p wA wB -> p wA wC -> EqCheck wB wC
=\/= Prim wZ wY
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
coalesceFwd (FP f1 :: FileName
f1 p1 :: FilePatchType wX wZ
p1 :> FP _ p2 :: FilePatchType wZ wY
p2) = (Prim wX wY -> FL Prim wX wY)
-> Maybe (Prim wX wY) -> Maybe (FL Prim wX wY)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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) (Maybe (Prim wX wY) -> Maybe (FL Prim wX wY))
-> Maybe (Prim wX wY) -> Maybe (FL Prim wX wY)
forall a b. (a -> b) -> a -> b
$ FileName
-> (:>) FilePatchType FilePatchType wX wY -> Maybe (Prim wX wY)
forall wX wY.
FileName
-> (:>) FilePatchType FilePatchType wX wY -> Maybe (Prim wX wY)
coalesceFilePrim FileName
f1 (FilePatchType wX wZ
p1 FilePatchType wX wZ
-> FilePatchType wZ wY -> (:>) FilePatchType FilePatchType wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FilePatchType wZ wY
p2) -- f1 = f2
coalesceFwd (Move a :: FileName
a b :: FileName
b :> Move b' :: FileName
b' a' :: FileName
a') | FileName
b FileName -> FileName -> Bool
forall a. Eq a => a -> a -> Bool
== FileName
b' = FL Prim wX wY -> Maybe (FL Prim wX wY)
forall a. a -> Maybe a
Just (FL Prim wX wY -> Maybe (FL Prim wX wY))
-> FL Prim wX wY -> Maybe (FL Prim wX wY)
forall a b. (a -> b) -> a -> b
$ FileName -> FileName -> Prim wX wY
forall wX wY. FileName -> FileName -> Prim wX wY
Move FileName
a FileName
a' 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
coalesceFwd (FP f :: FileName
f AddFile :> Move a :: FileName
a b :: FileName
b) | FileName
f FileName -> FileName -> Bool
forall a. Eq a => a -> a -> Bool
== FileName
a = FL Prim wX wY -> Maybe (FL Prim wX wY)
forall a. a -> Maybe a
Just (FL Prim wX wY -> Maybe (FL Prim wX wY))
-> FL Prim wX wY -> Maybe (FL Prim wX wY)
forall a b. (a -> b) -> a -> b
$ FileName -> FilePatchType wX wY -> Prim wX wY
forall wX wY. FileName -> FilePatchType wX wY -> Prim wX wY
FP FileName
b FilePatchType wX wY
forall wX wY. FilePatchType wX wY
AddFile 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
coalesceFwd (DP f :: FileName
f AddDir :> Move a :: FileName
a b :: FileName
b) | FileName
f FileName -> FileName -> Bool
forall a. Eq a => a -> a -> Bool
== FileName
a = FL Prim wX wY -> Maybe (FL Prim wX wY)
forall a. a -> Maybe a
Just (FL Prim wX wY -> Maybe (FL Prim wX wY))
-> FL Prim wX wY -> Maybe (FL Prim wX wY)
forall a b. (a -> b) -> a -> b
$ FileName -> DirPatchType wX wY -> Prim wX wY
forall wX wY. FileName -> DirPatchType wX wY -> Prim wX wY
DP FileName
b DirPatchType wX wY
forall wX wY. DirPatchType wX wY
AddDir 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
coalesceFwd (Move a :: FileName
a b :: FileName
b :> FP f :: FileName
f RmFile) | FileName
b FileName -> FileName -> Bool
forall a. Eq a => a -> a -> Bool
== FileName
f = FL Prim wX wY -> Maybe (FL Prim wX wY)
forall a. a -> Maybe a
Just (FL Prim wX wY -> Maybe (FL Prim wX wY))
-> FL Prim wX wY -> Maybe (FL Prim wX wY)
forall a b. (a -> b) -> a -> b
$ FileName -> FilePatchType wX wY -> Prim wX wY
forall wX wY. FileName -> FilePatchType wX wY -> Prim wX wY
FP FileName
a FilePatchType wX wY
forall wX wY. FilePatchType wX wY
RmFile 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
coalesceFwd (Move a :: FileName
a b :: FileName
b :> DP f :: FileName
f RmDir) | FileName
b FileName -> FileName -> Bool
forall a. Eq a => a -> a -> Bool
== FileName
f = FL Prim wX wY -> Maybe (FL Prim wX wY)
forall a. a -> Maybe a
Just (FL Prim wX wY -> Maybe (FL Prim wX wY))
-> FL Prim wX wY -> Maybe (FL Prim wX wY)
forall a b. (a -> b) -> a -> b
$ FileName -> DirPatchType wX wY -> Prim wX wY
forall wX wY. FileName -> DirPatchType wX wY -> Prim wX wY
DP FileName
a DirPatchType wX wY
forall wX wY. DirPatchType wX wY
RmDir 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
coalesceFwd (ChangePref p1 :: String
p1 f1 :: String
f1 t1 :: String
t1 :> ChangePref p2 :: String
p2 f2 :: String
f2 t2 :: String
t2) | String
p1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
p2 Bool -> Bool -> Bool
&& String
t1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
f2 = FL Prim wX wY -> Maybe (FL Prim wX wY)
forall a. a -> Maybe a
Just (FL Prim wX wY -> Maybe (FL Prim wX wY))
-> FL Prim wX wY -> Maybe (FL Prim wX wY)
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> Prim wX wY
forall wX wY. String -> String -> String -> Prim wX wY
ChangePref String
p1 String
f1 String
t2 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
coalesceFwd _ = Maybe (FL Prim wX wY)
forall a. Maybe a
Nothing

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 f :: forall wX wY. FL Prim wX wY -> FL Prim wX wY
f x :: 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 (FileName, Sealed2 Simple))
-> [Sealed2 Prim] -> Maybe [(FileName, Sealed2 Simple)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Sealed2 Prim -> Maybe (FileName, Sealed2 Simple)
toSimpleSealed ([Sealed2 Prim] -> Maybe [(FileName, Sealed2 Simple)])
-> [Sealed2 Prim] -> Maybe [(FileName, 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 sx :: [(FileName, 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 FileName (Sealed2 (FL Prim)) -> [Sealed2 (FL Prim)]
forall k a. Map k a -> [a]
elems (Map FileName (Sealed2 (FL Prim)) -> [Sealed2 (FL Prim)])
-> Map FileName (Sealed2 (FL Prim)) -> [Sealed2 (FL Prim)]
forall a b. (a -> b) -> a -> b
$
                (FileName
 -> ([Sealed2 Simple] -> [Sealed2 Simple]) -> Sealed2 (FL Prim))
-> Map FileName ([Sealed2 Simple] -> [Sealed2 Simple])
-> Map FileName (Sealed2 (FL Prim))
forall k a b. (k -> a -> b) -> Map k a -> Map k b
mapWithKey (\ k :: FileName
k p :: [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 (FileName -> FL Simple Any Any -> FL Prim Any Any
forall wX wY. FileName -> FL Simple wX wY -> FL Prim wX wY
fromSimples FileName
k ([Sealed2 Simple] -> FL Simple Any Any
forall (p :: * -> * -> *) wA wB. [Sealed2 p] -> FL p wA wB
unsealList ([Sealed2 Simple] -> [Sealed2 Simple]
p []))))) (Map FileName ([Sealed2 Simple] -> [Sealed2 Simple])
 -> Map FileName (Sealed2 (FL Prim)))
-> Map FileName ([Sealed2 Simple] -> [Sealed2 Simple])
-> Map FileName (Sealed2 (FL Prim))
forall a b. (a -> b) -> a -> b
$
                (([Sealed2 Simple] -> [Sealed2 Simple])
 -> ([Sealed2 Simple] -> [Sealed2 Simple])
 -> [Sealed2 Simple]
 -> [Sealed2 Simple])
-> [(FileName, [Sealed2 Simple] -> [Sealed2 Simple])]
-> Map FileName ([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
(.)) ([(FileName, [Sealed2 Simple] -> [Sealed2 Simple])]
 -> Map FileName ([Sealed2 Simple] -> [Sealed2 Simple]))
-> [(FileName, [Sealed2 Simple] -> [Sealed2 Simple])]
-> Map FileName ([Sealed2 Simple] -> [Sealed2 Simple])
forall a b. (a -> b) -> a -> b
$
                ((FileName, Sealed2 Simple)
 -> (FileName, [Sealed2 Simple] -> [Sealed2 Simple]))
-> [(FileName, Sealed2 Simple)]
-> [(FileName, [Sealed2 Simple] -> [Sealed2 Simple])]
forall a b. (a -> b) -> [a] -> [b]
map (\ (a :: FileName
a,b :: Sealed2 Simple
b) -> (FileName
a,(Sealed2 Simple
bSealed2 Simple -> [Sealed2 Simple] -> [Sealed2 Simple]
forall a. a -> [a] -> [a]
:))) [(FileName, Sealed2 Simple)]
sx
     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
. Sealed2 p -> p wA wA
forall (a :: * -> * -> *) wX wY. Sealed2 a -> a wX wY
unsafeUnseal2) (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 (FileName, Sealed2 Simple)
        toSimpleSealed :: Sealed2 Prim -> Maybe (FileName, Sealed2 Simple)
toSimpleSealed (Sealed2 p :: Prim wX wY
p) = ((FileName, Simple wX wY) -> (FileName, Sealed2 Simple))
-> Maybe (FileName, Simple wX wY)
-> Maybe (FileName, Sealed2 Simple)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Simple wX wY -> Sealed2 Simple)
-> (FileName, Simple wX wY) -> (FileName, 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 (FileName, Simple wX wY)
forall wX wY. Prim wX wY -> Maybe (FileName, 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 (FileName, Simple wX wY)
toSimple :: Prim wX wY -> Maybe (FileName, Simple wX wY)
toSimple (FP a :: FileName
a b :: FilePatchType wX wY
b) = (FileName, Simple wX wY) -> Maybe (FileName, Simple wX wY)
forall a. a -> Maybe a
Just (FileName
a, FilePatchType wX wY -> Simple wX wY
forall wX wY. FilePatchType wX wY -> Simple wX wY
SFP FilePatchType wX wY
b)
toSimple (DP a :: FileName
a AddDir) = (FileName, Simple wX wY) -> Maybe (FileName, Simple wX wY)
forall a. a -> Maybe a
Just (FileName
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 _ RmDir) = Maybe (FileName, Simple wX wY)
forall a. Maybe a
Nothing -- ordering is trickier with rmdir present
toSimple (Move _ _) = Maybe (FileName, Simple wX wY)
forall a. Maybe a
Nothing
toSimple (ChangePref a :: String
a b :: String
b c :: String
c) = (FileName, Simple wX wY) -> Maybe (FileName, Simple wX wY)
forall a. a -> Maybe a
Just (String -> FileName
fp2fn (String -> FileName) -> String -> FileName
forall a b. (a -> b) -> a -> b
$ String
darcsdir String -> ShowS
</> "prefs" String -> ShowS
</> "prefs", String -> String -> String -> Simple wX wY
forall wX wY. String -> String -> String -> Simple wX wY
SCP String
a String
b String
c)

fromSimple :: FileName -> Simple wX wY -> Prim wX wY
fromSimple :: FileName -> Simple wX wY -> Prim wX wY
fromSimple a :: FileName
a (SFP b :: FilePatchType wX wY
b) = FileName -> FilePatchType wX wY -> Prim wX wY
forall wX wY. FileName -> FilePatchType wX wY -> Prim wX wY
FP FileName
a FilePatchType wX wY
b
fromSimple a :: FileName
a (SDP b :: DirPatchType wX wY
b) = FileName -> DirPatchType wX wY -> Prim wX wY
forall wX wY. FileName -> DirPatchType wX wY -> Prim wX wY
DP FileName
a DirPatchType wX wY
b
fromSimple _ (SCP a :: String
a b :: String
b c :: 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 :: FileName -> FL Simple wX wY -> FL Prim wX wY
fromSimples :: FileName -> FL Simple wX wY -> FL Prim wX wY
fromSimples a :: FileName
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 (FileName -> Simple wW wY -> Prim wW wY
forall wX wY. FileName -> Simple wX wY -> Prim wX wY
fromSimple FileName
a)

tryHarderToShrink :: FL Prim wX wY -> FL Prim wX wY
tryHarderToShrink :: FL Prim wX wY -> FL Prim wX wY
tryHarderToShrink x :: 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 (prim :: * -> * -> *) wX wY.
PrimCanonize prim =>
FL prim wX wY -> Maybe (FL prim wX wY)
tryShrinkingInverse FL Prim wX wY
x)

tryToShrink2 :: FL Prim wX wY -> FL Prim wX wY
tryToShrink2 :: FL Prim wX wY -> FL Prim wX wY
tryToShrink2 psold :: 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 NilFL = FL Prim wX wY
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
shrinkABit (p :: Prim wX wY
p:>:ps :: 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 _ _ NilFL = Maybe (FL Prim wW wZ)
forall a. Maybe a
Nothing
tryOne sofar :: RL Prim wW wX
sofar p :: Prim wX wY
p (p1 :: Prim wY wY
p1:>:ps :: FL Prim wY wZ
ps) =
    case (:>) Prim Prim wX wY -> Maybe (FL Prim wX wY)
forall wX wY. (:>) Prim Prim wX wY -> Maybe (FL Prim wX wY)
coalesceFwd (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
    Just p' :: 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)
    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
               Nothing -> Maybe (FL Prim wW wZ)
forall a. Maybe a
Nothing
               Just (p1' :: Prim wX wZ
p1' :> p' :: 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 NilFL = FL Prim wX wY
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
sortCoalesceFL2 (x :: Prim wX wY
x:>:xs :: 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 (x :: Prim wX wY
x:>:xs :: 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 new :: Prim wX wY
new 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 new :: Prim wX wY
new ps :: FL Prim wY wZ
ps@(p :: Prim wY wY
p:>:ps' :: FL Prim wY wZ
ps')
    = case (:>) Prim Prim wX wY -> Maybe (FL Prim wX wY)
forall wX wY. (:>) Prim Prim wX wY -> Maybe (FL Prim wX wY)
coalesceFwd (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 (new' :: Prim wX wY
new' :>: 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 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 _ -> Either (FL Prim wX wZ) (FL Prim wX wZ)
forall a. a
impossible -- coalesce either returns a singleton or empty
      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 (p' :: Prim wX wZ
p' :> new' :: 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 r :: 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 r :: 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)
                                 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)

coalesceFilePrim :: FileName -> (FilePatchType :> FilePatchType) wX wY
                  -> Maybe (Prim wX wY)
coalesceFilePrim :: FileName
-> (:>) FilePatchType FilePatchType wX wY -> Maybe (Prim wX wY)
coalesceFilePrim f :: FileName
f (Hunk line1 :: Int
line1 old1 :: [ByteString]
old1 new1 :: [ByteString]
new1 :> Hunk line2 :: Int
line2 old2 :: [ByteString]
old2 new2 :: [ByteString]
new2)
    = FileName
-> Int
-> [ByteString]
-> [ByteString]
-> Int
-> [ByteString]
-> [ByteString]
-> Maybe (Prim wX wY)
forall wX wY.
FileName
-> Int
-> [ByteString]
-> [ByteString]
-> Int
-> [ByteString]
-> [ByteString]
-> Maybe (Prim wX wY)
coalesceHunk FileName
f Int
line2 [ByteString]
old2 [ByteString]
new2 Int
line1 [ByteString]
old1 [ByteString]
new1
-- Token replace patches operating right after (or before) AddFile (RmFile)
-- is an identity patch, as far as coalescing is concerned.
coalesceFilePrim f :: FileName
f (AddFile :> TokReplace{}) = Prim wX wY -> Maybe (Prim wX wY)
forall a. a -> Maybe a
Just (Prim wX wY -> Maybe (Prim wX wY))
-> Prim wX wY -> Maybe (Prim wX wY)
forall a b. (a -> b) -> a -> b
$ FileName -> FilePatchType wX wY -> Prim wX wY
forall wX wY. FileName -> FilePatchType wX wY -> Prim wX wY
FP FileName
f FilePatchType wX wY
forall wX wY. FilePatchType wX wY
AddFile
coalesceFilePrim f :: FileName
f (TokReplace{} :> RmFile) = Prim wX wY -> Maybe (Prim wX wY)
forall a. a -> Maybe a
Just (Prim wX wY -> Maybe (Prim wX wY))
-> Prim wX wY -> Maybe (Prim wX wY)
forall a b. (a -> b) -> a -> b
$ FileName -> FilePatchType wX wY -> Prim wX wY
forall wX wY. FileName -> FilePatchType wX wY -> Prim wX wY
FP FileName
f FilePatchType wX wY
forall wX wY. FilePatchType wX wY
RmFile
coalesceFilePrim f :: FileName
f (TokReplace t1 :: String
t1 o1 :: String
o1 n1 :: String
n1 :> TokReplace t2 :: String
t2 o2 :: String
o2 n2 :: String
n2)
    | String
t1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
t2 Bool -> Bool -> Bool
&& String
n1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
o2 = Prim wX wY -> Maybe (Prim wX wY)
forall a. a -> Maybe a
Just (Prim wX wY -> Maybe (Prim wX wY))
-> Prim wX wY -> Maybe (Prim wX wY)
forall a b. (a -> b) -> a -> b
$ FileName -> FilePatchType wX wY -> Prim wX wY
forall wX wY. FileName -> FilePatchType wX wY -> Prim wX wY
FP FileName
f (FilePatchType wX wY -> Prim wX wY)
-> FilePatchType wX wY -> Prim wX wY
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> FilePatchType wX wY
forall wX wY. String -> String -> String -> FilePatchType wX wY
TokReplace String
t1 String
o1 String
n2
coalesceFilePrim f :: FileName
f (Binary o :: ByteString
o m' :: ByteString
m' :> Binary m :: ByteString
m n :: ByteString
n)
    | ByteString
m ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
m' = Prim wX wY -> Maybe (Prim wX wY)
forall a. a -> Maybe a
Just (Prim wX wY -> Maybe (Prim wX wY))
-> Prim wX wY -> Maybe (Prim wX wY)
forall a b. (a -> b) -> a -> b
$ FileName -> FilePatchType wX wY -> Prim wX wY
forall wX wY. FileName -> FilePatchType wX wY -> Prim wX wY
FP FileName
f (FilePatchType wX wY -> Prim wX wY)
-> FilePatchType wX wY -> Prim wX wY
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> FilePatchType wX wY
forall wX wY. ByteString -> ByteString -> FilePatchType wX wY
Binary ByteString
o ByteString
n
coalesceFilePrim _ _ = Maybe (Prim wX wY)
forall a. Maybe a
Nothing

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

canonizeHunk :: Gap w
             => D.DiffAlgorithm -> FileName -> Int -> [B.ByteString] -> [B.ByteString]
             -> w (FL Prim)
canonizeHunk :: DiffAlgorithm
-> FileName -> Int -> [ByteString] -> [ByteString] -> w (FL Prim)
canonizeHunk _ f :: FileName
f line :: Int
line old :: [ByteString]
old new :: [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 (FileName -> FilePatchType wX wY -> Prim wX wY
forall wX wY. FileName -> FilePatchType wX wY -> Prim wX wY
FP FileName
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 da :: DiffAlgorithm
da f :: FileName
f line :: Int
line old :: [ByteString]
old new :: [ByteString]
new = FileName
-> Int -> [(Int, [ByteString], [ByteString])] -> w (FL Prim)
forall (w :: (* -> * -> *) -> *).
Gap w =>
FileName
-> Int -> [(Int, [ByteString], [ByteString])] -> w (FL Prim)
makeHoley FileName
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
          => FileName -> Int -> [(Int,[B.ByteString], [B.ByteString])]
          -> w (FL Prim)
makeHoley :: FileName
-> Int -> [(Int, [ByteString], [ByteString])] -> w (FL Prim)
makeHoley f :: FileName
f line :: 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
. (\(l :: Int
l,o :: [ByteString]
o,n :: [ByteString]
n) -> (forall wX wY. Prim wX wY) -> w Prim
forall (w :: (* -> * -> *) -> *) (p :: * -> * -> *).
Gap w =>
(forall wX wY. p wX wY) -> w p
freeGap (FileName -> FilePatchType wX wY -> Prim wX wY
forall wX wY. FileName -> FilePatchType wX wY -> Prim wX wY
FP FileName
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

   tryShrinkingInverse :: FL Prim wX wY -> Maybe (FL Prim wX wY)
tryShrinkingInverse (x :: Prim wX wY
x:>:y :: Prim wY wY
y:>:z :: FL Prim wY wY
z)
       | EqCheck wX wY
IsEq <- Prim wX wY -> Prim wY wX
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert Prim wX wY
x Prim wY wX -> Prim wY wY -> EqCheck wX wY
forall (p :: * -> * -> *) wA wB wC.
Eq2 p =>
p wA wB -> p wA wC -> EqCheck wB wC
=\/= Prim wY wY
y = FL Prim wY wY -> Maybe (FL Prim wY wY)
forall a. a -> Maybe a
Just FL Prim wY wY
z
       | Bool
otherwise = case FL Prim wY wY -> Maybe (FL Prim wY wY)
forall (prim :: * -> * -> *) wX wY.
PrimCanonize prim =>
FL prim wX wY -> Maybe (FL prim wX wY)
tryShrinkingInverse (Prim wY wY
yPrim wY wY -> FL Prim wY wY -> FL Prim wY wY
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>:FL Prim wY wY
z) of
                     Nothing -> Maybe (FL Prim wX wY)
forall a. Maybe a
Nothing
                     Just yz' :: FL Prim wY wY
yz' -> FL Prim wX wY -> Maybe (FL Prim wX wY)
forall a. a -> Maybe a
Just (FL Prim wX wY -> Maybe (FL Prim wX wY))
-> FL Prim wX wY -> Maybe (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 (Prim wX wY
x 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
yz') (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
$ FL Prim wX wY -> Maybe (FL Prim wX wY)
forall (prim :: * -> * -> *) wX wY.
PrimCanonize prim =>
FL prim wX wY -> Maybe (FL prim wX wY)
tryShrinkingInverse (Prim wX wY
xPrim 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
yz')
   tryShrinkingInverse _ = Maybe (FL Prim wX wY)
forall a. Maybe a
Nothing

   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 _ p :: 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 da :: DiffAlgorithm
da (FP f :: FileName
f (Hunk line :: Int
line old :: [ByteString]
old new :: [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
-> FileName
-> Int
-> [ByteString]
-> [ByteString]
-> FreeLeft (FL Prim)
forall (w :: (* -> * -> *) -> *).
Gap w =>
DiffAlgorithm
-> FileName -> Int -> [ByteString] -> [ByteString] -> w (FL Prim)
canonizeHunk DiffAlgorithm
da FileName
f Int
line [ByteString]
old [ByteString]
new
   canonize _ p :: 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
   -- Running canonize twice is apparently necessary to fix issue525;
   -- would be nice to understand why.
   canonizeFL :: DiffAlgorithm -> FL Prim wX wY -> FL Prim wX wY
canonizeFL da :: 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 (FL Prim wX wY -> FL Prim wX wY)
-> (FL Prim wX wY -> FL Prim wX wY)
-> FL Prim wX wY
-> FL Prim wX wY
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                   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)
   coalesce :: (:>) Prim Prim wX wY -> Maybe (FL Prim wX wY)
coalesce = (:>) Prim Prim wX wY -> Maybe (FL Prim wX wY)
forall wX wY. (:>) Prim Prim wX wY -> Maybe (FL Prim wX wY)
coalesceFwd