{-# LANGUAGE OverloadedLists #-}

module Data.Diff.VectorMyers (
  diffTexts
  , diffTextsToChangeEvents
  , diffTextsToChangeEventsConsolidate
  , diffTextsToChangeEvents'
  , diffStrings

  , diffTextsIO
  , diffTextsToChangeEventsIO
  , diffTextsToChangeEventsIOConsolidate
  , diffTextsToChangeEventsIO'
  , diffStringsIO

  , diff
  , Edit(..)

  , editScriptToChangeEvents
  , consolidateEditScript
  ) where

import Control.Monad.Primitive
import Control.Monad.ST
import Data.Bits (xor)
import Data.Diff.Types
import qualified Data.Foldable as F
import Data.Function
import Data.Sequence as Seq
import Data.Text as T
import Data.Vector.Unboxed as VU
import Data.Vector.Unboxed.Mutable as VUM
import Prelude hiding (read)


-- * Pure version uses ST

diffTexts :: Text -> Text -> Seq Edit
diffTexts :: Text -> Text -> Seq Edit
diffTexts Text
left Text
right = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
  -- This is faster than VU.fromList (T.unpack left), right?
  let l :: Vector Char
l = forall a. Unbox a => Int -> (Int -> a) -> Vector a
VU.generate (Text -> Int
T.length Text
left) (\Int
i -> Text -> Int -> Char
T.index Text
left Int
i)
  let r :: Vector Char
r = forall a. Unbox a => Int -> (Int -> a) -> Vector a
VU.generate (Text -> Int
T.length Text
right) (\Int
i -> Text -> Int -> Char
T.index Text
right Int
i)
  forall (m :: * -> *) a.
(PrimMonad m, Unbox a, Eq a, Show a) =>
Vector a -> Vector a -> m (Seq Edit)
diff Vector Char
l Vector Char
r

diffTextsToChangeEvents :: Text -> Text -> [ChangeEvent]
diffTextsToChangeEvents :: Text -> Text -> [ChangeEvent]
diffTextsToChangeEvents = (Seq Edit -> Seq Edit) -> Text -> Text -> [ChangeEvent]
diffTextsToChangeEvents' forall a. a -> a
id

diffTextsToChangeEventsConsolidate :: Text -> Text -> [ChangeEvent]
diffTextsToChangeEventsConsolidate :: Text -> Text -> [ChangeEvent]
diffTextsToChangeEventsConsolidate = (Seq Edit -> Seq Edit) -> Text -> Text -> [ChangeEvent]
diffTextsToChangeEvents' Seq Edit -> Seq Edit
consolidateEditScript

diffTextsToChangeEvents' :: (Seq Edit -> Seq Edit) -> Text -> Text -> [ChangeEvent]
diffTextsToChangeEvents' :: (Seq Edit -> Seq Edit) -> Text -> Text -> [ChangeEvent]
diffTextsToChangeEvents' Seq Edit -> Seq Edit
consolidateFn Text
left Text
right = forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList forall a b. (a -> b) -> a -> b
$ Vector Char -> Vector Char -> Seq Edit -> Seq ChangeEvent
editScriptToChangeEvents Vector Char
l Vector Char
r (Seq Edit -> Seq Edit
consolidateFn (forall a. (forall s. ST s a) -> a
runST (forall (m :: * -> *) a.
(PrimMonad m, Unbox a, Eq a, Show a) =>
Vector a -> Vector a -> m (Seq Edit)
diff Vector Char
l Vector Char
r)))
  where
    l :: Vector Char
l = forall a. Unbox a => Int -> (Int -> a) -> Vector a
VU.generate (Text -> Int
T.length Text
left) (\Int
i -> Text -> Int -> Char
T.index Text
left Int
i)
    r :: Vector Char
r = forall a. Unbox a => Int -> (Int -> a) -> Vector a
VU.generate (Text -> Int
T.length Text
right) (\Int
i -> Text -> Int -> Char
T.index Text
right Int
i)

-- | To use in benchmarking against other libraries that use String
diffStrings :: String -> String -> Seq Edit
diffStrings :: String -> String -> Seq Edit
diffStrings String
left String
right = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
  let leftThawed :: Vector Char
leftThawed = forall a. Unbox a => [a] -> Vector a
VU.fromList String
left
  let rightThawed :: Vector Char
rightThawed = forall a. Unbox a => [a] -> Vector a
VU.fromList String
right
  forall (m :: * -> *) a.
(PrimMonad m, Unbox a, Eq a, Show a) =>
Vector a -> Vector a -> m (Seq Edit)
diff Vector Char
leftThawed Vector Char
rightThawed

-- * IO version to benchmark against

diffTextsIO :: Text -> Text -> IO (Seq Edit)
diffTextsIO :: Text -> Text -> IO (Seq Edit)
diffTextsIO Text
left Text
right = do
  -- This is faster than VU.fromList (T.unpack left), right?
  let l :: Vector Char
l = forall a. Unbox a => Int -> (Int -> a) -> Vector a
VU.generate (Text -> Int
T.length Text
left) (\Int
i -> Text -> Int -> Char
T.index Text
left Int
i)
  let r :: Vector Char
r = forall a. Unbox a => Int -> (Int -> a) -> Vector a
VU.generate (Text -> Int
T.length Text
right) (\Int
i -> Text -> Int -> Char
T.index Text
right Int
i)
  forall (m :: * -> *) a.
(PrimMonad m, Unbox a, Eq a, Show a) =>
Vector a -> Vector a -> m (Seq Edit)
diff Vector Char
l Vector Char
r

diffTextsToChangeEventsIO :: Text -> Text -> IO [ChangeEvent]
diffTextsToChangeEventsIO :: Text -> Text -> IO [ChangeEvent]
diffTextsToChangeEventsIO = (Seq Edit -> Seq Edit) -> Text -> Text -> IO [ChangeEvent]
diffTextsToChangeEventsIO' forall a. a -> a
id

diffTextsToChangeEventsIOConsolidate :: Text -> Text -> IO [ChangeEvent]
diffTextsToChangeEventsIOConsolidate :: Text -> Text -> IO [ChangeEvent]
diffTextsToChangeEventsIOConsolidate = (Seq Edit -> Seq Edit) -> Text -> Text -> IO [ChangeEvent]
diffTextsToChangeEventsIO' Seq Edit -> Seq Edit
consolidateEditScript

diffTextsToChangeEventsIO' :: (Seq Edit -> Seq Edit) -> Text -> Text -> IO [ChangeEvent]
diffTextsToChangeEventsIO' :: (Seq Edit -> Seq Edit) -> Text -> Text -> IO [ChangeEvent]
diffTextsToChangeEventsIO' Seq Edit -> Seq Edit
consolidateFn Text
left Text
right = do
  -- This is faster than VU.fromList (T.unpack left), right?
  let l :: Vector Char
l = forall a. Unbox a => Int -> (Int -> a) -> Vector a
VU.generate (Text -> Int
T.length Text
left) (\Int
i -> Text -> Int -> Char
T.index Text
left Int
i)
  let r :: Vector Char
r = forall a. Unbox a => Int -> (Int -> a) -> Vector a
VU.generate (Text -> Int
T.length Text
right) (\Int
i -> Text -> Int -> Char
T.index Text
right Int
i)
  Seq Edit
edits <- forall (m :: * -> *) a.
(PrimMonad m, Unbox a, Eq a, Show a) =>
Vector a -> Vector a -> m (Seq Edit)
diff Vector Char
l Vector Char
r
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList forall a b. (a -> b) -> a -> b
$ Vector Char -> Vector Char -> Seq Edit -> Seq ChangeEvent
editScriptToChangeEvents Vector Char
l Vector Char
r (Seq Edit -> Seq Edit
consolidateFn Seq Edit
edits)

-- | To use in benchmarking against other libraries that use String
diffStringsIO :: String -> String -> IO (Seq Edit)
diffStringsIO :: String -> String -> IO (Seq Edit)
diffStringsIO String
left String
right = do
  let leftThawed :: Vector Char
leftThawed = forall a. Unbox a => [a] -> Vector a
VU.fromList String
left
  let rightThawed :: Vector Char
rightThawed = forall a. Unbox a => [a] -> Vector a
VU.fromList String
right
  forall (m :: * -> *) a.
(PrimMonad m, Unbox a, Eq a, Show a) =>
Vector a -> Vector a -> m (Seq Edit)
diff Vector Char
leftThawed Vector Char
rightThawed

-- * Core

diff :: (
  PrimMonad m, Unbox a, Eq a, Show a
  ) => Vector a -> Vector a -> m (Seq Edit)
diff :: forall (m :: * -> *) a.
(PrimMonad m, Unbox a, Eq a, Show a) =>
Vector a -> Vector a -> m (Seq Edit)
diff Vector a
e Vector a
f = forall (m :: * -> *) a.
(PrimMonad m, Unbox a, Eq a, Show a) =>
Vector a -> Vector a -> Int -> Int -> m (Seq Edit)
diff' Vector a
e Vector a
f Int
0 Int
0

diff' :: (
  PrimMonad m, Unbox a, Eq a, Show a
  ) => Vector a -> Vector a -> Int -> Int -> m (Seq Edit)
