Diff-0.4.0/0000755000000000000000000000000013541566341010561 5ustar0000000000000000Diff-0.4.0/Setup.hs0000644000000000000000000000011013541566341012205 0ustar0000000000000000#!/usr/bin/env runhaskell import Distribution.Simple main = defaultMain Diff-0.4.0/LICENSE0000644000000000000000000000267713541566341011602 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.0/Diff.cabal0000644000000000000000000000237313541566341012422 0ustar0000000000000000name: Diff version: 0.4.0 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.8 library 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: darcs location: http://hub.darcs.net/sterlingclover/Diff test-suite diff-tests 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.0/test/0000755000000000000000000000000013541566341011540 5ustar0000000000000000Diff-0.4.0/test/Test.hs0000644000000000000000000001667013541566341013025 0ustar0000000000000000module Main where import Test.Framework (defaultMain, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.QuickCheck import Data.Algorithm.Diff 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 ] ] 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])] Diff-0.4.0/src/0000755000000000000000000000000013541566341011350 5ustar0000000000000000Diff-0.4.0/src/Data/0000755000000000000000000000000013541566341012221 5ustar0000000000000000Diff-0.4.0/src/Data/Algorithm/0000755000000000000000000000000013541566341014147 5ustar0000000000000000Diff-0.4.0/src/Data/Algorithm/Diff.hs0000644000000000000000000001117113541566341015354 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.0/src/Data/Algorithm/DiffOutput.hs0000644000000000000000000001301713541566341016576 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.0/src/Data/Algorithm/DiffContext.hs0000644000000000000000000000662713541566341016733 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 , 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]]] -- | Do a grouped diff and then split up the chunks into runs that -- contain differences surrounded by N lines of unchanged text. If -- there is less then 2N+1 lines of unchanged text between two -- changes, the runs are left merged. getContextDiff :: Eq a => Int -> [a] -> [a] -> ContextDiff a getContextDiff 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