{-# 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 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
f FL Prim wW wZ
x =
case 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 forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL forall (a :: * -> * -> *) wY wY. a wY wY -> Sealed2 a
Sealed2 FL Prim wW wZ
x of
Just [(AnchoredPath, Sealed2 Simple)]
sx -> forall (a :: * -> * -> *) wX wZ. FL (FL a) wX wZ -> FL a wX wZ
concatFL forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) wA wB. [Sealed2 p] -> FL p wA wB
unsealList forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [a]
elems forall a b. (a -> b) -> a -> b
$
forall k a b. (k -> a -> b) -> Map k a -> Map k b
mapWithKey (\ AnchoredPath
k [Sealed2 Simple] -> [Sealed2 Simple]
p -> forall (a :: * -> * -> *) wY wY. a wY wY -> Sealed2 a
Sealed2 (forall wX wY. FL Prim wX wY -> FL Prim wX wY
f (forall wX wY. AnchoredPath -> FL Simple wX wY -> FL Prim wX wY
fromSimples AnchoredPath
k (forall (p :: * -> * -> *) wA wB. [Sealed2 p] -> FL p wA wB
unsealList ([Sealed2 Simple] -> [Sealed2 Simple]
p []))))) forall a b. (a -> b) -> a -> b
$
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
fromListWith (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)) forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map (\ (AnchoredPath
a,Sealed2 Simple
b) -> (AnchoredPath
a,(Sealed2 Simple
bforall a. a -> [a] -> [a]
:))) [(AnchoredPath, Sealed2 Simple)]
sx
Maybe [(AnchoredPath, Sealed2 Simple)]
Nothing -> 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 :: forall (p :: * -> * -> *) wA wB. [Sealed2 p] -> FL p wA wB
unsealList = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
(:>:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> * -> *) b.
(forall wX wY. a wX wY -> b) -> Sealed2 a -> b
unseal2 forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP) (forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP 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) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall (a :: * -> * -> *) wY wY. a wY wY -> Sealed2 a
Sealed2) (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
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 :: forall wX wY. Prim wX wY -> Maybe (AnchoredPath, Simple wX wY)
toSimple (FP AnchoredPath
a FilePatchType wX wY
b) = forall a. a -> Maybe a
Just (AnchoredPath
a, forall wX wY. FilePatchType wX wY -> Simple wX wY
SFP FilePatchType wX wY
b)
toSimple (DP AnchoredPath
a DirPatchType wX wY
AddDir) = forall a. a -> Maybe a
Just (AnchoredPath
a, forall wX wY. DirPatchType wX wY -> Simple wX wY
SDP forall wX wY. DirPatchType wX wY
AddDir)
toSimple (DP AnchoredPath
_ DirPatchType wX wY
RmDir) = forall a. Maybe a
Nothing
toSimple (Move AnchoredPath
_ AnchoredPath
_) = forall a. Maybe a
Nothing
toSimple (ChangePref String
a String
b String
c) = forall a. a -> Maybe a
Just (String -> AnchoredPath
floatPath (String
darcsdir String -> ShowS
</> String
"prefs" String -> ShowS
</> String
"prefs"), 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 :: forall wX wY. AnchoredPath -> Simple wX wY -> Prim wX wY
fromSimple AnchoredPath
a (SFP FilePatchType wX wY
b) = 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) = 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) = 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 :: forall wX wY. AnchoredPath -> FL Simple wX wY -> FL Prim wX wY
fromSimples AnchoredPath
a = forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL (forall wX wY. AnchoredPath -> Simple wX wY -> Prim wX wY
fromSimple AnchoredPath
a)
tryHarderToShrink :: FL Prim wX wY -> FL Prim wX wY
tryHarderToShrink :: forall wX wY. FL Prim wX wY -> FL Prim wX wY
tryHarderToShrink FL Prim wX wY
x = forall wX wY. FL Prim wX wY -> FL Prim wX wY
tryToShrink2 forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe FL Prim wX wY
x (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 :: forall wX wY. FL Prim wX wY -> FL Prim wX wY
tryToShrink2 FL Prim wX wY
psold =
let ps :: FL Prim wX wY
ps = 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 = forall wX wY. FL Prim wX wY -> FL Prim wX wY
shrinkABit FL Prim wX wY
ps
in
if forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Int
lengthFL FL Prim wX wY
ps_shrunk forall a. Ord a => a -> a -> Bool
< forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Int
lengthFL FL Prim wX wY
ps
then 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 :: FL Prim wX wY -> FL Prim wX wY
shrinkABit :: forall wX wY. FL Prim wX wY -> FL Prim wX wY
shrinkABit FL Prim wX wY
NilFL = forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
shrinkABit (Prim wX wY
p:>:FL Prim wY wY
ps) = forall a. a -> Maybe a -> a
fromMaybe (Prim wX wY
p forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: forall wX wY. FL Prim wX wY -> FL Prim wX wY
shrinkABit FL Prim wY wY
ps) forall a b. (a -> b) -> a -> b
$ forall wW wX wY wZ.
RL Prim wW wX
-> Prim wX wY -> FL Prim wY wZ -> Maybe (FL Prim wW wZ)
tryOne forall (a :: * -> * -> *) wX. RL a wX wX
NilRL Prim wX wY
p FL Prim wY wY
ps
tryOne :: RL Prim wW wX -> Prim wX wY -> FL Prim wY wZ
-> Maybe (FL Prim wW wZ)
tryOne :: 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
_ Prim wX wY
_ FL Prim wY wZ
NilFL = 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 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' -> forall a. a -> Maybe a
Just (forall (a :: * -> * -> *) wX wZ. RL a wX wZ -> FL a wX wZ
reverseRL RL Prim wW wX
sofar forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ FL Prim wX wY
p' 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 forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
commute (Prim wX wY
p 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 -> forall a. Maybe a
Nothing
Just (Prim wX wZ
p1' :> Prim wZ wY
p') -> 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
sofarforall (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
sortCoalesceFL2 :: FL Prim wX wY -> FL Prim wX wY
sortCoalesceFL2 :: forall wX wY. FL Prim wX wY -> FL Prim wX wY
sortCoalesceFL2 FL Prim wX wY
NilFL = forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
sortCoalesceFL2 (Prim wX wY
x:>:FL Prim wY wY
xs) | EqCheck wX wY
IsEq <- forall wX wY. Prim wX wY -> EqCheck wX wY
isIdentity Prim wX wY
x = 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) = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. a -> a
id forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ 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 forall a b. (a -> b) -> a -> b
$ forall wX wY. FL Prim wX wY -> FL Prim wX wY
sortCoalesceFL2 FL Prim wY wY
xs
pushCoalescePatch :: Prim wX wY -> FL Prim wY wZ
-> Either (FL Prim wX wZ) (FL Prim wX wZ)
pushCoalescePatch :: 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
NilFL = forall a b. a -> Either a b
Left (Prim wX wY
newforall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: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 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) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. a -> a
id forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ 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
ps'
Just FL Prim wX wY
NilFL -> forall a b. b -> Either a b
Right FL Prim wY wZ
ps'
Just FL Prim wX wY
_ -> forall a. HasCallStack => String -> a
error String
"impossible case"
Maybe (FL Prim wX wY)
Nothing -> if forall wX wY wW wZ. Prim wX wY -> Prim wW wZ -> Ordering
comparePrim Prim wX wY
new Prim wY wY
p forall a. Eq a => a -> a -> Bool
== Ordering
LT then forall a b. a -> Either a b
Left (Prim wX wY
newforall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>:FL Prim wY wZ
ps)
else case forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
commute (Prim wX wY
new 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 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 -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. a -> a
id forall a. a -> a
id forall a b. (a -> b) -> a -> b
$
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 -> forall a b. a -> Either a b
Left (Prim wX wZ
p' 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 -> forall a b. a -> Either a b
Left (Prim wX wY
newforall (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 :: forall wX wY wZ. Prim wX wY -> Prim wY wZ -> Maybe (FL Prim wX wZ)
coalesceOrCancel Prim wX wY
p1 Prim wY wZ
p2
| EqCheck wX wZ
IsEq <- forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert Prim wX wY
p1 forall (p :: * -> * -> *) wA wB wC.
Eq2 p =>
p wA wB -> p wA wC -> EqCheck wB wC
=\/= Prim wY wZ
p2 = forall a. a -> Maybe a
Just forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
| Bool
otherwise = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: forall (a :: * -> * -> *) wX. FL a wX wX
NilFL) forall a b. (a -> b) -> a -> b
$ forall wX wY wZ. Prim wX wY -> Prim wY wZ -> Maybe (Prim wX wZ)
coalescePair Prim wX wY
p1 Prim wY wZ
p2
coalescePair :: Prim wX wY -> Prim wY wZ -> Maybe (Prim wX wZ)
coalescePair :: forall wX wY wZ. 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 forall a. Eq a => a -> a -> Bool
/= AnchoredPath
f2 = forall a. Maybe a
Nothing
| Bool
otherwise = 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 forall a. Eq a => a -> a -> Bool
== AnchoredPath
b' = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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 forall a. Eq a => a -> a -> Bool
== AnchoredPath
a' = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall wX wY. AnchoredPath -> FilePatchType wX wY -> Prim wX wY
FP AnchoredPath
b forall wX wY. FilePatchType wX wY
AddFile
coalescePair (DP AnchoredPath
a DirPatchType wX wY
AddDir) (Move AnchoredPath
a' AnchoredPath
b) | AnchoredPath
a forall a. Eq a => a -> a -> Bool
== AnchoredPath
a' = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall wX wY. AnchoredPath -> DirPatchType wX wY -> Prim wX wY
DP AnchoredPath
b forall wX wY. DirPatchType wX wY
AddDir
coalescePair (Move AnchoredPath
a AnchoredPath
b) (FP AnchoredPath
b' FilePatchType wY wZ
RmFile) | AnchoredPath
b forall a. Eq a => a -> a -> Bool
== AnchoredPath
b' = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall wX wY. AnchoredPath -> FilePatchType wX wY -> Prim wX wY
FP AnchoredPath
a forall wX wY. FilePatchType wX wY
RmFile
coalescePair (Move AnchoredPath
a AnchoredPath
b) (DP AnchoredPath
b' DirPatchType wY wZ
RmDir) | AnchoredPath
b forall a. Eq a => a -> a -> Bool
== AnchoredPath
b' = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall wX wY. AnchoredPath -> DirPatchType wX wY -> Prim wX wY
DP AnchoredPath
a forall wX wY. DirPatchType wX wY
RmDir
coalescePair (ChangePref String
p String
a String
b) (ChangePref String
p' String
b' String
c)
| String
p forall a. Eq a => a -> a -> Bool
== String
p' Bool -> Bool -> Bool
&& String
b forall a. Eq a => a -> a -> Bool
== String
b' = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall wX wY. String -> String -> String -> Prim wX wY
ChangePref String
p String
a String
c
coalescePair Prim wX wY
_ Prim wY wZ
_ = forall a. Maybe a
Nothing
decoalescePair :: Prim wX wZ -> Prim wX wY -> Maybe (Prim wY wZ)
decoalescePair :: forall wX wZ wY. 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 forall a. Eq a => a -> a -> Bool
== AnchoredPath
b' = forall a. a -> Maybe a
Just (forall wX wY. AnchoredPath -> FilePatchType wX wY -> Prim wX wY
FP AnchoredPath
a forall wX wY. FilePatchType wX wY
RmFile)
decoalescePair (Move AnchoredPath
a AnchoredPath
b) (DP AnchoredPath
b' DirPatchType wX wY
AddDir) | AnchoredPath
b forall a. Eq a => a -> a -> Bool
== AnchoredPath
b' = forall a. a -> Maybe a
Just (forall wX wY. AnchoredPath -> DirPatchType wX wY -> Prim wX wY
DP AnchoredPath
a forall wX wY. DirPatchType wX wY
RmDir)
decoalescePair (FP AnchoredPath
f1 FilePatchType wX wZ
p1) (FP AnchoredPath
f2 FilePatchType wX wY
p2)
| AnchoredPath
f1 forall a. Eq a => a -> a -> Bool
/= AnchoredPath
f2 = forall a. Maybe a
Nothing
| Bool
otherwise = 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 = forall wX wY wZ. Prim wX wY -> Prim wY wZ -> Maybe (Prim wX wZ)
coalescePair (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 :: forall wX wY wZ.
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)
= 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
coalesceFilePrim AnchoredPath
f (FilePatchType wX wY
AddFile) (TokReplace{}) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall wX wY. AnchoredPath -> FilePatchType wX wY -> Prim wX wY
FP AnchoredPath
f forall wX wY. FilePatchType wX wY
AddFile
coalesceFilePrim AnchoredPath
f (TokReplace{}) (FilePatchType wY wZ
RmFile) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall wX wY. AnchoredPath -> FilePatchType wX wY -> Prim wX wY
FP AnchoredPath
f 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 forall a. Eq a => a -> a -> Bool
== String
t2 Bool -> Bool -> Bool
&& String
b forall a. Eq a => a -> a -> Bool
== String
b' = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall wX wY. AnchoredPath -> FilePatchType wX wY -> Prim wX wY
FP AnchoredPath
f forall a b. (a -> b) -> a -> b
$ 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 forall a. Eq a => a -> a -> Bool
== ByteString
m' = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall wX wY. AnchoredPath -> FilePatchType wX wY -> Prim wX wY
FP AnchoredPath
f forall a b. (a -> b) -> a -> b
$ forall wX wY. ByteString -> ByteString -> FilePatchType wX wY
Binary ByteString
o ByteString
n
coalesceFilePrim AnchoredPath
_ FilePatchType wX wY
_ FilePatchType wY wZ
_ = forall a. Maybe a
Nothing
decoalesceFilePrim :: AnchoredPath -> FilePatchType wX wZ -> FilePatchType wX wY
-> Maybe (Prim wY wZ)
decoalesceFilePrim :: forall wX wZ wY.
AnchoredPath
-> FilePatchType wX wZ -> FilePatchType wX wY -> Maybe (Prim wY wZ)
decoalesceFilePrim AnchoredPath
_ (FilePatchType wX wZ
AddFile) (FilePatchType wX wY
RmFile) = forall a. Maybe a
Nothing
decoalesceFilePrim AnchoredPath
_ (FilePatchType wX wZ
RmFile) (TokReplace{}) = forall a. Maybe a
Nothing
decoalesceFilePrim AnchoredPath
f FilePatchType wX wZ
z FilePatchType wX wY
x = forall wX wY wZ.
AnchoredPath
-> FilePatchType wX wY -> FilePatchType wY wZ -> Maybe (Prim wX wZ)
coalesceFilePrim AnchoredPath
f (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 :: 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
| Int
line2 forall a. Eq a => a -> a -> Bool
== Int
line1 Bool -> Bool -> Bool
&& Int
lengthold2 forall a. Ord a => a -> a -> Bool
< Int
lengthnew1 =
if forall a. Int -> [a] -> [a]
take Int
lengthold2 [ByteString]
new1 forall a. Eq a => a -> a -> Bool
/= [ByteString]
old2
then forall a. Maybe a
Nothing
else case forall a. Int -> [a] -> [a]
drop Int
lengthold2 [ByteString]
new1 of
[ByteString]
extranew -> forall a. a -> Maybe a
Just (forall wX wY. AnchoredPath -> FilePatchType wX wY -> Prim wX wY
FP AnchoredPath
f (forall wX wY.
Int -> [ByteString] -> [ByteString] -> FilePatchType wX wY
Hunk Int
line2 [ByteString]
old1 ([ByteString]
new2 forall a. [a] -> [a] -> [a]
++ [ByteString]
extranew)))
| Int
line2 forall a. Eq a => a -> a -> Bool
== Int
line1 Bool -> Bool -> Bool
&& Int
lengthold2 forall a. Ord a => a -> a -> Bool
> Int
lengthnew1 =
if forall a. Int -> [a] -> [a]
take Int
lengthnew1 [ByteString]
old2 forall a. Eq a => a -> a -> Bool
/= [ByteString]
new1
then forall a. Maybe a
Nothing
else case forall a. Int -> [a] -> [a]
drop Int
lengthnew1 [ByteString]
old2 of
[ByteString]
extraold -> forall a. a -> Maybe a
Just (forall wX wY. AnchoredPath -> FilePatchType wX wY -> Prim wX wY
FP AnchoredPath
f (forall wX wY.
Int -> [ByteString] -> [ByteString] -> FilePatchType wX wY
Hunk Int
line2 ([ByteString]
old1 forall a. [a] -> [a] -> [a]
++ [ByteString]
extraold) [ByteString]
new2))
| Int
line2 forall a. Eq a => a -> a -> Bool
== Int
line1 = if [ByteString]
new1 forall a. Eq a => a -> a -> Bool
== [ByteString]
old2 then forall a. a -> Maybe a
Just (forall wX wY. AnchoredPath -> FilePatchType wX wY -> Prim wX wY
FP AnchoredPath
f (forall wX wY.
Int -> [ByteString] -> [ByteString] -> FilePatchType wX wY
Hunk Int
line2 [ByteString]
old1 [ByteString]
new2))
else forall a. Maybe a
Nothing
| Int
line2 forall a. Ord a => a -> a -> Bool
< Int
line1 Bool -> Bool -> Bool
&& Int
lengthold2 forall a. Ord a => a -> a -> Bool
>= Int
line1 forall a. Num a => a -> a -> a
- Int
line2 =
case forall a. Int -> [a] -> [a]
take (Int
line1 forall a. Num a => a -> a -> a
- Int
line2) [ByteString]
old2 of
[ByteString]
extra-> forall wX wY.
AnchoredPath
-> Int
-> [ByteString]
-> [ByteString]
-> Int
-> [ByteString]
-> [ByteString]
-> Maybe (Prim wX wY)
coalesceHunk AnchoredPath
f Int
line2 ([ByteString]
extra forall a. [a] -> [a] -> [a]
++ [ByteString]
old1) ([ByteString]
extra forall a. [a] -> [a] -> [a]
++ [ByteString]
new1) Int
line2 [ByteString]
old2 [ByteString]
new2
| Int
line2 forall a. Ord a => a -> a -> Bool
> Int
line1 Bool -> Bool -> Bool
&& Int
lengthnew1 forall a. Ord a => a -> a -> Bool
>= Int
line2 forall a. Num a => a -> a -> a
- Int
line1 =
case forall a. Int -> [a] -> [a]
take (Int
line2 forall a. Num a => a -> a -> a
- Int
line1) [ByteString]
new1 of
[ByteString]
extra-> 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 forall a. [a] -> [a] -> [a]
++ [ByteString]
old2) ([ByteString]
extra forall a. [a] -> [a] -> [a]
++ [ByteString]
new2)
| Bool
otherwise = forall a. Maybe a
Nothing
where lengthold2 :: Int
lengthold2 = forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
old2
lengthnew1 :: Int
lengthnew1 = 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 :: forall (w :: (* -> * -> *) -> *).
Gap w =>
DiffAlgorithm
-> AnchoredPath
-> Int
-> [ByteString]
-> [ByteString]
-> w (FL Prim)
canonizeHunk DiffAlgorithm
_ AnchoredPath
f Int
line [ByteString]
old [ByteString]
new
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ByteString]
old Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ByteString]
new Bool -> Bool -> Bool
|| [ByteString]
old forall a. Eq a => a -> a -> Bool
== [ByteString
B.empty] Bool -> Bool -> Bool
|| [ByteString]
new forall a. Eq a => a -> a -> Bool
== [ByteString
B.empty]
= forall (w :: (* -> * -> *) -> *) (p :: * -> * -> *).
Gap w =>
(forall wX wY. p wX wY) -> w p
freeGap (forall wX wY. AnchoredPath -> FilePatchType wX wY -> Prim wX wY
FP AnchoredPath
f (forall wX wY.
Int -> [ByteString] -> [ByteString] -> FilePatchType wX wY
Hunk Int
line [ByteString]
old [ByteString]
new) forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: forall (a :: * -> * -> *) wX. FL a wX wX
NilFL)
canonizeHunk DiffAlgorithm
da AnchoredPath
f Int
line [ByteString]
old [ByteString]
new = forall (w :: (* -> * -> *) -> *).
Gap w =>
AnchoredPath
-> Int -> [(Int, [ByteString], [ByteString])] -> w (FL Prim)
makeHoley AnchoredPath
f Int
line 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 :: forall (w :: (* -> * -> *) -> *).
Gap w =>
AnchoredPath
-> Int -> [(Int, [ByteString], [ByteString])] -> w (FL Prim)
makeHoley AnchoredPath
f Int
line =
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (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 (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
(:>:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(Int
l,[ByteString]
o,[ByteString]
n) -> forall (w :: (* -> * -> *) -> *) (p :: * -> * -> *).
Gap w =>
(forall wX wY. p wX wY) -> w p
freeGap (forall wX wY. AnchoredPath -> FilePatchType wX wY -> Prim wX wY
FP AnchoredPath
f (forall wX wY.
Int -> [ByteString] -> [ByteString] -> FilePatchType wX wY
Hunk (Int
lforall a. Num a => a -> a -> a
+Int
line) [ByteString]
o [ByteString]
n)))) (forall (w :: (* -> * -> *) -> *) (p :: * -> * -> *).
Gap w =>
(forall wX. p wX wX) -> w p
emptyGap forall (a :: * -> * -> *) wX. FL a wX wX
NilFL)
instance PrimCanonize Prim where
tryToShrink :: forall wX wY. FL Prim wX wY -> FL Prim wX wY
tryToShrink = 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 :: forall wX wY. FL Prim wX wY -> FL Prim wX wY
sortCoalesceFL = 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 :: forall wX wY. DiffAlgorithm -> Prim wX wY -> FL Prim wX wY
canonize DiffAlgorithm
_ Prim wX wY
p | EqCheck wX wY
IsEq <- forall wX wY. Prim wX wY -> EqCheck wX wY
isIdentity Prim wX wY
p = forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
canonize DiffAlgorithm
da (FP AnchoredPath
f (Hunk Int
line [ByteString]
old [ByteString]
new)) = forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal forall (a :: * -> * -> *) wX wY1 wY2. a wX wY1 -> a wX wY2
unsafeCoercePEnd forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) wX. FreeLeft p -> Sealed (p wX)
unFreeLeft forall a b. (a -> b) -> a -> b
$ 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 forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
canonizeFL :: forall wX wY. DiffAlgorithm -> FL Prim wX wY -> FL Prim wX wY
canonizeFL DiffAlgorithm
da = forall (a :: * -> * -> *) wX wZ. FL (FL a) wX wZ -> FL a wX wZ
concatFL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL (forall (prim :: * -> * -> *) wX wY.
PrimCanonize prim =>
DiffAlgorithm -> prim wX wY -> FL prim wX wY
canonize DiffAlgorithm
da) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (prim :: * -> * -> *) wX wY.
PrimCanonize prim =>
FL prim wX wY -> FL prim wX wY
sortCoalesceFL
coalesce :: forall wX wY. (:>) Prim Prim wX wY -> Maybe (FL Prim wX wY)
coalesce (Prim wX wZ
p1 :> Prim wZ wY
p2) = 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 :: forall wX wY wZ. Prim wX wY -> Prim wY wZ -> Maybe (Prim wX wZ)
primCoalesce = forall wX wY wZ. Prim wX wY -> Prim wY wZ -> Maybe (Prim wX wZ)
coalescePair
primDecoalesce :: forall wX wZ wY. Prim wX wZ -> Prim wX wY -> Maybe (Prim wY wZ)
primDecoalesce = forall wX wZ wY. Prim wX wZ -> Prim wX wY -> Maybe (Prim wY wZ)
decoalescePair