Diff 0.5 → 1.0.2
raw patch · 6 files changed
Files
- CHANGELOG.md +47/−0
- Diff.cabal +39/−18
- src/Data/Algorithm/Diff.hs +9/−1
- src/Data/Algorithm/DiffContext.hs +120/−93
- src/Data/Algorithm/DiffOutput.hs +13/−6
- test/Test.hs +91/−16
+ CHANGELOG.md view
@@ -0,0 +1,47 @@+# 1.0.2++ - Output correct format when an input file is empty, e.g. `@@ --0,0 +1,3 @@`.++# 1.0.1.1++ - Require `base >= 4.11` (GHC 8.4).++# 1.0++ - Add Unix diff style annotations to output of `prettyContextDiff`,+ e.g `@@ -1,5 +1,4 @@`. This required three changes to the+ signature of `getContextDiff` due to the addition of a wrapper type+ `Numbered`, which enumerates the elements of the input list.++ - Signature change 1: The element pretty printer type changes from+ `(a -> Doc)` to `(Numbered a -> Doc)`. An unnumber function is+ provided so that the old behavior can be obtained by changing that+ argument from `pretty` to `(pretty . unnumber)`++ - Signature change 2: The result type of getContextDiff changes from+ `ContextDiff a` to `ContextDiff (Numbered a)`. A function+ `unNumberContextDiff` is provided to convert the result back to+ the old type.++ - Signature change 3: the context argument is now `Maybe Int` rather+ than `Int`, reflecting the change made to `getContextDiffNew` in 0.5.++ - A `prettyContextDiffOld` function is provided to get the old+ style output.++ - The old broken version of getContextDiffOld is removed.++ - Document the behavior of `groupBy'`.++# 0.5++ - Bring space complexity down to D^2 (Bodigrim).+ - Add `Bifunctor` instance (Jonathan King). Requires `base` >= 4.8.+ - Fix for the grouped context diff. It was omitting all trailing contexts.+ - Allow unlimited number of context elements (`getContextDiffNew`).++# 0.4++ - Generalize `Diff a` to `PolyDiff a b`.+ `Diff` has been replaced with a specialized synonym `type Diff a = PolyDiff a a`,+ but it's still not backward compatible if you imported `Diff(..)`.
Diff.cabal view
@@ -1,21 +1,40 @@+Cabal-Version: 1.18 name: Diff-version: 0.5-synopsis: O(ND) diff algorithm in haskell.-description: Implementation of the standard diff algorithm, and utilities for pretty printing.+version: 1.0.2+synopsis: Diff algorithm in pure Haskell+description: Implementation of the standard diff algorithm in Haskell.+ .+ Time complexity is O(ND) (input length * number of differences).+ Space complexity is O(D^2). Includes utilities for pretty printing. category: Algorithms+homepage: https://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.4.6927 license: BSD3 license-file: LICENSE author: Sterling Clover maintainer: David Fox <dsf@seereason.com>-Tested-With: GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5,- GHC == 8.8.4, GHC == 8.10.7, GHC == 9.0.2, GHC == 9.2.8, GHC == 9.4.7,- GHC == 9.6.3, GHC == 9.8.1 Build-Type: Simple-Cabal-Version: >= 1.10 +tested-with:+ GHC == 9.12.0+ GHC == 9.10.1+ GHC == 9.8.2+ GHC == 9.6.6+ GHC == 9.4.8+ GHC == 9.2.8+ GHC == 9.0.2+ GHC == 8.10.7+ GHC == 8.8.4+ GHC == 8.6.5+ GHC == 8.4.4++extra-doc-files: CHANGELOG.md+ library default-language: Haskell2010- build-depends: base >= 4.8 && <= 6, array, pretty >= 1.1+ build-depends:+ base >= 4.11 && <= 6+ , array+ , pretty >= 1.1 hs-source-dirs: src exposed-modules: Data.Algorithm.Diff,@@ -25,18 +44,20 @@ source-repository head type: git- location: http://github.com/seereason/Diff+ location: https://github.com/seereason/Diff test-suite diff-tests default-language: Haskell2010 type: exitcode-stdio-1.0- hs-source-dirs: test, src+ hs-source-dirs: test main-is: Test.hs- build-depends: base >= 3 && <= 6, array- , pretty, QuickCheck, test-framework- , test-framework-quickcheck2, process- , directory- other-modules:- Data.Algorithm.Diff,- Data.Algorithm.DiffOutput- Data.Algorithm.DiffContext+ build-depends:+ Diff+ , base >= 3 && <= 6+ , array+ , pretty+ , directory+ , process+ , QuickCheck+ , test-framework+ , test-framework-quickcheck2
src/Data/Algorithm/Diff.hs view
@@ -8,7 +8,7 @@ -- Portability : portable -- -- This is an implementation of the diff algorithm as described in--- \"An \( O(ND) \) Difference Algorithm and Its Variations (1986)\"+-- /An \( O(ND) \) Difference Algorithm and Its Variations (1986)/ -- <http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.4.6927>. -- For inputs of size \( O(N) \) with the number of differences \( D \) -- it has \( O(ND) \) time and \( O(D^2) \) space complexity.@@ -92,11 +92,19 @@ -- | Takes two lists and returns a list of differences between them. This is -- 'getDiffBy' with '==' used as predicate.+--+-- > > getDiff ["a","b","c","d","e"] ["a","c","d","f"]+-- > [Both "a" "a",First "b",Both "c" "c",Both "d" "d",First "e",Second "f"]+-- > > getDiff "abcde" "acdf"+-- > [Both 'a' 'a',First 'b',Both 'c' 'c',Both 'd' 'd',First 'e',Second 'f'] getDiff :: (Eq a) => [a] -> [a] -> [Diff a] getDiff = getDiffBy (==) -- | Takes two lists and returns a list of differences between them, grouped -- into chunks. This is 'getGroupedDiffBy' with '==' used as predicate.+--+-- > > getGroupedDiff "abcde" "acdf"+-- > [Both "a" "a",First "b",Both "cd" "cd",First "e",Second "f"] getGroupedDiff :: (Eq a) => [a] -> [a] -> [Diff [a]] getGroupedDiff = getGroupedDiffBy (==)
src/Data/Algorithm/DiffContext.hs view
@@ -11,71 +11,100 @@ -- Generates a grouped diff with merged runs, and outputs them in the manner of diff -u ----------------------------------------------------------------------------- module Data.Algorithm.DiffContext- ( getContextDiffNew+ ( ContextDiff, Hunk , getContextDiff- , getContextDiffOld , prettyContextDiff+ , prettyContextDiffOld+ , getContextDiffNumbered+ , Numbered(Numbered), numbered, unnumber+ , unNumberContextDiff+ , groupBy' ) where import Data.Algorithm.Diff (PolyDiff(..), Diff, getGroupedDiff)-import Data.List (groupBy)-import Data.Monoid (mappend)+-- import Data.List (groupBy)+import Data.Bifunctor import Text.PrettyPrint (Doc, text, empty, hcat) -type ContextDiff c = [[Diff [c]]]+type ContextDiff c = [Hunk c]+type Hunk c = [Diff [c]] --- | See https://github.com/haskell/containers/issues/424+-- | A version of 'groupBy' that does not assume the argument function+-- is transitive. This is used to partition the 'Diff' list into+-- segments that begin and end with matching ('Both') text, with and+-- have non-matching ('First' and 'Second') text in the middle.+--+-- > let notBoth1 a b = not (a == 1 || b == 1) in+-- >+-- > groupBy' notBoth1 [1,1,2,3,1,1,4,5,6,1]+-- > [[1],[1,2,3,1],[1,4,5,6,1]]+-- >+-- > groupBy notBoth1 [1,1,2,3,1,1,4,5,6,1]+-- > [[1],[1,2,3],[1],[1,4,5,6],[1]]+--+-- In the first result the list is split anywhere there are two+-- adjacent ones, as desired. groupBy' :: (a -> a -> Bool) -> [a] -> [[a]] groupBy' _ [] = []-groupBy' eq (x : xs) = go [x] xs+groupBy' eq (x0 : xs0) = go [x0] xs0 where go (x : xs) (y : zs) | eq x y = go (y : x : xs) zs go g (y : zs) = reverse g : go [y] zs go g [] = [reverse g] --- | See https://github.com/seereason/Diff/commit/35596ca45fdd6ee2559cf610bef7a86b4617988a.--- The original 'getContextDiff' omitted trailing context in diff hunks.--- This new one corrects the issue. Here is the example from the test--- suite:------ > prettyContextDiff (text "file1") (text "file2") text (getContextDiffOld 2 (lines textA) (lines textB))--- --- file1--- +++ file2--- @@--- a--- b--- -c--- @@--- d--- e--- @@--- i--- j--- -k------ > prettyContextDiff (text "file1") (text "file2") text (getContextDiff 2 (lines textA) (lines textB))--- --- file1--- +++ file2--- @@--- a--- b--- -c--- d--- e--- @@--- i--- j--- -k-getContextDiffNew ::+data Numbered a = Numbered Int a deriving Show+instance Eq a => Eq (Numbered a) where+ Numbered _ a == Numbered _ b = a == b+instance Ord a => Ord (Numbered a) where+ compare (Numbered _ a) (Numbered _ b) = compare a b++numbered :: [a] -> [Numbered a]+numbered xs = fmap (uncurry Numbered) (zip [1..] xs)++unnumber :: Numbered a -> a+unnumber (Numbered _ a) = a++-- |+-- > > let textA = ["a","b","c","d","e","f","g","h","i","j","k"]+-- > > let textB = ["a","b","d","e","f","g","h","i","j"]+-- > > let diff = getContextDiff (Just 2) textA textB+-- > > prettyContextDiff (text "file1") (text "file2") (text . unnumber) diff+-- > --- file1+-- > +++ file2+-- > @@ -1,5 +1,4 @@+-- > a+-- > b+-- > -c+-- > d+-- > e+-- > @@ -9,3 +8,2 @@+-- > i+-- > j+-- > -k+getContextDiff :: Eq a => Maybe Int -- ^ Number of context elements, Nothing means infinite -> [a] -> [a]- -> ContextDiff a-getContextDiffNew context a b =- groupBy' (\a b -> not (isBoth a && isBoth b)) $ doPrefix $ getGroupedDiff a b+ -> ContextDiff (Numbered a)+getContextDiff context a b =+ getContextDiffNumbered context (numbered a) (numbered b)++-- | If for some reason you need the line numbers stripped from the+-- result of getContextDiff for backwards compatibility.+unNumberContextDiff :: ContextDiff (Numbered a) -> ContextDiff a+unNumberContextDiff = fmap (fmap (bimap (fmap unnumber) (fmap unnumber)))++getContextDiffNumbered ::+ Eq a+ => Maybe Int -- ^ Number of context elements, Nothing means infinite+ -> [Numbered a]+ -> [Numbered a]+ -> ContextDiff (Numbered a)+getContextDiffNumbered context a0 b0 =+ groupBy' (\a b -> not (isBoth a && isBoth b)) $ doPrefix $ getGroupedDiff a0 b0 where- isBoth (Both {}) = True+ isBoth (Both _ _) = True isBoth _ = False -- Handle the common text leading up to a diff. doPrefix [] = []@@ -96,65 +125,63 @@ : doPrefix (Both (maybe mempty (\n -> drop n xs) context) (maybe mempty (\n -> drop n ys) context) : more) doSuffix (d : ds) = d : doSuffix ds -getContextDiff :: Eq a => Int -> [a] -> [a] -> ContextDiff a-getContextDiff context a b = getContextDiffNew (Just context) a b---- | Do a grouped diff and then split up the chunks into runs that--- contain differences surrounded by N lines of unchanged text. If--- there is less then 2N+1 lines of unchanged text between two--- changes, the runs are left merged.-getContextDiffOld :: Eq a => Int -> [a] -> [a] -> ContextDiff a-getContextDiffOld context a b =- group $ swap $ trimTail $ trimHead $ concatMap split $ getGroupedDiff a b- where- -- Drop the middle elements of a run of Both if there are more- -- than enough to form the context of the preceding changes and- -- the following changes.- split (Both xs ys) =- case length xs of- n | n > (2 * context) -> [Both (take context xs) (take context ys), Both (drop (n - context) xs) (drop (n - context) ys)]- _ -> [Both xs ys]- split x = [x]- -- If split created a pair of Both runs at the beginning or end- -- of the diff, remove the outermost.- trimHead [] = []- trimHead [Both _ _] = []- trimHead [Both _ _, Both _ _] = []- trimHead (Both _ _ : x@(Both _ _) : more) = x : more- trimHead xs = trimTail xs- trimTail [x@(Both _ _), Both _ _] = [x]- trimTail (x : more) = x : trimTail more- trimTail [] = []- -- If we see Second before First swap them so that the deletions- -- appear before the additions.- swap (x@(Second _) : y@(First _) : xs) = y : x : swap xs- swap (x : xs) = x : swap xs- swap [] = []- -- Split the list wherever we see adjacent Both constructors- group xs =- groupBy (\ x y -> not (isBoth x && isBoth y)) xs- where- isBoth (Both _ _) = True- isBoth _ = False- -- | Pretty print a ContextDiff in the manner of diff -u. prettyContextDiff :: Doc -- ^ Document 1 name -> Doc -- ^ Document 2 name- -> (c -> Doc) -- ^ Element pretty printer- -> ContextDiff c+ -> (Numbered c -> Doc) -- ^ Element pretty printer+ -> ContextDiff (Numbered c) -> Doc prettyContextDiff _ _ _ [] = empty prettyContextDiff old new prettyElem hunks =- hcat . map (`mappend` text "\n") $ (text "--- " `mappend` old :- text "+++ " `mappend` new :+ hcat . map (<> text "\n") $ (text "--- " <> old :+ text "+++ " <> new : concatMap prettyRun hunks) where -- Pretty print a run of adjacent changes prettyRun hunk =+ text ("@@ " <> formatHunk hunk <> " @@") : concatMap prettyChange hunk++ -- Pretty print a single change (e.g. one line of a text file)+ prettyChange (Both ts _) = map (\ l -> text " " <> prettyElem l) ts+ prettyChange (First ts) = map (\ l -> text "-" <> prettyElem l) ts+ prettyChange (Second ts) = map (\ l -> text "+" <> prettyElem l) ts++ formatHunk hunk = "-" <> formatRun (firsts hunk) <> " +" <> formatRun (seconds hunk)++ formatRun :: [Int] -> String+ formatRun [] = "-0,0"+ formatRun [n] = show n+ formatRun ns@(n : _) = show n <> "," <> show (length ns)++ firsts (Both ns _ : more) = fmap (\(Numbered n _) -> n) ns <> firsts more+ firsts (First ns : more) = fmap (\(Numbered n _) -> n) ns <> firsts more+ firsts (Second _ : more) = firsts more+ firsts [] = []++ seconds (Both _ ns : more) = fmap (\(Numbered n _) -> n) ns <> seconds more+ seconds (First _ : more) = seconds more+ seconds (Second ns : more) = fmap (\(Numbered n _) -> n) ns <> seconds more+ seconds [] = []++-- | Pretty print without line numbers.+prettyContextDiffOld ::+ Doc -- ^ Document 1 name+ -> Doc -- ^ Document 2 name+ -> (c -> Doc) -- ^ Element pretty printer+ -> ContextDiff c+ -> Doc+prettyContextDiffOld _ _ _ [] = empty+prettyContextDiffOld old new prettyElem hunks =+ hcat . map (<> text "\n") $ (text "--- " <> old :+ text "+++ " <> new :+ concatMap prettyRun hunks)+ where+ -- Pretty print a run of adjacent changes+ prettyRun hunk = text "@@" : concatMap prettyChange hunk -- Pretty print a single change (e.g. one line of a text file)- prettyChange (Both ts _) = map (\ l -> text " " `mappend` prettyElem l) ts- prettyChange (First ts) = map (\ l -> text "-" `mappend` prettyElem l) ts- prettyChange (Second ts) = map (\ l -> text "+" `mappend` prettyElem l) ts+ prettyChange (Both ts _) = map (\ l -> text " " <> prettyElem l) ts+ prettyChange (First ts) = map (\ l -> text "-" <> prettyElem l) ts+ prettyChange (Second ts) = map (\ l -> text "+" <> prettyElem l) ts
src/Data/Algorithm/DiffOutput.hs view
@@ -12,10 +12,9 @@ ----------------------------------------------------------------------------- module Data.Algorithm.DiffOutput where import Data.Algorithm.Diff-import Text.PrettyPrint+import Text.PrettyPrint hiding ((<>)) import Data.Char import Data.List-import Data.Monoid (mappend) -- | Converts Diffs to DiffOperations diffToLineRanges :: [Diff [String]] -> [DiffOperation LineRange]@@ -45,6 +44,14 @@ : toLineRange (leftLine+linesF) (rightLine+linesS) rs -- | pretty print the differences. The output is similar to the output of the diff utility+--+-- > > putStr (ppDiff (getGroupedDiff ["a","b","c","d","e"] ["a","c","d","f"]))+-- > 2d1+-- > < b+-- > 5c4+-- > < e+-- > ---+-- > > f ppDiff :: [Diff [String]] -> String ppDiff gdiff = let diffLineRanges = diffToLineRanges gdiff@@ -58,18 +65,18 @@ prettyDiffs (d : rest) = prettyDiff d $$ prettyDiffs rest where prettyDiff (Deletion inLeft lineNoRight) =- prettyRange (lrNumbers inLeft) `mappend` char 'd' `mappend` int lineNoRight $$+ prettyRange (lrNumbers inLeft) <> char 'd' <> int lineNoRight $$ prettyLines '<' (lrContents inLeft) prettyDiff (Addition inRight lineNoLeft) =- int lineNoLeft `mappend` char 'a' `mappend` prettyRange (lrNumbers inRight) $$+ int lineNoLeft <> char 'a' <> prettyRange (lrNumbers inRight) $$ prettyLines '>' (lrContents inRight) prettyDiff (Change inLeft inRight) =- prettyRange (lrNumbers inLeft) `mappend` char 'c' `mappend` prettyRange (lrNumbers inRight) $$+ prettyRange (lrNumbers inLeft) <> char 'c' <> prettyRange (lrNumbers inRight) $$ prettyLines '<' (lrContents inLeft) $$ text "---" $$ prettyLines '>' (lrContents inRight) prettyRange (start, end) =- if start == end then int start else int start `mappend` comma `mappend` int end+ if start == end then int start else int start <> comma <> int end prettyLines start lins = vcat (map (\l -> char start <+> text l) lins)
test/Test.hs view
@@ -1,3 +1,6 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE ScopedTypeVariables #-}+ module Main where import Test.Framework (defaultMain, testGroup)@@ -6,6 +9,9 @@ import Data.Algorithm.Diff import Data.Algorithm.DiffContext import Data.Algorithm.DiffOutput+import qualified Data.Array as A+import Data.Foldable+import Data.Semigroup (Arg(..)) import Text.PrettyPrint import System.IO@@ -32,7 +38,8 @@ slTest2 "lcsBoth" prop_lcsBoth, slTest2 "recover first" prop_recoverFirst, slTest2 "recover second" prop_recoverSecond,- slTest2 "lcs" prop_lcs+ slTest2 "lcs" prop_lcs,+ testProperty "compare random with reference" prop_compare_with_reference ], testGroup "output props" [ testProperty "self generates empty" $ forAll shortLists prop_ppDiffEqual,@@ -43,11 +50,29 @@ { diLeft = ["1","2","3","4","","5","6","7"] , diRight = ["1","2","3","q","b","u","l","","XXX6",""] }),- testProperty "test parse" prop_parse,- testProperty "test context" prop_context_diff+ testProperty "test parse" prop_parse+ ],+ testGroup "context props" [+ testProperty "test context" $ prop_ppContextDiffUnitTest+ (DiffInput+ { diLeft = ["a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k"]+ , diRight = ["a", "b", "d", "e", "f", "g", "h", "i", "j"]+ })+ "--- a\n+++ b\n@@ -1,5 +1,4 @@\n a\n b\n-c\n d\n e\n@@ -9,3 +8,2 @@\n i\n j\n-k\n",+ testProperty "compare with empty" $ prop_ppContextDiffUnitTest+ (DiffInput+ { diLeft = []+ , diRight = ["1","2","3"]+ })+ "--- a\n+++ b\n@@ --0,0 +1,3 @@\n+1\n+2\n+3\n",+ testProperty "compare with empty" $ prop_ppContextDiffUnitTest+ (DiffInput+ { diLeft = ["1","2","3"]+ , diRight = []+ })+ "--- a\n+++ b\n@@ -1,3 +-0,0 @@\n-1\n-2\n-3\n" ] ]- slTest s t = testProperty s $ forAll shortLists (t :: [Bool] -> Bool) slTest2 s t = testProperty s $ forAll2 shortLists (t :: [Bool] -> [Bool] -> Bool) @@ -166,6 +191,13 @@ hClose h return fp +prop_ppContextDiffUnitTest :: DiffInput -> String -> Property+prop_ppContextDiffUnitTest (DiffInput le ri) expected =+ show diff === expected+ where+ hunks = getContextDiff (Just 2) le ri+ diff = prettyContextDiff (text "a") (text "b") (text . unnumber) hunks+ -- | Check pretty printed DiffOperations can be parsed again prop_parse :: DiffInput -> Bool prop_parse (DiffInput le ri) =@@ -198,15 +230,58 @@ , (2, return prefix) , (2, return [str])] --- | FIXME - make a real quickcheck property-prop_context_diff :: Bool-prop_context_diff =- expected == actual- where- expected = [[Both ["a","b"] ["a","b"],- First ["c"],- Both ["d","e"] ["d","e"]],- [Both ["i","j"] ["i","j"],First ["k"]]]- actual = getContextDiff 2 (lines textA) (lines textB)- textA = "a\nb\nc\nd\ne\nf\ng\nh\ni\nj\nk\n"- textB = "a\nb\nd\ne\nf\ng\nh\ni\nj\n"+-- | Reference implementation, very slow.+naiveGetDiffBy :: forall a b. (a -> b -> Bool) -> [a] -> [b] -> [PolyDiff a b]+naiveGetDiffBy eq as bs = reverse $ (\(Arg _ ds) -> ds) $ tbl A.! (length us, length vs)+ where+ us = A.listArray (0, length as - 1) as+ vs = A.listArray (0, length bs - 1) bs++ -- Indices run up to length us/vs *inclusive*+ tbl :: A.Array (Int, Int) (Arg Word [PolyDiff a b])+ tbl = A.listArray ((0, 0), (length us, length vs))+ [ gen ui vi | ui <- [0..length us], vi <- [0..length vs] ]++ gen :: Int -> Int -> Arg Word [PolyDiff a b]+ gen ui vi+ | ui == 0, vi == 0 = Arg 0 []+ | ui == 0+ = left'+ | vi == 0+ = top'+ | otherwise+ = if eq u v+ then min (min left' top') diag'+ else min left' top'+ where+ Arg leftL leftP = tbl A.! (ui, vi - 1)+ Arg diagL diagP = tbl A.! (ui - 1, vi - 1)+ Arg topL topP = tbl A.! (ui - 1, vi)++ u = us A.! (ui - 1)+ v = vs A.! (vi - 1)++ left' = Arg (leftL + 1) (Second v : leftP)+ top' = Arg (topL + 1) (First u : topP)+ diag' = Arg diagL (Both u v : diagP)++prop_compare_with_reference :: Positive Word -> [(Int, Int)] -> Property+prop_compare_with_reference (Positive x) ixs' =+ counterexample (show (as, bs, d1, d2)) $+ length (notBoth d1) === length (notBoth d2)+ where+ as = [0 .. max 100 x]+ len = length as+ ixs = filter (uncurry (/=)) $ map (\(i, j) -> (i `mod` len, j `mod` len)) $ take 100 ixs'+ bs = foldl' applySwap as ixs+ d1 = getDiffBy (==) as bs+ d2 = naiveGetDiffBy (==) as bs++ applySwap xs (i, j) = zipWith+ (\k x -> (if k == i then xs !! j else if k == j then xs !! i else x))+ [0..]+ xs++ notBoth = filter $ \case+ Both{} -> False+ _ -> True