diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -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 --git a/Diff.cabal b/Diff.cabal --- a/Diff.cabal +++ b/Diff.cabal @@ -1,34 +1,63 @@ +Cabal-Version: 1.18 name: Diff -version: 0.3.4 -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: s.clover@gmail.com -Tested-With: GHC == 7.8.4 +maintainer: David Fox Build-Type: Simple -Cabal-Version: >= 1.8 +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 - build-depends: base >= 3 && <= 6, array, pretty >= 1.1 + default-language: Haskell2010 + build-depends: + base >= 4.11 && <= 6 + , array + , pretty >= 1.1 hs-source-dirs: src exposed-modules: Data.Algorithm.Diff, Data.Algorithm.DiffOutput Data.Algorithm.DiffContext - ghc-options: -O2 -Wall -funbox-strict-fields + ghc-options: -Wall -funbox-strict-fields source-repository head - type: darcs - location: http://hub.darcs.net/sterlingclover/Diff + type: git + 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 + build-depends: + Diff + , base >= 3 && <= 6 + , array + , pretty + , directory + , process + , QuickCheck + , test-framework + , test-framework-quickcheck2 diff --git a/src/Data/Algorithm/Diff.hs b/src/Data/Algorithm/Diff.hs --- a/src/Data/Algorithm/Diff.hs +++ b/src/Data/Algorithm/Diff.hs @@ -7,14 +7,15 @@ -- Stability : experimental -- Portability : portable -- --- This is an implementation of the O(ND) diff algorithm as described in --- \"An O(ND) Difference Algorithm and Its Variations (1986)\" --- . It is O(mn) in space. --- The algorithm is the same one used by standared Unix diff. +-- This is an implementation of the diff algorithm as described in +-- /An \( O(ND) \) Difference Algorithm and Its Variations (1986)/ +-- . +-- For inputs of size \( O(N) \) with the number of differences \( D \) +-- it has \( O(ND) \) time and \( O(D^2) \) space complexity. ----------------------------------------------------------------------------- module Data.Algorithm.Diff - ( Diff(..) + ( Diff, PolyDiff(..) -- * Comparing lists for differences , getDiff , getDiffBy @@ -25,17 +26,31 @@ ) where import Prelude hiding (pi) - -import Data.Array +import Data.Array (listArray, (!)) +import Data.Bifunctor -data DI = F | S | B deriving (Show, Eq) +data DI = F | S deriving (Show, Eq) -- | 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 -- newtype to only perform equality on side of a tuple). -data Diff a = First a | Second a | Both a a deriving (Show, Eq) +data PolyDiff a b = First a | Second b | Both a b + deriving (Show, Eq) +instance Functor (PolyDiff a) where + fmap _ (First a) = First a + fmap g (Second b) = Second (g b) + fmap g (Both a b) = Both a (g b) + +instance Bifunctor PolyDiff where + bimap f _ (First a) = First (f a) + bimap _ g (Second b) = Second (g b) + bimap f g (Both a b) = Both (f a) (g b) + +-- | This is 'PolyDiff' specialized so both sides are the same type. +type Diff a = PolyDiff a a + data DL = DL {poi :: !Int, poj :: !Int, path::[DI]} deriving (Show, Eq) instance Ord DL @@ -43,7 +58,7 @@ then poj x > poj y else poi x <= poi y -canDiag :: (a -> a -> Bool) -> [a] -> [a] -> Int -> Int -> Int -> Int -> Bool +canDiag :: (a -> b -> Bool) -> [a] -> [b] -> Int -> Int -> Int -> Int -> Bool canDiag eq as bs lena lenb = \ i j -> if i < lena && j < lenb then (arAs ! i) `eq` (arBs ! j) else False where arAs = listArray (0,lena - 1) as @@ -64,11 +79,11 @@ addsnake :: (Int -> Int -> Bool) -> DL -> DL addsnake cd dl | cd pi pj = addsnake cd $ - dl {poi = pi + 1, poj = pj + 1, path=(B : path dl)} + dl {poi = pi + 1, poj = pj + 1, path = path dl} | otherwise = dl where pi = poi dl; pj = poj dl -lcs :: (a -> a -> Bool) -> [a] -> [a] -> [DI] +lcs :: (a -> b -> Bool) -> [a] -> [b] -> [DI] lcs eq as bs = path . head . dropWhile (\dl -> poi dl /= lena || poj dl /= lenb) . concat . iterate (dstep cd) . (:[]) . addsnake cd $ DL {poi=0,poj=0,path=[]} @@ -77,24 +92,33 @@ -- | Takes two lists and returns a list of differences between them. This is -- 'getDiffBy' with '==' used as predicate. -getDiff :: (Eq t) => [t] -> [t] -> [Diff t] +-- +-- > > 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 :: (Eq t) => [t] -> [t] -> [Diff [t]] +-- +-- > > getGroupedDiff "abcde" "acdf" +-- > [Both "a" "a",First "b",Both "cd" "cd",First "e",Second "f"] +getGroupedDiff :: (Eq a) => [a] -> [a] -> [Diff [a]] getGroupedDiff = getGroupedDiffBy (==) -- | A form of 'getDiff' with no 'Eq' constraint. Instead, an equality predicate -- is taken as the first argument. -getDiffBy :: (t -> t -> Bool) -> [t] -> [t] -> [Diff t] +getDiffBy :: (a -> b -> Bool) -> [a] -> [b] -> [PolyDiff a b] getDiffBy eq a b = markup a b . reverse $ lcs eq a b - where markup (x:xs) ys (F:ds) = First x : markup xs ys ds + where markup (x:xs) (y:ys) ds + | eq x y = Both x y : markup xs ys ds + markup (x:xs) ys (F:ds) = First x : markup xs ys ds markup xs (y:ys) (S:ds) = Second y : markup xs ys ds - markup (x:xs) (y:ys) (B:ds) = Both x y : markup xs ys ds markup _ _ _ = [] -getGroupedDiffBy :: (t -> t -> Bool) -> [t] -> [t] -> [Diff [t]] +getGroupedDiffBy :: (a -> b -> Bool) -> [a] -> [b] -> [PolyDiff [a] [b]] getGroupedDiffBy eq a b = go $ getDiffBy eq a b where go (First x : xs) = let (fs, rest) = goFirsts xs in First (x:fs) : go rest go (Second x : xs) = let (fs, rest) = goSeconds xs in Second (x:fs) : go rest diff --git a/src/Data/Algorithm/DiffContext.hs b/src/Data/Algorithm/DiffContext.hs --- a/src/Data/Algorithm/DiffContext.hs +++ b/src/Data/Algorithm/DiffContext.hs @@ -11,73 +11,177 @@ -- Generates a grouped diff with merged runs, and outputs them in the manner of diff -u ----------------------------------------------------------------------------- module Data.Algorithm.DiffContext - ( getContextDiff + ( ContextDiff, Hunk + , getContextDiff , prettyContextDiff + , prettyContextDiffOld + , getContextDiffNumbered + , Numbered(Numbered), numbered, unnumber + , unNumberContextDiff + , groupBy' ) where -import Data.Algorithm.Diff (Diff(..), getGroupedDiff) -import Data.List (groupBy) -import Data.Monoid (mappend) +import Data.Algorithm.Diff (PolyDiff(..), Diff, getGroupedDiff) +-- 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]] --- | 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. -getContextDiff :: Eq a => Int -> [a] -> [a] -> ContextDiff a +-- | 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 (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] + +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 (Numbered a) getContextDiff context a b = - group $ swap $ trimTail $ trimHead $ concatMap split $ getGroupedDiff 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 - -- 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 + isBoth (Both _ _) = True + isBoth _ = False + -- Handle the common text leading up to a diff. + doPrefix [] = [] + doPrefix [Both _ _] = [] + doPrefix (Both xs ys : more) = + Both (maybe xs (\n -> drop (max 0 (length xs - n)) xs) context) + (maybe ys (\n -> drop (max 0 (length ys - n)) ys) context) : doSuffix more + -- Prefix finished, do the diff then the following suffix + doPrefix (d : ds) = doSuffix (d : ds) + -- Handle the common text following a diff. + doSuffix [] = [] + doSuffix [Both xs ys] = [Both (maybe xs (\n -> take n xs) context) (maybe ys (\n -> take n ys) context)] + doSuffix (Both xs ys : more) + | maybe True (\n -> length xs <= n * 2) context = + Both xs ys : doPrefix more + doSuffix (Both xs ys : more) = + Both (maybe xs (\n -> take n xs) context) (maybe ys (\n -> take n ys) context) + : doPrefix (Both (maybe mempty (\n -> drop n xs) context) (maybe mempty (\n -> drop n ys) context) : more) + doSuffix (d : ds) = d : doSuffix ds -- | 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 diff --git a/src/Data/Algorithm/DiffOutput.hs b/src/Data/Algorithm/DiffOutput.hs --- a/src/Data/Algorithm/DiffOutput.hs +++ b/src/Data/Algorithm/DiffOutput.hs @@ -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) diff --git a/test/Test.hs b/test/Test.hs --- a/test/Test.hs +++ b/test/Test.hs @@ -1,10 +1,17 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE ScopedTypeVariables #-} + module Main where import Test.Framework (defaultMain, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.QuickCheck 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 @@ -31,16 +38,41 @@ 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, --testProperty "compare our lists with diff" $ forAll2 shortLists prop_ppDiffShort, testProperty "compare random with diff" prop_ppDiffR, + testProperty "compare with diff, issue #5" $ prop_ppDiffR + (DiffInput + { diLeft = ["1","2","3","4","","5","6","7"] + , diRight = ["1","2","3","q","b","u","l","","XXX6",""] + }), 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) @@ -134,9 +166,9 @@ prop_ppDiffR (DiffInput le ri) = let haskDiff=ppDiff $ getGroupedDiff le ri utilDiff= unsafePerformIO (runDiff (unlines le) (unlines ri)) - in cover (haskDiff == utilDiff) 90 "exact match" $ + in cover 90 (haskDiff == utilDiff) "exact match" $ classify (haskDiff == utilDiff) "exact match" - (div ((length haskDiff)*100) (length utilDiff) < 110) -- less than 10% bigger + (div ((length (lines haskDiff))*100) (length (lines utilDiff)) < 110) -- less than 10% bigger where runDiff left right = do leftFile <- writeTemp left @@ -159,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) = @@ -190,3 +229,59 @@ , (3, return (prefix ++ ["XXX" ++ str])) , (2, return prefix) , (2, return [str])] + +-- | 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