{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wno-unused-imports -Werror=name-shadowing #-}
module Test.Syd.Diff
(
Diff,
PolyDiff (..),
getTextDiff,
getStringDiff,
getGroupedStringDiff,
getVectorDiff,
getGroupedVectorDiff,
getVectorDiffBy,
getGroupedVectorDiffBy,
Edit (..),
getEditScript,
getEditScriptBy,
computeDiffFromEditScript,
computeGroupedDiffFromEditScript,
getDiff,
getDiffBy,
getGroupedDiff,
getGroupedDiffBy,
)
where
import Control.Monad
import Control.Monad.ST
import Data.DList (DList)
import qualified Data.DList as DList
import Data.Maybe (fromJust)
import Data.STRef
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Array as TA
import Data.Vector (Vector, (!))
import qualified Data.Vector as V
import Data.Vector.Mutable (MVector)
import qualified Data.Vector.Mutable as MV
type Diff a = PolyDiff a a
mapDiff :: (a -> b) -> Diff a -> Diff b
mapDiff :: forall a b. (a -> b) -> Diff a -> Diff b
mapDiff a -> b
f = forall a c b d.
(a -> c) -> (b -> d) -> PolyDiff a b -> PolyDiff c d
bimapPolyDiff a -> b
f a -> b
f
data PolyDiff a b = First a | Second b | Both a b
deriving (Int -> PolyDiff a b -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> PolyDiff a b -> ShowS
forall a b. (Show a, Show b) => [PolyDiff a b] -> ShowS
forall a b. (Show a, Show b) => PolyDiff a b -> String
showList :: [PolyDiff a b] -> ShowS
$cshowList :: forall a b. (Show a, Show b) => [PolyDiff a b] -> ShowS
show :: PolyDiff a b -> String
$cshow :: forall a b. (Show a, Show b) => PolyDiff a b -> String
showsPrec :: Int -> PolyDiff a b -> ShowS
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> PolyDiff a b -> ShowS
Show, PolyDiff a b -> PolyDiff a b -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => PolyDiff a b -> PolyDiff a b -> Bool
/= :: PolyDiff a b -> PolyDiff a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => PolyDiff a b -> PolyDiff a b -> Bool
== :: PolyDiff a b -> PolyDiff a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => PolyDiff a b -> PolyDiff a b -> Bool
Eq)
bimapPolyDiff :: (a -> c) -> (b -> d) -> PolyDiff a b -> PolyDiff c d
bimapPolyDiff :: forall a c b d.
(a -> c) -> (b -> d) -> PolyDiff a b -> PolyDiff c d
bimapPolyDiff a -> c
f b -> d
g = \case
First a
a -> forall a b. a -> PolyDiff a b
First (a -> c
f a
a)
Second b
b -> forall a b. b -> PolyDiff a b
Second (b -> d
g b
b)
Both a
a b
b -> forall a b. a -> b -> PolyDiff a b
Both (a -> c
f a
a) (b -> d
g b
b)
getDiff :: Eq a => [a] -> [a] -> [Diff a]
getDiff :: forall a. Eq a => [a] -> [a] -> [Diff a]
getDiff = forall a b. (a -> b -> Bool) -> [a] -> [b] -> [PolyDiff a b]
getDiffBy forall a. Eq a => a -> a -> Bool
(==)
getDiffBy :: (a -> b -> Bool) -> [a] -> [b] -> [PolyDiff a b]
getDiffBy :: forall a b. (a -> b -> Bool) -> [a] -> [b] -> [PolyDiff a b]
getDiffBy a -> b -> Bool
eq [a]
as [b]
bs = forall a. Vector a -> [a]
V.toList (forall a b.
(a -> b -> Bool) -> Vector a -> Vector b -> Vector (PolyDiff a b)
getVectorDiffBy a -> b -> Bool
eq (forall a. [a] -> Vector a
V.fromList [a]
as) (forall a. [a] -> Vector a
V.fromList [b]
bs))
getGroupedDiff :: Eq a => [a] -> [a] -> [Diff [a]]
getGroupedDiff :: forall a. Eq a => [a] -> [a] -> [Diff [a]]
getGroupedDiff = forall a b. (a -> b -> Bool) -> [a] -> [b] -> [PolyDiff [a] [b]]
getGroupedDiffBy forall a. Eq a => a -> a -> Bool
(==)
getGroupedDiffBy :: (a -> b -> Bool) -> [a] -> [b] -> [PolyDiff [a] [b]]
getGroupedDiffBy :: forall a b. (a -> b -> Bool) -> [a] -> [b] -> [PolyDiff [a] [b]]
getGroupedDiffBy a -> b -> Bool
eq [a]
as [b]
bs = forall a. Vector a -> [a]
V.toList (forall a b. (a -> b) -> Vector a -> Vector b
V.map (forall a c b d.
(a -> c) -> (b -> d) -> PolyDiff a b -> PolyDiff c d
bimapPolyDiff forall a. Vector a -> [a]
V.toList forall a. Vector a -> [a]
V.toList) (forall a b.
(a -> b -> Bool)
-> Vector a -> Vector b -> Vector (PolyDiff (Vector a) (Vector b))
getGroupedVectorDiffBy a -> b -> Bool
eq (forall a. [a] -> Vector a
V.fromList [a]
as) (forall a. [a] -> Vector a
V.fromList [b]
bs)))
getTextDiff :: Text -> Text -> Vector (Diff Text)
getTextDiff :: Text -> Text -> Vector (Diff Text)
getTextDiff Text
expected Text
actual = forall a b. (a -> b) -> Vector a -> Vector b
V.map (forall a b. (a -> b) -> Diff a -> Diff b
mapDiff Vector Char -> Text
packFromVector) forall a b. (a -> b) -> a -> b
$ forall a. Eq a => Vector a -> Vector a -> Vector (Diff (Vector a))
getGroupedVectorDiff (Text -> Vector Char
unpackToVector Text
expected) (Text -> Vector Char
unpackToVector Text
actual)
where
packFromVector :: Vector Char -> Text
packFromVector :: Vector Char -> Text
packFromVector = String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Vector a -> [a]
V.toList
unpackToVector :: Text -> Vector Char
unpackToVector :: Text -> Vector Char
unpackToVector = forall a. [a] -> Vector a
V.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
getStringDiff :: String -> String -> [Diff Char]
getStringDiff :: String -> String -> [Diff Char]
getStringDiff String
actual String
expected = forall a. Vector a -> [a]
V.toList (forall a. Eq a => Vector a -> Vector a -> Vector (Diff a)
getVectorDiff (forall a. [a] -> Vector a
V.fromList String
actual) (forall a. [a] -> Vector a
V.fromList String
expected))
getGroupedStringDiff :: String -> String -> [Diff String]
getGroupedStringDiff :: String -> String -> [Diff String]
getGroupedStringDiff String
actual String
expected = forall a. Vector a -> [a]
V.toList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> Vector a -> Vector b
V.map (forall a b. (a -> b) -> Diff a -> Diff b
mapDiff forall a. Vector a -> [a]
V.toList) forall a b. (a -> b) -> a -> b
$ forall a. Eq a => Vector a -> Vector a -> Vector (Diff (Vector a))
getGroupedVectorDiff (forall a. [a] -> Vector a
V.fromList String
actual) (forall a. [a] -> Vector a
V.fromList String
expected)
getVectorDiff :: Eq a => Vector a -> Vector a -> Vector (Diff a)
getVectorDiff :: forall a. Eq a => Vector a -> Vector a -> Vector (Diff a)
getVectorDiff = forall a b.
(a -> b -> Bool) -> Vector a -> Vector b -> Vector (PolyDiff a b)
getVectorDiffBy forall a. Eq a => a -> a -> Bool
(==)
getVectorDiffBy :: forall a b. (a -> b -> Bool) -> Vector a -> Vector b -> Vector (PolyDiff a b)
getVectorDiffBy :: forall a b.
(a -> b -> Bool) -> Vector a -> Vector b -> Vector (PolyDiff a b)
getVectorDiffBy a -> b -> Bool
eq Vector a
old Vector b
new = forall a b.
Vector a -> Vector b -> Vector Edit -> Vector (PolyDiff a b)
computeDiffFromEditScript Vector a
old Vector b
new (forall a b. (a -> b -> Bool) -> Vector a -> Vector b -> Vector Edit
getEditScriptBy a -> b -> Bool
eq Vector a
old Vector b
new)
getGroupedVectorDiff :: Eq a => Vector a -> Vector a -> Vector (Diff (Vector a))
getGroupedVectorDiff :: forall a. Eq a => Vector a -> Vector a -> Vector (Diff (Vector a))
getGroupedVectorDiff = forall a b.
(a -> b -> Bool)
-> Vector a -> Vector b -> Vector (PolyDiff (Vector a) (Vector b))
getGroupedVectorDiffBy forall a. Eq a => a -> a -> Bool
(==)
getGroupedVectorDiffBy :: forall a b. (a -> b -> Bool) -> Vector a -> Vector b -> Vector (PolyDiff (Vector a) (Vector b))
getGroupedVectorDiffBy :: forall a b.
(a -> b -> Bool)
-> Vector a -> Vector b -> Vector (PolyDiff (Vector a) (Vector b))
getGroupedVectorDiffBy a -> b -> Bool
eq Vector a
old Vector b
new = forall a b.
Vector a
-> Vector b
-> Vector Edit
-> Vector (PolyDiff (Vector a) (Vector b))
computeGroupedDiffFromEditScript Vector a
old Vector b
new (forall a b. (a -> b -> Bool) -> Vector a -> Vector b -> Vector Edit
getEditScriptBy a -> b -> Bool
eq Vector a
old Vector b
new)
getEditScript :: forall a. Eq a => Vector a -> Vector a -> Vector Edit
getEditScript :: forall a. Eq a => Vector a -> Vector a -> Vector Edit
getEditScript = forall a b. (a -> b -> Bool) -> Vector a -> Vector b -> Vector Edit
getEditScriptBy forall a. Eq a => a -> a -> Bool
(==)
getEditScriptBy :: forall a b. (a -> b -> Bool) -> Vector a -> Vector b -> Vector Edit
getEditScriptBy :: forall a b. (a -> b -> Bool) -> Vector a -> Vector b -> Vector Edit
getEditScriptBy a -> b -> Bool
eq Vector a
old Vector b
new = forall a. [a] -> Vector a
V.fromList forall a b. (a -> b) -> a -> b
$ forall a. DList a -> [a]
DList.toList forall a b. (a -> b) -> a -> b
$ forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ forall s. Vector a -> Vector b -> Int -> Int -> ST s (DList Edit)
go Vector a
old Vector b
new Int
0 Int
0
where
go :: forall s. Vector a -> Vector b -> Int -> Int -> ST s (DList Edit)
go :: forall s. Vector a -> Vector b -> Int -> Int -> ST s (DList Edit)
go Vector a
e Vector b
f Int
i Int
j = do
let upperN :: Int
upperN :: Int
upperN = forall a. Vector a -> Int
V.length Vector a
e
let upperM :: Int
upperM :: Int
upperM = forall a. Vector a -> Int
V.length Vector b
f
let upperL :: Int
upperL :: Int
upperL = Int
upperN forall a. Num a => a -> a -> a
+ Int
upperM
let upperZ :: Int
upperZ :: Int
upperZ = Int
2 forall a. Num a => a -> a -> a
* forall a. Ord a => a -> a -> a
min Int
upperN Int
upperM forall a. Num a => a -> a -> a
+ Int
2
if Int
upperN forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
upperM forall a. Ord a => a -> a -> Bool
> Int
0
then do
let w :: Int
w :: Int
w = Int
upperN forall a. Num a => a -> a -> a
- Int
upperM
MVector s Int
g <- forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MVector (PrimState m) a)
MV.replicate Int
upperZ Int
0 :: ST s (MVector s Int)
MVector s Int
p <- forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MVector (PrimState m) a)
MV.replicate Int
upperZ Int
0 :: ST s (MVector s Int)
let hs :: [Int]
hs :: [Int]
hs = [Int
0 .. ((Int
upperL forall a. Integral a => a -> a -> a
`quot` Int
2) forall a. Num a => a -> a -> a
+ (if forall a. Integral a => a -> Bool
odd Int
upperL then Int
1 else Int
0))]
Maybe (DList Edit)
mResult <- forall (m :: * -> *) a b.
Monad m =>
[a] -> (a -> m (Maybe b)) -> m (Maybe b)
forUntilJust [Int]
hs forall a b. (a -> b) -> a -> b
$ \Int
h -> do
forall (m :: * -> *) a b.
Monad m =>
[a] -> (a -> m (Maybe b)) -> m (Maybe b)
forUntilJust [Int
0, Int
1 :: Int] forall a b. (a -> b) -> a -> b
$ \Int
r -> do
let (MVector s Int
c, MVector s Int
d, Int
o, Int
m) = if Int
r forall a. Eq a => a -> a -> Bool
== Int
0 then (MVector s Int
g, MVector s Int
p, Int
1, Int
1) else (MVector s Int
p, MVector s Int
g, Int
0, -Int
1)
let lo :: Int
lo :: Int
lo = -(Int
h forall a. Num a => a -> a -> a
- Int
2 forall a. Num a => a -> a -> a
* forall a. Ord a => a -> a -> a
max Int
0 (Int
h forall a. Num a => a -> a -> a
- Int
upperM))
let hi :: Int
hi :: Int
hi = Int
h forall a. Num a => a -> a -> a
- Int
2 forall a. Num a => a -> a -> a
* forall a. Ord a => a -> a -> a
max Int
0 (Int
h forall a. Num a => a -> a -> a
- Int
upperN)
let ks :: [Int]
ks :: [Int]
ks = [Int
lo, Int
lo forall a. Num a => a -> a -> a
+ Int
2 .. Int
hi]
forall (m :: * -> *) a b.
Monad m =>
[a] -> (a -> m (Maybe b)) -> m (Maybe b)
forUntilJust [Int]
ks forall a b. (a -> b) -> a -> b
$ \Int
k -> do
Int
initAVal <- do
let part1 :: Bool
part1 = Int
k forall a. Eq a => a -> a -> Bool
== -Int
h
let part2 :: Bool
part2 = Int
k forall a. Eq a => a -> a -> Bool
/= Int
h
let kp1Ix :: Int
kp1Ix = (Int
k forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
`modPortable` Int
upperZ
let km1Ix :: Int
km1Ix = (Int
k forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
`modPortable` Int
upperZ
if Bool
part1
then forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m a
MV.unsafeRead MVector s Int
c Int
kp1Ix
else do
if Bool
part2
then do
Int
km1 <- forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m a
MV.unsafeRead MVector s Int
c Int
km1Ix
Int
kp1 <- forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m a
MV.unsafeRead MVector s Int
c Int
kp1Ix
let part3 :: Bool
part3 = Int
km1 forall a. Ord a => a -> a -> Bool
< Int
kp1
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
if Bool
part3
then Int
kp1
else Int
km1 forall a. Num a => a -> a -> a
+ Int
1
else do
Int
km1 <- forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m a
MV.unsafeRead MVector s Int
c Int
km1Ix
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Int
km1 forall a. Num a => a -> a -> a
+ Int
1
STRef s Int
a <- forall a s. a -> ST s (STRef s a)
newSTRef Int
initAVal
let initBVal :: Int
initBVal :: Int
initBVal = Int
initAVal forall a. Num a => a -> a -> a
- Int
k
STRef s Int
b <- forall a s. a -> ST s (STRef s a)
newSTRef Int
initBVal
STRef s Int
s <- forall a s. a -> ST s (STRef s a)
newSTRef Int
initAVal
STRef s Int
t <- forall a s. a -> ST s (STRef s a)
newSTRef Int
initBVal
let computeWhileCond :: ST s Bool
computeWhileCond = do
Int
aVal <- forall s a. STRef s a -> ST s a
readSTRef STRef s Int
a
let part1 :: Bool
part1 = Int
aVal forall a. Ord a => a -> a -> Bool
< Int
upperN
if Bool
part1
then do
Int
bVal <- forall s a. STRef s a -> ST s a
readSTRef STRef s Int
b
let part2 :: Bool
part2 = Int
bVal forall a. Ord a => a -> a -> Bool
< Int
upperM
let mkPart3 :: ST s Bool
mkPart3 = do
let imo :: Int
imo = Int
1 forall a. Num a => a -> a -> a
- Int
o
omi :: Int
omi = Int
o forall a. Num a => a -> a -> a
- Int
1
a
leftVal <- do
let ix :: Int
ix = Int
imo forall a. Num a => a -> a -> a
* Int
upperN forall a. Num a => a -> a -> a
+ Int
m forall a. Num a => a -> a -> a
* Int
aVal forall a. Num a => a -> a -> a
+ Int
omi
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Vector a
e forall a. Vector a -> Int -> a
! Int
ix
b
rightVal <- do
let ix :: Int
ix = Int
imo forall a. Num a => a -> a -> a
* Int
upperM forall a. Num a => a -> a -> a
+ Int
m forall a. Num a => a -> a -> a
* Int
bVal forall a. Num a => a -> a -> a
+ Int
omi
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Vector b
f forall a. Vector a -> Int -> a
! Int
ix
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ a
leftVal a -> b -> Bool
`eq` b
rightVal
Bool
part2 forall (m :: * -> *). Applicative m => Bool -> m Bool -> m Bool
&&. ST s Bool
mkPart3
else forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m ()
whileM_ ST s Bool
computeWhileCond forall a b. (a -> b) -> a -> b
$ do
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Int
a (forall a. Num a => a -> a -> a
+ Int
1)
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Int
b (forall a. Num a => a -> a -> a
+ Int
1)
do
Int
aVal <- forall s a. STRef s a -> ST s a
readSTRef STRef s Int
a
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
MV.unsafeWrite MVector s Int
c (Int
k Int -> Int -> Int
`modPortable` Int
upperZ) Int
aVal
let z :: Int
z = -(Int
k forall a. Num a => a -> a -> a
- Int
w)
let
part1 :: Bool
part1 = Int
upperL forall a. Integral a => a -> a -> a
`rem` Int
2 forall a. Eq a => a -> a -> Bool
== Int
o
hmo :: Int
hmo = Int
h forall a. Num a => a -> a -> a
- Int
o
part2 :: Bool
part2 = Int
z forall a. Ord a => a -> a -> Bool
>= -Int
hmo
part3 :: Bool
part3 = Int
z forall a. Ord a => a -> a -> Bool
<= Int
hmo
mkPart4 :: ST s Bool
mkPart4 = do
Int
ck <- forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m a
MV.unsafeRead MVector s Int
c (Int
k Int -> Int -> Int
`modPortable` Int
upperZ)
Int
dz <- forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m a
MV.unsafeRead MVector s Int
d (Int
z Int -> Int -> Int
`modPortable` Int
upperZ)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
ck forall a. Num a => a -> a -> a
+ Int
dz forall a. Ord a => a -> a -> Bool
>= Int
upperN)
mkCondition :: ST s Bool
mkCondition = Bool
part1 forall (m :: * -> *). Applicative m => Bool -> m Bool -> m Bool
&&. (Bool
part2 forall (m :: * -> *). Applicative m => Bool -> m Bool -> m Bool
&&. (Bool
part3 forall (m :: * -> *). Applicative m => Bool -> m Bool -> m Bool
&&. ST s Bool
mkPart4))
Bool
condition <- ST s Bool
mkCondition
if Bool
condition
then do
(Int
upperD, Int
x, Int
y, Int
u, Int
v) <- do
Int
aVal <- forall s a. STRef s a -> ST s a
readSTRef STRef s Int
a
Int
bVal <- forall s a. STRef s a -> ST s a
readSTRef STRef s Int
b
Int
sVal <- forall s a. STRef s a -> ST s a
readSTRef STRef s Int
s
Int
tVal <- forall s a. STRef s a -> ST s a
readSTRef STRef s Int
t
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
if Int
o forall a. Eq a => a -> a -> Bool
== Int
1
then (Int
2 forall a. Num a => a -> a -> a
* Int
h forall a. Num a => a -> a -> a
- Int
1, Int
sVal, Int
tVal, Int
aVal, Int
bVal)
else (Int
2 forall a. Num a => a -> a -> a
* Int
h, Int
upperN forall a. Num a => a -> a -> a
- Int
aVal, Int
upperM forall a. Num a => a -> a -> a
- Int
bVal, Int
upperN forall a. Num a => a -> a -> a
- Int
sVal, Int
upperM forall a. Num a => a -> a -> a
- Int
tVal)
if Int
upperD forall a. Ord a => a -> a -> Bool
> Int
1 Bool -> Bool -> Bool
|| (Int
x forall a. Eq a => a -> a -> Bool
/= Int
u Bool -> Bool -> Bool
&& Int
y forall a. Eq a => a -> a -> Bool
/= Int
v)
then do
DList Edit
firstHalf <- forall s. Vector a -> Vector b -> Int -> Int -> ST s (DList Edit)
go (forall a. Int -> Int -> Vector a -> Vector a
V.slice Int
0 Int
x Vector a
e) (forall a. Int -> Int -> Vector a -> Vector a
V.slice Int
0 Int
y Vector b
f) Int
i Int
j
DList Edit
secondHalf <- forall s. Vector a -> Vector b -> Int -> Int -> ST s (DList Edit)
go (forall a. Int -> Int -> Vector a -> Vector a
sliceIx Int
u Int
upperN Vector a
e) (forall a. Int -> Int -> Vector a -> Vector a
sliceIx Int
v Int
upperM Vector b
f) (Int
i forall a. Num a => a -> a -> a
+ Int
u) (Int
j forall a. Num a => a -> a -> a
+ Int
v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just (DList Edit
firstHalf forall a. Semigroup a => a -> a -> a
<> DList Edit
secondHalf))
else
if Int
upperM forall a. Ord a => a -> a -> Bool
> Int
upperN
then do
forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Vector a -> Vector b -> Int -> Int -> ST s (DList Edit)
go forall a. Vector a
V.empty (forall a. Int -> Int -> Vector a -> Vector a
sliceIx Int
upperN Int
upperM Vector b
f) (Int
i forall a. Num a => a -> a -> a
+ Int
upperN) (Int
j forall a. Num a => a -> a -> a
+ Int
upperN)
else
if Int
upperM forall a. Ord a => a -> a -> Bool
< Int
upperN
then do
forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Vector a -> Vector b -> Int -> Int -> ST s (DList Edit)
go (forall a. Int -> Int -> Vector a -> Vector a
sliceIx Int
upperM Int
upperN Vector a
e) forall a. Vector a
V.empty (Int
i forall a. Num a => a -> a -> a
+ Int
upperM) (Int
j forall a. Num a => a -> a -> a
+ Int
upperM)
else
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just forall a. Monoid a => a
mempty)
else forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
case Maybe (DList Edit)
mResult of
Maybe (DList Edit)
Nothing -> forall a. HasCallStack => String -> a
error String
"Test.Syd.Diff: This is a bug, the diffing algorithm was supposed to terminate and it didn't."
Just DList Edit
result -> forall (f :: * -> *) a. Applicative f => a -> f a
pure DList Edit
result
else do
if Int
upperN forall a. Ord a => a -> a -> Bool
> Int
0
then do
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> DList a
DList.singleton (Int -> Int -> Edit
Delete Int
i Int
upperN)
else do
if Int
upperM forall a. Ord a => a -> a -> Bool
> Int
0
then do
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> DList a
DList.singleton (Int -> Int -> Int -> Edit
Insert Int
i Int
j Int
upperM)
else do
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. DList a
DList.empty
computeGroupedDiffFromEditScript :: Vector a -> Vector b -> Vector Edit -> Vector (PolyDiff (Vector a) (Vector b))
computeGroupedDiffFromEditScript :: forall a b.
Vector a
-> Vector b
-> Vector Edit
-> Vector (PolyDiff (Vector a) (Vector b))
computeGroupedDiffFromEditScript Vector a
old Vector b
new Vector Edit
editSteps = forall a. (forall s. ST s (MVector s a)) -> Vector a
V.create forall a b. (a -> b) -> a -> b
$ do
let size :: Int
size = forall (t :: * -> *) a. Foldable t => t a -> Int
length Vector Edit
editSteps forall a. Num a => a -> a -> a
* Int
2 forall a. Num a => a -> a -> a
+ Int
1
MVector s (PolyDiff (Vector a) (Vector b))
v <- forall (m :: * -> *) a.
PrimMonad m =>
Int -> m (MVector (PrimState m) a)
MV.new Int
size
STRef s Int
groupMarker <- forall a s. a -> ST s (STRef s a)
newSTRef Int
0
STRef s Int
oldMarker <- forall a s. a -> ST s (STRef s a)
newSTRef Int
0
STRef s Int
curMarker <- forall a s. a -> ST s (STRef s a)
newSTRef Int
0
STRef s Int
newMarker <- forall a s. a -> ST s (STRef s a)
newSTRef Int
0
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Vector Edit
editSteps forall a b. (a -> b) -> a -> b
$ \Edit
editStep -> do
Int
inbetweenIx <- forall s a. STRef s a -> ST s a
readSTRef STRef s Int
oldMarker
let inbetweenLen :: Int
inbetweenLen = Edit -> Int
oldPosition Edit
editStep forall a. Num a => a -> a -> a
- Int
inbetweenIx
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
inbetweenLen forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$ do
Int
groupIx <- forall s a. STRef s a -> ST s a
readSTRef STRef s Int
groupMarker
Int
oldIx <- forall s a. STRef s a -> ST s a
readSTRef STRef s Int
oldMarker
Int
newIx <- forall s a. STRef s a -> ST s a
readSTRef STRef s Int
newMarker
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
MV.unsafeWrite MVector s (PolyDiff (Vector a) (Vector b))
v Int
groupIx (forall a b. a -> b -> PolyDiff a b
Both (forall a. Int -> Int -> Vector a -> Vector a
V.slice Int
oldIx Int
inbetweenLen Vector a
old) (forall a. Int -> Int -> Vector a -> Vector a
V.slice Int
newIx Int
inbetweenLen Vector b
new))
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Int
groupMarker (forall a. Num a => a -> a -> a
+ Int
1)
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Int
oldMarker (forall a. Num a => a -> a -> a
+ Int
inbetweenLen)
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Int
curMarker (forall a. Num a => a -> a -> a
+ Int
inbetweenLen)
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Int
newMarker (forall a. Num a => a -> a -> a
+ Int
inbetweenLen)
case Edit
editStep of
Delete Int
oldPosStart Int
upperN -> do
Int
groupIx <- forall s a. STRef s a -> ST s a
readSTRef STRef s Int
groupMarker
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
MV.unsafeWrite MVector s (PolyDiff (Vector a) (Vector b))
v Int
groupIx (forall a b. a -> PolyDiff a b
First (forall a. Int -> Int -> Vector a -> Vector a
V.slice Int
oldPosStart Int
upperN Vector a
old))
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Int
groupMarker (forall a. Num a => a -> a -> a
+ Int
1)
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Int
oldMarker (forall a. Num a => a -> a -> a
+ Int
upperN)
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Int
curMarker (forall a. Num a => a -> a -> a
+ Int
upperN)
Insert Int
_ Int
newPosStart Int
upperM -> do
Int
groupIx <- forall s a. STRef s a -> ST s a
readSTRef STRef s Int
groupMarker
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
MV.unsafeWrite MVector s (PolyDiff (Vector a) (Vector b))
v Int
groupIx (forall a b. b -> PolyDiff a b
Second (forall a. Int -> Int -> Vector a -> Vector a
V.slice Int
newPosStart Int
upperM Vector b
new))
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Int
groupMarker (forall a. Num a => a -> a -> a
+ Int
1)
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Int
curMarker (forall a. Num a => a -> a -> a
+ Int
upperM)
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Int
newMarker (forall a. Num a => a -> a -> a
+ Int
upperM)
Int
oldIx <- forall s a. STRef s a -> ST s a
readSTRef STRef s Int
oldMarker
let afterLen :: Int
afterLen = forall a. Vector a -> Int
V.length Vector a
old forall a. Num a => a -> a -> a
- Int
oldIx
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
afterLen forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$ do
Int
newIx <- forall s a. STRef s a -> ST s a
readSTRef STRef s Int
newMarker
Int
groupIx <- forall s a. STRef s a -> ST s a
readSTRef STRef s Int
groupMarker
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
MV.unsafeWrite MVector s (PolyDiff (Vector a) (Vector b))
v Int
groupIx (forall a b. a -> b -> PolyDiff a b
Both (forall a. Int -> Int -> Vector a -> Vector a
V.slice Int
oldIx Int
afterLen Vector a
old) (forall a. Int -> Int -> Vector a -> Vector a
V.slice Int
newIx Int
afterLen Vector b
new))
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Int
groupMarker (forall a. Num a => a -> a -> a
+ Int
1)
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Int
oldMarker (forall a. Num a => a -> a -> a
+ Int
1)
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Int
curMarker (forall a. Num a => a -> a -> a
+ Int
1)
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Int
newMarker (forall a. Num a => a -> a -> a
+ Int
1)
Int
endGroupIx <- forall s a. STRef s a -> ST s a
readSTRef STRef s Int
groupMarker
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall s a. Int -> Int -> MVector s a -> MVector s a
MV.slice Int
0 Int
endGroupIx MVector s (PolyDiff (Vector a) (Vector b))
v)
computeDiffFromEditScript :: Vector a -> Vector b -> Vector Edit -> Vector (PolyDiff a b)
computeDiffFromEditScript :: forall a b.
Vector a -> Vector b -> Vector Edit -> Vector (PolyDiff a b)
computeDiffFromEditScript Vector a
old Vector b
new Vector Edit
editSteps = forall a. (forall s. ST s (MVector s a)) -> Vector a
V.create forall a b. (a -> b) -> a -> b
$ do
let totalSize :: Int
totalSize = forall a. Vector a -> Int
V.length Vector a
old forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a b. (a -> b) -> Vector a -> Vector b
V.map Edit -> Int
insertLength Vector Edit
editSteps)
MVector s (PolyDiff a b)
v <- forall (m :: * -> *) a.
PrimMonad m =>
Int -> m (MVector (PrimState m) a)
MV.new Int
totalSize
STRef s Int
oldMarker <- forall a s. a -> ST s (STRef s a)
newSTRef Int
0
STRef s Int
curMarker <- forall a s. a -> ST s (STRef s a)
newSTRef Int
0
STRef s Int
newMarker <- forall a s. a -> ST s (STRef s a)
newSTRef Int
0
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Vector Edit
editSteps forall a b. (a -> b) -> a -> b
$ \Edit
editStep -> do
let computeWhileCond1 :: ST s Bool
computeWhileCond1 = do
Int
oldIx <- forall s a. STRef s a -> ST s a
readSTRef STRef s Int
oldMarker
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Edit -> Int
oldPosition Edit
editStep forall a. Ord a => a -> a -> Bool
> Int
oldIx
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m ()
whileM_ ST s Bool
computeWhileCond1 forall a b. (a -> b) -> a -> b
$ do
Int
oldIx <- forall s a. STRef s a -> ST s a
readSTRef STRef s Int
oldMarker
Int
curIx <- forall s a. STRef s a -> ST s a
readSTRef STRef s Int
curMarker
Int
newIx <- forall s a. STRef s a -> ST s a
readSTRef STRef s Int
newMarker
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
MV.unsafeWrite MVector s (PolyDiff a b)
v Int
curIx (forall a b. a -> b -> PolyDiff a b
Both (Vector a
old forall a. Vector a -> Int -> a
! Int
oldIx) (Vector b
new forall a. Vector a -> Int -> a
! Int
newIx))
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Int
oldMarker (forall a. Num a => a -> a -> a
+ Int
1)
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Int
curMarker (forall a. Num a => a -> a -> a
+ Int
1)
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Int
newMarker (forall a. Num a => a -> a -> a
+ Int
1)
case Edit
editStep of
Delete Int
oldPosStart Int
upperN -> do
Int
curIx <- forall s a. STRef s a -> ST s a
readSTRef STRef s Int
curMarker
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0 .. Int
upperN forall a. Num a => a -> a -> a
- Int
1] forall a b. (a -> b) -> a -> b
$ \Int
n -> do
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
MV.unsafeWrite MVector s (PolyDiff a b)
v (Int
curIx forall a. Num a => a -> a -> a
+ Int
n) (forall a b. a -> PolyDiff a b
First (Vector a
old forall a. Vector a -> Int -> a
! (Int
oldPosStart forall a. Num a => a -> a -> a
+ Int
n)))
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Int
oldMarker (forall a. Num a => a -> a -> a
+ Int
upperN)
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Int
curMarker (forall a. Num a => a -> a -> a
+ Int
upperN)
Insert Int
_ Int
newPosStart Int
upperM -> do
Int
curIx <- forall s a. STRef s a -> ST s a
readSTRef STRef s Int
curMarker
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0 .. Int
upperM forall a. Num a => a -> a -> a
- Int
1] forall a b. (a -> b) -> a -> b
$ \Int
n -> do
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
MV.unsafeWrite MVector s (PolyDiff a b)
v (Int
curIx forall a. Num a => a -> a -> a
+ Int
n) (forall a b. b -> PolyDiff a b
Second (Vector b
new forall a. Vector a -> Int -> a
! (Int
newPosStart forall a. Num a => a -> a -> a
+ Int
n)))
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Int
curMarker (forall a. Num a => a -> a -> a
+ Int
upperM)
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Int
newMarker (forall a. Num a => a -> a -> a
+ Int
upperM)
let computeWhileCond2 :: ST s Bool
computeWhileCond2 = do
Int
oldIx <- forall s a. STRef s a -> ST s a
readSTRef STRef s Int
oldMarker
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Int
oldIx forall a. Ord a => a -> a -> Bool
< forall a. Vector a -> Int
V.length Vector a
old
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m ()
whileM_ ST s Bool
computeWhileCond2 forall a b. (a -> b) -> a -> b
$ do
Int
oldIx <- forall s a. STRef s a -> ST s a
readSTRef STRef s Int
oldMarker
Int
curIx <- forall s a. STRef s a -> ST s a
readSTRef STRef s Int
curMarker
Int
newIx <- forall s a. STRef s a -> ST s a
readSTRef STRef s Int
newMarker
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
MV.unsafeWrite MVector s (PolyDiff a b)
v Int
curIx (forall a b. a -> b -> PolyDiff a b
Both (Vector a
old forall a. Vector a -> Int -> a
! Int
oldIx) (Vector b
new forall a. Vector a -> Int -> a
! Int
newIx))
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Int
oldMarker (forall a. Num a => a -> a -> a
+ Int
1)
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Int
curMarker (forall a. Num a => a -> a -> a
+ Int
1)
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Int
newMarker (forall a. Num a => a -> a -> a
+ Int
1)
forall (f :: * -> *) a. Applicative f => a -> f a
pure MVector s (PolyDiff a b)
v
data Edit
=
Delete
Int
Int
|
Insert
Int
Int
Int
deriving (Int -> Edit -> ShowS
[Edit] -> ShowS
Edit -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Edit] -> ShowS
$cshowList :: [Edit] -> ShowS
show :: Edit -> String
$cshow :: Edit -> String
showsPrec :: Int -> Edit -> ShowS
$cshowsPrec :: Int -> Edit -> ShowS
Show, Edit -> Edit -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Edit -> Edit -> Bool
$c/= :: Edit -> Edit -> Bool
== :: Edit -> Edit -> Bool
$c== :: Edit -> Edit -> Bool
Eq, Eq Edit
Edit -> Edit -> Bool
Edit -> Edit -> Ordering
Edit -> Edit -> Edit
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Edit -> Edit -> Edit
$cmin :: Edit -> Edit -> Edit
max :: Edit -> Edit -> Edit
$cmax :: Edit -> Edit -> Edit
>= :: Edit -> Edit -> Bool
$c>= :: Edit -> Edit -> Bool
> :: Edit -> Edit -> Bool
$c> :: Edit -> Edit -> Bool
<= :: Edit -> Edit -> Bool
$c<= :: Edit -> Edit -> Bool
< :: Edit -> Edit -> Bool
$c< :: Edit -> Edit -> Bool
compare :: Edit -> Edit -> Ordering
$ccompare :: Edit -> Edit -> Ordering
Ord)
oldPosition :: Edit -> Int
oldPosition :: Edit -> Int
oldPosition = \case
Delete Int
i Int
_ -> Int
i
Insert Int
i Int
_ Int
_ -> Int
i
insertLength :: Edit -> Int
insertLength :: Edit -> Int
insertLength = \case
Delete Int
_ Int
_ -> Int
0
Insert Int
_ Int
_ Int
m -> Int
m
modPortable :: Int -> Int -> Int
modPortable :: Int -> Int -> Int
modPortable Int
a Int
b =
let r :: Int
r = Int
a forall a. Integral a => a -> a -> a
`rem` Int
b
in if Int
r forall a. Ord a => a -> a -> Bool
>= Int
0 then Int
r else Int
r forall a. Num a => a -> a -> a
+ Int
b
sliceIx :: Int -> Int -> Vector a -> Vector a
sliceIx :: forall a. Int -> Int -> Vector a -> Vector a
sliceIx Int
start Int
end = forall a. Int -> Int -> Vector a -> Vector a
V.slice Int
start (Int
end forall a. Num a => a -> a -> a
- Int
start)
(&&.) :: Applicative m => Bool -> m Bool -> m Bool
&&. :: forall (m :: * -> *). Applicative m => Bool -> m Bool -> m Bool
(&&.) Bool
b1 m Bool
mkB2 = do
if Bool
b1
then m Bool
mkB2
else forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
forUntilJust :: Monad m => [a] -> (a -> m (Maybe b)) -> m (Maybe b)
forUntilJust :: forall (m :: * -> *) a b.
Monad m =>
[a] -> (a -> m (Maybe b)) -> m (Maybe b)
forUntilJust [] a -> m (Maybe b)
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
forUntilJust (a
a : [a]
rest) a -> m (Maybe b)
func = do
Maybe b
mRes <- a -> m (Maybe b)
func a
a
case Maybe b
mRes of
Maybe b
Nothing -> forall (m :: * -> *) a b.
Monad m =>
[a] -> (a -> m (Maybe b)) -> m (Maybe b)
forUntilJust [a]
rest a -> m (Maybe b)
func
Just b
res -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just b
res
whileM_ :: (Monad m) => m Bool -> m a -> m ()
whileM_ :: forall (m :: * -> *) a. Monad m => m Bool -> m a -> m ()
whileM_ m Bool
p m a
f = m ()
go
where
go :: m ()
go = do
Bool
x <- m Bool
p
if Bool
x
then m a
f forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m ()
go
else forall (m :: * -> *) a. Monad m => a -> m a
return ()