diff' :: forall (m :: * -> *) a.
(PrimMonad m, Unbox a, Eq a, Show a) =>
Vector a -> Vector a -> Int -> Int -> m (Seq Edit)
diff' Vector a
e Vector a
f Int
i Int
j = do
  let (Int
bigN, Int
bigM) = (forall a. Unbox a => Vector a -> Int
VU.length Vector a
e, forall a. Unbox a => Vector a -> Int
VU.length Vector a
f)
  let bigZ :: Int
bigZ = (Int
2 forall a. Num a => a -> a -> a
* (forall a. Ord a => a -> a -> a
min Int
bigN Int
bigM)) forall a. Num a => a -> a -> a
+ Int
2
  MVector (PrimState m) Int
g <- forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
new Int
bigZ
  MVector (PrimState m) Int
p <- forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
new Int
bigZ
  forall (m :: * -> *) a.
(PrimMonad m, Unbox a, Eq a, Show a) =>
MVector (PrimState m) Int
-> MVector (PrimState m) Int
-> Vector a
-> Vector a
-> Int
-> Int
-> m (Seq Edit)
diff'' MVector (PrimState m) Int
g MVector (PrimState m) Int
p Vector a
e Vector a
f Int
i Int
j

diff'' :: (
  PrimMonad m, Unbox a, Eq a, Show a
  ) => MVector (PrimState m) Int -> MVector (PrimState m) Int -> Vector a -> Vector a -> Int -> Int -> m (Seq Edit)
