{-# LANGUAGE OverloadedLists #-}

{-|
Module:      Data.Diff.Myers
Copyright:   (c) 2023 Tom McLaughlin
License:     BSD3
Stability:   experimental
Portability: portable

This is a fast Haskell implementation of the Myers text diff algorithm[1]. It is heavily inspired by the Python version in [this post](https://blog.robertelder.org/diff-algorithm/), and should have the same @O(min(len(a), len(b)))@ space complexity. (By contrast, the [Diff](https://hackage.haskell.org/package/Diff) package advertises @O(ab)@ space complexity.) The implementation uses unboxed mutable vectors for performance.

This repo also can also build a couple other versions for benchmarking comparison, gated behind flags.

* @-funi_myers@ will build the version from the [uni-util](https://hackage.haskell.org/package/uni-util-2.3.0.3/docs/Util-Myers.html) package.
* @-fdiff_myers@ will use the [Diff](https://hackage.haskell.org/package/Diff) package.

[1]: E. Myers (1986). "An O(ND) Difference Algorithm and Its Variations". Algorithmica. 1 (2): 251–266. CiteSeerX [10.1.1.4.6927](https://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.4.6927). doi:[10.1007/BF01840446](https://doi.org/10.1007%2FBF01840446). S2CID [6996809](https://api.semanticscholar.org/CorpusID:6996809).

-}

module Data.Diff.Myers (
  -- * Pure diffing (uses ST monad)
  diffTexts
  , diffTextsToChangeEvents
  , diffTextsToChangeEventsConsolidate
  , diffTextsToChangeEvents'
  , diffVectors
  , diffStrings

  -- * Lowest level diff function
  , diff

  -- * Working with edit scripts
  , editScriptToChangeEvents
  , consolidateEditScript

  -- * Util
  , fastTextToVector

  -- * Types
  , Edit(..)
  ) where

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


-- | Diff 'Text's to produce an edit script.
diffTexts :: Text -> Text -> Seq Edit
diffTexts :: Text -> Text -> Seq Edit
diffTexts Text
left Text
right = (forall s. ST s (Seq Edit)) -> Seq Edit
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Seq Edit)) -> Seq Edit)
-> (forall s. ST s (Seq Edit)) -> Seq Edit
forall a b. (a -> b) -> a -> b
$
  Vector Char -> Vector Char -> ST s (Seq Edit)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a, Eq a, Show a) =>
Vector a -> Vector a -> m (Seq Edit)
diff (Text -> Vector Char
fastTextToVector Text
left)
       (Text -> Vector Char
fastTextToVector Text
right)

-- | Diff 'Text's to produce LSP-style change events.
diffTextsToChangeEvents :: Text -> Text -> [ChangeEvent]
diffTextsToChangeEvents :: Text -> Text -> [ChangeEvent]
diffTextsToChangeEvents = (Seq Edit -> Seq Edit) -> Text -> Text -> [ChangeEvent]
diffTextsToChangeEvents' Seq Edit -> Seq Edit
forall a. a -> a
id

-- | Diff 'Text's to produce consolidated LSP-style change events.
diffTextsToChangeEventsConsolidate :: Text -> Text -> [ChangeEvent]
diffTextsToChangeEventsConsolidate :: Text -> Text -> [ChangeEvent]
diffTextsToChangeEventsConsolidate = (Seq Edit -> Seq Edit) -> Text -> Text -> [ChangeEvent]
diffTextsToChangeEvents' Seq Edit -> Seq Edit
consolidateEditScript

-- | Diff 'Text's with a custom consolidation function.
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 = Seq ChangeEvent -> [ChangeEvent]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Seq ChangeEvent -> [ChangeEvent])
-> Seq ChangeEvent -> [ChangeEvent]
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 s. ST s (Seq Edit)) -> Seq Edit
forall a. (forall s. ST s a) -> a
runST (Vector Char -> Vector Char -> ST s (Seq Edit)
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 = Text -> Vector Char
fastTextToVector Text
left
    r :: Vector Char
r = Text -> Vector Char
fastTextToVector Text
right

-- | Diff 'VU.Vector's to produce an edit script.
diffVectors :: VU.Vector Char -> VU.Vector Char -> Seq Edit
diffVectors :: Vector Char -> Vector Char -> Seq Edit
diffVectors Vector Char
left Vector Char
right = (forall s. ST s (Seq Edit)) -> Seq Edit
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Seq Edit)) -> Seq Edit)
-> (forall s. ST s (Seq Edit)) -> Seq Edit
forall a b. (a -> b) -> a -> b
$ Vector Char -> Vector Char -> ST s (Seq Edit)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a, Eq a, Show a) =>
Vector a -> Vector a -> m (Seq Edit)
diff Vector Char
left Vector Char
right

