{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE TupleSections #-}

module Darcs.Patch.Prim.V1.Coalesce
    ()
    where

import Darcs.Prelude

import qualified Data.Map as M

import qualified Data.ByteString as B ( ByteString )

import System.FilePath ( (</>) )

import Darcs.Patch.Prim.Class ( PrimCoalesce(..) )
import Darcs.Patch.Prim.Coalesce
import Darcs.Patch.Prim.V1.Commute ()
import Darcs.Patch.Prim.V1.Core ( DirPatchType(..), FilePatchType(..), Prim(..) )
import Darcs.Patch.Prim.V1.Show ()
import Darcs.Patch.Witnesses.Eq ( EqCheck(..) )
import Darcs.Patch.Witnesses.Ordered ( FL(..), concatFL, mapFL )
import Darcs.Patch.Witnesses.Sealed ( Sealed2(..), unseal2 )
import Darcs.Patch.Witnesses.Unsafe ( unsafeCoerceP )

import Darcs.Util.Global ( darcsdir )
import Darcs.Util.Path ( AnchoredPath, unsafeFloatPath )

-- | Map a monadic function over an 'FL' of 'Prim's.
--
-- Be careful which 'Monad' to choose when using this function. For instance,
-- 'Maybe' would return 'Nothing' if any of the calls failed to shrink their
-- argument, which usually not what we want. A suitable candidate is @('Any',)@.
mapPrimFL :: Monad m
          => (forall wA wB . FL Prim wA wB -> m (FL Prim wA wB))
          -> FL Prim wX wY -> m (FL Prim wX wY)
mapPrimFL :: forall (m :: * -> *) wX wY.
Monad m =>
(forall wA wB. FL Prim wA wB -> m (FL Prim wA wB))
-> FL Prim wX wY -> m (FL Prim wX wY)
mapPrimFL forall wA wB. FL Prim wA wB -> m (FL Prim wA wB)
f FL Prim wX wY
ps =
  -- an optimisation; break the list up into independent sublists
  -- and apply f to each of them
  case (Sealed2 Prim -> Maybe (AnchoredPath, Sealed2 Prim))
-> [Sealed2 Prim] -> Maybe [(AnchoredPath, Sealed2 Prim)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Sealed2 Prim -> Maybe (AnchoredPath, Sealed2 Prim)
withPathAsKey ([Sealed2 Prim] -> Maybe [(AnchoredPath, Sealed2 Prim)])
-> [Sealed2 Prim] -> Maybe [(AnchoredPath, Sealed2 Prim)]
forall a b. (a -> b) -> a -> b
$ (forall wW wZ. Prim wW wZ -> Sealed2 Prim)
-> FL Prim wX wY -> [Sealed2 Prim]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL Prim wW wZ -> Sealed2 Prim
forall wW wZ. Prim wW wZ -> Sealed2 Prim
forall (a :: * -> * -> *) wX wY. a wX wY -> Sealed2 a
Sealed2 FL Prim wX wY
ps of
    Just [(AnchoredPath, Sealed2 Prim)]
pairs ->
      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)
-> (Map AnchoredPath (Sealed2 (FL Prim)) -> FL (FL Prim) wX wY)
-> Map AnchoredPath (Sealed2 (FL Prim))
-> FL Prim wX wY
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      [Sealed2 (FL Prim)] -> FL (FL Prim) wX wY
forall (p :: * -> * -> *) wA wB. [Sealed2 p] -> FL p wA wB
unsealList ([Sealed2 (FL Prim)] -> FL (FL Prim) wX wY)
-> (Map AnchoredPath (Sealed2 (FL Prim)) -> [Sealed2 (FL Prim)])
-> Map AnchoredPath (Sealed2 (FL Prim))
-> FL (FL Prim) wX wY
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      Map AnchoredPath (Sealed2 (FL Prim)) -> [Sealed2 (FL Prim)]
forall k a. Map k a -> [a]
M.elems (Map AnchoredPath (Sealed2 (FL Prim)) -> FL Prim wX wY)
-> m (Map AnchoredPath (Sealed2 (FL Prim))) -> m (FL Prim wX wY)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      ((([Sealed2 Prim] -> [Sealed2 Prim]) -> m (Sealed2 (FL Prim)))
-> Map AnchoredPath ([Sealed2 Prim] -> [Sealed2 Prim])
-> m (Map AnchoredPath (Sealed2 (FL Prim)))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Map AnchoredPath a -> m (Map AnchoredPath b)
mapM ((FL Prim Any Any -> Sealed2 (FL Prim))
-> m (FL Prim Any Any) -> m (Sealed2 (FL Prim))
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FL Prim Any Any -> Sealed2 (FL Prim)
forall (a :: * -> * -> *) wX wY. a wX wY -> Sealed2 a
Sealed2 (m (FL Prim Any Any) -> m (Sealed2 (FL Prim)))
-> (([Sealed2 Prim] -> [Sealed2 Prim]) -> m (FL Prim Any Any))
-> ([Sealed2 Prim] -> [Sealed2 Prim])
-> m (Sealed2 (FL Prim))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FL Prim Any Any -> m (FL Prim Any Any)
forall wA wB. FL Prim wA wB -> m (FL Prim wA wB)
f (FL Prim Any Any -> m (FL Prim Any Any))
-> (([Sealed2 Prim] -> [Sealed2 Prim]) -> FL Prim Any Any)
-> ([Sealed2 Prim] -> [Sealed2 Prim])
-> m (FL Prim Any Any)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Sealed2 Prim] -> FL Prim Any Any
forall (p :: * -> * -> *) wA wB. [Sealed2 p] -> FL p wA wB
unsealList ([Sealed2 Prim] -> FL Prim Any Any)
-> (([Sealed2 Prim] -> [Sealed2 Prim]) -> [Sealed2 Prim])
-> ([Sealed2 Prim] -> [Sealed2 Prim])
-> FL Prim Any Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Sealed2 Prim] -> [Sealed2 Prim])
-> [Sealed2 Prim] -> [Sealed2 Prim]
forall a b. (a -> b) -> a -> b
$ [])) (Map AnchoredPath ([Sealed2 Prim] -> [Sealed2 Prim])
 -> m (Map AnchoredPath (Sealed2 (FL Prim))))
