Diff-1.0.2/0000755000000000000000000000000007346545000010553 5ustar0000000000000000Diff-1.0.2/CHANGELOG.md0000644000000000000000000000326607346545000012373 0ustar0000000000000000# 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-1.0.2/Diff.cabal0000644000000000000000000000305507346545000012412 0ustar0000000000000000Cabal-Version: 1.18 name: Diff version: 1.0.2 synopsis: Diff algorithm in pure Haskell description: Implementation of the standard diff algorithm in Haskell. . Time complexity is O(ND) (input length * number of differences). Space complexity is O(D^2). Includes utilities for pretty printing. category: Algorithms homepage: https://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.4.6927 license: BSD3 license-file: LICENSE author: Sterling Clover maintainer: David Fox Build-Type: Simple tested-with: GHC == 9.12.0 GHC == 9.10.1 GHC == 9.8.2 GHC == 9.6.6 GHC == 9.4.8 GHC == 9.2.8 GHC == 9.0.2 GHC == 8.10.7 GHC == 8.8.4 GHC == 8.6.5 GHC == 8.4.4 extra-doc-files: CHANGELOG.md library default-language: Haskell2010 build-depends: base >= 4.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 Diff-1.0.2/LICENSE0000644000000000000000000000267707346545000011574 0ustar0000000000000000Copyright (c) Stering Clover 2008 All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the author nor the names of his contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. Diff-1.0.2/Setup.lhs0000644000000000000000000000011407346545000012357 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain Diff-1.0.2/src/Data/Algorithm/0000755000000000000000000000000007346545000014141 5ustar0000000000000000Diff-1.0.2/src/Data/Algorithm/Diff.hs0000644000000000000000000001250207346545000015345 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- 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)/ -- . -- 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) Diff-1.0.2/src/Data/Algorithm/DiffContext.hs0000644000000000000000000001567507346545000016730 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- 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 Diff-1.0.2/src/Data/Algorithm/DiffOutput.hs0000644000000000000000000001312107346545000016564 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- 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) Diff-1.0.2/test/0000755000000000000000000000000007346545000011532 5ustar0000000000000000Diff-1.0.2/test/Test.hs0000644000000000000000000002630007346545000013006 0ustar0000000000000000{-# 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