myers-diff 0.1.0.0 → 0.2.0.0

raw patch · 16 files changed

+407/−375 lines, 16 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• README.md +1/−1
• app/Main.hs +1/−1
• bench-criterion/Bench/VectorIO.hs +44/−0
• bench-criterion/Main.hs +3/−3
• bench-weigh/Main.hs +3/−3
• myers-diff.cabal +5/−5
• src-diff-myers/Data/Diff/DiffMyers.hs +49/−0
• src-diff-myers/Data/Diff/DiffMyersShim.hs +0/−49
• src-uni-myers/Data/Diff/UniMyers.hs +51/−3
• src-uni-myers/Data/Diff/UniMyersShim.hs +0/−53
• src/Data/Diff/Myers.hs +240/−0
• src/Data/Diff/VectorMyers.hs +0/−251
• test-diff-myers/Spec/DiffMyersSpec.hs +4/−4
• test-uni-myers/Spec/UniMyersSpec.hs +1/−1
• test/Spec/VectorMyersSpec.hs +1/−1

@@ -2,6 +2,10 @@  ## Unreleased +## 0.2.0.0++* Tidy modules and add haddocks+ ## 0.1.0.0  * Initial release.

@@ -1,5 +1,5 @@ -# Welcome to `myers-diff`+# Welcome to `myers-diff` [![Hackage](https://img.shields.io/hackage/v/myers-diff.svg)](https://hackage.haskell.org/package/myers-diff) ![myers-diff](https://github.com/codedownio/myers-diff/actions/workflows/ci.yml/badge.svg)  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. 

@@ -1,7 +1,7 @@  module Main (main) where -import Data.Diff.VectorMyers+import Data.Diff.Myers import Data.String.Interpolate import Data.Text.IO as T import Test.QuickCheck