-- | 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 s. ST s (Seq Edit)) -> Seq Edit
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Seq Edit)) -> Seq Edit)
-> (forall s. ST s (Seq Edit)) -> Seq Edit
forall a b. (a -> b) -> a -> b
$ do
  let leftThawed :: Vector Char
leftThawed = String -> Vector Char
forall a. Unbox a => [a] -> Vector a
VU.fromList String
left
  let rightThawed :: Vector Char
rightThawed = String -> Vector Char
forall a. Unbox a => [a] -> Vector a
VU.fromList String
right
  Vector Char -> Vector Char -> ST s (Seq Edit)
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 = Vector a -> Vector a -> Int -> Int -> m (Seq Edit)
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

{-# SPECIALISE diff' :: Vector Char -> Vector Char -> Int -> Int -> ST () (Seq Edit) #-}
{-# SPECIALISE diff' :: Vector Char -> Vector Char -> Int -> Int -> IO (Seq Edit) #-}
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) = (Vector a -> Int
forall a. Unbox a => Vector a -> Int
VU.length Vector a
e, Vector a -> Int
forall a. Unbox a => Vector a -> Int
VU.length Vector a
f)
  let bigZ :: Int
bigZ = (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
bigN Int
bigM)) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2
  MVector (PrimState m) Int
g <- Int -> m (MVector (PrimState m) Int)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
new Int
bigZ
  MVector (PrimState m) Int
p <- Int -> m (MVector (PrimState m) Int)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
new Int
bigZ
  MVector (PrimState m) Int
-> MVector (PrimState m) Int
-> Vector a
-> Vector a
-> Int
-> Int
-> m (Seq Edit)
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

{-# SPECIALISE diff'' :: MVector (PrimState (ST ())) Int -> MVector (PrimState (ST ())) Int -> Vector Char -> Vector Char -> Int -> Int -> ST () (Seq Edit) #-}
{-# SPECIALISE diff'' :: MVector (PrimState IO) Int -> MVector (PrimState IO) Int -> Vector Char -> Vector Char -> Int -> Int -> IO (Seq Edit) #-}
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) = (Vector a -> Int
forall a. Unbox a => Vector a -> Int
VU.length Vector a
e, Vector a -> Int
forall a. Unbox a => Vector a -> Int
VU.length Vector a
f)
  let (Int
bigL, Int
bigZ) = (Int
bigN Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
bigM, (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
bigN Int
bigM)) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)

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

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

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

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

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

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


     | Int
bigN Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 -> Seq Edit -> m (Seq Edit)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [Int -> Int -> Edit
EditDelete Int
i (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
bigN Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))]
     | Int
bigM Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> Seq Edit -> m (Seq Edit)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
     | Bool