diff'' :: forall (m :: * -> *) a.
(PrimMonad m, Unbox a, Eq a, Show a) =>
MVector (PrimState m) Int
-> MVector (PrimState m) Int
-> Vector a
-> Vector a
-> Int
-> Int
-> m (Seq Edit)
diff'' MVector (PrimState m) Int
g' MVector (PrimState m) Int
p' Vector a
e Vector a
f Int
i Int
j = do
  let (Int
bigN, Int
bigM) = (forall a. Unbox a => Vector a -> Int
VU.length Vector a
e, forall a. Unbox a => Vector a -> Int
VU.length Vector a
f)
  let (Int
bigL, Int
bigZ) = (Int
bigN forall a. Num a => a -> a -> a
+ Int
bigM, (Int
2 forall a. Num a => a -> a -> a
* (forall a. Ord a => a -> a -> a
min Int
bigN Int
bigM)) forall a. Num a => a -> a -> a
+ Int
2)

  if | Int
bigN forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
bigM forall a. Ord a => a -> a -> Bool
> Int
0 -> do
         let w :: Int
w = Int
bigN forall a. Num a => a -> a -> a
- Int
bigM

         -- Clear out the reused memory vectors
         let g :: MVector (PrimState m) Int
g = forall a s. Unbox a => Int -> Int -> MVector s a -> MVector s a
VUM.unsafeSlice Int
0 Int
bigZ MVector (PrimState m) Int
g'
         forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> a -> m ()
VUM.set MVector (PrimState m) Int
g Int
0
         let p :: MVector (PrimState m) Int
p = forall a s. Unbox a => Int -> Int -> MVector s a -> MVector s a
VUM.unsafeSlice Int
0 Int
bigZ MVector (PrimState m) Int
p'
         forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> a -> m ()
VUM.set MVector (PrimState m) Int
p Int
0

         forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. (a -> a) -> a
fix Int
0 forall a b. (a -> b) -> a -> b
$ \Int -> m (Seq Edit)
loopBaseH -> \case
           Int
h | Bool -> Bool
not (Int
h forall a. Ord a => a -> a -> Bool
<= ((Int
bigL forall a. Integral a => a -> a -> a
`pyDiv` Int
2) forall a. Num a => a -> a -> a
+ (if (Int
bigL forall a. Integral a => a -> a -> a
`pyMod` Int
2) forall a. Eq a => a -> a -> Bool
/= Int
0 then Int
1 else Int
0))) -> forall (m :: * -> *) a. Monad m => a -> m a
return []
           Int
h -> do
             let loopH :: m (Seq Edit)
