Diff 0.5 → 1.0

raw patch · 6 files changed

+236/−111 lines, 6 filesdep +semigroupsdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: semigroups

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +12/−0
• Diff.cabal +12/−4
• src/Data/Algorithm/Diff.hs +9/−1
• src/Data/Algorithm/DiffContext.hs +119/−94
• src/Data/Algorithm/DiffOutput.hs +13/−6
• test/Test.hs +71/−6

@@ -0,0 +1,12 @@+# 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(..)`.

@@ -1,8 +1,13 @@+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+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@@ -11,8 +16,9 @@                      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 +extra-doc-files:     CHANGELOG.md+ library   default-language: Haskell2010   build-depends:   base >= 4.8 && <= 6, array, pretty >= 1.1@@ -36,6 +42,8 @@                 , pretty, QuickCheck, test-framework                 , test-framework-quickcheck2, process                 , directory+  if impl(ghc < 8.0)+    build-depends: semigroups   other-modules:                    Data.Algorithm.Diff,                    Data.Algorithm.DiffOutput

@@ -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 (==) 

@@ -11,71 +11,99 @@ -- Generates a grouped diff with merged runs, and outputs them in the manner of diff -u ----------------------------------------------------------------------------- module Data.Algorithm.DiffContext-    ( getContextDiffNew-    , getContextDiff-    , getContextDiffOld+    ( getContextDiff     , 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 +124,62 @@                    : 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 [] = error "empty hunk!"+      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 [] = []++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

@@ -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) 

@@ -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,@@ -203,10 +210,68 @@ 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)+      -- Note that the line numbers don't affect equality+      expected = [[Both [Numbered 1 "a",Numbered 2 "b"] [Numbered 1 "a",Numbered 2 "b"],+                   First [Numbered 3 "c"],+                   Both [Numbered 4 "d",Numbered 5 "e"] [Numbered 3 "d",Numbered 4 "e"]],+                  [Both [Numbered 9 "i",Numbered 10 "j"] [Numbered 8 "i",Numbered 9 "j"],+                   First [Numbered 11 "k"]]]+      actual = getContextDiff (Just 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