@@ -0,0 +1,44 @@+{-# OPTIONS_GHC -fno-warn-missing-export-lists #-}++module Bench.VectorIO where++import Data.Diff.Types+import Data.Diff.Myers+import qualified Data.Foldable as F+import Data.Sequence+import Data.Text as T+import Data.Vector.Unboxed as VU+++-- * IO versions of the 'Data.Diff.VectorMyers' diff functions for benchmarking++-- | Diff 'Text's to produce an edit script.+diffTextsIO :: Text -> Text -> IO (Seq Edit)+diffTextsIO left right = do+  -- This is faster than VU.fromList (T.unpack left), right?+  let l = VU.generate (T.length left) (\i -> T.index left i)+  let r = VU.generate (T.length right) (\i -> T.index right i)+  diff l r++-- | Diff 'Text's to produce LSP-style change events.+diffTextsToChangeEventsIO :: Text -> Text -> IO [ChangeEvent]+diffTextsToChangeEventsIO = diffTextsToChangeEventsIO' id++-- | Diff 'Text's to produce consolidated LSP-style change events.+diffTextsToChangeEventsIOConsolidate :: Text -> Text -> IO [ChangeEvent]+diffTextsToChangeEventsIOConsolidate = diffTextsToChangeEventsIO' consolidateEditScript++diffTextsToChangeEventsIO' :: (Seq Edit -> Seq Edit) -> Text -> Text -> IO [ChangeEvent]+diffTextsToChangeEventsIO' consolidateFn left right = do+  -- This is faster than VU.fromList (T.unpack left), right?+  let l = VU.generate (T.length left) (\i -> T.index left i)+  let r = VU.generate (T.length right) (\i -> T.index right i)+  edits <- diff l r+  return $ F.toList $ editScriptToChangeEvents l r (consolidateFn edits)++-- | To use in benchmarking against other libraries that use String+diffStringsIO :: String -> String -> IO (Seq Edit)+diffStringsIO left right = do+  let leftThawed = VU.fromList left+  let rightThawed = VU.fromList right+  diff leftThawed rightThawed

@@ -4,13 +4,13 @@  import Criterion import Criterion.Main-import qualified Data.Diff.VectorMyers as VM+import qualified Data.Diff.Myers as VM import Data.String.Interpolate import Data.Text as T import TestLib.Instances ()  #ifdef DIFF_MYERS-import qualified Data.Diff.DiffMyersShim as DM+import qualified Data.Diff.DiffMyers as DM #endif  @@ -29,7 +29,7 @@       , bench "Vector to ChangeEvents (consolidated)" $ nf (\(x, y) -> VM.diffTextsToChangeEventsConsolidate x y) (initialText, finalText)  #ifdef DIFF_MYERS-      , bench "Diff" $ nf (\(x, y) -> DM.diffDiff x y) (initial, final)+      , bench "Diff" $ nf (\(x, y) -> DM.diff x y) (initial, final) #endif     ]   ]

@@ -2,7 +2,7 @@  module Main (main) where -import qualified Data.Diff.VectorMyers as VM+import qualified Data.Diff.Myers as VM import Data.String import Data.String.Interpolate import Data.Text as T@@ -13,14 +13,14 @@ import Weigh  #ifdef DIFF_MYERS-import qualified Data.Diff.DiffMyersShim as DM+import qualified Data.Diff.DiffMyers as DM #endif   main :: IO () main = mainWith $ do #ifdef DIFF_MYERS-  func "Diff" (\(x, y) -> DM.diffDiff x y) (T.unpack file1, T.unpack file2)+  func "Diff" (\(x, y) -> DM.diff x y) (T.unpack file1, T.unpack file2) #endif    func "Vector" (\(x, y) -> VM.diffTextsToChangeEvents x y) (file1, file2)

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           myers-diff-version:        0.1.0.0+version:        0.2.0.0 description:    Please see the README on GitHub at <https://github.com/codedownio/myers-diff#readme> homepage:       https://github.com/codedownio/myers-diff#readme bug-reports:    https://github.com/codedownio/myers-diff/issues@@ -34,8 +34,8 @@  library   exposed-modules:+      Data.Diff.Myers       Data.Diff.Types-      Data.Diff.VectorMyers   other-modules:       Paths_myers_diff   hs-source-dirs:@@ -71,14 +71,13 @@   if flag(uni_myers)     exposed-modules:         Data.Diff.UniMyers-        Data.Diff.UniMyersShim     hs-source-dirs:         src-uni-myers     build-depends:         array   if flag(diff_myers)     exposed-modules:-        Data.Diff.DiffMyersShim+        Data.Diff.DiffMyers     hs-source-dirs:         src-diff-myers     build-depends:@@ -184,7 +183,7 @@         Spec.UniMyersSpec     hs-source-dirs:         test-uni-myers-  if flag(uni_myers)+  if flag(diff_myers)     other-modules:         Spec.DiffMyersSpec     hs-source-dirs:@@ -194,6 +193,7 @@   type: exitcode-stdio-1.0   main-is: Main.hs   other-modules:+      Bench.VectorIO       TestLib.Apply       TestLib.Generators       TestLib.Instances

@@ -0,0 +1,49 @@++module Data.Diff.DiffMyers (+  diff+  ) where++import qualified Data.Algorithm.Diff as DD+import Data.Diff.Types+import Data.Function+import qualified Data.List as L+import qualified Data.Text as T+++utilDiffToLspDiff :: [DD.Diff String] -> [ChangeEvent]+utilDiffToLspDiff elems = go [] 0 0 elems+  where+    go events curLine curChar ((DD.Both chars _):xs) = go events curLine' curChar' xs+      where+        curLine' = curLine + countNewlines chars+        curChar' = if hasNewline chars then lengthOfLastLine chars else curChar + (L.length chars)++    go events curLine curChar ((DD.First chars):xs) = go ((ChangeEvent (Range startPos endPos) ""):events) curLine' curChar' xs+      where+        startPos = Position curLine curChar+        endPos = Position (curLine + countNewlines chars) (if hasNewline chars then lengthOfLastLine chars else curChar + (L.length chars))++        curLine' = curLine+        curChar' = curChar+    go events curLine curChar ((DD.Second chars):xs) = go ((ChangeEvent (Range startPos endPos) (T.pack chars)):events) curLine' curChar' xs+      where+        startPos = Position curLine curChar+        endPos = startPos++        curLine' = curLine + countNewlines chars+        curChar' = if hasNewline chars then lengthOfLastLine chars else curChar + (L.length chars)++    go events _curLine _curChar [] = reverse events++    hasNewline = any (== '\n')++    lengthOfLastLine chars = chars+                           & T.pack+                           & T.splitOn "\n"+                           & last+                           & T.length++    countNewlines = L.foldl' (\total c -> if c == '\n' then total + 1 else total) 0++diff :: String -> String -> [ChangeEvent]+diff s1 s2 = utilDiffToLspDiff (DD.getGroupedDiff s1 s2)

@@ -1,49 +0,0 @@--module Data.Diff.DiffMyersShim (-  diffDiff-  ) where--import qualified Data.Algorithm.Diff as DD-import Data.Diff.Types-import Data.Function-import qualified Data.List as L-import qualified Data.Text as T---utilDiffToLspDiff :: [DD.Diff String] -> [ChangeEvent]-utilDiffToLspDiff elems = go [] 0 0 elems-  where-    go events curLine curChar ((DD.Both chars _):xs) = go events curLine' curChar' xs-      where-        curLine' = curLine + countNewlines chars-        curChar' = if hasNewline chars then lengthOfLastLine chars else curChar + (L.length chars)--    go events curLine curChar ((DD.First chars):xs) = go ((ChangeEvent (Range startPos endPos) ""):events) curLine' curChar' xs-      where-        startPos = Position curLine curChar-        endPos = Position (curLine + countNewlines chars) (if hasNewline chars then lengthOfLastLine chars else curChar + (L.length chars))--        curLine' = curLine-        curChar' = curChar-    go events curLine curChar ((DD.Second chars):xs) = go ((ChangeEvent (Range startPos endPos) (T.pack chars)):events) curLine' curChar' xs-      where-        startPos = Position curLine curChar-        endPos = startPos--        curLine' = curLine + countNewlines chars-        curChar' = if hasNewline chars then lengthOfLastLine chars else curChar + (L.length chars)--    go events _curLine _curChar [] = reverse events--    hasNewline = any (== '\n')--    lengthOfLastLine chars = chars-                           & T.pack-                           & T.splitOn "\n"-                           & last-                           & T.length--    countNewlines = L.foldl' (\total c -> if c == '\n' then total + 1 else total) 0--diffDiff :: String -> String -> [ChangeEvent]-diffDiff s1 s2 = utilDiffToLspDiff (DD.getGroupedDiff s1 s2)

@@ -31,13 +31,19 @@    diff,    diff2,    DiffElement(..),++   utilDiff,+   utilDiffToLspDiff    ) where  -import Data.Array- import Control.Monad.ST-import Data.Array.ST+import Data.Array hiding (index)+import Data.Array.ST hiding (index)+import Data.Diff.Types+import Data.Function+import qualified Data.List as L+import qualified Data.Text as T  -- import Util.ExtendedPrelude @@ -317,3 +323,45 @@             fmap                (\ (xs1,xs2) -> (x:xs1,xs2))                (sTC xs)++-- * Shim+++utilDiffToLspDiff :: [DiffElement Char] -> [ChangeEvent]+utilDiffToLspDiff elems = go [] 0 0 elems+  where+    go events curLine curChar ((InBoth chars):xs) = go events curLine' curChar' xs+      where+        curLine' = curLine + countNewlines chars+        curChar' = if hasNewline chars then lengthOfLastLine chars else curChar + (L.length chars)++    go events curLine curChar ((InFirst chars):xs) = go ((ChangeEvent (Range startPos endPos) ""):events) curLine' curChar' xs+      where+        startPos = Position curLine curChar+        endPos = Position (curLine + countNewlines chars) (if hasNewline chars then lengthOfLastLine chars else curChar + (L.length chars))++        curLine' = curLine+        curChar' = curChar++    go events curLine curChar ((InSecond chars):xs) = go ((ChangeEvent (Range startPos endPos) (T.pack chars)):events) curLine' curChar' xs+      where+        startPos = Position curLine curChar+        endPos = startPos++        curLine' = curLine + countNewlines chars+        curChar' = if hasNewline chars then lengthOfLastLine chars else curChar + (L.length chars)++    go events _curLine _curChar [] = reverse events++    hasNewline = any (== '\n')++    lengthOfLastLine chars = chars+                           & T.pack+                           & T.splitOn "\n"+                           & last+                           & T.length++    countNewlines = L.foldl' (\total c -> if c == '\n' then total + 1 else total) 0++utilDiff :: String -> String -> [ChangeEvent]+utilDiff s1 s2 = utilDiffToLspDiff (diff s1 s2)