-> Map AnchoredPath ([Sealed2 Prim] -> [Sealed2 Prim])
-> m (Map AnchoredPath (Sealed2 (FL Prim)))
forall a b. (a -> b) -> a -> b
$
      (([Sealed2 Prim] -> [Sealed2 Prim])
 -> ([Sealed2 Prim] -> [Sealed2 Prim])
 -> [Sealed2 Prim]
 -> [Sealed2 Prim])
-> [(AnchoredPath, [Sealed2 Prim] -> [Sealed2 Prim])]
-> Map AnchoredPath ([Sealed2 Prim] -> [Sealed2 Prim])
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith ((([Sealed2 Prim] -> [Sealed2 Prim])
 -> ([Sealed2 Prim] -> [Sealed2 Prim])
 -> [Sealed2 Prim]
 -> [Sealed2 Prim])
-> ([Sealed2 Prim] -> [Sealed2 Prim])
-> ([Sealed2 Prim] -> [Sealed2 Prim])
-> [Sealed2 Prim]
-> [Sealed2 Prim]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ([Sealed2 Prim] -> [Sealed2 Prim])
-> ([Sealed2 Prim] -> [Sealed2 Prim])
-> [Sealed2 Prim]
-> [Sealed2 Prim]
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)) ([(AnchoredPath, [Sealed2 Prim] -> [Sealed2 Prim])]
 -> Map AnchoredPath ([Sealed2 Prim] -> [Sealed2 Prim]))
