Diff-0.3.2/0000755000000000000000000000000012521573144010556 5ustar0000000000000000Diff-0.3.2/Diff.cabal0000644000000000000000000000151612521573144012415 0ustar0000000000000000name: Diff version: 0.3.2 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.6 library build-depends: base >= 3 && <= 6, array, pretty 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 Diff-0.3.2/LICENSE0000644000000000000000000000267712521573144011577 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.3.2/Setup.lhs0000644000000000000000000000011412521573144012362 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain Diff-0.3.2/src/0000755000000000000000000000000012521573144011345 5ustar0000000000000000Diff-0.3.2/src/Data/0000755000000000000000000000000012521573144012216 5ustar0000000000000000Diff-0.3.2/src/Data/Algorithm/0000755000000000000000000000000012521573144014144 5ustar0000000000000000Diff-0.3.2/src/Data/Algorithm/Diff.hs0000644000000000000000000001074512521573144015357 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(..) -- * Comparing lists for differences , getDiff , getDiffBy -- * Finding chunks of differences , getGroupedDiff , getGroupedDiffBy ) where import Prelude hiding (pi) import Data.Array 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 Diff a = First a | Second a | Both a a deriving (Show, Eq) 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 -> a -> Bool) -> [a] -> [a] -> 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 -> a -> Bool) -> [a] -> [a] -> [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 t) => [t] -> [t] -> [Diff t] 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 t) => [t] -> [t] -> [Diff [t]] getGroupedDiff = getGroupedDiffBy (==) -- | A form of 'getDiff' with no 'Eq' constraint. Instead, an equality predicate -- is taken as the first argument. getDiffBy :: (t -> t -> Bool) -> [t] -> [t] -> [Diff t] 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 :: (t -> t -> Bool) -> [t] -> [t] -> [Diff [t]] 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.3.2/src/Data/Algorithm/DiffContext.hs0000644000000000000000000000661512521573144016725 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 (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 Diff-0.3.2/src/Data/Algorithm/DiffOutput.hs0000644000000000000000000000706112521573144016575 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.Monoid (mappend) -- | pretty print the differences. The output is similar to the output of the diff utility ppDiff :: [Diff [String]] -> String ppDiff gdiff = let diffLineRanges = toLineRange 1 1 gdiff in render (prettyDiffs diffLineRanges) ++ "\n" 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 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) type LineNo = Int data LineRange = LineRange { lrNumbers :: (LineNo, LineNo) , lrContents :: [String] } deriving (Show) data DiffOperation a = Deletion a LineNo | Addition a LineNo | Change a a deriving (Show)