@@ -1,53 +0,0 @@--module Data.Diff.UniMyersShim (-  utilDiff-  ) where--import Data.Diff.Types-import qualified Data.Diff.UniMyers as UM-import Data.Function-import qualified Data.List as L-import qualified Data.Text as T---utilDiffToLspDiff :: [UM.DiffElement Char] -> [ChangeEvent]-utilDiffToLspDiff elems = go [] 0 0 elems-  where-    go events curLine curChar ((UM.InBoth chars):xs) = go events curLine' curChar' xs-      where-        curLine' = curLine + countNewlines chars-        curChar' = if hasNewline chars then fromIntegral (lengthOfLastLine chars) else curChar + fromIntegral (L.length chars)--    go events curLine curChar ((UM.InFirst chars):xs) = go ((ChangeEvent (Range startPos endPos) ""):events) curLine' curChar' xs-      where-        startPos = Position curLine curChar-        endPos = Position (curLine + countNewlines chars) (if hasNewline chars then fromIntegral (lengthOfLastLine chars) else curChar + fromIntegral (L.length chars))--        curLine' = curLine-        curChar' = curChar--    go events curLine curChar ((UM.InSecond chars):xs) = go ((ChangeEvent (Range startPos endPos) (T.pack chars)):events) curLine' curChar' xs-      where-        startPos = Position curLine curChar-        endPos = startPos--        curLine' = curLine + countNewlines chars-        curChar' = if hasNewline chars then fromIntegral (lengthOfLastLine chars) else curChar + fromIntegral (L.length chars)--    go events _curLine _curChar [] = reverse events--    hasNewline = any (== '\n')--    lengthOfLastLine chars = chars-                           & T.pack-                           & T.splitOn "\n"-                           & last-                           & T.length--    countNewlines = L.foldl' (\total c -> if c == '\n' then total + 1 else total) 0--utilDiff :: String -> String -> [ChangeEvent]-utilDiff s1 s2 = utilDiffToLspDiff (UM.diff s1 s2)--s1 = ""-s2 = "I"