-> [(AnchoredPath, [Sealed2 Prim] -> [Sealed2 Prim])]
-> Map AnchoredPath ([Sealed2 Prim] -> [Sealed2 Prim])
forall a b. (a -> b) -> a -> b
$ ((AnchoredPath, Sealed2 Prim)
 -> (AnchoredPath, [Sealed2 Prim] -> [Sealed2 Prim]))
-> [(AnchoredPath, Sealed2 Prim)]
-> [(AnchoredPath, [Sealed2 Prim] -> [Sealed2 Prim])]
forall a b. (a -> b) -> [a] -> [b]
map (\(AnchoredPath
k, Sealed2 Prim
v) -> (AnchoredPath
k, (Sealed2 Prim
v Sealed2 Prim -> [Sealed2 Prim] -> [Sealed2 Prim]
forall a. a -> [a] -> [a]
:))) [(AnchoredPath, Sealed2 Prim)]
pairs)
    Maybe [(AnchoredPath, Sealed2 Prim)]
Nothing -> FL Prim wX wY -> m (FL Prim wX wY)
forall wA wB. FL Prim wA wB -> m (FL Prim wA wB)
f FL Prim wX wY
ps
  where
    unsealList :: [Sealed2 p] -> FL p wA wB
    unsealList :: forall (p :: * -> * -> *) wA wB. [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 a b. (a -> b -> b) -> b -> [a] -> b
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 p wX wY -> p wA wA
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)

    withPathAsKey :: Sealed2 Prim -> Maybe (AnchoredPath, Sealed2 Prim)
    withPathAsKey :: Sealed2 Prim -> Maybe (AnchoredPath, Sealed2 Prim)
withPathAsKey (Sealed2 Prim wX wY
p) = (AnchoredPath -> (AnchoredPath, Sealed2 Prim))
-> Maybe AnchoredPath -> Maybe (AnchoredPath, Sealed2 Prim)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (, Prim wX wY -> Sealed2 Prim
forall (a :: * -> * -> *) wX wY. a wX wY -> Sealed2 a
Sealed2 Prim wX wY
p) (Maybe AnchoredPath -> Maybe (AnchoredPath, Sealed2 Prim))
-> Maybe AnchoredPath -> Maybe (AnchoredPath, Sealed2 Prim)
forall a b. (a -> b) -> a -> b
$ Prim wX wY -> Maybe AnchoredPath
forall {wX} {wY}. Prim wX wY -> Maybe AnchoredPath
getKey Prim wX wY
p

    getKey :: Prim wX wY -> Maybe AnchoredPath
getKey (FP AnchoredPath
fp FilePatchType wX wY
_) = AnchoredPath -> Maybe AnchoredPath
forall a. a -> Maybe a
Just AnchoredPath
fp
    getKey (DP AnchoredPath
fp DirPatchType wX wY
AddDir) = AnchoredPath -> Maybe AnchoredPath
forall a. a -> Maybe a
Just AnchoredPath
fp
    getKey (DP AnchoredPath
_ DirPatchType wX wY
RmDir) = Maybe AnchoredPath
forall a. Maybe a
Nothing -- ordering is trickier with rmdir present
    getKey (Move {}) = Maybe AnchoredPath
forall a. Maybe a
Nothing
    getKey (ChangePref {}) = AnchoredPath -> Maybe AnchoredPath
forall a. a -> Maybe a
Just (HasCallStack => FilePath -> AnchoredPath
FilePath -> AnchoredPath
unsafeFloatPath (FilePath
darcsdir FilePath -> FilePath -> FilePath
</> FilePath
"prefs" FilePath -> FilePath -> FilePath
</> FilePath
"prefs"))

-- | @'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 :: 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 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
coalescePair (ChangePref FilePath
p FilePath
a FilePath
b) (ChangePref FilePath
p' FilePath
b' FilePath
c)
  | FilePath
p FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
p' Bool -> Bool -> Bool
&& FilePath
b FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
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
$ FilePath -> FilePath -> FilePath -> Prim wX wZ
forall wX wY. FilePath -> FilePath -> FilePath -> Prim wX wY
ChangePref FilePath
p FilePath
a FilePath
c
coalescePair Prim wX wY
_ Prim wY wZ
_ = Maybe (Prim wX wZ)
forall a. Maybe a
Nothing

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)
    = 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 AddFile or before RmFile
