myers-diff (empty) → 0.1.0.0

raw patch · 20 files changed

+1565/−0 lines, 20 filesdep +Diffdep +QuickCheckdep +arraysetup-changed

Dependencies added: Diff, QuickCheck, array, base, containers, criterion, deepseq, exceptions, myers-diff, primitive, quickcheck-instances, random, sandwich, sandwich-quickcheck, string-interpolate, text, text-rope, vector, weigh

Files

• CHANGELOG.md +7/−0
• README.md +11/−0
• Setup.hs +2/−0
• app/Main.hs +17/−0
• bench-criterion/Main.hs +76/−0
• bench-weigh/Main.hs +79/−0
• myers-diff.cabal +290/−0
• src-diff-myers/Data/Diff/DiffMyersShim.hs +49/−0
• src-uni-myers/Data/Diff/UniMyers.hs +319/−0
• src-uni-myers/Data/Diff/UniMyersShim.hs +53/−0
• src/Data/Diff/Types.hs +29/−0
• src/Data/Diff/VectorMyers.hs +251/−0
• test-diff-myers/Spec/DiffMyersSpec.hs +35/−0
• test-lib/TestLib/Apply.hs +38/−0
• test-lib/TestLib/Generators.hs +122/−0
• test-lib/TestLib/Instances.hs +23/−0
• test-lib/TestLib/Util.hs +15/−0
• test-uni-myers/Spec/UniMyersSpec.hs +34/−0
• test/Spec.hs +28/−0
• test/Spec/VectorMyersSpec.hs +87/−0

@@ -0,0 +1,7 @@+# Changelog for `myers-diff`++## Unreleased++## 0.1.0.0++* Initial release.

@@ -0,0 +1,11 @@++# Welcome to `myers-diff`++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).

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,17 @@++module Main (main) where++import Data.Diff.VectorMyers+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}|]

