Diff-0.4.1/0000755000000000000000000000000007346545000010555 5ustar0000000000000000Diff-0.4.1/Diff.cabal0000644000000000000000000000246207346545000012415 0ustar0000000000000000name: Diff version: 0.4.1 synopsis: O(ND) diff algorithm in haskell. description: Implementation of the standard diff algorithm, and utilities for pretty printing. category: Algorithms license: BSD3 license-file: LICENSE author: Sterling Clover maintainer: s.clover@gmail.com Tested-With: GHC == 7.8.4 Build-Type: Simple Cabal-Version: >= 1.10 library default-language: Haskell2010 build-depends: base >= 3 && <= 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 source-repository head type: git location: http://github.com/seereason/Diff test-suite diff-tests default-language: Haskell2010 type: exitcode-stdio-1.0 hs-source-dirs: test, src main-is: Test.hs build-depends: base >= 3 && <= 6, array , pretty, QuickCheck, test-framework , test-framework-quickcheck2, process , directory other-modules: Data.Algorithm.Diff, Data.Algorithm.DiffOutput Data.Algorithm.DiffContext Diff-0.4.1/LICENSE0000644000000000000000000000267707346545000011576 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-0.4.1/Setup.lhs0000644000000000000000000000011407346545000012361 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain Diff-0.4.1/src/Data/Algorithm/0000755000000000000000000000000007346545000014143 5ustar0000000000000000Diff-0.4.1/src/Data/Algorithm/Diff.hs0000644000000000000000000001117107346545000015350 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 O(ND) diff algorithm as described in -- \"An O(ND) Difference Algorithm and Its Variations (1986)\" -- . It is O(mn) in space. -- The algorithm is the same one used by standared Unix diff. ----------------------------------------------------------------------------- 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, (!)) data DI = F | S | B 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) -- | 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=(B : 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 :: (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 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) 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 :: (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-0.4.1/src/Data/Algorithm/DiffContext.hs0000644000000000000000000001301107346545000016710 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 ( getContextDiff , getContextDiffOld , prettyContextDiff ) where import Data.Algorithm.Diff (PolyDiff(..), Diff, getGroupedDiff) import Data.List (groupBy) import Data.Monoid (mappend) import Text.PrettyPrint (Doc, text, empty, hcat) type ContextDiff c = [[Diff [c]]] -- | See https://github.com/haskell/containers/issues/424 groupBy' :: (a -> a -> Bool) -> [a] -> [[a]] groupBy' _ [] = [] groupBy' eq (x : xs) = go [x] xs 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 getContextDiff :: Eq a => Int -> [a] -> [a] -> ContextDiff a getContextDiff context a b = groupBy' (\a b -> not (isBoth a && isBoth b)) $ doPrefix $ getGroupedDiff a b where isBoth (Both {}) = True isBoth _ = False -- Handle the common text leading up to a diff. doPrefix [] = [] doPrefix [Both _ _] = [] doPrefix (Both xs ys : more) = Both (drop (max 0 (length xs - context)) xs) (drop (max 0 (length ys - context)) ys) : 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 (take context xs) (take context ys)] doSuffix (Both xs ys : more) | length xs <= context * 2 = Both xs ys : doPrefix more doSuffix (Both xs ys : more) = Both (take context xs) (take context ys) : doPrefix (Both (drop context xs) (drop context ys) : more) doSuffix (d : ds) = d : doSuffix ds -- | 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 -> Doc prettyContextDiff _ _ _ [] = empty prettyContextDiff old new prettyElem hunks = hcat . map (`mappend` text "\n") $ (text "--- " `mappend` old : text "+++ " `mappend` 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 Diff-0.4.1/src/Data/Algorithm/DiffOutput.hs0000644000000000000000000001301707346545000016572 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 import Data.Char import Data.List import Data.Monoid (mappend) -- | 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 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) `mappend` char 'd' `mappend` int lineNoRight $$ prettyLines '<' (lrContents inLeft) prettyDiff (Addition inRight lineNoLeft) = int lineNoLeft `mappend` char 'a' `mappend` prettyRange (lrNumbers inRight) $$ prettyLines '>' (lrContents inRight) prettyDiff (Change inLeft inRight) = prettyRange (lrNumbers inLeft) `mappend` char 'c' `mappend` 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 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-0.4.1/test/0000755000000000000000000000000007346545000011534 5ustar0000000000000000Diff-0.4.1/test/Test.hs0000644000000000000000000001775507346545000013026 0ustar0000000000000000module 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 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 ], 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 "test parse" prop_parse, testProperty "test context" prop_context_diff ] ] 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 haskDiff)*100) (length 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 -- | 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])] -- | FIXME - make a real quickcheck property prop_context_diff :: Bool 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) textA = "a\nb\nc\nd\ne\nf\ng\nh\ni\nj\nk\n" textB = "a\nb\nd\ne\nf\ng\nh\ni\nj\n"