-- is an identity patch, as far as coalescing is concerned.
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 FilePath
t1 FilePath
a FilePath
b) (TokReplace FilePath
t2 FilePath
b' FilePath
c)
    | FilePath
t1 FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
t2 Bool -> Bool -> Bool
&& FilePath
b FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
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
$ FilePath -> FilePath -> FilePath -> FilePatchType wX wZ
forall wX wY.
FilePath -> FilePath -> FilePath -> FilePatchType wX wY
TokReplace FilePath
t1 FilePath
a FilePath
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

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 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 a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
old2
          lengthnew1 :: Int
lengthnew1 = [ByteString] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
new1

instance PrimCoalesce Prim where
  tryToShrink :: forall wX wY. FL Prim wX wY -> Maybe (FL Prim wX wY)
tryToShrink = (Any, FL Prim wX wY) -> Maybe (FL Prim wX wY)
forall a. (Any, a) -> Maybe a
withAnyToMaybe ((Any, FL Prim wX wY) -> Maybe (FL Prim wX wY))
-> (FL Prim wX wY -> (Any, FL Prim wX wY))
-> FL Prim wX wY
-> Maybe (FL Prim wX wY)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall wA wB. FL Prim wA wB -> (Any, FL Prim wA wB))
-> FL Prim wX wY -> (Any, FL Prim wX wY)
forall (m :: * -> *) wX wY.
Monad m =>
(forall wA wB. FL Prim wA wB -> m (FL Prim wA wB))
-> FL Prim wX wY -> m (FL Prim wX wY)
mapPrimFL FL Prim wA wB -> (Any, FL Prim wA wB)
forall wA wB. FL Prim wA wB -> (Any, FL Prim wA wB)
forall (prim :: * -> * -> *) wX wY.
PrimCoalesce prim =>
FL prim wX wY -> (Any, FL prim wX wY)
sortCoalesceFL2

  sortCoalesceFL :: forall wX wY. FL Prim wX wY -> FL Prim wX wY
sortCoalesceFL = (Any, FL Prim wX wY) -> FL Prim wX wY
forall a b. (a, b) -> b
snd ((Any, FL Prim wX wY) -> FL Prim wX wY)
-> (FL Prim wX wY -> (Any, FL Prim wX wY))
-> FL Prim wX wY
-> FL Prim wX wY
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall wA wB. FL Prim wA wB -> (Any, FL Prim wA wB))
-> FL Prim wX wY -> (Any, FL Prim wX wY)
forall (m :: * -> *) wX wY.
Monad m =>
(forall wA wB. FL Prim wA wB -> m (FL Prim wA wB))
-> FL Prim wX wY -> m (FL Prim wX wY)
mapPrimFL FL Prim wA wB -> (Any, FL Prim wA wB)
forall wA wB. FL Prim wA wB -> (Any, FL Prim wA wB)
forall (prim :: * -> * -> *) wX wY.
PrimCoalesce prim =>
FL prim wX wY -> (Any, FL prim wX wY)
sortCoalesceFL2

  primCoalesce :: forall wX wY wZ. 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

  isIdentity :: forall wX wY. Prim wX wY -> EqCheck wX wY