loopH = Int -> m (Seq Edit)
loopBaseH (Int
h forall a. Num a => a -> a -> a
+ Int
1)
             forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. (a -> a) -> a
fix (Int
0 :: Int) forall a b. (a -> b) -> a -> b
$ \Int -> m (Seq Edit)
loopBaseR -> \case
               Int
r | Bool -> Bool
not (Int
r forall a. Ord a => a -> a -> Bool
<= Int
1) -> m (Seq Edit)
loopH
               Int
r -> do
                 let loopR :: m (Seq Edit)
loopR = Int -> m (Seq Edit)
loopBaseR (Int
r forall a. Num a => a -> a -> a
+ Int
1)
                 let (MVector (PrimState m) Int
c, MVector (PrimState m) Int
d, Int
o, Int
m) = if Int
r forall a. Eq a => a -> a -> Bool
== Int
0 then (MVector (PrimState m) Int
g, MVector (PrimState m) Int
p, Int
1, Int
1) else (MVector (PrimState m) Int
p, MVector (PrimState m) Int
g, Int
0, -Int
1)
                 forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. (a -> a) -> a
fix (forall a. Num a => a -> a
negate (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
bigM))))) forall a b. (a -> b) -> a -> b
$ \Int -> m (Seq Edit)
loopBaseK -> \case
                   Int
k | Bool -> Bool
not (Int
k forall a. Ord a => a -> a -> Bool
<= (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
bigN))))) -> m (Seq Edit)
loopR
                   Int
k -> do
                     let loopK :: m (Seq Edit)
loopK = Int -> m (Seq Edit)
loopBaseK (Int
k forall a. Num a => a -> a -> a
+ Int
2)
                     Int
aInitial <- do
                       Int
prevC <- forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
unsafeRead MVector (PrimState m) Int
c ((Int
kforall a. Num a => a -> a -> a
-Int
1) forall a. Integral a => a -> a -> a
`pyMod` Int
bigZ)
                       Int
nextC <- forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
unsafeRead MVector (PrimState m) Int
c ((Int
kforall a. Num a => a -> a -> a
+Int
1) forall a. Integral a => a -> a -> a
`pyMod` Int
bigZ)
                       forall (m :: * -> *) a. Monad m => a -> m a
return (if (Int
k forall a. Eq a => a -> a -> Bool
== (-Int
h) Bool -> Bool -> Bool
|| (Int
k forall a. Eq a => a -> a -> Bool
/= Int
h Bool -> Bool -> Bool
&& (Int
prevC forall a. Ord a => a -> a -> Bool
< Int
nextC))) then Int
nextC else Int
prevC forall a. Num a => a -> a -> a
+ Int
1)
                     let bInitial :: Int