@@ -0,0 +1,240 @@+{-# 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'+  , diffStrings++  -- * Lowest level diff function+  , diff++  -- * Working with edit scripts+  , editScriptToChangeEvents+  , consolidateEditScript++  -- * Types+  , Edit(..)+  ) 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)+++-- | Diff 'Text's to produce an edit script.+diffTexts :: Text -> Text -> Seq Edit+diffTexts left right = runST $ do+  -- This is faster than VU.fromList (T.unpack left), right?+  let l = VU.generate (T.length left) (\i -> T.index left i)+  let r = VU.generate (T.length right) (\i -> T.index right i)+  diff l r++-- | Diff 'Text's to produce LSP-style change events.+diffTextsToChangeEvents :: Text -> Text -> [ChangeEvent]+diffTextsToChangeEvents = diffTextsToChangeEvents' id++-- | Diff 'Text's to produce consolidated LSP-style change events.+diffTextsToChangeEventsConsolidate :: Text -> Text -> [ChangeEvent]+diffTextsToChangeEventsConsolidate = diffTextsToChangeEvents' consolidateEditScript++-- | Diff 'Text's with a custom consolidation function.+diffTextsToChangeEvents' :: (Seq Edit -> Seq Edit) -> Text -> Text -> [ChangeEvent]+diffTextsToChangeEvents' consolidateFn left right = F.toList $ editScriptToChangeEvents l r (consolidateFn (runST (diff l r)))+  where+    l = VU.generate (T.length left) (\i -> T.index left i)+    r = VU.generate (T.length right) (\i -> T.index right i)++-- | To use in benchmarking against other libraries that use String.+diffStrings :: String -> String -> Seq Edit+diffStrings left right = runST $ do+  let leftThawed = VU.fromList left+  let rightThawed = VU.fromList right+  diff leftThawed rightThawed++-- * Core++diff :: (+  PrimMonad m, Unbox a, Eq a, Show a+  ) => Vector a -> Vector a -> m (Seq Edit)+diff e f = diff' e f 0 0++diff' :: (+  PrimMonad m, Unbox a, Eq a, Show a+  ) => Vector a -> Vector a -> Int -> Int -> m (Seq Edit)+diff' e f i j = do+  let (bigN, bigM) = (VU.length e, VU.length f)+  let bigZ = (2 * (min bigN bigM)) + 2+  g <- new bigZ+  p <- new bigZ+  diff'' g p e f i 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'' g' p' e f i j = do+  let (bigN, bigM) = (VU.length e, VU.length f)+  let (bigL, bigZ) = (bigN + bigM, (2 * (min bigN bigM)) + 2)++  if | bigN > 0 && bigM > 0 -> do+         let w = bigN - bigM++         -- Clear out the reused memory vectors+         let g = VUM.unsafeSlice 0 bigZ g'+         VUM.set g 0+         let p = VUM.unsafeSlice 0 bigZ p'+         VUM.set p 0++         flip fix 0 $ \loopBaseH -> \case+           h | not (h <= ((bigL `pyDiv` 2) + (if (bigL `pyMod` 2) /= 0 then 1 else 0))) -> return []+           h -> do+             let loopH = loopBaseH (h + 1)+             flip fix (0 :: Int) $ \loopBaseR -> \case+               r | not (r <= 1) -> loopH+               r -> do+                 let loopR = loopBaseR (r + 1)+                 let (c, d, o, m) = if r == 0 then (g, p, 1, 1) else (p, g, 0, -1)+                 flip fix (negate (h - (2 * (max 0 (h - bigM))))) $ \loopBaseK -> \case+                   k | not (k <= (h - (2 * (max 0 (h - bigN))))) -> loopR+                   k -> do+                     let loopK = loopBaseK (k + 2)+                     aInitial <- do+                       prevC <- unsafeRead c ((k-1) `pyMod` bigZ)+                       nextC <- unsafeRead c ((k+1) `pyMod` bigZ)+                       return (if (k == (-h) || (k /= h && (prevC < nextC))) then nextC else prevC + 1)+                     let bInitial = aInitial - k+                     let (s, t) = (aInitial, bInitial)++                     (a, b) <- flip fix (aInitial, bInitial) $ \loop (a', b') -> do+                       if | a' < bigN && b' < bigM -> do+                              let eVal = e `unsafeIndex` (((1 - o) * bigN) + (m*a') + (o - 1))+                              let fVal = f `unsafeIndex` (((1 - o) * bigM) + (m*b') + (o - 1))+                              if | eVal == fVal -> loop (a' + 1, b' + 1)+                                 | otherwise -> pure (a', b')+                          | otherwise -> pure (a', b')++                     write c (k `pyMod` bigZ) a+                     let z = negate (k - w)++                     cVal <- unsafeRead c (k `pyMod` bigZ)+                     dVal <- unsafeRead d (z `pyMod` bigZ)+                     if | (bigL `pyMod` 2 == o) && (z >= (negate (h-o))) && (z <= (h-o)) && (cVal + dVal >= bigN) -> do+                            let (bigD, x, y, u, v) = if o == 1 then ((2*h)-1, s, t, a, b) else (2*h, bigN-a, bigM-b, bigN-s, bigM-t)+                            if | bigD > 1 || (x /= u && y /= v) ->+                                  mappend <$> diff'' g p (VU.unsafeSlice 0 x e) (VU.unsafeSlice 0 y f) i j+                                          <*> diff'' g p (VU.unsafeSlice u (bigN - u) e) (VU.unsafeSlice v (bigM - v) f) (i+u) (j+v)+                               | bigM > bigN ->+                                  diff'' g p (VU.unsafeSlice 0 0 e) (VU.unsafeSlice bigN (bigM - bigN) f) (i+bigN) (j+bigN)+                               | bigM < bigN ->+                                  diff'' g p (VU.unsafeSlice bigM (bigN - bigM) e) (VU.unsafeSlice 0 0 f) (i+bigM) (j+bigM)+                               | otherwise -> return []+                        | otherwise -> loopK+++     | bigN > 0 -> return [EditDelete i (i + (bigN - 1))]+     | bigM == 0 -> return []+     | otherwise -> return [EditInsert i j (j + (bigM - 1))]++{-# INLINABLE pyMod #-}+pyMod :: Integral a => a -> a -> a+pyMod x y = if y >= 0 then x `mod` y else (x `mod` y) - y++{-# INLINABLE pyDiv #-}+pyDiv :: Integral a => a -> a -> a+pyDiv x y = if (x < 0) `xor` (y < 0) then -((-x) `div` y) else x `div` y+++-- | Convert edit script to LSP-style change events.+editScriptToChangeEvents :: VU.Vector Char -> VU.Vector Char -> Seq Edit -> Seq ChangeEvent+editScriptToChangeEvents left right = go mempty 0 0 0+  where+    go :: Seq ChangeEvent -> Int -> Int -> Int -> Seq Edit -> Seq ChangeEvent+    go seqSoFar _ _ _ Empty = seqSoFar++    -- Implicit unchanged section before delete+    go seqSoFar pos line ch args@((EditDelete from _to) :<| _) |+      pos < from = go seqSoFar from line' ch' args+        where+          (numNewlinesEncountered, lastLineLength) = countNewlinesAndLastLineLength (VU.slice pos (from - pos) left)+          line' = line + numNewlinesEncountered+          ch' | numNewlinesEncountered == 0 = ch + (from - pos)+              | otherwise = lastLineLength+    -- Implicit unchanged section before insert+    go seqSoFar pos line ch args@((EditInsert from _rightFrom _rightTo) :<| _) |+      pos < from = go seqSoFar from line' ch' args+        where+          (numNewlinesEncountered, lastLineLength) = countNewlinesAndLastLineLength (VU.slice pos (from - pos) left)+          line' = line + numNewlinesEncountered+          ch' | numNewlinesEncountered == 0 = ch + (from - pos)+              | otherwise = lastLineLength++    go seqSoFar pos line ch ((EditDelete from to) :<| rest) = go (seqSoFar |> change) pos' line ch rest+      where+        change = ChangeEvent (Range (Position line ch) (Position line' ch')) ""+        pos' = to + 1++        deleted = VU.slice from (to + 1 - from) left+        (numNewlinesInDeleted, lastLineLengthInDeleted) = countNewlinesAndLastLineLength deleted+        line' = line + numNewlinesInDeleted+        ch' = if | numNewlinesInDeleted == 0 -> ch + (to - pos + 1)+                 | otherwise -> lastLineLengthInDeleted++    go seqSoFar pos line ch ((EditInsert _at rightFrom rightTo) :<| rest) = go (seqSoFar |> change) pos' line' ch' rest+      where+        change = ChangeEvent (Range (Position line ch) (Position line ch)) (vectorToText inserted)+        pos' = pos++        inserted = VU.slice rightFrom (rightTo + 1 - rightFrom) right+        (numNewlinesInInserted, lastLineLengthInInserted) = countNewlinesAndLastLineLength inserted+        line' = line + numNewlinesInInserted+        ch' = if | numNewlinesInInserted == 0 -> ch + VU.length inserted+                 | otherwise -> lastLineLengthInInserted++    countNewlinesAndLastLineLength :: VU.Vector Char -> (Int, Int)+    countNewlinesAndLastLineLength = VU.foldl' (\(tot, lastLineLength) ch -> if ch == '\n' then (tot + 1, 0) else (tot, lastLineLength + 1)) (0, 0)++    vectorToText :: VU.Vector Char -> T.Text+    vectorToText = T.pack . 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}]+-- | Consolidate adjacent edit script entries to shorten the script.+consolidateEditScript :: Seq Edit -> Seq Edit+consolidateEditScript ((EditInsert pos1 from1 to1) :<| (EditInsert pos2 from2 to2) :<| rest)+  | pos1 == pos2 && to1 + 1 == from2 = consolidateEditScript ((EditInsert pos1 from1 to2) <| rest)+consolidateEditScript ((EditDelete from1 to1) :<| (EditDelete from2 to2) :<| rest)+  | to1 + 1 == from2 = consolidateEditScript ((EditDelete from1 to2) <| rest)+consolidateEditScript (x :<| y :<| rest) = x <| (consolidateEditScript (y <| rest))+consolidateEditScript x = x

@@ -1,251 +0,0 @@-{-# 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 left right = runST $ do-  -- This is faster than VU.fromList (T.unpack left), right?-  let l = VU.generate (T.length left) (\i -> T.index left i)-  let r = VU.generate (T.length right) (\i -> T.index right i)-  diff l r--diffTextsToChangeEvents :: Text -> Text -> [ChangeEvent]-diffTextsToChangeEvents = diffTextsToChangeEvents' id--diffTextsToChangeEventsConsolidate :: Text -> Text -> [ChangeEvent]-diffTextsToChangeEventsConsolidate = diffTextsToChangeEvents' consolidateEditScript--diffTextsToChangeEvents' :: (Seq Edit -> Seq Edit) -> Text -> Text -> [ChangeEvent]-diffTextsToChangeEvents' consolidateFn left right = F.toList $ editScriptToChangeEvents l r (consolidateFn (runST (diff l r)))-  where-    l = VU.generate (T.length left) (\i -> T.index left i)-    r = VU.generate (T.length right) (\i -> T.index right i)---- | To use in benchmarking against other libraries that use String-diffStrings :: String -> String -> Seq Edit-diffStrings left right = runST $ do-  let leftThawed = VU.fromList left-  let rightThawed = VU.fromList right-  diff leftThawed rightThawed---- * IO version to benchmark against--diffTextsIO :: Text -> Text -> IO (Seq Edit)-diffTextsIO left right = do-  -- This is faster than VU.fromList (T.unpack left), right?-  let l = VU.generate (T.length left) (\i -> T.index left i)-  let r = VU.generate (T.length right) (\i -> T.index right i)-  diff l r--diffTextsToChangeEventsIO :: Text -> Text -> IO [ChangeEvent]-diffTextsToChangeEventsIO = diffTextsToChangeEventsIO' id--diffTextsToChangeEventsIOConsolidate :: Text -> Text -> IO [ChangeEvent]-diffTextsToChangeEventsIOConsolidate = diffTextsToChangeEventsIO' consolidateEditScript--diffTextsToChangeEventsIO' :: (Seq Edit -> Seq Edit) -> Text -> Text -> IO [ChangeEvent]-diffTextsToChangeEventsIO' consolidateFn left right = do-  -- This is faster than VU.fromList (T.unpack left), right?-  let l = VU.generate (T.length left) (\i -> T.index left i)-  let r = VU.generate (T.length right) (\i -> T.index right i)-  edits <- diff l r-  return $ F.toList $ editScriptToChangeEvents l r (consolidateFn edits)---- | To use in benchmarking against other libraries that use String-diffStringsIO :: String -> String -> IO (Seq Edit)-diffStringsIO left right = do-  let leftThawed = VU.fromList left-  let rightThawed = VU.fromList right-  diff leftThawed rightThawed---- * Core--diff :: (-  PrimMonad m, Unbox a, Eq a, Show a-  ) => Vector a -> Vector a -> m (Seq Edit)-diff e f = diff' e f 0 0--diff' :: (-  PrimMonad m, Unbox a, Eq a, Show a-  ) => Vector a -> Vector a -> Int -> Int -> m (Seq Edit)-diff' e f i j = do-  let (bigN, bigM) = (VU.length e, VU.length f)-  let bigZ = (2 * (min bigN bigM)) + 2-  g <- new bigZ-  p <- new bigZ-  diff'' g p e f i 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'' g' p' e f i j = do-  let (bigN, bigM) = (VU.length e, VU.length f)-  let (bigL, bigZ) = (bigN + bigM, (2 * (min bigN bigM)) + 2)--  if | bigN > 0 && bigM > 0 -> do-         let w = bigN - bigM--         -- Clear out the reused memory vectors-         let g = VUM.unsafeSlice 0 bigZ g'-         VUM.set g 0-         let p = VUM.unsafeSlice 0 bigZ p'-         VUM.set p 0--         flip fix 0 $ \loopBaseH -> \case-           h | not (h <= ((bigL `pyDiv` 2) + (if (bigL `pyMod` 2) /= 0 then 1 else 0))) -> return []-           h -> do-             let loopH = loopBaseH (h + 1)-             flip fix (0 :: Int) $ \loopBaseR -> \case-               r | not (r <= 1) -> loopH-               r -> do-                 let loopR = loopBaseR (r + 1)-                 let (c, d, o, m) = if r == 0 then (g, p, 1, 1) else (p, g, 0, -1)-                 flip fix (negate (h - (2 * (max 0 (h - bigM))))) $ \loopBaseK -> \case-                   k | not (k <= (h - (2 * (max 0 (h - bigN))))) -> loopR-                   k -> do-                     let loopK = loopBaseK (k + 2)-                     aInitial <- do-                       prevC <- unsafeRead c ((k-1) `pyMod` bigZ)-                       nextC <- unsafeRead c ((k+1) `pyMod` bigZ)-                       return (if (k == (-h) || (k /= h && (prevC < nextC))) then nextC else prevC + 1)-                     let bInitial = aInitial - k-                     let (s, t) = (aInitial, bInitial)--                     (a, b) <- flip fix (aInitial, bInitial) $ \loop (a', b') -> do-                       if | a' < bigN && b' < bigM -> do-                              let eVal = e `unsafeIndex` (((1 - o) * bigN) + (m*a') + (o - 1))-                              let fVal = f `unsafeIndex` (((1 - o) * bigM) + (m*b') + (o - 1))-                              if | eVal == fVal -> loop (a' + 1, b' + 1)-                                 | otherwise -> pure (a', b')-                          | otherwise -> pure (a', b')--                     write c (k `pyMod` bigZ) a-                     let z = negate (k - w)--                     cVal <- unsafeRead c (k `pyMod` bigZ)-                     dVal <- unsafeRead d (z `pyMod` bigZ)-                     if | (bigL `pyMod` 2 == o) && (z >= (negate (h-o))) && (z <= (h-o)) && (cVal + dVal >= bigN) -> do-                            let (bigD, x, y, u, v) = if o == 1 then ((2*h)-1, s, t, a, b) else (2*h, bigN-a, bigM-b, bigN-s, bigM-t)-                            if | bigD > 1 || (x /= u && y /= v) ->-                                  mappend <$> diff'' g p (VU.unsafeSlice 0 x e) (VU.unsafeSlice 0 y f) i j-                                          <*> diff'' g p (VU.unsafeSlice u (bigN - u) e) (VU.unsafeSlice v (bigM - v) f) (i+u) (j+v)-                               | bigM > bigN ->-                                  diff'' g p (VU.unsafeSlice 0 0 e) (VU.unsafeSlice bigN (bigM - bigN) f) (i+bigN) (j+bigN)-                               | bigM < bigN ->-                                  diff'' g p (VU.unsafeSlice bigM (bigN - bigM) e) (VU.unsafeSlice 0 0 f) (i+bigM) (j+bigM)-                               | otherwise -> return []-                        | otherwise -> loopK---     | bigN > 0 -> return [EditDelete i (i + (bigN - 1))]-     | bigM == 0 -> return []-     | otherwise -> return [EditInsert i j (j + (bigM - 1))]--{-# INLINABLE pyMod #-}-pyMod :: Integral a => a -> a -> a-pyMod x y = if y >= 0 then x `mod` y else (x `mod` y) - y--{-# INLINABLE pyDiv #-}-pyDiv :: Integral a => a -> a -> a-pyDiv x y = if (x < 0) `xor` (y < 0) then -((-x) `div` y) else x `div` y----- * Converting edit script to LSP-style change events--editScriptToChangeEvents :: VU.Vector Char -> VU.Vector Char -> Seq Edit -> Seq ChangeEvent-editScriptToChangeEvents left right = go mempty 0 0 0-  where-    go :: Seq ChangeEvent -> Int -> Int -> Int -> Seq Edit -> Seq ChangeEvent-    go seqSoFar _ _ _ Empty = seqSoFar--    -- Implicit unchanged section before delete-    go seqSoFar pos line ch args@((EditDelete from _to) :<| _) |-      pos < from = go seqSoFar from line' ch' args-        where-          (numNewlinesEncountered, lastLineLength) = countNewlinesAndLastLineLength (VU.slice pos (from - pos) left)-          line' = line + numNewlinesEncountered-          ch' | numNewlinesEncountered == 0 = ch + (from - pos)-              | otherwise = lastLineLength-    -- Implicit unchanged section before insert-    go seqSoFar pos line ch args@((EditInsert from _rightFrom _rightTo) :<| _) |-      pos < from = go seqSoFar from line' ch' args-        where-          (numNewlinesEncountered, lastLineLength) = countNewlinesAndLastLineLength (VU.slice pos (from - pos) left)-          line' = line + numNewlinesEncountered-          ch' | numNewlinesEncountered == 0 = ch + (from - pos)-              | otherwise = lastLineLength--    go seqSoFar pos line ch ((EditDelete from to) :<| rest) = go (seqSoFar |> change) pos' line ch rest-      where-        change = ChangeEvent (Range (Position line ch) (Position line' ch')) ""-        pos' = to + 1--        deleted = VU.slice from (to + 1 - from) left-        (numNewlinesInDeleted, lastLineLengthInDeleted) = countNewlinesAndLastLineLength deleted-        line' = line + numNewlinesInDeleted-        ch' = if | numNewlinesInDeleted == 0 -> ch + (to - pos + 1)-                 | otherwise -> lastLineLengthInDeleted--    go seqSoFar pos line ch ((EditInsert _at rightFrom rightTo) :<| rest) = go (seqSoFar |> change) pos' line' ch' rest-      where-        change = ChangeEvent (Range (Position line ch) (Position line ch)) (vectorToText inserted)-        pos' = pos--        inserted = VU.slice rightFrom (rightTo + 1 - rightFrom) right-        (numNewlinesInInserted, lastLineLengthInInserted) = countNewlinesAndLastLineLength inserted-        line' = line + numNewlinesInInserted-        ch' = if | numNewlinesInInserted == 0 -> ch + VU.length inserted-                 | otherwise -> lastLineLengthInInserted--    countNewlinesAndLastLineLength :: VU.Vector Char -> (Int, Int)-    countNewlinesAndLastLineLength = VU.foldl' (\(tot, lastLineLength) ch -> if ch == '\n' then (tot + 1, 0) else (tot, lastLineLength + 1)) (0, 0)--    vectorToText :: VU.Vector Char -> T.Text-    vectorToText = T.pack . 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 ((EditInsert pos1 from1 to1) :<| (EditInsert pos2 from2 to2) :<| rest)-  | pos1 == pos2 && to1 + 1 == from2 = consolidateEditScript ((EditInsert pos1 from1 to2) <| rest)-consolidateEditScript ((EditDelete from1 to1) :<| (EditDelete from2 to2) :<| rest)-  | to1 + 1 == from2 = consolidateEditScript ((EditDelete from1 to2) <| rest)-consolidateEditScript (x :<| y :<| rest) = x <| (consolidateEditScript (y <| rest))-consolidateEditScript x = x

@@ -3,7 +3,7 @@  module Spec.DiffMyersSpec (spec) where -import Data.Diff.DiffMyersShim+import Data.Diff.DiffMyers import Data.Diff.Types import Data.Text as T import Test.Sandwich@@ -16,10 +16,10 @@ spec = describe "DiffMyers" $ do   describe "Single-line cases" $ do     it "simple insertion" $ do-      diffDiff "ab" "abc" `shouldBe` ([ChangeEvent (Range (Position 0 2) (Position 0 2)) "c"])+      diff "ab" "abc" `shouldBe` ([ChangeEvent (Range (Position 0 2) (Position 0 2)) "c"])      it "simple deletion" $ do-      diffDiff "abc" "ab" `shouldBe` ([ChangeEvent (Range (Position 0 2) (Position 0 3)) ""])+      diff "abc" "ab" `shouldBe` ([ChangeEvent (Range (Position 0 2) (Position 0 3)) ""])    describe "QuickCheck" $ introduceQuickCheck $ modifyMaxSuccess (const 10000) $ do     prop "Single change" $ \(InsertOrDelete (from, to)) -> verifyDiff from to@@ -29,7 +29,7 @@ verifyDiff :: Text -> Text -> Bool verifyDiff from to = applyChangesText change from == to   where-    change = diffDiff (T.unpack from) (T.unpack to)+    change = diff (T.unpack from) (T.unpack to)  main :: IO () main = runSandwichWithCommandLineArgs defaultOptions spec

@@ -3,7 +3,7 @@ module Spec.UniMyersSpec (spec) where  import Data.Diff.Types-import Data.Diff.UniMyersShim+import Data.Diff.UniMyers import Data.Text as T import Test.Sandwich import Test.Sandwich.QuickCheck

@@ -6,7 +6,7 @@  import Control.Monad.Catch (MonadThrow) import Data.Diff.Types-import Data.Diff.VectorMyers+import Data.Diff.Myers import Data.Text as T import Test.Sandwich import Test.Sandwich.QuickCheck