@@ -0,0 +1,76 @@+{-# LANGUAGE CPP #-}++module Main (main) where++import Criterion+import Criterion.Main+import qualified Data.Diff.VectorMyers as VM+import Data.String.Interpolate+import Data.Text as T+import TestLib.Instances ()++#ifdef DIFF_MYERS+import qualified Data.Diff.DiffMyersShim 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.diffDiff 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"+      |]

@@ -0,0 +1,79 @@+{-# LANGUAGE CPP #-}++module Main (main) where++import qualified Data.Diff.VectorMyers as VM+import Data.String+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.Instances ()+import Weigh++#ifdef DIFF_MYERS+import qualified Data.Diff.DiffMyersShim 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)+#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"++       putStrLn "HI"++       a++       import Data.Aeson as A++       -- | Here's a nice comment on bar+       bar :: IO ()+       bar = do+         putStrLn "hello"+         putStrLn "world"+      |]

@@ -0,0 +1,290 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.35.1.+--+-- see: https://github.com/sol/hpack++name:           myers-diff+version:        0.1.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+author:         Tom McLaughlin+maintainer:     tom@codedown.io+copyright:      2023 Tom McLaughlin+license:        BSD3+build-type:     Simple+extra-source-files:+    README.md+    CHANGELOG.md++source-repository head+  type: git+  location: https://github.com/codedownio/myers-diff++flag diff_myers+  description: Include the diff implementation from the "Diff" package+  manual: True+  default: False++flag uni_myers+  description: Use the diff implementation from the "uni-util" package (buggy). This causes LGPL code to be included.+  manual: True+  default: False++library+  exposed-modules:+      Data.Diff.Types+      Data.Diff.VectorMyers+  other-modules:+      Paths_myers_diff+  hs-source-dirs:+      src+  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+  build-depends:+      base >=4.7 && <5+    , containers+    , exceptions+    , primitive+    , text+    , vector+  default-language: Haskell2010+  if flag(uni_myers)+    cpp-options: -DUNI_MYERS+  if flag(diff_myers)+    cpp-options: -DDIFF_MYERS+  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+    hs-source-dirs:+        src-diff-myers+    build-depends:+        Diff++executable myers-diff+  main-is: Main.hs+  other-modules:+      TestLib.Apply+      TestLib.Generators+      TestLib.Instances+      TestLib.Util+      Paths_myers_diff+  hs-source-dirs:+      app+      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+    , deepseq+    , exceptions+    , myers-diff+    , primitive+    , quickcheck-instances+    , string-interpolate+    , text+    , text-rope+    , vector+  default-language: Haskell2010+  if flag(uni_myers)+    cpp-options: -DUNI_MYERS+  if flag(diff_myers)+    cpp-options: -DDIFF_MYERS++test-suite myers-diff-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Spec.VectorMyersSpec+      TestLib.Apply+      TestLib.Generators+      TestLib.Instances+      TestLib.Util+      Paths_myers_diff+  hs-source-dirs:+      test+      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+    , deepseq+    , exceptions+    , myers-diff+    , primitive+    , quickcheck-instances+    , sandwich+    , sandwich-quickcheck+    , string-interpolate+    , text+    , text-rope+    , vector+  default-language: Haskell2010+  if flag(uni_myers)+    cpp-options: -DUNI_MYERS+  if flag(diff_myers)+    cpp-options: -DDIFF_MYERS+  if flag(uni_myers)+    other-modules:+        Spec.UniMyersSpec+    hs-source-dirs:+        test-uni-myers+  if flag(uni_myers)+    other-modules:+        Spec.DiffMyersSpec+    hs-source-dirs:+        test-diff-myers++benchmark myers-diff-criterion+  type: exitcode-stdio-1.0+  main-is: Main.hs+  other-modules:+      TestLib.Apply+      TestLib.Generators+      TestLib.Instances+      TestLib.Util+      Paths_myers_diff+  hs-source-dirs:+      bench-criterion+      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+    , array+    , base >=4.7 && <5+    , containers+    , criterion+    , deepseq+    , exceptions+    , myers-diff+    , primitive+    , quickcheck-instances+    , random+    , string-interpolate+    , text+    , text-rope+    , vector+  default-language: Haskell2010+  if flag(uni_myers)+    cpp-options: -DUNI_MYERS+  if flag(diff_myers)+    cpp-options: -DDIFF_MYERS++benchmark myers-diff-weigh+  type: exitcode-stdio-1.0+  main-is: Main.hs+  other-modules:+      TestLib.Apply+      TestLib.Generators+      TestLib.Instances+      TestLib.Util+      Paths_myers_diff+  hs-source-dirs:+      bench-weigh+      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+    , array+    , base >=4.7 && <5+    , containers+    , deepseq+    , exceptions+    , myers-diff+    , primitive+    , quickcheck-instances+    , 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

@@ -0,0 +1,49 @@++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)

@@ -0,0 +1,319 @@++-- Taken this code from https://hackage.haskell.org/package/uni-util, in the Util.Myers module+-- This code is under the LGPL.++{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Implementation of the Myers algorithm, from "An O(ND) Difference Algorithm+-- and Its Variations", by Eugene Myers page 6 (figure 2).+--+-- Specification: if+--+--    f1 (InBoth v) = Just v+--    f1 (InFirst v) = Just v+--    f1 (InSecond v) = Nothing+--+-- and+--+--    f2 (InBoth v) = Just v+--    f2 (InFirst v) = Nothing+--    f2 (InSecond v) = Just v+--+-- then+--+--    mapPartial f1 (diff l1 l2) == l1+--+-- and+--+--    mapPartial f2 (diff l1 l2) == l2+module Data.Diff.UniMyers (+   diff,+   diff2,+   DiffElement(..),+   ) where+++import Data.Array++import Control.Monad.ST+import Data.Array.ST++-- import Util.ExtendedPrelude++-- -----------------------------------------------------------------------+-- Datatypes+-- -----------------------------------------------------------------------++data DiffElement v =+      InBoth [v]+   |  InFirst [v]+   |  InSecond [v] deriving (Show)++-- -----------------------------------------------------------------------+-- The implementation.  The whole function, apart from the body of diff+-- itself, is taken from a message from Andrew Bromage+-- -----------------------------------------------------------------------++diff :: (Eq a) => [a] -> [a] -> [DiffElement a]+diff l1 l2 =+   let+      common = lcss l1 l2++      addFirst :: [a] -> [DiffElement a] -> [DiffElement a]+      addFirst [] de0 = de0+      addFirst l1 de0 = InFirst l1 : de0++      addSecond :: [a] -> [DiffElement a] -> [DiffElement a]+      addSecond [] de0 = de0+      addSecond l1 de0 = InSecond l1 : de0++      doCommon :: Eq a => [a] -> [a] -> [a] -> [DiffElement a]+      doCommon [] l1 l2 = (addFirst l1) . (addSecond l2) $ []+      doCommon (c:cs) l10 l20 =+         let+            Just (l1A,l11) = splitToElem (== c) l10+            Just (l2A,l21) = splitToElem (== c) l20+            de0 = doCommon cs l11 l21+            de1 = case de0 of+               (InBoth cs:rest) -> InBoth (c:cs):rest+               _ -> InBoth [c] : de0+         in+             (addFirst l1A) . (addSecond l2A) $ de1+   in+      doCommon common l1 l2++-- stolen from message from Andrew Bromage+algb :: (Eq a) => [a] -> [a] -> [Int]+algb xs ys+  = 0 : algb1 xs [ (y,0) | y <- ys ]+  where+    algb1 [] ys' = map snd ys'+    algb1 (x:xs) ys'+      = algb1 xs (algb2 0 0 ys')+      where+        algb2 _ _ [] = []+        algb2 k0j1 k1j1 ((y,k0j):ys)+          = let kjcurr = if x == y then k0j1+1 else max k1j1 k0j+            in (y,kjcurr) : algb2 k0j kjcurr ys++algc :: (Eq a) => Int -> Int -> [a] -> [a] -> [a] -> [a]+algc m n xs []  = id+algc m n [x] ys = if x `elem` ys then (x:) else id+algc m n xs ys+  = algc m2 k xs1 (take k ys) . algc (m-m2) (n-k) xs2 (drop k ys)+  where+    m2 = m `div` 2++    xs1 = take m2 xs+    xs2 = drop m2 xs++    l1 = algb xs1 ys+    l2 = reverse (algb (reverse xs2) (reverse ys))++    k = findk 0 0 (-1) (zip l1 l2)++    findk k km m [] = km+    findk k km m ((x,y):xys)+      | x+y >= m  = findk (k+1) k  (x+y) xys+      | otherwise = findk (k+1) km m     xys++lcss :: (Eq a) => [a] -> [a] -> [a]+lcss xs ys = algc (length xs) (length ys) xs ys []+++{- Here, as an appendix, is my slow inefficient version -}+diff2 :: Eq v => [v] -> [v] -> [DiffElement v]+diff2 [] [] = []+diff2 a b = runST (diffST2 a b)++-- NB. diffST does not work if both arguments are null, so that+-- case should be handled separately.+diffST2 :: forall v s . Eq v => [v] -> [v] -> ST s [DiffElement v]+diffST2 a b =+   do+      let+         m = length a+         (aArr :: Array Int v) = listArray (1,m) a++         n = length b+         (bArr :: Array Int v) = listArray (1,n) b++         match :: Int -> Int -> Bool+         match x y = (aArr ! x) == (bArr ! y)++         -- Given (x,y) return the highest (x+k,y+k) such that (x+1,y+1),+         -- (x+2,y+2)...(x+k,y+k) match.+         scan :: Int -> Int -> (Int,Int)+         scan x y =+            if x < m && y < n+               then+                  let+                     x' = x+1+                     y' = y+1+                  in+                     if match x' y' then scan x' y' else (x,y)+               else+                  (x,y)++         max = m+n+      -- We do the computation using an STArray for V+      -- We arrange that there is always a -1 on either side of the+      -- existing range, to simplify handling of the end-cases.+      (v :: STUArray s Int Int) <- newArray (-max-1,max+1) (-1)+      writeArray v 1 0++      -- The w array contains a list of integers (x,y) such that the snakes+      -- starting from the elements (x+1,y+1) together make up all the snakes+      -- needed in the optimal solution.+      --+      -- The idea is that storage for w should not get too big, either if a+      -- and b are much the same, or if they are completely different.  Thus+      -- in most cases quadratic behaviour *should* be avoided.+      (w :: STArray s Int [(Int,Int)]) <- newArray (-max,max) []++      let+         -- step carries out the algorithm for a given (d,k), returning+         -- the appropriate w-list.+         step :: Int -> Int -> ST s [(Int,Int)]+         step d k =+            if k > d+               then+                  innerStep (d+1) (-(d+1))+               else+                  innerStep d k++         innerStep :: Int -> Int -> ST s [(Int,Int)]+         innerStep d k =+            do+               vkplus <- readArray v (k+1)+               vkminus <- readArray v (k-1)+               (x,l0) <- if vkminus < vkplus+                  then+                     do+                        l0 <- readArray w (k+1)+                        return (vkplus,l0)+                  else+                     do+                        l <- readArray w (k-1)+                        return (vkminus+1,l)+               let+                  y = x - k++                  (x',_) = scan x y++                  l1 =+                     if x' == x+                        then+                           l0+                        else+                           (x,y) : l0++               -- Can we finish now?+               if x' >= m && (y + (x' - x)) >= n+                  then+                     return l1+                  else+                     do+                        writeArray v k x'+                        writeArray w k l1+                        step d (k+2)++      snakes <- step 0 0++      let+         -- The task is now to reassemble snakes to produce a list.  Since+         -- the snakes are given in reverse order, we may as well produce the+         -- elements in that order and work backwards.++         addSnake :: (Int,Int) -> (Int,Int)+            -> [DiffElement v] -> [DiffElement v]+         addSnake (lastX,lastY) (x,y) l0 =+            -- We assume that elements a[lastX+1...] and b[lastY+1...] have+            -- been dealt with, and we now add on a segment starting with a+            -- snake which begins at (x+1,y+1).+            let+               -- Compute the end of the snake+               (x',y') = scan x y++               -- Add on elements b[y'+1..lastY]+               l1 = (InSecond (map (\ index -> bArr ! index)+                       [y'+1..lastY])) : l0+               -- Add on elements a[x'+1..lastX]+               l2 = (InFirst (map (\ index -> aArr ! index)+                       [x'+1..lastX])) : l1+               -- Add on snake+               l3 = (InBoth (map (\ index -> aArr ! index)+                       [x+1..x'])) : l2+            in+               l3++         doSnakes :: (Int,Int) -> [(Int,Int)] -> [DiffElement v]+            -> [DiffElement v]+         doSnakes last [] l0 =+            -- we pretend there's a zero-length snake starting at (1,1).+            if last /= (0,0) then addSnake last (0,0) l0 else l0+         doSnakes last (s:ss) l0 =+            let+               l1 = addSnake last s l0+            in+               doSnakes s ss l1++         result0 = doSnakes (m,n) snakes []++         result1 = filter+            -- Filter out null elements+            (\ de -> case de of+               InFirst [] -> False+               InSecond [] -> False+               InBoth [] -> False+               _ -> True+               )+            result0++      return result1+{- -}+++-- | This version was posted to the Haskell mailing list by Gertjan Kamsteeg+-- on Sun, 15 Dec 2002.+-- But it seems to be slightly slower than the others.+{-++data In a = F a | S a | B a deriving Show++diff xs ys = steps ([(0,0,[],xs,ys)],[]) where+  steps (((_,_,ws,[],[]):_),_) = reverse ws+  steps d                      = steps (step d) where+    step (ps,qs) = let (us,vs) = h1 ps in (h3 qs (h2 us),vs) where+      h1 []     = ([],[])+      h1 (p:ps) = let (rs,ss) = next p; (us,vs) = h1 ps in (rs++us,ss++vs)+         where+            next (k,n,ws,(x:xs),[])           = ([(k+1,n+1,F x:ws,xs,[])],[])+            next (k,n,ws,[],(y:ys))           = ([(k-1,n+1,S y:ws,[],ys)],[])+            next (k,n,ws,xs@(x:us),ys@(y:vs))+              | x == y    = ([],[(k,n+1,B x:ws,us,vs)])+              | otherwise = ([(k+1,n+1,F x:ws,us,ys),(k-1,n+1,S y:ws,xs,vs)],[])+      h2 []                                   = []+      h2 ps@[_]                               = ps+      h2 (p@(k1,n1,_,_,_):ps@(q@(k2,n2,_,_,_):us))+        | k1 == k2  = if n1 <= n2 then p:h2 us else q:h2 us+        | otherwise = p:h2 ps+      h3 ps [] = ps+      h3 [] qs = qs+      h3 (ps@(p@(k1,n1,_,_,_):us)) (qs@(q@(k2,n2,_,_,_):vs))+        | k1 > k2   = p:h3 us qs+        | k1 == k2  = if n1 <= n2 then p:h3 us vs else q:h3 us vs+        | otherwise = q:h3 ps vs+-}+++splitToElem :: (a -> Bool) -> [a] -> Maybe ([a],[a])+splitToElem fn = sTC+   where+      sTC [] = Nothing+      sTC (x:xs) =+         if fn x then Just ([],xs) else+            fmap+               (\ (xs1,xs2) -> (x:xs1,xs2))+               (sTC xs)

@@ -0,0 +1,53 @@++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,29 @@+{-# OPTIONS_GHC -fno-warn-partial-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-export-lists #-}++module Data.Diff.Types where++import Data.Text+++data Edit = EditDelete { deleteFrom :: Int+                       , deleteTo :: Int }+          | EditInsert { insertPos :: Int+                       , insertFrom :: Int+                       , insertTo :: Int }+  deriving (Show, Eq)+++-- * Types to mimic TextDocumentContentChangeEvent from the lsp-types package++data Position = Position { positionLine :: Int+                         , positionCh :: Int }+  deriving (Show, Eq)++data Range = Range { rangeStart :: Position+                   , rangeEnd :: Position }+  deriving (Show, Eq)++data ChangeEvent = ChangeEvent { range :: Range+                               , text :: Text }+  deriving (Show, Eq)

@@ -0,0 +1,251 @@+{-# 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

@@ -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.DiffMyersShim+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+      diffDiff "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)) ""])++  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 = diffDiff (T.unpack from) (T.unpack to)++main :: IO ()+main = runSandwichWithCommandLineArgs defaultOptions spec

@@ -0,0 +1,38 @@++module TestLib.Apply (+  applyChangesText+  , applyChangeText++  , applyChanges+  , applyChange+  ) where++import Data.Diff.Types+import qualified Data.List as L+import Data.Text+import Data.Text.Rope (Rope)+import qualified Data.Text.Rope as Rope+++-- * Text++applyChangesText :: [ChangeEvent] -> Text -> Text+applyChangesText changes rope = L.foldl' (flip applyChangeText) rope changes++applyChangeText :: ChangeEvent -> Text -> Text+applyChangeText change t = Rope.toText (applyChange change (Rope.fromText t))++-- * Rope++applyChanges :: [ChangeEvent] -> Rope -> Rope+applyChanges changes rope = L.foldl' (flip applyChange) rope changes++applyChange :: ChangeEvent -> Rope -> Rope+applyChange (ChangeEvent (Range (Position sl sc) (Position fl fc)) txt) str+  = changeChars str (Rope.Position (fromIntegral sl) (fromIntegral sc)) (Rope.Position (fromIntegral fl) (fromIntegral fc)) txt++changeChars :: Rope -> Rope.Position -> Rope.Position -> Text -> Rope+changeChars str start finish new = mconcat [before', Rope.fromText new, after]+ where+   (before, after) = Rope.splitAtPosition finish str+   (before', _) = Rope.splitAtPosition start before

@@ -0,0 +1,122 @@+{-# OPTIONS_GHC -fno-warn-missing-export-lists #-}++module TestLib.Generators where++import Data.Function+import Data.String.Interpolate+import Data.Text as T+import Test.QuickCheck as Q+import Test.QuickCheck.Instances.Text ()+++newtype InsertOrDelete = InsertOrDelete (Text, Text)+  deriving (Show, Eq)+instance Arbitrary InsertOrDelete where+  arbitrary = InsertOrDelete <$> oneof [arbitraryInsert, arbitraryDelete]++newtype DocInsertOrDelete = DocInsertOrDelete (Text, Text)+  deriving (Show, Eq)+instance Arbitrary DocInsertOrDelete where+  arbitrary = DocInsertOrDelete <$> oneof [arbitraryDocInsert, arbitraryDocDelete]++newtype MultiInsertOrDelete = MultiInsertOrDelete (Text, Text)+  deriving (Show, Eq)+instance Arbitrary MultiInsertOrDelete where+  arbitrary = arbitrary >>= (MultiInsertOrDelete <$>) . arbitraryChangesSized++newtype DocMultiInsertOrDelete = DocMultiInsertOrDelete (Text, Text)+  deriving (Show, Eq)+instance Arbitrary DocMultiInsertOrDelete where+  arbitrary = arbitrary >>= (DocMultiInsertOrDelete <$>) . arbitraryChangesSized++-- * Apply a series of changes++arbitraryChangesSized :: Text -> Gen (Text, Text)+arbitraryChangesSized initial = sized $ \n -> flip fix (n, initial) $ \loop -> \case+  (0, x) -> return (initial, x)+  (j, cur) -> do+    -- Prefer inserts to deletes at a 3:1 ratio+    next <- oneof [arbitraryInsertOn cur, arbitraryInsertOn cur, arbitraryInsertOn cur, arbitraryDeleteOn cur]+    loop (j - 1, next)++-- * Inserts and deletes++arbitraryDocInsert :: Gen (Text, Text)+arbitraryDocInsert = arbitraryDoc >>= (\initial -> (initial, ) <$> arbitraryInsertOn initial)++arbitraryInsert :: Gen (Text, Text)+arbitraryInsert = arbitrary >>= (\initial -> (initial, ) <$> arbitraryInsertOn initial)++arbitraryInsertOn :: Text -> Gen Text+arbitraryInsertOn initial = do+  toInsert <- arbitrary++  pos <- chooseInt (0, T.length initial)+  let (x, y) = T.splitAt pos initial++  return (x <> toInsert <> y)+++arbitraryDelete :: Gen (Text, Text)+arbitraryDelete = arbitrary >>= (\initial -> (initial, ) <$> arbitraryDeleteOn initial)++arbitraryDocDelete :: Gen (Text, Text)+arbitraryDocDelete = arbitraryDoc >>= (\initial -> (initial, ) <$> arbitraryDeleteOn initial)++arbitraryDeleteOn :: Text -> Gen Text+arbitraryDeleteOn initial = do+  pos1 <- chooseInt (0, max 0 (T.length initial - 1))+  pos2 <- chooseInt (pos1, T.length initial)++  let (x, y) = T.splitAt pos1 initial+  let (_, z) = T.splitAt (pos2 - pos1) y++  return (x <> z)++-- * Docs++arbitraryLine :: Gen Text+arbitraryLine = oneof [pure "", arbitrary]++arbitraryDoc :: Gen Text+arbitraryDoc = T.intercalate "\n" <$> listOf arbitraryLine++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"+      |]

@@ -0,0 +1,23 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module TestLib.Instances () where++import Control.DeepSeq+import Data.Diff.Types+import GHC.Generics+++deriving instance Generic Position+deriving instance NFData Position++deriving instance Generic Range+deriving instance NFData Range++deriving instance Generic ChangeEvent+deriving instance NFData ChangeEvent++deriving instance Generic Edit+deriving instance NFData Edit

@@ -0,0 +1,15 @@++module TestLib.Util (+  mkDelete+  , mkInsert+  ) where++import Data.Diff.Types+import Data.Text as T+++mkDelete :: (Int, Int) -> (Int, Int) -> ChangeEvent+mkDelete (l1, c1) (l2, c2) = ChangeEvent (Range (Position l1 c1) (Position l2 c2)) ""++mkInsert :: (Int, Int) -> (Int, Int) -> Text -> ChangeEvent+mkInsert (l1, c1) (l2, c2) t = ChangeEvent (Range (Position l1 c1) (Position l2 c2)) t

@@ -0,0 +1,34 @@+{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}++module Spec.UniMyersSpec (spec) where++import Data.Diff.Types+import Data.Diff.UniMyersShim+import Data.Text as T+import Test.Sandwich+import Test.Sandwich.QuickCheck+import TestLib.Apply+import TestLib.Generators+++spec :: TopSpec+spec = describe "uni_myers" $ do+  describe "Single-line cases" $ do+    it "simple insertion" $ do+      utilDiff "ab" "abc" `shouldBe` ([ChangeEvent (Range (Position 0 2) (Position 0 2)) "c"])++    it "simple deletion" $ do+      utilDiff "abc" "ab" `shouldBe` ([ChangeEvent (Range (Position 0 2) (Position 0 3)) ""])++  introduceQuickCheck $ modifyMaxSuccess (const 1000) $ 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 = utilDiff (T.unpack from) (T.unpack to)++main :: IO ()+main = runSandwichWithCommandLineArgs defaultOptions spec

@@ -0,0 +1,28 @@+{-# LANGUAGE CPP #-}++module Main (main) where++import Test.Sandwich++#ifdef UNI_MYERS+import Spec.UniMyersSpec as UniMyersSpec+#endif++#ifdef DIFF_MYERS+import Spec.DiffMyersSpec as DiffMyersSpec+#endif++import Spec.VectorMyersSpec as VectorMyersSpec+++main :: IO ()+main = runSandwichWithCommandLineArgs defaultOptions $ do+#ifdef UNI_MYERS+  UniMyersSpec.spec+#endif++#ifdef DIFF_MYERS+  DiffMyersSpec.spec+#endif++  VectorMyersSpec.spec

@@ -0,0 +1,87 @@+{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}+{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}+{-# LANGUAGE OverloadedLists #-}++module Spec.VectorMyersSpec (spec) where++import Control.Monad.Catch (MonadThrow)+import Data.Diff.Types+import Data.Diff.VectorMyers+import Data.Text as T+import Test.Sandwich+import Test.Sandwich.QuickCheck+import TestLib.Apply+import TestLib.Generators+import TestLib.Util+++spec :: TopSpec+spec = describe "VectorMyers" $ do+  describe "Single deletes" $ do+    checkDiff "a" "" [mkDelete (0, 0) (0, 1)]+    checkDiff "ab" "a" [mkDelete (0, 1) (0, 2)]+    checkDiff "ab" "b" [mkDelete (0, 0) (0, 1)]+    checkDiff "\na" "\n" [mkDelete (1, 0) (1, 1)]+    checkDiff "\n\na" "\n\n" [mkDelete (2, 0) (2, 1)]++  describe "Single inserts" $ do+    checkDiff "" "a" [mkInsert (0, 0) (0, 0) "a"]+    checkDiff "\n" "a\n" [mkInsert (0, 0) (0, 0) "a"]+    checkDiff "\n" "\na" [mkInsert (1, 0) (1, 0) "a"]++  describe "Double deletes" $ do+    checkDiff "ab" "" [mkDelete (0, 0) (0, 2)]++    checkDiff "xab" "x" [mkDelete (0, 1) (0, 2), mkDelete (0, 1) (0, 2)]+    checkDiffConsolidated "xab" "x" [mkDelete (0, 1) (0, 3)]++    checkDiff "abc" "b" [mkDelete (0, 0) (0, 1), mkDelete (0, 1) (0, 2)]++  describe "Double inserts" $ do+    checkDiff "" "ab" [mkInsert (0, 0) (0, 0) "ab"]+    checkDiff "x" "xab" [mkInsert (0, 1) (0, 1) "a", mkInsert (0, 2) (0, 2) "b"]+    checkDiffConsolidated "x" "xab" [mkInsert (0, 1) (0, 1) "ab"]++  describe "Longer inserts" $ do+    checkDiff "" "abcde" [mkInsert (0, 0) (0, 0) "abcde"]++  describe "consolidateEditScript" $ do+    it "consolidates two inserts" $ do+      consolidateEditScript [EditInsert 1 1 1, EditInsert 1 2 2] `shouldBe` [EditInsert 1 1 2]+    it "consolidates two deletes" $ do+      consolidateEditScript [EditDelete 1 1, EditDelete 2 2] `shouldBe` [EditDelete 1 2]++  describe "QuickCheck" $ introduceQuickCheck $ modifyMaxSuccess (const 10000) $ do+    describe "Arbitrary text" $ do+      prop "Single change" $ \(InsertOrDelete (from, to)) -> verifyDiff from to+      prop "Multiple changes" $ \(MultiInsertOrDelete (from, to)) -> verifyDiff from to++    describe "Arbitrary document (series of arbitrary texts with plenty of newlines)" $ do+      prop "Single change" $ \(DocInsertOrDelete (from, to)) -> verifyDiff from to+      prop "Multiple changes" $ \(DocMultiInsertOrDelete (from, to)) -> verifyDiff from to+++checkDiff :: MonadThrow m => Text -> Text -> [ChangeEvent] -> SpecFree context m ()+checkDiff from to changes = it (show from <> " -> " <> show to) $ do+  -- Check that the given changes actually work+  applyChangesText changes from `shouldBe` to++  -- Diff produces the desired changse+  diffTextsToChangeEvents from to `shouldBe` changes++checkDiffConsolidated :: MonadThrow m => Text -> Text -> [ChangeEvent] -> SpecFree context m ()+checkDiffConsolidated from to changes = it (show from <> " -> " <> show to <> " (consolidated)") $ do+  -- Check that the given changes actually work+  applyChangesText changes from `shouldBe` to++  -- Diff produces the desired changse+  diffTextsToChangeEventsConsolidate from to `shouldBe` changes++verifyDiff :: Text -> Text -> Bool+verifyDiff from to = (applyChangesText change from == to) && (applyChangesText changeConsolidated from == to)+  where+    change = diffTextsToChangeEvents from to+    changeConsolidated = diffTextsToChangeEventsConsolidate from to++main :: IO ()+main = runSandwichWithCommandLineArgs defaultOptions spec