bInitial = Int
aInitial forall a. Num a => a -> a -> a
- Int
k
                     let (Int
s, Int
t) = (Int
aInitial, Int
bInitial)

                     (Int
a, Int
b) <- forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. (a -> a) -> a
fix (Int
aInitial, Int
bInitial) forall a b. (a -> b) -> a -> b
$ \(Int, Int) -> m (Int, Int)
loop (Int
a', Int
b') -> do
                       if | Int
a' forall a. Ord a => a -> a -> Bool
< Int
bigN Bool -> Bool -> Bool
&& Int
b' forall a. Ord a => a -> a -> Bool
< Int
bigM -> do
                              let eVal :: a
eVal = Vector a
e forall a. Unbox a => Vector a -> Int -> a
`unsafeIndex` (((Int
1 forall a. Num a => a -> a -> a
- Int
o) forall a. Num a => a -> a -> a
* Int
bigN) forall a. Num a => a -> a -> a
+ (Int
mforall a. Num a => a -> a -> a
*Int
a') forall a. Num a => a -> a -> a
+ (Int
o forall a. Num a => a -> a -> a
- Int
1))
                              let fVal :: a
fVal = Vector a
f forall a. Unbox a => Vector a -> Int -> a
`unsafeIndex` (((Int
1 forall a. Num a => a -> a -> a
- Int
o) forall a. Num a => a -> a -> a
* Int
bigM) forall a. Num a => a -> a -> a
+ (Int
mforall a. Num a => a -> a -> a
*Int
b') forall a. Num a => a -> a -> a
+ (Int
o forall a. Num a => a -> a -> a
- Int
1))
                              if | a
eVal forall a. Eq a => a -> a -> Bool
== a
fVal -> (Int, Int) -> m (Int, Int)
loop (Int
a' forall a. Num a => a -> a -> a
+ Int
1, Int
b' forall a. Num a => a -> a -> a
+ Int
1)
                                 | Bool
otherwise -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
a', Int
b')
                          | Bool
otherwise -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
a', Int
b')

                     forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
write MVector (PrimState m) Int
c (Int
k forall a. Integral a => a -> a -> a
`pyMod` Int
bigZ) Int
a
                     let z :: Int
z = forall a. Num a => a -> a
negate (Int
k forall a. Num a => a -> a -> a
- Int
w)

                     Int
cVal <- forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
unsafeRead MVector (PrimState m) Int
c (Int
k forall a. Integral a => a -> a -> a
`pyMod` Int
bigZ)
                     Int
dVal <- forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
unsafeRead MVector (PrimState m) Int
d (Int
z forall a. Integral a => a -> a -> a
`pyMod` Int
bigZ)
                     if | (Int
bigL forall a. Integral a => a -> a -> a
`pyMod` Int
2 forall a. Eq a => a -> a -> Bool
== Int
o) Bool -> Bool -> Bool
&& (Int
z forall a. Ord a => a -> a -> Bool
>= (forall a. Num a => a -> a
negate (Int
hforall a. Num a => a -> a -> a
-Int
o))) Bool -> Bool -> Bool
&& (Int
z forall a. Ord a => a -> a -> Bool
<= (Int
hforall a. Num a => a -> a -> a
-Int
o)) Bool -> Bool -> Bool
&& (Int
cVal forall a. Num a => a -> a -> a
+ Int
dVal forall a. Ord a => a -> a -> Bool
>= Int
bigN) -> do
                            let (Int
bigD, Int
x, Int
y, Int
u, Int
v) = if Int
o forall a. Eq a => a -> a -> Bool
== Int
1 then ((Int
2forall a. Num a => a -> a -> a
*Int
h)forall a. Num a => a -> a -> a
-Int
1, Int
s, Int
t, Int
a, Int
b) else (Int
2forall a. Num a => a -> a -> a
*Int
h, Int
bigNforall a. Num a => a -> a -> a
-Int
a, Int
bigMforall a. Num a => a -> a -> a
-Int
b, Int
bigNforall a. Num a => a -> a -> a
-Int
s, Int
bigMforall a. Num a => a -> a -> a
-Int
t)
                            if | Int
bigD 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) ->
                                  forall a. Monoid a => a -> a -> a
mappend forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
(PrimMonad m, Unbox a, Eq a, Show a) =>
MVector (PrimState m) Int
-> MVector (PrimState m) Int
-> Vector a
-> Vector a
-> Int
-> Int
-> m (Seq Edit)
diff'' MVector (PrimState m) Int
g MVector (PrimState m) Int
p (forall a. Unbox a => Int -> Int -> Vector a -> Vector a
VU.unsafeSlice Int
0 Int
x Vector a
e) (forall a. Unbox a => Int -> Int -> Vector a -> Vector a
VU.unsafeSlice Int
0 Int
y Vector a
f) Int
i Int
j
                                          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a.
(PrimMonad m, Unbox a, Eq a, Show a) =>
MVector (PrimState m) Int
-> MVector (PrimState m) Int
-> Vector a
-> Vector a
-> Int
-> Int
-> m (Seq Edit)
diff'' MVector (PrimState m) Int
g MVector (PrimState m) Int
p (forall a. Unbox a => Int -> Int -> Vector a -> Vector a
VU.unsafeSlice Int
u (Int
bigN forall a. Num a => a -> a -> a
- Int
u) Vector a
e) (forall a. Unbox a => Int -> Int -> Vector a -> Vector a
VU.unsafeSlice Int
v (Int
bigM forall a. Num a => a -> a -> a
- Int
v) Vector a
f) (Int
iforall a. Num a => a -> a -> a
+Int
u) (Int
jforall a. Num a => a -> a -> a
+Int
v)
                               | Int
bigM forall a. Ord a => a -> a -> Bool
> Int
bigN ->
                                  forall (m :: * -> *) a.
(PrimMonad m, Unbox a, Eq a, Show a) =>
MVector (PrimState m) Int
-> MVector (PrimState m) Int
-> Vector a
-> Vector a
-> Int
-> Int
-> m (Seq Edit)
diff'' MVector (PrimState m) Int
g MVector (PrimState m) Int
p (forall a. Unbox a => Int -> Int -> Vector a -> Vector a
VU.unsafeSlice Int
0 Int
0 Vector a
e) (forall a. Unbox a => Int -> Int -> Vector a -> Vector a
VU.unsafeSlice Int
bigN (Int
bigM forall a. Num a => a -> a -> a
- Int
bigN) Vector a
f) (Int
iforall a. Num a => a -> a -> a
+Int
bigN) (Int
jforall a. Num a => a -> a -> a
+Int
bigN)
                               | Int
bigM forall a. Ord a => a -> a -> Bool
< Int
bigN ->
                                  forall (m :: * -> *) a.
(PrimMonad m, Unbox a, Eq a, Show a) =>
MVector (PrimState m) Int
-> MVector (PrimState m) Int
-> Vector a
-> Vector a
-> Int
-> Int
-> m (Seq Edit)
diff'' MVector (PrimState m) Int
g MVector (PrimState m) Int
p (forall a. Unbox a => Int -> Int -> Vector a -> Vector a
VU.unsafeSlice Int
bigM (Int
bigN forall a. Num a => a -> a -> a
- Int
bigM) Vector a
e) (forall a. Unbox a => Int -> Int -> Vector a -> Vector a
VU.unsafeSlice Int
0 Int
0 Vector a
f) (Int
iforall a. Num a => a -> a -> a
+Int
bigM) (Int
jforall a. Num a => a -> a -> a
+Int
bigM)
                               | Bool
otherwise -> forall (m :: * -> *) a. Monad m => a -> m a
return []
                        | Bool
otherwise -> m (Seq Edit)
loopK


     | Int
bigN forall a. Ord a => a -> a -> Bool
> Int
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return [Int -> Int -> Edit
EditDelete Int
i (Int
i forall a. Num a => a -> a -> a
+ (Int
bigN forall a. Num a => a -> a -> a
- Int
1))]
     | Int
bigM forall a. Eq a => a -> a -> Bool
== Int
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return []
     | Bool
otherwise -> forall (m :: * -> *) a. Monad m => a -> m a
return [Int -> Int -> Int -> Edit
EditInsert Int
i Int
j (Int
j forall a. Num a => a -> a -> a
+ (Int
bigM forall a. Num a => a -> a -> a
- Int
1))]

{-# INLINABLE pyMod #-}
pyMod :: Integral a => a -> a -> a
pyMod :: forall a. Integral a => a -> a -> a
pyMod a
x a
y = if a
y forall a. Ord a => a -> a -> Bool
>= a
0 then a
x forall a. Integral a => a -> a -> a
`mod` a
y else (a
x forall a. Integral a => a -> a -> a
`mod` a
y) forall a. Num a => a -> a -> a
- a
y

{-# INLINABLE pyDiv #-}
pyDiv :: Integral a => a -> a -> a
pyDiv :: forall a. Integral a => a -> a -> a
pyDiv a
x a
y = if (a
x forall a. Ord a => a -> a -> Bool
< a
0) forall a. Bits a => a -> a -> a
`xor` (a
y forall a. Ord a => a -> a -> Bool
< a
0) then -((-a
x) forall a. Integral a => a -> a -> a
`div` a
y) else a
x forall a. Integral a => a -> a -> a
`div` a
y


-- * Converting edit script to LSP-style change events

editScriptToChangeEvents :: VU.Vector Char -> VU.Vector Char -> Seq Edit -> Seq ChangeEvent
editScriptToChangeEvents :: Vector Char -> Vector Char -> Seq Edit -> Seq ChangeEvent
editScriptToChangeEvents Vector Char
left Vector Char
right = Seq ChangeEvent -> Int -> Int -> Int -> Seq Edit -> Seq ChangeEvent
go forall a. Monoid a => a
mempty Int
0 Int
0 Int
0
  where
    go :: Seq ChangeEvent -> Int -> Int -> Int -> Seq Edit -> Seq ChangeEvent
    go :: Seq ChangeEvent -> Int -> Int -> Int -> Seq Edit -> Seq ChangeEvent
go Seq ChangeEvent
seqSoFar Int
_ Int
_ Int
_ Seq Edit
Empty = Seq ChangeEvent
seqSoFar

    -- Implicit unchanged section before delete
    go Seq ChangeEvent
seqSoFar Int
pos Int
line Int
ch args :: Seq Edit
args@((EditDelete Int
from Int
_to) :<| Seq Edit
_) |
      Int
pos forall a. Ord a => a -> a -> Bool
< Int
from = Seq ChangeEvent -> Int -> Int -> Int -> Seq Edit -> Seq ChangeEvent
go Seq ChangeEvent
seqSoFar Int
from Int
line' Int
ch' Seq Edit
args
        where
          (Int
numNewlinesEncountered, Int
lastLineLength) = Vector Char -> (Int, Int)
countNewlinesAndLastLineLength (forall a. Unbox a => Int -> Int -> Vector a -> Vector a
VU.slice Int
pos (Int
from forall a. Num a => a -> a -> a
- Int
pos) Vector Char
left)
          line' :: Int
line' = Int
line forall a. Num a => a -> a -> a
+ Int
numNewlinesEncountered
          ch' :: Int
ch' | Int
numNewlinesEncountered forall a. Eq a => a -> a -> Bool
== Int
0 = Int
ch forall a. Num a => a -> a -> a
+ (Int
from forall a. Num a => a -> a -> a
- Int
pos)
              | Bool
otherwise = Int
lastLineLength
    -- Implicit unchanged section before insert
    go Seq ChangeEvent
seqSoFar Int
pos Int
line Int
ch args :: Seq Edit
args@((EditInsert Int
from Int
_rightFrom Int
_rightTo) :<| Seq Edit
_) |
      Int
pos forall a. Ord a => a -> a -> Bool
< Int
from = Seq ChangeEvent -> Int -> Int -> Int -> Seq Edit -> Seq ChangeEvent
go Seq ChangeEvent
seqSoFar Int
from Int
line' Int
ch' Seq Edit
args
        where
          (Int
numNewlinesEncountered, Int
lastLineLength) = Vector Char -> (Int, Int)
countNewlinesAndLastLineLength (forall a. Unbox a => Int -> Int -> Vector a -> Vector a
VU.slice Int
pos (Int
from forall a. Num a => a -> a -> a
- Int
pos) Vector Char
left)
          line' :: Int
line' = Int
line forall a. Num a => a -> a -> a
+ Int
numNewlinesEncountered
          ch' :: Int
ch' | Int
numNewlinesEncountered forall a. Eq a => a -> a -> Bool
== Int
0 = Int
ch forall a. Num a => a -> a -> a
+ (Int
from forall a. Num a => a -> a -> a
- Int
pos)
              | Bool
otherwise = Int
lastLineLength

    go Seq ChangeEvent
seqSoFar Int
pos Int
line Int
ch ((EditDelete Int
from Int
to) :<| Seq Edit
rest) = Seq ChangeEvent -> Int -> Int -> Int -> Seq Edit -> Seq ChangeEvent
go (Seq ChangeEvent
seqSoFar forall a. Seq a -> a -> Seq a
|> ChangeEvent
change) Int
pos' Int
line Int
ch Seq Edit
rest
      where
        change :: ChangeEvent
change = Range -> Text -> ChangeEvent
ChangeEvent (Position -> Position -> Range
Range (Int -> Int -> Position
Position Int
line Int
ch) (Int -> Int -> Position
Position Int
line' Int
ch')) Text
""
        pos' :: Int
pos' = Int
to forall a. Num a => a -> a -> a
+ Int
1

        deleted :: Vector Char
deleted = forall a. Unbox a => Int -> Int -> Vector a -> Vector a
VU.slice Int
from (Int
to forall a. Num a => a -> a -> a
+ Int
1 forall a. Num a => a -> a -> a
- Int
from) Vector Char
left
        (Int
numNewlinesInDeleted, Int
lastLineLengthInDeleted) = Vector Char -> (Int, Int)
countNewlinesAndLastLineLength Vector Char
deleted
        line' :: Int
line' = Int
line forall a. Num a => a -> a -> a
+ Int
numNewlinesInDeleted
        ch' :: Int
ch' = if | Int
numNewlinesInDeleted forall a. Eq a => a -> a -> Bool
== Int
0 -> Int
ch forall a. Num a => a -> a -> a
+ (Int
to forall a. Num a => a -> a -> a
- Int
pos forall a. Num a => a -> a -> a
+ Int
1)
                 | Bool
otherwise -> Int
lastLineLengthInDeleted

    go Seq ChangeEvent
seqSoFar Int
pos Int
line Int
ch ((EditInsert Int
_at Int
rightFrom Int
rightTo) :<| Seq Edit
rest) = Seq ChangeEvent -> Int -> Int -> Int -> Seq Edit -> Seq ChangeEvent
go (Seq ChangeEvent
seqSoFar forall a. Seq a -> a -> Seq a
|> ChangeEvent
change) Int
pos' Int
line' Int
ch' Seq Edit
rest
      where
        change :: ChangeEvent
change = Range -> Text -> ChangeEvent
ChangeEvent (Position -> Position -> Range
Range (Int -> Int -> Position
Position Int
line Int
ch) (Int -> Int -> Position
Position Int
line Int
ch)) (Vector Char -> Text
vectorToText Vector Char
inserted)
        pos' :: Int
pos' = Int
pos

        inserted :: Vector Char
inserted = forall a. Unbox a => Int -> Int -> Vector a -> Vector a
VU.slice Int
rightFrom (Int
rightTo forall a. Num a => a -> a -> a
+ Int
1 forall a. Num a => a -> a -> a
- Int
rightFrom) Vector Char
right
        (Int
numNewlinesInInserted, Int
lastLineLengthInInserted) = Vector Char -> (Int, Int)
countNewlinesAndLastLineLength Vector Char
inserted
        line' :: Int
line' = Int
line forall a. Num a => a -> a -> a
+ Int
numNewlinesInInserted
        ch' :: Int
ch' = if | Int
numNewlinesInInserted forall a. Eq a => a -> a -> Bool
== Int
0 -> Int
ch forall a. Num a => a -> a -> a
+ forall a. Unbox a => Vector a -> Int
VU.length Vector Char
inserted
                 | Bool
otherwise -> Int
lastLineLengthInInserted

    countNewlinesAndLastLineLength :: VU.Vector Char -> (Int, Int)
    countNewlinesAndLastLineLength :: Vector Char -> (Int, Int)
countNewlinesAndLastLineLength = forall b a. Unbox b => (a -> b -> a) -> a -> Vector b -> a
VU.foldl' (\(Int
tot, Int
lastLineLength) Char
ch -> if Char
ch forall a. Eq a => a -> a -> Bool
== Char
'\n' then (Int
tot forall a. Num a => a -> a -> a
+ Int
1, Int
0) else (Int
tot, Int
lastLineLength forall a. Num a => a -> a -> a
+ Int
1)) (Int
0, Int
0)

    vectorToText :: VU.Vector Char -> T.Text
    vectorToText :: Vector Char -> Text
vectorToText = String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Unbox a => Vector a -> [a]
VU.toList

-- * Consolidate edits

-- λ> diffTexts "x" "xab"
-- fromList [EditInsert {insertPos = 1, insertFrom = 1, insertTo = 1},EditInsert {insertPos = 1, insertFrom = 2, insertTo = 2}]
-- λ> diffTexts "xab" "x"
-- fromList [EditDelete {deleteFrom = 1, deleteTo = 1},EditDelete {deleteFrom = 2, deleteTo = 2}]
consolidateEditScript :: Seq Edit -> Seq Edit
consolidateEditScript :: Seq Edit -> Seq Edit
consolidateEditScript ((EditInsert Int
pos1 Int
from1 Int
to1) :<| (EditInsert Int
pos2 Int
from2 Int
to2) :<| Seq Edit
rest)
  | Int
pos1 forall a. Eq a => a -> a -> Bool
== Int
pos2 Bool -> Bool -> Bool
&& Int
to1 forall a. Num a => a -> a -> a
+ Int
1 forall a. Eq a => a -> a -> Bool
== Int
from2 = Seq Edit -> Seq Edit
consolidateEditScript ((Int -> Int -> Int -> Edit
EditInsert Int
pos1 Int
from1 Int
to2) forall a. a -> Seq a -> Seq a
<| Seq Edit
rest)
consolidateEditScript ((EditDelete Int
from1 Int
to1) :<| (EditDelete Int
from2 Int
to2) :<| Seq Edit
rest)
  | Int
to1 forall a. Num a => a -> a -> a
+ Int
1 forall a. Eq a => a -> a -> Bool
== Int
from2 = Seq Edit -> Seq Edit
consolidateEditScript ((Int -> Int -> Edit
EditDelete Int
from1 Int
to2) forall a. a -> Seq a -> Seq a
<| Seq Edit
rest)
consolidateEditScript (Edit
x :<| Edit
y :<| Seq Edit
rest) = Edit
x forall a. a -> Seq a -> Seq a
<| (Seq Edit -> Seq Edit
consolidateEditScript (Edit
y forall a. a -> Seq a -> Seq a
<| Seq Edit
rest))
consolidateEditScript Seq Edit
x = Seq Edit
x