fast-myers-diff (empty) → 0.0.0
raw patch · 4 files changed
+884/−0 lines, 4 filesdep +basedep +dlistdep +fast-myers-diff
Dependencies added: base, dlist, fast-myers-diff, hspec, text, vector
Files
- LICENSE +7/−0
- fast-myers-diff.cabal +55/−0
- src/Myers/Diff.hs +532/−0
- test/Main.hs +290/−0
+ LICENSE view
@@ -0,0 +1,7 @@+Copyright 2023 Tom Sydney Kerckhove++Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the “Software”), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ fast-myers-diff.cabal view
@@ -0,0 +1,55 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.35.2.+--+-- see: https://github.com/sol/hpack++name: fast-myers-diff+version: 0.0.0+synopsis: A fast implementation of the Myers diff algorithm.+description: A fast implementation of the diffing algorithm described in 'An O(ND) Difference Algorithm and Its Variations' by Eugene W. Myers.+category: Testing+homepage: https://github.com/NorfairKing/sydtest#readme+bug-reports: https://github.com/NorfairKing/sydtest/issues+author: Tom Sydney Kerckhove+maintainer: syd@cs-syd.eu+copyright: Copyright (c) 2023 Tom Sydney Kerckhove+license: MIT+license-file: LICENSE+build-type: Simple+extra-source-files:+ LICENSE++source-repository head+ type: git+ location: https://github.com/NorfairKing/sydtest++library+ exposed-modules:+ Myers.Diff+ other-modules:+ Paths_fast_myers_diff+ hs-source-dirs:+ src+ build-depends:+ base >=4.7 && <5+ , dlist+ , text+ , vector+ default-language: Haskell2010++test-suite fast-myers-diff-test+ type: exitcode-stdio-1.0+ main-is: Main.hs+ other-modules:+ Paths_fast_myers_diff+ hs-source-dirs:+ test+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ base >=4.7 && <5+ , fast-myers-diff+ , hspec+ , text+ , vector+ default-language: Haskell2010
+ src/Myers/Diff.hs view
@@ -0,0 +1,532 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -Wno-unused-imports -Werror=name-shadowing #-}++-- | Myers Diff+--+-- This is an implementation of the O(ND) diff algorithm as described in+-- \"An O(ND) Difference Algorithm and Its Variations (1986)\"+-- <http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.4.6927>.+module Myers.Diff+ ( -- * Diffing+ Diff,+ PolyDiff (..),+ getTextDiff,+ getStringDiff,+ getGroupedStringDiff,+ getVectorDiff,+ getGroupedVectorDiff,+ getVectorDiffBy,+ getGroupedVectorDiffBy,++ -- ** Internals+ Edit (..),+ getEditScript,+ getEditScriptBy,+ computeDiffFromEditScript,+ computeGroupedDiffFromEditScript,++ -- ** Backwards compatibility with @Diff@+ getDiff,+ getDiffBy,+ getGroupedDiff,+ getGroupedDiffBy,+ )+where++import Control.Monad+import Control.Monad.ST+import Data.DList (DList)+import qualified Data.DList as DList+import Data.Maybe (fromJust)+import Data.STRef+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Array as TA+import Data.Vector (Vector, (!))+import qualified Data.Vector as V+import Data.Vector.Mutable (MVector)+import qualified Data.Vector.Mutable as MV++type Diff a = PolyDiff a a++mapDiff :: (a -> b) -> Diff a -> Diff b+mapDiff f = bimapPolyDiff f f++-- | A value is either from the 'First' list, the 'Second' or from 'Both'.+-- 'Both' contains both the left and right values, in case you are using a form+-- of equality that doesn't check all data (for example, if you are using a+-- custom equality relation to only perform equality on side of a tuple).+data PolyDiff a b = First a | Second b | Both a b+ deriving (Show, Eq)++bimapPolyDiff :: (a -> c) -> (b -> d) -> PolyDiff a b -> PolyDiff c d+bimapPolyDiff f g = \case+ First a -> First (f a)+ Second b -> Second (g b)+ Both a b -> Both (f a) (g b)++-- |+--+-- For backward compatibility with 'Diff', use more specific functions if you can.+getDiff :: Eq a => [a] -> [a] -> [Diff a]+getDiff = getDiffBy (==)++-- |+--+-- For backward compatibility with 'Diff', use more specific functions if you can.+getDiffBy :: (a -> b -> Bool) -> [a] -> [b] -> [PolyDiff a b]+getDiffBy eq as bs = V.toList (getVectorDiffBy eq (V.fromList as) (V.fromList bs))++-- |+--+-- For backward compatibility with 'Diff', use more specific functions if you can.+getGroupedDiff :: Eq a => [a] -> [a] -> [Diff [a]]+getGroupedDiff = getGroupedDiffBy (==)++-- |+--+-- For backward compatibility with 'Diff', use more specific functions if you can.+getGroupedDiffBy :: (a -> b -> Bool) -> [a] -> [b] -> [PolyDiff [a] [b]]+getGroupedDiffBy eq as bs = V.toList (V.map (bimapPolyDiff V.toList V.toList) (getGroupedVectorDiffBy eq (V.fromList as) (V.fromList bs)))++-- | 'Text' diff+--+-- Uses pack and unpack, so does not roundtrip.+-- It uses pack and unpack because 'Text' is not the same as @Vector Char@;+-- You can't index a text in O(1) time, it takes O(n) time.+getTextDiff :: Text -> Text -> Vector (Diff Text)+getTextDiff expected actual = V.map (mapDiff packFromVector) $ getGroupedVectorDiff (unpackToVector expected) (unpackToVector actual)+ where+ packFromVector :: Vector Char -> Text+ packFromVector = T.pack . V.toList+ unpackToVector :: Text -> Vector Char+ unpackToVector = V.fromList . T.unpack++-- | 'String' diff+--+-- You probably want to use 'getTextDiff' with packed strings instead, but this+-- function doesn't have the roundtripping problem that 'getTextDiff' has.+getStringDiff :: String -> String -> [Diff Char]+getStringDiff actual expected = V.toList (getVectorDiff (V.fromList actual) (V.fromList expected))++-- | Grouped 'String' diff+--+-- Like 'getStringDiff' but with entire strings instead of individual characters.+getGroupedStringDiff :: String -> String -> [Diff String]+getGroupedStringDiff actual expected = V.toList $ V.map (mapDiff V.toList) $ getGroupedVectorDiff (V.fromList actual) (V.fromList expected)++-- | Diff two 'Vector's+--+-- Prefer 'getGroupedVectorDiff' for performance reasons.+getVectorDiff :: Eq a => Vector a -> Vector a -> Vector (Diff a)+getVectorDiff = getVectorDiffBy (==)++-- | Diff two 'Vector's with different types using a custom equality operator+--+-- Prefer 'getGroupedVectorDiffBy' for performance reasons.+getVectorDiffBy :: forall a b. (a -> b -> Bool) -> Vector a -> Vector b -> Vector (PolyDiff a b)+getVectorDiffBy eq old new = computeDiffFromEditScript old new (getEditScriptBy eq old new)++-- | Diff two 'Vector's with grouped results+getGroupedVectorDiff :: Eq a => Vector a -> Vector a -> Vector (Diff (Vector a))+getGroupedVectorDiff = getGroupedVectorDiffBy (==)++-- | Diff two 'Vector's with grouped results using a custom equality operator+getGroupedVectorDiffBy :: forall a b. (a -> b -> Bool) -> Vector a -> Vector b -> Vector (PolyDiff (Vector a) (Vector b))+getGroupedVectorDiffBy eq old new = computeGroupedDiffFromEditScript old new (getEditScriptBy eq old new)++-- | Compute the edit script to turn a given 'Vector' into the second given 'Vector'+getEditScript :: forall a. Eq a => Vector a -> Vector a -> Vector Edit+getEditScript = getEditScriptBy (==)++-- | Compute the edit script to turn a given 'Vector' into the second given 'Vector' with a custom equality relation+--+-- From https://blog.robertelder.org/diff-algorithm/+getEditScriptBy :: forall a b. (a -> b -> Bool) -> Vector a -> Vector b -> Vector Edit+getEditScriptBy eq old new = V.fromList $ DList.toList $ runST $ go old new 0 0+ where+ go :: forall s. Vector a -> Vector b -> Int -> Int -> ST s (DList Edit)+ go e f i j = do+ -- N,M,L,Z = len(e),len(f),len(e)+len(f),2*min(len(e),len(f))+2+ let upperN :: Int+ upperN = V.length e++ let upperM :: Int+ upperM = V.length f++ let upperL :: Int+ upperL = upperN + upperM++ let upperZ :: Int+ upperZ = 2 * min upperN upperM + 2++ -- if N > 0 and M > 0:+ if upperN > 0 && upperM > 0+ then do+ -- w,g,p = N-M,[0]*Z,[0]*Z+ let w :: Int+ w = upperN - upperM++ g <- MV.replicate upperZ 0 :: ST s (MVector s Int)++ p <- MV.replicate upperZ 0 :: ST s (MVector s Int)++ -- for h in range(0, (L//2+(L%2!=0))+1):+ let hs :: [Int]+ hs = [0 .. ((upperL `quot` 2) + (if odd upperL then 1 else 0))]++ mResult <- forUntilJust hs $ \h -> do+ -- for r in range(0, 2):+ forUntilJust [0, 1 :: Int] $ \r -> do+ -- c,d,o,m = (g,p,1,1) if r==0 else (p,g,0,-1)+ let (c, d, o, m) = if r == 0 then (g, p, 1, 1) else (p, g, 0, -1)++ -- for k in range(-(h-2*max(0,h-M)), h-2*max(0,h-N)+1, 2):+ let lo :: Int+ lo = -(h - 2 * max 0 (h - upperM))++ let hi :: Int+ hi = h - 2 * max 0 (h - upperN)++ let ks :: [Int]+ ks = [lo, lo + 2 .. hi]++ forUntilJust ks $ \k -> do+ -- a = c[(k+1)%Z] if (k==-h or k!=h and c[(k-1)%Z]<c[(k+1)%Z]) else c[(k-1)%Z]+1+ initAVal <- do+ let part1 = k == -h++ let part2 = k /= h++ -- (k+1)%Z+ let kp1Ix = (k + 1) `modPortable` upperZ++ -- (k-1)%Z+ let km1Ix = (k - 1) `modPortable` upperZ+ if part1+ then MV.unsafeRead c kp1Ix+ else do+ if part2+ then do+ -- c[(k-1)%Z]+ km1 <- MV.unsafeRead c km1Ix++ -- c[(k+1)%Z]+ kp1 <- MV.unsafeRead c kp1Ix+ let part3 = km1 < kp1+ pure $+ if part3+ then kp1+ else km1 + 1+ else do+ km1 <- MV.unsafeRead c km1Ix++ pure $ km1 + 1++ a <- newSTRef initAVal++ -- b = a-k+ let initBVal :: Int+ initBVal = initAVal - k++ b <- newSTRef initBVal++ -- s,t = a,b+ s <- newSTRef initAVal+ t <- newSTRef initBVal++ -- while a<N and b<M and e[(1-o)*N+m*a+(o-1)]==f[(1-o)*M+m*b+(o-1)]:+ let computeWhileCond = do+ aVal <- readSTRef a+ -- a<N+ let part1 = aVal < upperN+ if part1+ then do+ bVal <- readSTRef b+ -- b<M+ let part2 = bVal < upperM+ -- e[(1-o)*N+m*a+(o-1)]==f[(1-o)*M+m*b+(o-1)]:+ let mkPart3 = do+ let imo = 1 - o+ omi = o - 1+ -- e[(1-o)*N+m*a+(o-1)]+ leftVal <- do+ -- (1-o)*N+m*a+(o-1)+ let ix = imo * upperN + m * aVal + omi++ pure $ e ! ix+ -- f[(1-o)*M+m*b+(o-1)]+ rightVal <- do+ -- (1-o)*M+m*b+(o-1)+ let ix = imo * upperM + m * bVal + omi++ pure $ f ! ix+ pure $ leftVal `eq` rightVal+ part2 &&. mkPart3+ else pure False+ whileM_ computeWhileCond $ do+ -- a,b = a+1,b+1+ modifySTRef a (+ 1)+ modifySTRef b (+ 1)+ -- c[k%Z],z=a,-(k-w)+ do+ aVal <- readSTRef a++ MV.unsafeWrite c (k `modPortable` upperZ) aVal++ let z = -(k - w)++ -- if L%2==o and z>=-(h-o) and z<=h-o and c[k%Z]+d[z%Z] >= N:+ let -- L%2==o+ part1 = upperL `rem` 2 == o+ -- (h-o)+ hmo = h - o+ -- z>=-(h-o)+ part2 = z >= -hmo+ -- z<=h-o+ part3 = z <= hmo+ -- c[k%Z]+d[z%Z] >= N+ mkPart4 = do+ ck <- MV.unsafeRead c (k `modPortable` upperZ)++ dz <- MV.unsafeRead d (z `modPortable` upperZ)++ pure (ck + dz >= upperN)+ mkCondition = part1 &&. (part2 &&. (part3 &&. mkPart4))+ condition <- mkCondition+ if condition+ then do+ -- D,x,y,u,v = (2*h-1,s,t,a,b) if o==1 else (2*h,N-a,M-b,N-s,M-t)+ (upperD, x, y, u, v) <- do+ aVal <- readSTRef a+ bVal <- readSTRef b+ sVal <- readSTRef s+ tVal <- readSTRef t+ pure $+ if o == 1+ then (2 * h - 1, sVal, tVal, aVal, bVal)+ else (2 * h, upperN - aVal, upperM - bVal, upperN - sVal, upperM - tVal)++ -- if D > 1 or (x != u and y != v):+ if upperD > 1 || (x /= u && y /= v)+ then do+ -- return diff(e[0:x],f[0:y],i,j)+diff(e[u:N],f[v:M],i+u,j+v)+ -- diff(e[0:x],f[0:y],i,j)+ firstHalf <- go (V.slice 0 x e) (V.slice 0 y f) i j+ -- diff(e[u:N],f[v:M],i+u,j+v)+ secondHalf <- go (sliceIx u upperN e) (sliceIx v upperM f) (i + u) (j + v)+ pure (Just (firstHalf <> secondHalf))+ else -- elif M > N:++ if upperM > upperN+ then do+ -- return diff([],f[N:M],i+N,j+N)+ Just <$> go V.empty (sliceIx upperN upperM f) (i + upperN) (j + upperN)+ else -- elif M < N:++ if upperM < upperN+ then do+ -- return diff(e[M:N],[],i+M,j+M)+ Just <$> go (sliceIx upperM upperN e) V.empty (i + upperM) (j + upperM)+ else -- else:+ -- return []+ pure (Just mempty)+ else pure Nothing+ case mResult of+ Nothing -> error "Diff: This is a bug, the diffing algorithm was supposed to terminate and it didn't."+ Just result -> pure result+ else do+ -- elif N > 0: # Modify the return statements below if you want a different edit+ if upperN > 0+ then do+ -- return [{"operation": "delete", "position_old": i+n} for n in range(0,N)]++ pure $ DList.singleton (Delete i upperN)+ else do+ -- return [{"operation": "insert", "position_old": i,"position_new":j+n} for n in range(0,M)]+ if upperM > 0+ then do+ pure $ DList.singleton (Insert i j upperM)+ else do+ pure DList.empty++-- | Compute a diff using an edit script.+--+-- Prefer `computeGroupedDiffFromEditScript` for performance reasons.+computeGroupedDiffFromEditScript :: Vector a -> Vector b -> Vector Edit -> Vector (PolyDiff (Vector a) (Vector b))+computeGroupedDiffFromEditScript old new editSteps = V.create $ do+ -- Computing the exact size is cumbersome, so we make enough space and cut down later.+ -- Enough space means: Space between every two edit steps, and one before and one after.+ let size = length editSteps * 2 + 1+ v <- MV.new size+ groupMarker <- newSTRef 0++ oldMarker <- newSTRef 0+ curMarker <- newSTRef 0+ newMarker <- newSTRef 0++ forM_ editSteps $ \editStep -> do+ -- Copy over the pieces between the last and current edit+ inbetweenIx <- readSTRef oldMarker+ let inbetweenLen = oldPosition editStep - inbetweenIx+ when (inbetweenLen > 0) $ do+ groupIx <- readSTRef groupMarker+ oldIx <- readSTRef oldMarker+ newIx <- readSTRef newMarker+ MV.unsafeWrite v groupIx (Both (V.slice oldIx inbetweenLen old) (V.slice newIx inbetweenLen new))+ modifySTRef groupMarker (+ 1)+ modifySTRef oldMarker (+ inbetweenLen)+ modifySTRef curMarker (+ inbetweenLen)+ modifySTRef newMarker (+ inbetweenLen)++ -- Apply the edit+ case editStep of+ Delete oldPosStart upperN -> do+ groupIx <- readSTRef groupMarker+ MV.unsafeWrite v groupIx (First (V.slice oldPosStart upperN old))+ modifySTRef groupMarker (+ 1)+ modifySTRef oldMarker (+ upperN)+ modifySTRef curMarker (+ upperN)+ Insert _ newPosStart upperM -> do+ groupIx <- readSTRef groupMarker+ MV.unsafeWrite v groupIx (Second (V.slice newPosStart upperM new))+ modifySTRef groupMarker (+ 1)+ modifySTRef curMarker (+ upperM)+ modifySTRef newMarker (+ upperM)++ oldIx <- readSTRef oldMarker+ let afterLen = V.length old - oldIx+ when (afterLen > 0) $ do+ newIx <- readSTRef newMarker+ groupIx <- readSTRef groupMarker+ MV.unsafeWrite v groupIx (Both (V.slice oldIx afterLen old) (V.slice newIx afterLen new))+ modifySTRef groupMarker (+ 1)+ modifySTRef oldMarker (+ 1)+ modifySTRef curMarker (+ 1)+ modifySTRef newMarker (+ 1)++ endGroupIx <- readSTRef groupMarker++ pure (MV.slice 0 endGroupIx v)++-- | Compute a diff using an edit script.+--+-- Prefer `computeGroupedDiffFromEditScript` for performance reasons.+computeDiffFromEditScript :: Vector a -> Vector b -> Vector Edit -> Vector (PolyDiff a b)+computeDiffFromEditScript old new editSteps = V.create $ do+ -- The total size of the diff is the size of the old vector plus the number+ -- of inserts that need to happen.+ -- Not minus the number of deletions, because they get a 'First' constructor and stay.+ let totalSize = V.length old + sum (V.map insertLength editSteps)++ v <- MV.new totalSize+ oldMarker <- newSTRef 0+ curMarker <- newSTRef 0+ newMarker <- newSTRef 0++ forM_ editSteps $ \editStep -> do+ let computeWhileCond1 = do+ oldIx <- readSTRef oldMarker+ pure $ oldPosition editStep > oldIx+ -- Copy over the pieces between the last and current edit+ whileM_ computeWhileCond1 $ do+ oldIx <- readSTRef oldMarker+ curIx <- readSTRef curMarker+ newIx <- readSTRef newMarker+ MV.unsafeWrite v curIx (Both (old ! oldIx) (new ! newIx))+ modifySTRef oldMarker (+ 1)+ modifySTRef curMarker (+ 1)+ modifySTRef newMarker (+ 1)++ -- Apply the edit+ case editStep of+ Delete oldPosStart upperN -> do+ curIx <- readSTRef curMarker+ forM_ [0 .. upperN - 1] $ \n -> do+ MV.unsafeWrite v (curIx + n) (First (old ! (oldPosStart + n)))+ modifySTRef oldMarker (+ upperN)+ modifySTRef curMarker (+ upperN)+ Insert _ newPosStart upperM -> do+ curIx <- readSTRef curMarker+ forM_ [0 .. upperM - 1] $ \n -> do+ MV.unsafeWrite v (curIx + n) (Second (new ! (newPosStart + n)))+ modifySTRef curMarker (+ upperM)+ modifySTRef newMarker (+ upperM)++ let computeWhileCond2 = do+ oldIx <- readSTRef oldMarker+ pure $ oldIx < V.length old++ -- Copy over the pieces between the last and current edit+ whileM_ computeWhileCond2 $ do+ oldIx <- readSTRef oldMarker+ curIx <- readSTRef curMarker+ newIx <- readSTRef newMarker++ MV.unsafeWrite v curIx (Both (old ! oldIx) (new ! newIx))+ modifySTRef oldMarker (+ 1)+ modifySTRef curMarker (+ 1)+ modifySTRef newMarker (+ 1)++ pure v++data Edit+ = -- | Delete from the old vector+ Delete+ Int+ -- ^ position in the old vector+ Int+ -- ^ number of items to delete+ | -- | Insert into the old vector+ Insert+ Int+ -- ^ position in the old vector+ Int+ -- ^ position in the new vector+ Int+ -- ^ number of items to insert+ deriving (Show, Eq, Ord)++oldPosition :: Edit -> Int+oldPosition = \case+ Delete i _ -> i+ Insert i _ _ -> i++insertLength :: Edit -> Int+insertLength = \case+ Delete _ _ -> 0+ Insert _ _ m -> m++modPortable :: Int -> Int -> Int+modPortable a b =+ let r = a `rem` b+ in if r >= 0 then r else r + b++sliceIx :: Int -> Int -> Vector a -> Vector a+sliceIx start end = V.slice start (end - start)++-- | Short-circuiting monadic (&&)+(&&.) :: Applicative m => Bool -> m Bool -> m Bool+(&&.) b1 mkB2 = do+ if b1+ then mkB2+ else pure False++forUntilJust :: Monad m => [a] -> (a -> m (Maybe b)) -> m (Maybe b)+forUntilJust [] _ = pure Nothing+forUntilJust (a : rest) func = do+ mRes <- func a+ case mRes of+ Nothing -> forUntilJust rest func+ Just res -> pure $ Just res++whileM_ :: (Monad m) => m Bool -> m a -> m ()+whileM_ p f = go+ where+ go = do+ x <- p+ if x+ then f >> go+ else return ()
+ test/Main.hs view
@@ -0,0 +1,290 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -Wno-orphans #-}++module Main (main) where++import Control.Monad+import Data.String+import qualified Data.Text as T+import Data.Vector (Vector)+import qualified Data.Vector as V+import Myers.Diff+import Test.Hspec+import Test.Hspec.QuickCheck++-- Just for this test+instance IsString (Vector Char) where+ fromString = V.fromList++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+ describe "getEditScript" $ do+ let exampleSpec :: Vector Char -> Vector Char -> Vector Edit -> Spec+ exampleSpec old new expected =+ it+ ( unwords+ [ "works for",+ show old,+ show new,+ show expected+ ]+ )+ $ do+ let actual = getEditScript old new+ when (actual /= expected) $+ expectationFailure $+ unlines+ [ unwords ["actual:", show actual],+ unwords ["expected:", show expected]+ ]++ exampleSpec "" "" []+ exampleSpec "a" "a" []+ exampleSpec "a" "b" [Delete 0 1, Insert 1 0 1]+ exampleSpec "ab" "ac" [Delete 1 1, Insert 2 1 1]+ exampleSpec "b" "aba" [Insert 0 0 1, Insert 1 2 1]+ exampleSpec "abc" "acb" [Delete 1 1, Insert 3 2 1]+ exampleSpec "aaa" "aba" [Delete 0 1, Insert 2 1 1]+ exampleSpec "foofoo" "foo" [Delete 1 1, Delete 3 1, Delete 5 1]+ exampleSpec "foo" "foofoo" [Insert 1 1 1, Insert 2 3 1, Insert 3 5 1]++ describe "computeDiffFromEditScript" $ do+ let exampleSpec :: Vector Char -> Vector Char -> Vector Edit -> Vector (Diff Char) -> Spec+ exampleSpec old new editScript expected =+ it+ ( unwords+ [ "works for",+ show old,+ show new,+ show editScript,+ show expected+ ]+ )+ $ do+ let actual = computeDiffFromEditScript old new editScript+ when (actual /= expected) $+ expectationFailure $+ unlines+ [ unwords ["actual:", show actual],+ unwords ["expected:", show expected]+ ]++ exampleSpec "" "" [] []+ exampleSpec "a" "a" [] [Both 'a' 'a']+ exampleSpec "a" "b" [Delete 0 1, Insert 1 0 1] [First 'a', Second 'b']+ exampleSpec "ab" "ac" [Delete 1 1, Insert 2 1 1] [Both 'a' 'a', First 'b', Second 'c']+ exampleSpec "b" "aba" [Insert 0 0 1, Insert 1 2 1] [Second 'a', Both 'b' 'b', Second 'a']+ exampleSpec "abc" "acb" [Delete 1 1, Insert 3 2 1] [Both 'a' 'a', First 'b', Both 'c' 'c', Second 'b']+ exampleSpec "aaa" "aba" [Delete 0 1, Insert 2 1 1] [First 'a', Both 'a' 'a', Second 'b', Both 'a' 'a']+ exampleSpec "foofoo" "foo" [Delete 1 1, Delete 3 1, Delete 5 1] [Both 'f' 'f', First 'o', Both 'o' 'o', First 'f', Both 'o' 'o', First 'o']+ exampleSpec "foo" "foofoo" [Insert 1 1 1, Insert 2 3 1, Insert 3 5 1] [Both 'f' 'f', Second 'o', Both 'o' 'o', Second 'f', Both 'o' 'o', Second 'o']++ describe "getVectorDiff" $ do+ let exampleSpec :: Vector Char -> Vector Char -> Vector (Diff Char) -> Spec+ exampleSpec old new expected =+ it+ ( unwords+ [ "works for",+ show old,+ show new,+ show expected+ ]+ )+ $ do+ let actual = getVectorDiff old new+ when (actual /= expected) $+ expectationFailure $+ unlines+ [ unwords ["actual:", show actual],+ unwords ["expected:", show expected]+ ]+ exampleSpec "" "" []+ exampleSpec "a" "a" [Both 'a' 'a']+ exampleSpec "a" "b" [First 'a', Second 'b']+ exampleSpec "ab" "ac" [Both 'a' 'a', First 'b', Second 'c']+ exampleSpec "aaa" "aba" [First 'a', Both 'a' 'a', Second 'b', Both 'a' 'a']+ exampleSpec "abgdef" "gh" [First 'a', First 'b', Both 'g' 'g', First 'd', First 'e', Second 'h', First 'f']+ exampleSpec "foofoo" "foo" [Both 'f' 'f', First 'o', Both 'o' 'o', First 'f', Both 'o' 'o', First 'o']++ prop "says that any list is entirely different from the empty list (left)" $ \ls ->+ let v = V.fromList (ls :: String)+ in getVectorDiff v "" `shouldBe` V.map First v++ prop "says that any list is entirely different from the empty list (right)" $ \ls ->+ let v = V.fromList (ls :: String)+ in getVectorDiff "" v `shouldBe` V.map Second v++ prop "does not find diffs in identical strings" $ \ls ->+ let v = V.fromList (ls :: String)+ in getVectorDiff v v `shouldBe` V.map (\a -> Both a a) v++ prop "only puts equal characters in 'Both'" $ \(ls1, ls2) ->+ let v1 = V.fromList (ls1 :: String)+ v2 = V.fromList (ls2 :: String)+ diff = getVectorDiff v1 v2+ valid = \case+ First _ -> True+ Second _ -> True+ Both a b -> a == b+ in all valid diff++ let rebuildFirst :: Vector (PolyDiff a b) -> Vector a+ rebuildFirst = V.mapMaybe $ \case+ First a -> Just a+ Second _ -> Nothing+ Both a _ -> Just a+ prop "lets you rebuild the old vector" $ \(ls1, ls2) -> do+ let v1 = V.fromList (ls1 :: String)+ v2 = V.fromList (ls2 :: String)+ rebuildFirst (getVectorDiff v1 v2) `shouldBe` v1++ let rebuildSecond :: Vector (PolyDiff a b) -> Vector b+ rebuildSecond = V.mapMaybe $ \case+ First _ -> Nothing+ Second b -> Just b+ Both _ b -> Just b+ prop "lets you rebuild the new vector" $ \(ls1, ls2) -> do+ let v1 = V.fromList (ls1 :: String)+ v2 = V.fromList (ls2 :: String)+ rebuildSecond (getVectorDiff v1 v2) `shouldBe` v2++ let unrollGroupedDiff :: Vector (PolyDiff (Vector a) (Vector b)) -> Vector (PolyDiff a b)+ unrollGroupedDiff = foldMap unrollPolyDiff++ -- Not performant, only for testing+ unrollPolyDiff :: PolyDiff (Vector a) (Vector b) -> Vector (PolyDiff a b)+ unrollPolyDiff = \case+ First va -> V.map First va+ Second vb -> V.map Second vb+ Both va vb -> V.zipWith Both va vb++ prop "is the same thing as getGroupedVectorDiff, but unrolled (unroll grouped)" $ \(ls1, ls2) ->+ let v1 = V.fromList (ls1 :: String)+ v2 = V.fromList (ls2 :: String)+ grouped = getGroupedVectorDiff v1 v2+ individual = getVectorDiff v1 v2+ in unrollGroupedDiff grouped `shouldBe` individual++ describe "getGroupedVectorDiff" $ do+ prop "says that any list is entirely different from the empty list (left)" $ \ls ->+ let v = V.fromList (ls :: String)+ in getGroupedVectorDiff v "" `shouldBe` (if V.null v then V.empty else V.singleton (First v))++ prop "says that any list is entirely different from the empty list (right)" $ \ls ->+ let v = V.fromList (ls :: String)+ in getGroupedVectorDiff "" v `shouldBe` (if V.null v then V.empty else V.singleton (Second v))++ prop "does not find diffs in identical strings" $ \ls ->+ let v = V.fromList (ls :: String)+ in getGroupedVectorDiff v v `shouldBe` (if V.null v then V.empty else V.singleton (Both v v))++ prop "only puts equal vectors in 'Both'" $ \(ls1, ls2) ->+ let v1 = V.fromList (ls1 :: String)+ v2 = V.fromList (ls2 :: String)+ diff = getGroupedVectorDiff v1 v2+ valid = \case+ First _ -> True+ Second _ -> True+ Both a b -> a == b+ in all valid diff++ let rebuildFirst :: Vector (PolyDiff (Vector a) (Vector b)) -> Vector a+ rebuildFirst =+ V.concat+ . V.toList+ . V.mapMaybe+ ( \case+ First a -> Just a+ Second _ -> Nothing+ Both a _ -> Just a+ )+ prop "lets you rebuild the old vector" $ \(ls1, ls2) -> do+ let v1 = V.fromList (ls1 :: String)+ v2 = V.fromList (ls2 :: String)+ rebuildFirst (getGroupedVectorDiff v1 v2) `shouldBe` v1++ let rebuildSecond :: Vector (PolyDiff (Vector a) (Vector b)) -> Vector b+ rebuildSecond =+ V.concat+ . V.toList+ . V.mapMaybe+ ( \case+ First _ -> Nothing+ Second b -> Just b+ Both _ b -> Just b+ )+ prop "lets you rebuild the new vector" $ \(ls1, ls2) -> do+ let v1 = V.fromList (ls1 :: String)+ v2 = V.fromList (ls2 :: String)+ rebuildSecond (getGroupedVectorDiff v1 v2) `shouldBe` v2++ -- Not performant, only for testing.+ let rollupUngroupedDiff :: Vector (PolyDiff a b) -> Vector (PolyDiff (Vector a) (Vector b))+ rollupUngroupedDiff = V.fromList . go . V.toList+ where+ go = \case+ [] -> []+ (d : ds) -> case d of+ First _ ->+ let (fs, rest) = goFirsts (d : ds)+ in First (V.fromList fs) : go rest+ Second _ ->+ let (ss, rest) = goSeconds (d : ds)+ in Second (V.fromList ss) : go rest+ Both _ _ ->+ let (bs, rest) = goBoths (d : ds)+ in Both (V.fromList (map fst bs)) (V.fromList (map snd bs)) : go rest+ goFirsts = \case+ (First a : ds) ->+ let (fs, rest) = goFirsts ds+ in (a : fs, rest)+ rest -> ([], rest)+ goSeconds = \case+ (Second a : ds) ->+ let (fs, rest) = goSeconds ds+ in (a : fs, rest)+ rest -> ([], rest)+ goBoths = \case+ (Both a b : ds) ->+ let (fs, rest) = goBoths ds+ in ((a, b) : fs, rest)+ rest -> ([], rest)++ let squishGroupedDiff :: Vector (PolyDiff (Vector a) (Vector b)) -> Vector (PolyDiff (Vector a) (Vector b))+ squishGroupedDiff = V.fromList . go . V.toList+ where+ go = \case+ [] -> []+ [pd] -> [pd]+ (First a : First b : rest) -> go (First (a <> b) : rest)+ (Second a : Second b : rest) -> go (Second (a <> b) : rest)+ (Both a b : Both c d : rest) -> go (Both (a <> c) (b <> d) : rest)+ (d : rest) -> d : go rest+ prop "is the same thing as getVectorDiff, but rolled up and squished (rollup individual)" $ \(ls1, ls2) ->+ let v1 = V.fromList (ls1 :: String)+ v2 = V.fromList (ls2 :: String)+ grouped = getGroupedVectorDiff v1 v2+ individual = getVectorDiff v1 v2+ in squishGroupedDiff grouped `shouldBe` rollupUngroupedDiff individual++ describe "getStringDiff" $ do+ it "can output a large diff quickly enough if there is no diff" $+ let s = replicate 10000 'a'+ in length (getStringDiff s s) `shouldBe` 10000++ it "can output a large diff quickly enough if it's only diff" $+ length (getStringDiff (replicate 10000 'a') "b") `shouldBe` 10001++ describe "getTextDiff" $ do+ it "can output a large diff quickly enough if there is no diff" $+ let s = T.pack $ replicate 10000 'a'+ in length (getTextDiff s s) `shouldBe` 1++ it "can output a large diff quickly enough if it's only diff" $+ length (getTextDiff (T.pack (replicate 10000 'a')) "b") `shouldBe` 15