fast-myers-diff 0.0.0 → 0.0.2
raw patch · 4 files changed
Files
- Changelog.md +9/−0
- fast-myers-diff.cabal +7/−5
- src/Myers/Diff.hs +47/−13
- test/Main.hs +7/−0
+ Changelog.md view
@@ -0,0 +1,9 @@+# Revision history for fast-myers-diff++## 0.0.2 -- 2025-01-15++- Edit distance functions++## 0.0.1 -- 2024-09-08++- Added `NFData` instance for `PolyDiff`
fast-myers-diff.cabal view
@@ -1,16 +1,16 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.2.+-- This file has been generated from package.yaml by hpack version 0.36.1. -- -- see: https://github.com/sol/hpack name: fast-myers-diff-version: 0.0.0+version: 0.0.2 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+homepage: https://github.com/NorfairKing/fast-myers-diff#readme+bug-reports: https://github.com/NorfairKing/fast-myers-diff/issues author: Tom Sydney Kerckhove maintainer: syd@cs-syd.eu copyright: Copyright (c) 2023 Tom Sydney Kerckhove@@ -19,10 +19,11 @@ build-type: Simple extra-source-files: LICENSE+ Changelog.md source-repository head type: git- location: https://github.com/NorfairKing/sydtest+ location: https://github.com/NorfairKing/fast-myers-diff library exposed-modules:@@ -33,6 +34,7 @@ src build-depends: base >=4.7 && <5+ , deepseq , dlist , text , vector
src/Myers/Diff.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -20,6 +22,12 @@ getVectorDiffBy, getGroupedVectorDiffBy, + -- * Distance+ getTextEditDistance,+ getStringEditDistance,+ getEditDistance,+ getEditDistanceBy,+ -- ** Internals Edit (..), getEditScript,@@ -35,6 +43,7 @@ ) where +import Control.DeepSeq (NFData) import Control.Monad import Control.Monad.ST import Data.DList (DList)@@ -48,6 +57,7 @@ import qualified Data.Vector as V import Data.Vector.Mutable (MVector) import qualified Data.Vector.Mutable as MV+import GHC.Generics type Diff a = PolyDiff a a @@ -59,7 +69,7 @@ -- 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)+ deriving (Show, Eq, Generic, NFData) bimapPolyDiff :: (a -> c) -> (b -> d) -> PolyDiff a b -> PolyDiff c d bimapPolyDiff f g = \case@@ -70,7 +80,7 @@ -- | -- -- For backward compatibility with 'Diff', use more specific functions if you can.-getDiff :: Eq a => [a] -> [a] -> [Diff a]+getDiff :: (Eq a) => [a] -> [a] -> [Diff a] getDiff = getDiffBy (==) -- |@@ -82,7 +92,7 @@ -- | -- -- For backward compatibility with 'Diff', use more specific functions if you can.-getGroupedDiff :: Eq a => [a] -> [a] -> [Diff [a]]+getGroupedDiff :: (Eq a) => [a] -> [a] -> [Diff [a]] getGroupedDiff = getGroupedDiffBy (==) -- |@@ -120,7 +130,7 @@ -- | Diff two 'Vector's -- -- Prefer 'getGroupedVectorDiff' for performance reasons.-getVectorDiff :: Eq a => Vector a -> Vector a -> Vector (Diff a)+getVectorDiff :: (Eq a) => Vector a -> Vector a -> Vector (Diff a) getVectorDiff = getVectorDiffBy (==) -- | Diff two 'Vector's with different types using a custom equality operator@@ -130,15 +140,39 @@ 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 :: (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) +-- | 'Text edit distance+getTextEditDistance :: Text -> Text -> Word+getTextEditDistance actual expected = getStringEditDistance (T.unpack actual) (T.unpack expected)++-- | 'String' edit distance+getStringEditDistance :: String -> String -> Word+getStringEditDistance actual expected = getEditDistance (V.fromList actual) (V.fromList expected)++-- | Compute the total size of the edit script vector from 'getEditScript.+getEditDistance :: (Eq a) => Vector a -> Vector a -> Word+getEditDistance = getEditDistanceBy (==)++-- | Compute the total size of the edit script vector from 'getEditScriptBy'.+getEditDistanceBy :: (a -> b -> Bool) -> Vector a -> Vector b -> Word+getEditDistanceBy eq old new =+ -- This 'fromIntegral' is safe because you'd need a ridiculously large edit+ -- script for it to cause trouble, and that would crash the program before+ -- 'fromIntegral' could.+ (fromIntegral :: Int -> Word) $ sum $ V.map editCost $ getEditScriptBy eq old new+ where+ editCost = \case+ Delete _ c -> c+ Insert _ _ c -> c+ -- | 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 :: 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@@ -475,18 +509,18 @@ data Edit = -- | Delete from the old vector Delete+ -- position in the old vector Int- -- ^ position in the old vector+ -- number of items to delete Int- -- ^ number of items to delete | -- | Insert into the old vector Insert+ -- position in the old vector Int- -- ^ position in the old vector+ -- position in the new vector Int- -- ^ position in the new vector+ -- number of items to insert Int- -- ^ number of items to insert deriving (Show, Eq, Ord) oldPosition :: Edit -> Int@@ -508,13 +542,13 @@ sliceIx start end = V.slice start (end - start) -- | Short-circuiting monadic (&&)-(&&.) :: Applicative m => Bool -> m Bool -> m Bool+(&&.) :: (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 :: (Monad m) => [a] -> (a -> m (Maybe b)) -> m (Maybe b) forUntilJust [] _ = pure Nothing forUntilJust (a : rest) func = do mRes <- func a
test/Main.hs view
@@ -85,6 +85,13 @@ 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 "getStringEditDistance" $ do+ prop "is 0 for identical strings" $ \t ->+ getStringEditDistance t t `shouldBe` 0++ it "returns 6 for these two completely different strings" $+ getStringEditDistance "abc" "def" `shouldBe` 6+ describe "getVectorDiff" $ do let exampleSpec :: Vector Char -> Vector Char -> Vector (Diff Char) -> Spec exampleSpec old new expected =