isIdentity (FP AnchoredPath
_ (Binary ByteString
old ByteString
new)) | ByteString
old ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
new = EqCheck Any Any -> EqCheck wX wY
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP EqCheck Any Any
forall wA. EqCheck wA wA
IsEq
  isIdentity (FP AnchoredPath
_ (Hunk Int
_ [ByteString]
old [ByteString]
new)) | [ByteString]
old [ByteString] -> [ByteString] -> Bool
forall a. Eq a => a -> a -> Bool
== [ByteString]
new = EqCheck Any Any -> EqCheck wX wY
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP EqCheck Any Any
forall wA. EqCheck wA wA
IsEq
  isIdentity (FP AnchoredPath
_ (TokReplace FilePath
_ FilePath
old FilePath
new)) | FilePath
old FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
new = EqCheck Any Any -> EqCheck wX wY
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP EqCheck Any Any
forall wA. EqCheck wA wA
IsEq
  isIdentity (Move AnchoredPath
old AnchoredPath
new) | AnchoredPath
old AnchoredPath -> AnchoredPath -> Bool
forall a. Eq a => a -> a -> Bool
== AnchoredPath
new = EqCheck Any Any -> EqCheck wX wY
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP EqCheck Any Any
forall wA. EqCheck wA wA
IsEq
  isIdentity Prim wX wY
_ = EqCheck wX wY
forall wA wB. EqCheck wA wB
NotEq

  -- Basically, identical patches are equal and
  -- @Move < DP < FP < ChangePref@.
  -- Everything else is compared in dictionary order of its arguments.
  comparePrim :: forall wA wB wC wD. Prim wA wB -> Prim wC wD -> Ordering
comparePrim (Move AnchoredPath
a AnchoredPath
b) (Move AnchoredPath
c AnchoredPath
d) = (AnchoredPath, AnchoredPath)
-> (AnchoredPath, AnchoredPath) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (AnchoredPath
a, AnchoredPath
b) (AnchoredPath
c, AnchoredPath
d)
  comparePrim (Move AnchoredPath
_ AnchoredPath
_) Prim wC wD
_ = Ordering
LT
  comparePrim Prim wA wB
_ (Move AnchoredPath
_ AnchoredPath
_) = Ordering
GT
  comparePrim (DP AnchoredPath
d1 DirPatchType wA wB
p1) (DP AnchoredPath
d2 DirPatchType wC wD
p2) = (AnchoredPath, DirPatchType wA wB)
-> (AnchoredPath, DirPatchType wA wB) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (AnchoredPath
d1, DirPatchType wA wB
p1) ((AnchoredPath, DirPatchType wA wB) -> Ordering)
-> (AnchoredPath, DirPatchType wA wB) -> Ordering
forall a b. (a -> b) -> a -> b
$ (AnchoredPath, DirPatchType wC wD)
-> (AnchoredPath, DirPatchType wA wB)
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP (AnchoredPath
d2, DirPatchType wC wD
p2)
  comparePrim (DP AnchoredPath
_ DirPatchType wA wB
_) Prim wC wD
_ = Ordering
LT
  comparePrim Prim wA wB
_ (DP AnchoredPath
_ DirPatchType wC wD
_) = Ordering
GT
  comparePrim (FP AnchoredPath
f1 FilePatchType wA wB
fp1) (FP AnchoredPath
f2 FilePatchType wC wD
fp2) =
    (AnchoredPath, FilePatchType wA wB)
-> (AnchoredPath, FilePatchType wA wB) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (AnchoredPath
f1, FilePatchType wA wB
fp1) ((AnchoredPath, FilePatchType wA wB) -> Ordering)
-> (AnchoredPath, FilePatchType wA wB) -> Ordering
forall a b. (a -> b) -> a -> b
$ (AnchoredPath, FilePatchType wC wD)
-> (AnchoredPath, FilePatchType wA wB)
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP (AnchoredPath
f2, FilePatchType wC wD
fp2)
  comparePrim (FP AnchoredPath
_ FilePatchType wA wB
_) Prim wC wD
_ = Ordering
LT
  comparePrim Prim wA wB
_ (FP AnchoredPath
_ FilePatchType wC wD
_) = Ordering
GT
  comparePrim (ChangePref FilePath
a1 FilePath
b1 FilePath
c1) (ChangePref FilePath
a2 FilePath
b2 FilePath
c2) =
    (FilePath, FilePath, FilePath)
-> (FilePath, FilePath, FilePath) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (FilePath
c1, FilePath
b1, FilePath
a1) (FilePath
c2, FilePath
b2, FilePath
a2)