otherwise -> Seq Edit -> m (Seq Edit)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [Int -> Int -> Int -> Edit
EditInsert Int
i Int
j (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
bigM Int -> Int -> Int
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 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0 then a
x a -> a -> a
forall a. Integral a => a -> a -> a
`mod` a
y else (a
x a -> a -> a
forall a. Integral a => a -> a -> a
`mod` a
y) a -> a -> a
forall a. Num a => a -> a -> a
- a
y

{-# INLINABLE intMod2 #-}
intMod2 :: Int -> Int
intMod2 :: Int -> Int
intMod2 Int
n = Int
n Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
1

-- | Convert 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 Seq ChangeEvent
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 Int -> Int -> Bool
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 (Int -> Int -> Vector Char -> Vector Char
forall a. Unbox a => Int -> Int -> Vector a -> Vector a
VU.slice Int
pos (Int
from Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
pos) Vector Char
left)
          line' :: Int
line' = Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
numNewlinesEncountered
          ch' :: Int
ch' | Int
numNewlinesEncountered Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Int
ch Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
from Int -> Int -> Int
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 Int -> Int -> Bool
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 (Int -> Int -> Vector Char -> Vector Char
forall a. Unbox a => Int -> Int -> Vector a -> Vector a
VU.slice Int
pos (Int
from Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
pos) Vector Char
left)
          line' :: Int
line' = Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
numNewlinesEncountered
          ch' :: Int
ch' | Int
numNewlinesEncountered Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Int
ch Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
from Int -> Int -> Int
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 Seq ChangeEvent -> ChangeEvent -> Seq ChangeEvent
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

        deleted :: Vector Char
deleted = Int -> Int -> Vector Char -> Vector Char
forall a. Unbox a => Int -> Int -> Vector a -> Vector a
VU.slice Int
from (Int
to Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
numNewlinesInDeleted
        ch' :: Int
ch' = if | Int
numNewlinesInDeleted Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> Int
ch Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
to Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
pos Int -> Int -> Int
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 Seq ChangeEvent -> ChangeEvent -> Seq ChangeEvent
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 = Int -> Int -> Vector Char -> Vector Char
forall a. Unbox a => Int -> Int -> Vector a -> Vector a
VU.slice Int
rightFrom (Int
rightTo Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
numNewlinesInInserted
        ch' :: Int
ch' = if | Int
numNewlinesInInserted Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> Int
ch Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Vector Char -> Int
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 = ((Int, Int) -> Char -> (Int, Int))
-> (Int, Int) -> Vector Char -> (Int, Int)
forall b a. Unbox b => (a -> b -> a) -> a -> Vector b -> a
VU.foldl' (\(Int
tot, Int
lastLineLength) Char
ch -> if Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' then (Int
tot Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int
0) else (Int
tot, Int
lastLineLength Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) (Int
0, Int
0)

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

-- * Consolidate edits

-- | Consolidate adjacent edit script entries to shorten the script.
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
pos2 Bool -> Bool -> Bool
&& Int
to1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
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) Edit -> Seq Edit -> Seq Edit
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
from2 = Seq Edit -> Seq Edit
consolidateEditScript ((Int -> Int -> Edit
EditDelete Int
from1 Int
to2) Edit -> Seq Edit -> Seq Edit
forall a. a -> Seq a -> Seq a
<| Seq Edit
rest)
consolidateEditScript (Edit
x :<| Edit
y :<| Seq Edit
rest) = Edit
x Edit -> Seq Edit -> Seq Edit
forall a. a -> Seq a -> Seq a
<| (Seq Edit -> Seq Edit
consolidateEditScript (Edit
y Edit -> Seq Edit -> Seq Edit
forall a. a -> Seq a -> Seq a
<| Seq Edit
rest))
consolidateEditScript Seq Edit
x = Seq Edit
x


-- | This is currently the only way to convert a 'Text' to a 'VU.Vector' without extraneous allocations.
-- Taken from https://stackoverflow.com/a/77388392/2659595
-- Once the text library contains a foldM function, we can switch to that and avoid importing internal
-- functions.
-- See https://github.com/haskell/text/pull/543
fastTextToVector :: Text -> VU.Vector Char
fastTextToVector :: Text -> Vector Char
fastTextToVector Text
t =
  case Text -> Stream Char
TI.stream Text
t of
    TI.Stream s -> Step s Char
step s
s0 Size
_ -> (forall s. ST s (MVector s Char)) -> Vector Char
forall a. Unbox a => (forall s. ST s (MVector s a)) -> Vector a
VU.create ((forall s. ST s (MVector s Char)) -> Vector Char)
-> (forall s. ST s (MVector s Char)) -> Vector Char
forall a b. (a -> b) -> a -> b
$ do
      MVector s Char
m <- Int -> ST s (MVector (PrimState (ST s)) Char)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
VUM.new (Text -> Int
T.length Text
t)
      let
        go :: s -> Int -> f ()
go s
s Int
i =
          case s -> Step s Char
step s
s of
            Step s Char
TI.Done -> () -> f ()
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
            TI.Skip s
s' -> s -> Int -> f ()
go s
s' Int
i
            TI.Yield Char
x s
s' -> do
              MVector (PrimState f) Char -> Int -> Char -> f ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
VUM.write MVector s Char
MVector (PrimState f) Char
m Int
i Char
x
              s -> Int -> f ()
go s
s' (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      s -> Int -> ST s ()
forall {f :: * -> *}.
(PrimState f ~ s, PrimMonad f) =>
s -> Int -> f ()
go s
s0 Int
0
      MVector s Char -> ST s (MVector s Char)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MVector s Char
m