Diff 0.1.2 → 1.0.2
raw patch · 7 files changed
Files
- CHANGELOG.md +47/−0
- Data/Algorithm/Diff.hs +0/−76
- Diff.cabal +54/−14
- src/Data/Algorithm/Diff.hs +137/−0
- src/Data/Algorithm/DiffContext.hs +187/−0
- src/Data/Algorithm/DiffOutput.hs +138/−0
- test/Test.hs +287/−0
+ 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(..)`.
− Data/Algorithm/Diff.hs
@@ -1,76 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Data.Algorithm.Diff--- Copyright : (c) Sterling Clover 2008--- License : BSD 3 Clause--- Maintainer : s.clover@gmail.com--- 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://citeseer.ist.psu.edu/myers86ond.html>. It is O(mn) in space.--- The algorithm is the same one used by standared Unix diff.--- The assumption is that users of this library will want to diff over--- interesting things or peform interesting tasks with the results--- (given that, otherwise, they would simply use the standard Unix diff--- utility). Thus no attempt is made to present a fancier API to aid--- in doing standard and uninteresting things with the results.--------------------------------------------------------------------------------module Data.Algorithm.Diff (DI(..), getDiff, getGroupedDiff) where-import Data.Array-import Data.List---- | Difference Indicator. A value is either from the First list, the Second--- or from Both.-data DI = F | S | B deriving (Show, Eq)--data DL = DL {poi::Int, poj::Int, path::[DI]} deriving (Show, Eq)--instance Ord DL where x <= y = poi x <= poi y--canDiag :: (Eq a) => [a] -> [a] -> Int -> Int -> (Int, Int) -> Bool-canDiag as bs lena lenb = \(i,j) ->- if i < lena && j < lenb then arAs ! i == arBs ! j else False- where arAs = listArray (0,lena - 1) as- arBs = listArray (0,lenb - 1) bs--chunk :: Int -> [a] -> [[a]]-chunk x = unfoldr (\a -> case splitAt x a of ([],[]) -> Nothing; a' -> Just a')--dstep :: ((Int,Int)->Bool) -> [DL] -> [DL]-dstep cd dls = map maximum $ [hd]:(chunk 2 rst)- where (hd:rst) = concatMap extend dls- extend dl = let pdl = path dl- in [addsnake cd $ dl {poi=poi dl + 1, path=(F : pdl)},- addsnake cd $ dl {poj=poj dl + 1, path=(S : pdl)}]--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)}- | otherwise = dl- where pi = poi dl; pj = poj dl--lcs :: (Eq a) => [a] -> [a] -> [DI]-lcs as bs = path . head . dropWhile (\dl -> poi dl /= lena || poj dl /= lenb) .- concat . iterate (dstep cd) . (:[]) . addsnake cd $- DL {poi=0,poj=0,path=[]}- where cd = canDiag as bs lena lenb- lena = length as; lenb = length bs---- | Takes two lists and returns a list indicating the differences--- between them.-getDiff :: (Eq t) => [t] -> [t] -> [(DI, t)]-getDiff a b = markup a b . reverse $ lcs a b- where markup (x:xs) ys (F:ds) = (F, x) : markup xs ys ds- markup xs (y:ys) (S:ds) = (S, y) : markup xs ys ds- markup (x:xs) (_:ys) (B:ds) = (B, x) : markup xs ys ds- markup _ _ _ = []---- | Takes two lists and returns a list indicating the differences--- between them, grouped into chunks.-getGroupedDiff :: (Eq t) => [t] -> [t] -> [(DI, [t])]-getGroupedDiff a b = map go . groupBy (\x y -> fst x == fst y) $ getDiff a b- where go ((d,x) : xs) = (d, x : map snd xs)
Diff.cabal view
@@ -1,23 +1,63 @@+Cabal-Version: 1.18 name: Diff-version: 0.1.2-synopsis: O(ND) diff algorithm in haskell.-description: Basic implementation of the standard diff algorithm.+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 == 6.8.2+maintainer: David Fox <dsf@seereason.com> Build-Type: Simple-build-Depends: base-Cabal-Version: >= 1.2 -flag small-base+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- if flag(small-base)- build-depends: base >= 3, array- else- build-depends: base < 3- exposed-modules: Data.Algorithm.Diff- ghc-options: -Wall+ 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: -Wall -funbox-strict-fields++source-repository head+ type: git+ location: https://github.com/seereason/Diff++test-suite diff-tests+ default-language: Haskell2010+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Test.hs+ build-depends:+ Diff+ , base >= 3 && <= 6+ , array+ , pretty+ , directory+ , process+ , QuickCheck+ , test-framework+ , test-framework-quickcheck2
+ src/Data/Algorithm/Diff.hs view
@@ -0,0 +1,137 @@+-----------------------------------------------------------------------------+-- |+-- Module : Data.Algorithm.Diff+-- Copyright : (c) Sterling Clover 2008-2011, Kevin Charter 2011+-- License : BSD 3 Clause+-- Maintainer : s.clover@gmail.com+-- Stability : experimental+-- Portability : portable+--+-- 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, PolyDiff(..)+ -- * Comparing lists for differences+ , getDiff+ , getDiffBy++ -- * Finding chunks of differences+ , getGroupedDiff+ , getGroupedDiffBy+ ) where++import Prelude hiding (pi)+import Data.Array (listArray, (!))+import Data.Bifunctor++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 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+ where x <= y = if poi x == poi y+ then poj x > poj y+ else poi x <= poi y++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+ arBs = listArray (0,lenb - 1) bs++dstep :: (Int -> Int -> Bool) -> [DL] -> [DL]+dstep cd dls = hd:pairMaxes rst+ where (hd:rst) = nextDLs dls+ nextDLs [] = []+ nextDLs (dl:rest) = dl':dl'':nextDLs rest+ where dl' = addsnake cd $ dl {poi=poi dl + 1, path=(F : pdl)}+ dl'' = addsnake cd $ dl {poj=poj dl + 1, path=(S : pdl)}+ pdl = path dl+ pairMaxes [] = []+ pairMaxes [x] = [x]+ pairMaxes (x:y:rest) = max x y:pairMaxes rest++addsnake :: (Int -> Int -> Bool) -> DL -> DL+addsnake cd dl+ | cd pi pj = addsnake cd $+ dl {poi = pi + 1, poj = pj + 1, path = path dl}+ | otherwise = dl+ where pi = poi dl; pj = poj dl++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=[]}+ where cd = canDiag eq as bs lena lenb+ lena = length as; lenb = length bs++-- | 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 (==)++-- | A form of 'getDiff' with no 'Eq' constraint. Instead, an equality predicate+-- is taken as the first argument.+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) (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 _ _ _ = []++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+ go (Both x y : xs) = let (fs, rest) = goBoth xs+ (fxs, fys) = unzip fs+ in Both (x:fxs) (y:fys) : go rest+ go [] = []++ goFirsts (First x : xs) = let (fs, rest) = goFirsts xs in (x:fs, rest)+ goFirsts xs = ([],xs)++ goSeconds (Second x : xs) = let (fs, rest) = goSeconds xs in (x:fs, rest)+ goSeconds xs = ([],xs)++ goBoth (Both x y : xs) = let (fs, rest) = goBoth xs in ((x,y):fs, rest)+ goBoth xs = ([],xs)
+ src/Data/Algorithm/DiffContext.hs view
@@ -0,0 +1,187 @@+-----------------------------------------------------------------------------+-- |+-- Module : Data.Algorithm.DiffContext+-- Copyright : (c) David Fox (2015)+-- License : BSD 3 Clause+-- Maintainer : s.clover@gmail.com+-- Stability : experimental+-- Portability : portable+-- Author : David Fox (ddssff at the email service from google)+--+-- Generates a grouped diff with merged runs, and outputs them in the manner of diff -u+-----------------------------------------------------------------------------+module Data.Algorithm.DiffContext+ ( ContextDiff, Hunk+ , getContextDiff+ , prettyContextDiff+ , prettyContextDiffOld+ , getContextDiffNumbered+ , Numbered(Numbered), numbered, unnumber+ , unNumberContextDiff+ , groupBy'+ ) where++import Data.Algorithm.Diff (PolyDiff(..), Diff, getGroupedDiff)+-- import Data.List (groupBy)+import Data.Bifunctor+import Text.PrettyPrint (Doc, text, empty, hcat)++type ContextDiff c = [Hunk c]+type Hunk c = [Diff [c]]++-- | 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 =+ 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 _ = 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+ -> (Numbered c -> Doc) -- ^ Element pretty printer+ -> ContextDiff (Numbered c)+ -> Doc+prettyContextDiff _ _ _ [] = empty+prettyContextDiff 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 ("@@ " <> 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 " " <> 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
@@ -0,0 +1,138 @@+-----------------------------------------------------------------------------+-- |+-- Module : Data.Algorithm.DiffOutput+-- Copyright : (c) Sterling Clover 2008-2011, Kevin Charter 2011+-- License : BSD 3 Clause+-- Maintainer : s.clover@gmail.com+-- Stability : experimental+-- Portability : portable+-- Author : Stephan Wehr (wehr@factisresearch.com) and JP Moresmau (jp@moresmau.fr)+--+-- Generates a string output that is similar to diff normal mode+-----------------------------------------------------------------------------+module Data.Algorithm.DiffOutput where+import Data.Algorithm.Diff+import Text.PrettyPrint hiding ((<>))+import Data.Char+import Data.List++-- | Converts Diffs to DiffOperations+diffToLineRanges :: [Diff [String]] -> [DiffOperation LineRange]+diffToLineRanges = toLineRange 1 1+ where+ toLineRange :: Int -> Int -> [Diff [String]] -> [DiffOperation LineRange]+ toLineRange _ _ []=[]+ toLineRange leftLine rightLine (Both ls _:rs)=+ let lins=length ls+ in toLineRange (leftLine+lins) (rightLine+lins) rs+ toLineRange leftLine rightLine (Second lsS:First lsF:rs)=+ toChange leftLine rightLine lsF lsS rs+ toLineRange leftLine rightLine (First lsF:Second lsS:rs)=+ toChange leftLine rightLine lsF lsS rs+ toLineRange leftLine rightLine (Second lsS:rs)=+ let linesS=length lsS+ diff=Addition (LineRange (rightLine,rightLine+linesS-1) lsS) (leftLine-1)+ in diff : toLineRange leftLine (rightLine+linesS) rs+ toLineRange leftLine rightLine (First lsF:rs)=+ let linesF=length lsF+ diff=Deletion (LineRange (leftLine,leftLine+linesF-1) lsF) (rightLine-1)+ in diff: toLineRange(leftLine+linesF) rightLine rs+ toChange leftLine rightLine lsF lsS rs=+ let linesS=length lsS+ linesF=length lsF+ in Change (LineRange (leftLine,leftLine+linesF-1) lsF) (LineRange (rightLine,rightLine+linesS-1) lsS)+ : 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+ in+ render (prettyDiffs diffLineRanges) ++ "\n"+++-- | pretty print of diff operations+prettyDiffs :: [DiffOperation LineRange] -> Doc+prettyDiffs [] = empty+prettyDiffs (d : rest) = prettyDiff d $$ prettyDiffs rest+ where+ prettyDiff (Deletion inLeft lineNoRight) =+ prettyRange (lrNumbers inLeft) <> char 'd' <> int lineNoRight $$+ prettyLines '<' (lrContents inLeft)+ prettyDiff (Addition inRight lineNoLeft) =+ int lineNoLeft <> char 'a' <> prettyRange (lrNumbers inRight) $$+ prettyLines '>' (lrContents inRight)+ prettyDiff (Change inLeft 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 <> comma <> int end+ prettyLines start lins =+ vcat (map (\l -> char start <+> text l) lins)++-- | Parse pretty printed Diffs as DiffOperations+parsePrettyDiffs :: String -> [DiffOperation LineRange]+parsePrettyDiffs = reverse . doParse [] . lines+ where+ doParse diffs [] = diffs+ doParse diffs s =+ let (mnd,r) = parseDiff s+ in case mnd of+ Just nd -> doParse (nd:diffs) r+ _ -> doParse diffs r+ parseDiff [] = (Nothing,[])+ parseDiff (h:rs) = let+ (r1,hrs1) = parseRange h+ in case hrs1 of+ ('d':hrs2) -> parseDel r1 hrs2 rs+ ('a':hrs2) -> parseAdd r1 hrs2 rs+ ('c':hrs2) -> parseChange r1 hrs2 rs+ _ -> (Nothing,rs)+ parseDel r1 hrs2 rs = let+ (r2,_) = parseRange hrs2+ (ls,rs2) = span (isPrefixOf "<") rs+ in (Just $ Deletion (LineRange r1 (map (drop 2) ls)) (fst r2), rs2)+ parseAdd r1 hrs2 rs = let+ (r2,_) = parseRange hrs2+ (ls,rs2) = span (isPrefixOf ">") rs+ in (Just $ Addition (LineRange r2 (map (drop 2) ls)) (fst r1), rs2)+ parseChange r1 hrs2 rs = let+ (r2,_) = parseRange hrs2+ (ls1,rs2) = span (isPrefixOf "<") rs+ in case rs2 of+ ("---":rs3) -> let+ (ls2,rs4) = span (isPrefixOf ">") rs3+ in (Just $ Change (LineRange r1 (map (drop 2) ls1)) (LineRange r2 (map (drop 2) ls2)), rs4)+ _ -> (Nothing,rs2)+ parseRange :: String -> ((LineNo, LineNo),String)+ parseRange l = let+ (fstLine,rs) = span isDigit l+ (sndLine,rs3) = case rs of+ (',':rs2) -> span isDigit rs2+ _ -> (fstLine,rs)+ in ((read fstLine,read sndLine),rs3)++-- | Line number alias+type LineNo = Int++-- | Line Range: start, end and contents+data LineRange = LineRange { lrNumbers :: (LineNo, LineNo)+ , lrContents :: [String]+ }+ deriving (Show,Read,Eq,Ord)++-- | Diff Operation representing changes to apply+data DiffOperation a = Deletion a LineNo+ | Addition a LineNo+ | Change a a+ deriving (Show,Read,Eq,Ord)
+ test/Test.hs view
@@ -0,0 +1,287 @@+{-# 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+import System.Exit+import System.IO.Unsafe (unsafePerformIO)+import Debug.Trace (trace)+import System.Environment (getArgs)+import Data.Maybe (mapMaybe, catMaybes)+import System.Process (readProcessWithExitCode)+import System.Directory (getTemporaryDirectory)+++main :: IO ()+main = defaultMain [ testGroup "sub props" [+ slTest "empty in subs" prop_emptyInSubs,+ slTest "self in subs" prop_selfInSubs,+ slTest "count subs" prop_countSubs,+ slTest "every sub is a sub" prop_everySubIsSub,+ slTest2 "sub prop" prop_sub+ ],+ testGroup "diff props" [+ slTest "lcsEmpty" prop_lcsEmpty,+ slTest "lcsSelf" prop_lcsSelf,+ slTest2 "lcsBoth" prop_lcsBoth,+ slTest2 "recover first" prop_recoverFirst,+ slTest2 "recover second" prop_recoverSecond,+ 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)++-- We need some quick and dirty subsequence stuff for the diff tests,+-- so we build that and some tests for it.++-- | Determines whether one list is a subsequence of another.+isSub :: (Eq a) => [a] -> [a] -> Bool+isSub [] _ = True+isSub (_:_) [] = False+isSub (x:xs) (y:ys) | x == y = isSub xs ys+ | otherwise = isSub (x:xs) ys++-- | Lists the subsequences of a list.+subs :: [a] -> [[a]]+subs [] = [[]]+subs (x:rest) = map (x:) restss ++ restss+ where restss = subs rest++prop_emptyInSubs = elem [] . subs+prop_selfInSubs xs = elem xs (subs xs)+prop_countSubs xs = length (subs xs) == 2^(length xs)+prop_sub xs ys = isSub xs ys == elem xs (subs ys)+prop_everySubIsSub xs = all (flip isSub xs) (subs xs)+++-- | Obtains a longest common subsequence of two lists using their+-- diff. Note that there is an @lcs@ function in the+-- 'Data.Algorithm.Diff' module, but it's not exported. It's trivial+-- to reconstruct the LCS though, just by taking the 'B' elements.+diffLCS :: (Eq a) => [a] -> [a] -> [a]+diffLCS xs ys = recoverLCS $ getDiff xs ys++-- | Recovers the (longest) common subsequence from a diff.+recoverLCS :: [Diff a] -> [a]+recoverLCS (Both x _ : xs) = x : recoverLCS xs+recoverLCS (_ : xs) = recoverLCS xs+recoverLCS [] = []++-- | Recovers the first list from a diff.+recoverFirst :: [Diff a] -> [a]+recoverFirst (First x : xs) = x : recoverFirst xs+recoverFirst (Both x _ : xs) = x : recoverFirst xs+recoverFirst (_ : xs) = recoverFirst xs+recoverFirst [] = []++-- | Recovers the second list from a diff.+recoverSecond :: [Diff a] -> [a]+recoverSecond (Second x : xs) = x : recoverSecond xs+recoverSecond (Both x _ : xs) = x : recoverSecond xs+recoverSecond (_ : xs) = recoverSecond xs+recoverSecond [] = []++-- | Indicates whether a list is a longest common subsequence of two+-- lists.+isLCS :: (Eq a) => [a] -> [a] -> [a] -> Bool+isLCS ss xs ys = isSub ss ys && isSub ss ys && length ss == lenLCS xs ys++-- | Computes the length of the longest common subsequence of two+-- lists. This is a naive and inefficient recursive implementation+-- that doesn't memoize repeated sub-calls, so don't use it with large+-- lists.+lenLCS :: (Eq a) => [a] -> [a] -> Int+lenLCS [] _ = 0+lenLCS _ [] = 0+lenLCS (x:xs) (y:ys) | x == y = 1 + lenLCS xs ys+ | otherwise = max (lenLCS (x:xs) ys) (lenLCS xs (y:ys))+++prop_recoverFirst xs ys = recoverFirst (getDiff xs ys) == xs+prop_recoverSecond xs ys = recoverSecond (getDiff xs ys) == ys+prop_lcs xs ys = isLCS (diffLCS xs ys) xs ys+prop_lcsEmpty xs = diffLCS xs [] == [] && diffLCS [] xs == []+prop_lcsSelf xs = diffLCS xs xs == xs+prop_lcsBoth xs ys = all areMatch $ getDiff xs ys+ where areMatch (Both x y) = x == y+ areMatch _ = True++-- | Lists of no more than twelve elements.+shortLists :: (Arbitrary a) => Gen [a]+shortLists = sized $ \n -> resize (min n 12) $ listOf arbitrary++-- | 'forAll' where the generator is used twice.+forAll2 :: (Show a, Testable prop) => Gen a -> (a -> a -> prop) -> Property+forAll2 gen f = forAll gen $ \x -> forAll gen (f x)++prop_ppDiffEqual xs=ppDiff (getGroupedDiff xs xs)=="\n"++-- | truly random tests+prop_ppDiffR :: DiffInput -> Property+prop_ppDiffR (DiffInput le ri) =+ let haskDiff=ppDiff $ getGroupedDiff le ri+ utilDiff= unsafePerformIO (runDiff (unlines le) (unlines ri))+ in cover 90 (haskDiff == utilDiff) "exact match" $+ classify (haskDiff == utilDiff) "exact match"+ (div ((length (lines haskDiff))*100) (length (lines utilDiff)) < 110) -- less than 10% bigger+ where+ runDiff left right =+ do leftFile <- writeTemp left+ rightFile <- writeTemp right+ (ecode, out, err) <-+ readProcessWithExitCode "diff" [leftFile, rightFile] ""+ -- putStrLn ("OUT:\n" ++ out)+ -- putStrLn ("ERR:\n" ++ err)+ -- putStrLn ("ECODE:\n" ++ show ecode)+ case ecode of+ ExitSuccess -> return out+ ExitFailure 1 -> return out+ ExitFailure i -> error ("'diff " ++ leftFile ++ " " ++ rightFile +++ "' failed with exit code " ++ show i +++ ": " ++ show err)+ writeTemp s =+ do dir <- getTemporaryDirectory+ (fp, h) <- openTempFile dir "HTF-diff.txt"+ hPutStr h s+ 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) =+ let difflrs = diffToLineRanges $ getGroupedDiff le ri+ output = render (prettyDiffs difflrs) ++ "\n"+ parsed = parsePrettyDiffs output+ in difflrs == parsed++data DiffInput = DiffInput { diLeft :: [String], diRight :: [String] }+ deriving (Show)++leftDiffInput = ["1", "2", "3", "4", "", "5", "6", "7"]++instance Arbitrary DiffInput where+ arbitrary =+ do let leftLines = leftDiffInput+ rightLinesLines <- mapM modifyLine (leftLines ++ [""])+ return $ DiffInput leftLines+ (concat rightLinesLines)+ where+ randomString =+ do c <- elements ['a' .. 'z']+ return [c]+ modifyLine :: String -> Gen [String]+ modifyLine str =+ do prefixLen <- frequency [(20-i, return i) | i <- [0..5]]+ prefix <- mapM (const randomString) [1..prefixLen]+ frequency [ (5, return (prefix ++ [str]))+ , (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