Diff 0.3.4 → 1.0.2
raw patch · 6 files changed
Files
- CHANGELOG.md +47/−0
- Diff.cabal +44/−15
- src/Data/Algorithm/Diff.hs +42/−18
- src/Data/Algorithm/DiffContext.hs +151/−47
- src/Data/Algorithm/DiffOutput.hs +13/−6
- test/Test.hs +99/−4
+ 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,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 <dsf@seereason.com> 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
src/Data/Algorithm/Diff.hs view
@@ -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)\"--- <http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.4.6927>. 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)/+-- <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. ----------------------------------------------------------------------------- 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
src/Data/Algorithm/DiffContext.hs view
@@ -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
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,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