packages feed

myers-diff 0.2.0.0 → 0.3.0.0

raw patch · 19 files changed

+576/−343 lines, 19 filesdep −randomPVP ok

version bump matches the API change (PVP)

Dependencies removed: random

API changes (from Hackage documentation)

+ Data.Diff.Myers: diffVectors :: Vector Char -> Vector Char -> Seq Edit
+ Data.Diff.Myers: fastTextToVector :: Text -> Vector Char

Files

CHANGELOG.md view
@@ -2,6 +2,11 @@  ## Unreleased +## 0.3.0.0++* Fix quadratic `Text` -> `Vector` conversion.+* Add benchmarks and optimize performance.+ ## 0.2.0.0  * Tidy modules and add haddocks
README.md view
@@ -1,11 +1,60 @@  # 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.+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. 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.+* `-fdiff` will use the [Diff](https://hackage.haskell.org/package/Diff) package. +## Comparison to other libraries++The [Diff](https://hackage.haskell.org/package/Diff) package also implements the Myers algorithm, but a less space-efficient variant. That package advertises $O(D^2)$ space complexity, where $D$ is the number of differences between the two inputs. In the worst case, $D = \max(len(a), len(b))$, so the space usage can be quadratic in the input length.+ [^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).++## Benchmarks++You can generate all the benchmarks by running `./run_all_benchmarks.sh`. Full results can be found in `./benchmark_results`. All benchmarks were run on an Intel i9-13900K.++TL;DR:+* These benchmarks focus on inputs of different sizes, where a single ~30 character region is either inserted or deleted.+* `myers-diff` is faster by around 2.5x, and the advantage grows with larger inputs (around 100k characters).+* `myers-diff` is more space-efficient by 5x for tiny inputs, shrinking to 1.5x for 10k character inputs and 1.3x for 100k character inputs.++Other benchmarks could be run, of course. Future work could involve testing inputs with multiple separated edits, and/or edits of different sizes. Please file an issue if you'd like to discuss a particular workload.++### Time: small inserts++**Test scenario**: generate a random input of $N$ characters, then insert a random string of $\leq 30$ characters somewhere to produce a modified input. Generate 100 such pairs and compare the diffing time of `myers-diff` with `Diff` using [criterion](https://hackage.haskell.org/package/criterion).++![small_insert.png](./benchmark_results/small_insert.png)++| Input size (chars) | myers-diff | Diff | Speedup |+| ----------- | ----------- | ----------- | ----------- |+| 10  | 408us | 1.07ms | 2.6x |+| 100 | 587us | 1.53ms | 2.6x |+| 1000 | 1.81ms | 3.46ms | 1.9x |+| 10000 | 16.6ms | 40.8ms | 2.5x |+| 100000 | 188ms | 823ms | 4.4x |++### Time: small deletes++**Test scenario**: same as for small inserts, but this time delete $\leq 30$ characters from the second input.++![small_delete.png](./benchmark_results/small_delete.png)++These results are very similar to those for small inserts.++### Space: small inserts++**Test scenario**: same as for the small inserts time test. In this test, we measure the bytes allocated by the diffing process using [weigh](https://hackage.haskell.org/package/weigh).++|Input size (chars)|myers-diff (bytes)|Diff (bytes)| Diff / myers-diff|+|---|---|---|---|+|10|1,681,120|8,904,176|5.3x|+|100|3,619,928|13,833,520|3.8x|+|1000|20,044,048|31,669,480|1.6x|+|10000|171,103,240|250,594,080|1.5x|+|100000|1,666,421,824|2,172,753,512|1.3x|
− app/Main.hs
@@ -1,17 +0,0 @@--module Main (main) where--import Data.Diff.Myers-import Data.String.Interpolate-import Data.Text.IO as T-import Test.QuickCheck-import TestLib.Generators---main :: IO ()-main = do-  (doc, doc') <- generate $ variant (42 :: Int) $ resize 50 $ (arbitraryDoc >>= arbitraryChangesSized)-  T.putStrLn [i|Got doc: #{doc}|]-  T.putStrLn [i|Got doc': #{doc'}|]-  let diffs = consolidateEditScript $ diffTexts doc doc'-  T.putStrLn [i|Edit script: #{diffs}|]
+ bench-criterion-small-deletes/Main.hs view
@@ -0,0 +1,22 @@++module Main (main) where++import Criterion+import Criterion.Main+import Data.String.Interpolate+import TestLib.Benchmarking+++numSamples :: Int+numSamples = 500++main :: IO ()+main = defaultMain [+  bgroup [i|Small delete|] [+             testGroup getPairSingleDelete numSamples 10+             , testGroup getPairSingleDelete numSamples 100+             , testGroup getPairSingleDelete numSamples 1000+             , testGroup getPairSingleDelete numSamples 10000+             , testGroup getPairSingleDelete numSamples 100000+             ]+  ]
+ bench-criterion-small-inserts/Main.hs view
@@ -0,0 +1,22 @@++module Main (main) where++import Criterion+import Criterion.Main+import Data.String.Interpolate+import TestLib.Benchmarking+++numSamples :: Int+numSamples = 500++main :: IO ()+main = defaultMain [+  bgroup [i|Small insert|] [+             testGroup getPairSingleInsert numSamples 10+             , testGroup getPairSingleInsert numSamples 100+             , testGroup getPairSingleInsert numSamples 1000+             , testGroup getPairSingleInsert numSamples 10000+             , testGroup getPairSingleInsert numSamples 100000+             ]+  ]
− bench-criterion/Bench/VectorIO.hs
@@ -1,44 +0,0 @@-{-# 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
− bench-criterion/Main.hs
@@ -1,76 +0,0 @@-{-# LANGUAGE CPP #-}--module Main (main) where--import Criterion-import Criterion.Main-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.DiffMyers as DM-#endif---getPair :: IO (String, String, Text, Text)-getPair = do-  putStrLn "Generating pair"-  return (T.unpack file1, T.unpack file2, file1, file2)--main :: IO ()-main = defaultMain [-  env getPair $ \(~(initial, final, initialText, finalText)) ->-    bgroup "Simple" [-      bench "Vector to edit script" $ nf (\(x, y) -> VM.diffTexts x y) (initialText, finalText)-      , bench "Vector to edit script (consolidated)" $ nf (\(x, y) -> VM.consolidateEditScript $ VM.diffTexts x y) (initialText, finalText)-      , bench "Vector to ChangeEvent" $ nf (\(x, y) -> VM.diffTextsToChangeEvents x y) (initialText, finalText)-      , bench "Vector to ChangeEvents (consolidated)" $ nf (\(x, y) -> VM.diffTextsToChangeEventsConsolidate x y) (initialText, finalText)--#ifdef DIFF_MYERS-      , bench "Diff" $ nf (\(x, y) -> DM.diff x y) (initial, final)-#endif-    ]-  ]---file1 :: Text-file1 =-  [__i|foo = 42-       :t foo--       homophones <- readFile "homophones.list"--       putStrLn "HI"--       abc--       import Data.Aeson as A--       -- | Here's a nice comment on bar-       bar :: IO ()-       bar = do-         putStrLn "hello"-         putStrLn "world"-      |]--file2 :: Text-file2 =-  [__i|foo = 42-       :t foo--       homophones <- readFile "homophones.list"--       putStrLn "HI"--       a--       import Data.Aeson as A--       -- | Here's a nice comment on bar-       bar :: IO ()-       bar = do-         putStrLn "hello"-         putStrLn "world"-      |]
+ bench-micro/Main.hs view
@@ -0,0 +1,92 @@+{-# LANGUAGE BangPatterns #-}+module Main (main) where++import Control.Monad+import Criterion+import Criterion.Main+import Data.Maybe+import Data.String.Interpolate+import Data.Text as T+import Data.Text.Internal.Fusion+import qualified Data.Vector.Unboxed as VU+import qualified Data.Vector.Unboxed.Mutable as M+import Weigh+++-- * Weight testing++testFunc :: Int -> Text -> Weigh ()+testFunc inputSize text = wgroup [i|#{inputSize} characters|] $ do+  func' "VU.fromList" fromListMethod text+  func' "VU.fromListN" fromListNMethod text+  func' "generate" generateMethod text+  func' "unfoldr" unfoldrMethod text+  func' "unfoldrN" unfoldrNMethod text+  func' "unfoldrExactN" unfoldrExactNMethod text+  func' "stream" streamCreateMethod text++-- * Criterion testing++testGroup :: Int -> Text -> Benchmark+testGroup inputSize text =+  bgroup [i|#{inputSize} characters|] [+    bench "unfoldr" $ nf unfoldrMethod text+    , bench "stream" $ nf streamCreateMethod text+    -- , bench "VU.fromList" $ nf fromListMethod text+    -- , bench "VU.fromListN" $ nf fromListNMethod text+    -- , bench "generate" $ nf generateMethod text+    -- , bench "unfoldrN" $ nf unfoldrNMethod text+    -- , bench "unfoldrExactN" $ nf unfoldrExactNMethod text+    ]+++-- * Methods++fromListMethod :: Text -> VU.Vector Char+fromListMethod = VU.fromList . T.unpack++fromListNMethod :: Text -> VU.Vector Char+fromListNMethod t = VU.fromListN (T.length t) (T.unpack t)++-- | This one has great allocation but it's O(n^2) time!+generateMethod :: Text -> VU.Vector Char+generateMethod t = VU.generate (T.length t) (T.index t)++unfoldrMethod :: Text -> VU.Vector Char+unfoldrMethod = VU.unfoldr T.uncons++unfoldrNMethod :: Text -> VU.Vector Char+unfoldrNMethod t = VU.unfoldrN (T.length t) T.uncons t++unfoldrExactNMethod :: Text -> VU.Vector Char+unfoldrExactNMethod t = VU.unfoldrExactN (T.length t) (fromJust . T.uncons) t++streamCreateMethod :: Text -> VU.Vector Char+streamCreateMethod t =+  case stream t of+    Stream step s0 _ -> VU.create $ do+      m <- M.new (T.length t)+      let+        go s i =+          case step s of+            Done -> pure ()+            Skip s' -> go s' i+            Yield x s' -> do+              M.write m i x+              go s' (i + 1)+      go s0 0+      pure m++-- * Main++main :: IO ()+main = do+  defaultMain [+    testGroup n (T.replicate n "0") | n <- [10, 100, 1000, 10000, 100000]+    -- testGroup n | n <- [10, 100, 1000, 10000, 100000]+    ]++  mainWith $+    forM_ [10, 100, 1000, 10000, 100000] $ \n -> do+      let !text = T.replicate n "0"+      testFunc n text
bench-weigh/Main.hs view
@@ -3,77 +3,55 @@ module Main (main) where  import qualified Data.Diff.Myers as VM-import Data.String+import qualified Data.List as L import Data.String.Interpolate import Data.Text as T-import Data.Text.Encoding as T import qualified Data.Vector.Unboxed as VU-import Data.Vector.Unboxed.Mutable as VUM+import TestLib.Benchmarking import TestLib.Instances () import Weigh -#ifdef DIFF_MYERS-import qualified Data.Diff.DiffMyers as DM+#ifdef DIFF+import qualified Data.Diff.Diff as DD #endif  -main :: IO ()-main = mainWith $ do-#ifdef DIFF_MYERS-  func "Diff" (\(x, y) -> DM.diff x y) (T.unpack file1, T.unpack file2)+testFunc :: Int -> [(String, String, Text, Text, VU.Vector Char, VU.Vector Char)] -> Weigh ()+testFunc inputSize samples = wgroup [i|#{inputSize} characters|] $ do+  func' "myers-diff-vector" (L.map (\(_, _, _, _, initialVector, finalVector) -> (VM.diffVectors initialVector finalVector))) samples+  func' "myers-diff-string" (L.map (\(initialString, finalString, _, _, _, _) -> (VM.diffStrings initialString finalString))) samples+  func' "myers-diff-text" (L.map (\(_, _, initialText, finalText, _, _) -> (VM.diffTexts initialText finalText))) samples+#ifdef DIFF+  func' "Diff" (L.map (\(initialString, finalString, _, _, _, _) -> (DD.diff initialString finalString))) samples #endif -  func "Vector" (\(x, y) -> VM.diffTextsToChangeEvents x y) (file1, file2)--  -- value "file1 vector" (force (VU.generate (T.length file1) (\i -> T.index file1 i)))-  -- value "file2 vector" (force (VU.generate (T.length file2) (\i -> T.index file2 i)))--  -- value "file1" file1-  -- value "file2" file2--  value "file2 string" (T.unpack file2)-  value "file2 bytes" (T.encodeUtf8 file2)--  action "file2 vector" (VUM.generate (T.length file2) (\i -> T.index file2 i))----file1 :: Text-file1 =-  [__i|foo = 42-       :t foo--       homophones <- readFile "homophones.list"--       putStrLn "HI"--       abc--       import Data.Aeson as A--       -- | Here's a nice comment on bar-       bar :: IO ()-       bar = do-         putStrLn "hello"-         putStrLn "world"-      |]--file2 :: Text-file2 =-  [__i|foo = 42-       :t foo--       homophones <- readFile "homophones.list"+main :: IO ()+main = do+  insertSamples10 <- getPairSingleInsert 100 10+  insertSamples100 <- getPairSingleInsert 100 100+  insertSamples1000 <- getPairSingleInsert 100 1000+  insertSamples10000 <- getPairSingleInsert 100 10000+  insertSamples100000 <- getPairSingleInsert 100 100000 -       putStrLn "HI"+  deleteSamples10 <- getPairSingleDelete 100 10+  deleteSamples100 <- getPairSingleDelete 100 100+  deleteSamples1000 <- getPairSingleDelete 100 1000+  deleteSamples10000 <- getPairSingleDelete 100 10000+  deleteSamples100000 <- getPairSingleDelete 100 100000 -       a+  mainWith $ do+    setFormat Markdown -       import Data.Aeson as A+    wgroup [i|Single insert (100 samples each)|] $ do+      testFunc 10 insertSamples10+      testFunc 100 insertSamples100+      testFunc 1000 insertSamples1000+      testFunc 10000 insertSamples10000+      testFunc 100000 insertSamples100000 -       -- | Here's a nice comment on bar-       bar :: IO ()-       bar = do-         putStrLn "hello"-         putStrLn "world"-      |]+    wgroup [i|Single delete (100 samples each)|] $ do+      testFunc 10 deleteSamples10+      testFunc 100 deleteSamples100+      testFunc 1000 deleteSamples1000+      testFunc 10000 deleteSamples10000+      testFunc 100000 deleteSamples100000
myers-diff.cabal view
@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.1.+-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack  name:           myers-diff-version:        0.2.0.0+version:        0.3.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@@ -22,7 +22,7 @@   type: git   location: https://github.com/codedownio/myers-diff -flag diff_myers+flag diff   description: Include the diff implementation from the "Diff" package   manual: True   default: False@@ -66,8 +66,8 @@   default-language: Haskell2010   if flag(uni_myers)     cpp-options: -DUNI_MYERS-  if flag(diff_myers)-    cpp-options: -DDIFF_MYERS+  if flag(diff)+    cpp-options: -DDIFF   if flag(uni_myers)     exposed-modules:         Data.Diff.UniMyers@@ -75,24 +75,28 @@         src-uni-myers     build-depends:         array-  if flag(diff_myers)+  if flag(diff)     exposed-modules:-        Data.Diff.DiffMyers+        Data.Diff.Diff     hs-source-dirs:-        src-diff-myers+        src-diff     build-depends:         Diff -executable myers-diff-  main-is: Main.hs+test-suite myers-diff-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs   other-modules:+      Spec.VectorMyersSpec       TestLib.Apply+      TestLib.Benchmarking       TestLib.Generators       TestLib.Instances       TestLib.Util+      TestLib.VectorIO       Paths_myers_diff   hs-source-dirs:-      app+      test       test-lib   default-extensions:       OverloadedStrings@@ -114,11 +118,14 @@       QuickCheck     , base >=4.7 && <5     , containers+    , criterion     , deepseq     , exceptions     , myers-diff     , primitive     , quickcheck-instances+    , sandwich+    , sandwich-quickcheck     , string-interpolate     , text     , text-rope@@ -126,21 +133,32 @@   default-language: Haskell2010   if flag(uni_myers)     cpp-options: -DUNI_MYERS-  if flag(diff_myers)-    cpp-options: -DDIFF_MYERS+  if flag(diff)+    cpp-options: -DDIFF+  if flag(uni_myers)+    other-modules:+        Spec.UniMyersSpec+    hs-source-dirs:+        test-uni-myers+  if flag(diff)+    other-modules:+        Spec.DiffMyersSpec+    hs-source-dirs:+        test-diff -test-suite myers-diff-test+benchmark micro   type: exitcode-stdio-1.0-  main-is: Spec.hs+  main-is: Main.hs   other-modules:-      Spec.VectorMyersSpec       TestLib.Apply+      TestLib.Benchmarking       TestLib.Generators       TestLib.Instances       TestLib.Util+      TestLib.VectorIO       Paths_myers_diff   hs-source-dirs:-      test+      bench-micro       test-lib   default-extensions:       OverloadedStrings@@ -162,45 +180,86 @@       QuickCheck     , base >=4.7 && <5     , containers+    , criterion     , deepseq     , exceptions     , myers-diff     , primitive     , quickcheck-instances-    , sandwich-    , sandwich-quickcheck     , string-interpolate     , text     , text-rope     , vector+    , weigh   default-language: Haskell2010   if flag(uni_myers)     cpp-options: -DUNI_MYERS-  if flag(diff_myers)-    cpp-options: -DDIFF_MYERS+  if flag(diff)+    cpp-options: -DDIFF++benchmark myers-diff-criterion-small-deletes+  type: exitcode-stdio-1.0+  main-is: Main.hs+  other-modules:+      TestLib.Apply+      TestLib.Benchmarking+      TestLib.Generators+      TestLib.Instances+      TestLib.Util+      TestLib.VectorIO+      Paths_myers_diff+  hs-source-dirs:+      bench-criterion-small-deletes+      test-lib+  default-extensions:+      OverloadedStrings+      QuasiQuotes+      NamedFieldPuns+      RecordWildCards+      ScopedTypeVariables+      FlexibleContexts+      FlexibleInstances+      LambdaCase+      ConstraintKinds+      ViewPatterns+      TupleSections+      MultiWayIf+      NumericUnderscores+      MultiParamTypeClasses+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N -O2+  build-depends:+      QuickCheck+    , base >=4.7 && <5+    , containers+    , criterion+    , deepseq+    , exceptions+    , myers-diff+    , primitive+    , quickcheck-instances+    , string-interpolate+    , text+    , text-rope+    , vector+  default-language: Haskell2010   if flag(uni_myers)-    other-modules:-        Spec.UniMyersSpec-    hs-source-dirs:-        test-uni-myers-  if flag(diff_myers)-    other-modules:-        Spec.DiffMyersSpec-    hs-source-dirs:-        test-diff-myers+    cpp-options: -DUNI_MYERS+  if flag(diff)+    cpp-options: -DDIFF -benchmark myers-diff-criterion+benchmark myers-diff-criterion-small-inserts   type: exitcode-stdio-1.0   main-is: Main.hs   other-modules:-      Bench.VectorIO       TestLib.Apply+      TestLib.Benchmarking       TestLib.Generators       TestLib.Instances       TestLib.Util+      TestLib.VectorIO       Paths_myers_diff   hs-source-dirs:-      bench-criterion+      bench-criterion-small-inserts       test-lib   default-extensions:       OverloadedStrings@@ -220,7 +279,6 @@   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N -O2   build-depends:       QuickCheck-    , array     , base >=4.7 && <5     , containers     , criterion@@ -229,7 +287,6 @@     , myers-diff     , primitive     , quickcheck-instances-    , random     , string-interpolate     , text     , text-rope@@ -237,17 +294,19 @@   default-language: Haskell2010   if flag(uni_myers)     cpp-options: -DUNI_MYERS-  if flag(diff_myers)-    cpp-options: -DDIFF_MYERS+  if flag(diff)+    cpp-options: -DDIFF  benchmark myers-diff-weigh   type: exitcode-stdio-1.0   main-is: Main.hs   other-modules:       TestLib.Apply+      TestLib.Benchmarking       TestLib.Generators       TestLib.Instances       TestLib.Util+      TestLib.VectorIO       Paths_myers_diff   hs-source-dirs:       bench-weigh@@ -270,9 +329,9 @@   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N -O2   build-depends:       QuickCheck-    , array     , base >=4.7 && <5     , containers+    , criterion     , deepseq     , exceptions     , myers-diff@@ -286,5 +345,5 @@   default-language: Haskell2010   if flag(uni_myers)     cpp-options: -DUNI_MYERS-  if flag(diff_myers)-    cpp-options: -DDIFF_MYERS+  if flag(diff)+    cpp-options: -DDIFF
− src-diff-myers/Data/Diff/DiffMyers.hs
@@ -1,49 +0,0 @@--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)
+ src-diff/Data/Diff/Diff.hs view
@@ -0,0 +1,49 @@++module Data.Diff.Diff (+  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)
src/Data/Diff/Myers.hs view
@@ -24,6 +24,7 @@   , diffTextsToChangeEvents   , diffTextsToChangeEventsConsolidate   , diffTextsToChangeEvents'+  , diffVectors   , diffStrings    -- * Lowest level diff function@@ -33,18 +34,22 @@   , editScriptToChangeEvents   , consolidateEditScript +  -- * Util+  , fastTextToVector+   -- * Types   , Edit(..)   ) where  import Control.Monad.Primitive import Control.Monad.ST-import Data.Bits (xor)+import Data.Bits import Data.Diff.Types import qualified Data.Foldable as F import Data.Function import Data.Sequence as Seq import 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)@@ -52,11 +57,9 @@  -- | 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+diffTexts left right = runST $+  diff (fastTextToVector left)+       (fastTextToVector right)  -- | Diff 'Text's to produce LSP-style change events. diffTextsToChangeEvents :: Text -> Text -> [ChangeEvent]@@ -70,9 +73,13 @@ 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)+    l = fastTextToVector left+    r = fastTextToVector right +-- | Diff 'VU.Vector's to produce an edit script.+diffVectors :: VU.Vector Char -> VU.Vector Char -> Seq Edit+diffVectors left right = runST $ diff left right+ -- | To use in benchmarking against other libraries that use String. diffStrings :: String -> String -> Seq Edit diffStrings left right = runST $ do@@ -87,6 +94,8 @@   ) => Vector a -> Vector a -> m (Seq Edit) diff e f = diff' e f 0 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)@@ -97,6 +106,8 @@   p <- new bigZ   diff'' g p e f i 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)@@ -114,7 +125,7 @@          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 | not (h <= ((bigL `quot` 2) + (if (intMod2 bigL) /= 0 then 1 else 0))) -> return []            h -> do              let loopH = loopBaseH (h + 1)              flip fix (0 :: Int) $ \loopBaseR -> \case@@ -146,7 +157,7 @@                       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+                     if | (intMod2 bigL == 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@@ -167,10 +178,9 @@ 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-+{-# INLINABLE intMod2 #-}+intMod2 :: Int -> Int+intMod2 n = n .&. 1  -- | Convert edit script to LSP-style change events. editScriptToChangeEvents :: VU.Vector Char -> VU.Vector Char -> Seq Edit -> Seq ChangeEvent@@ -226,10 +236,6 @@  -- * 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)@@ -238,3 +244,25 @@   | to1 + 1 == from2 = consolidateEditScript ((EditDelete from1 to2) <| rest) consolidateEditScript (x :<| y :<| rest) = x <| (consolidateEditScript (y <| rest)) consolidateEditScript x = 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 t =+  case TI.stream t of+    TI.Stream step s0 _ -> VU.create $ do+      m <- VUM.new (T.length t)+      let+        go s i =+          case step s of+            TI.Done -> pure ()+            TI.Skip s' -> go s' i+            TI.Yield x s' -> do+              VUM.write m i x+              go s' (i + 1)+      go s0 0+      pure m
− test-diff-myers/Spec/DiffMyersSpec.hs
@@ -1,35 +0,0 @@-{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}-{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}--module Spec.DiffMyersSpec (spec) where--import Data.Diff.DiffMyers-import Data.Diff.Types-import Data.Text as T-import Test.Sandwich-import Test.Sandwich.QuickCheck-import TestLib.Apply-import TestLib.Generators---spec :: TopSpec-spec = describe "DiffMyers" $ do-  describe "Single-line cases" $ do-    it "simple insertion" $ do-      diff "ab" "abc" `shouldBe` ([ChangeEvent (Range (Position 0 2) (Position 0 2)) "c"])--    it "simple deletion" $ do-      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-    prop "Multiple changes" $ \(MultiInsertOrDelete (from, to)) -> verifyDiff from to---verifyDiff :: Text -> Text -> Bool-verifyDiff from to = applyChangesText change from == to-  where-    change = diff (T.unpack from) (T.unpack to)--main :: IO ()-main = runSandwichWithCommandLineArgs defaultOptions spec
+ test-diff/Spec/DiffMyersSpec.hs view
@@ -0,0 +1,35 @@+{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}+{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}++module Spec.DiffMyersSpec (spec) where++import Data.Diff.Myers+import Data.Diff.Types+import Data.Text as T+import Test.Sandwich+import Test.Sandwich.QuickCheck+import TestLib.Apply+import TestLib.Generators+++spec :: TopSpec+spec = describe "DiffMyers" $ do+  describe "Single-line cases" $ do+    it "simple insertion" $ do+      diffTextsToChangeEvents "ab" "abc" `shouldBe` ([ChangeEvent (Range (Position 0 2) (Position 0 2)) "c"])++    it "simple deletion" $ do+      diffTextsToChangeEvents "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+    prop "Multiple changes" $ \(MultiInsertOrDelete (from, to)) -> verifyDiff from to+++verifyDiff :: Text -> Text -> Bool+verifyDiff from to = applyChangesText change from == to+  where+    change = diffTextsToChangeEvents from to++main :: IO ()+main = runSandwichWithCommandLineArgs defaultOptions spec
+ test-lib/TestLib/Benchmarking.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE TypeApplications #-}++module TestLib.Benchmarking (+  testGroup++  , getPairSingleInsert+  , getPairSingleDelete++  , getPairWithEdit++  , PairFn+  ) where++import Control.Monad+import Criterion+import qualified Data.Diff.Myers as VM+import qualified Data.List as L+import Data.String.Interpolate+import Data.Text as T+import qualified Data.Vector.Unboxed as VU+import Test.QuickCheck+import TestLib.Generators+import TestLib.Instances ()++#ifdef DIFF+import qualified Data.Diff.Diff as DD+#endif+++-- * Test group++testGroup :: PairFn -> Int -> Int -> Benchmark+testGroup getPair numSamples inputSize =+  env (getPair numSamples inputSize) $ \samples -> do+    bgroup [i|#{inputSize} characters|] [+      bench "myers-diff-vector" $ nf (L.map (\(_, _, _, _, initialVector, finalVector) -> (VM.diffVectors initialVector finalVector))) samples+      , bench "myers-diff-string" $ nf (L.map (\(initialString, finalString, _, _, _, _) -> (VM.diffStrings initialString finalString))) samples+      , bench "myers-diff-text" $ nf (L.map (\(_, _, initialText, finalText, _, _) -> (VM.diffTexts initialText finalText))) samples+#ifdef DIFF+      , bench "Diff" $ nf (L.map (\(initialString, finalString, _, _, _, _) -> (DD.diff initialString finalString))) samples+#endif+      ]++-- * Pair generation++type PairFn = Int -> Int -> IO [(String, String, Text, Text, VU.Vector Char, VU.Vector Char)]++getPairWithEdit :: (Text -> Gen Text) -> PairFn+getPairWithEdit makeEdit numSamples inputSize = do+  replicateM numSamples $ do+    (t1, t2) <- generate ((resize inputSize arbitraryAlphanumericString) >>= (\initial -> (initial, ) <$> makeEdit initial))++    return (T.unpack t1, T.unpack t2+           , t1, t2+           , VM.fastTextToVector t1, VM.fastTextToVector t2+           )++getPairSingleInsert :: PairFn+getPairSingleInsert = getPairWithEdit arbitraryInsertOn++getPairSingleDelete :: PairFn+getPairSingleDelete = getPairWithEdit arbitraryDeleteOn
test-lib/TestLib/Generators.hs view
@@ -41,6 +41,7 @@  -- * Inserts and deletes +-- | Arbitrarily insert up to size parameter characters arbitraryDocInsert :: Gen (Text, Text) arbitraryDocInsert = arbitraryDoc >>= (\initial -> (initial, ) <$> arbitraryInsertOn initial) @@ -63,10 +64,14 @@ arbitraryDocDelete :: Gen (Text, Text) arbitraryDocDelete = arbitraryDoc >>= (\initial -> (initial, ) <$> arbitraryDeleteOn initial) +-- | Arbitrarily delete up to size parameter characters arbitraryDeleteOn :: Text -> Gen Text arbitraryDeleteOn initial = do+  size <- getSize+  amountToDelete :: Int <- chooseInt (1, size)+   pos1 <- chooseInt (0, max 0 (T.length initial - 1))-  pos2 <- chooseInt (pos1, T.length initial)+  pos2 <- chooseInt (pos1, min (pos1 + amountToDelete) (T.length initial))    let (x, y) = T.splitAt pos1 initial   let (_, z) = T.splitAt (pos2 - pos1) y@@ -80,6 +85,12 @@  arbitraryDoc :: Gen Text arbitraryDoc = T.intercalate "\n" <$> listOf arbitraryLine++arbitraryAlphanumericString :: Gen Text+arbitraryAlphanumericString = T.pack <$> listOf alphaNumericChar++alphaNumericChar :: Gen Char+alphaNumericChar = elements (['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ [' '])  file1 :: Text file1 =
+ test-lib/TestLib/VectorIO.hs view
@@ -0,0 +1,41 @@+{-# OPTIONS_GHC -fno-warn-missing-export-lists #-}++module TestLib.VectorIO where++import Data.Diff.Myers+import Data.Diff.Types+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 =+  diff (fastTextToVector left)+       (fastTextToVector right)++-- | 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+  let l = fastTextToVector left+  let r = fastTextToVector right+  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 =+  diff (VU.fromList left)+       (VU.fromList right)
test/Spec.hs view
@@ -8,7 +8,7 @@ import Spec.UniMyersSpec as UniMyersSpec #endif -#ifdef DIFF_MYERS+#ifdef DIFF import Spec.DiffMyersSpec as DiffMyersSpec #endif @@ -21,7 +21,7 @@   UniMyersSpec.spec #endif -#ifdef DIFF_MYERS+#ifdef DIFF   DiffMyersSpec.spec #endif