diff --git a/Diff.cabal b/Diff.cabal --- a/Diff.cabal +++ b/Diff.cabal @@ -1,38 +1,39 @@ -name: Diff -version: 0.2.0 -synopsis: O(ND) diff algorithm in haskell. -description: Basic implementation of the standard diff algorithm. -category: Algorithms -license: BSD3 -license-file: LICENSE -author: Sterling Clover -maintainer: s.clover@gmail.com -Tested-With: GHC == 6.8.2 -Build-Type: Simple -build-Depends: base -Cabal-Version: >= 1.6 - -flag small-base - -library - if flag(small-base) - build-depends: base >= 3 && <= 6, array - else - build-depends: base < 3 - hs-source-dirs: src - exposed-modules: Data.Algorithm.Diff - ghc-options: -O2 -Wall -funbox-strict-fields - --- test-suite properties --- hs-source-dirs: src, test --- main-is: Test.hs --- type: exitcode-stdio-1.0 - --- build-depends: --- QuickCheck >= 2.4, --- test-framework >= 0.4, --- test-framework-quickcheck2 >= 0.2 - -source-repository head - type: darcs - location: http://patch-tag.com/r/sclv/diff +name: Diff +version: 0.3.0 +synopsis: O(ND) diff algorithm in haskell. +description: Basic implementation of the standard diff algorithm. +category: Algorithms +license: BSD3 +license-file: LICENSE +author: Sterling Clover +maintainer: s.clover@gmail.com +Tested-With: GHC == 6.8.2 +Build-Type: Simple +build-Depends: base +Cabal-Version: >= 1.6 + +flag small-base + +library + if flag(small-base) + build-depends: base >= 3 && <= 6, array + else + build-depends: base < 3 + hs-source-dirs: src + exposed-modules: + Data.Algorithm.Diff, + Data.Algorithm.DiffOutput + ghc-options: -O2 -Wall -funbox-strict-fields + build-depends: pretty + +-- test-suite properties +-- hs-source-dirs: src, test +-- main-is: Test.hs +-- type: exitcode-stdio-1.0 + +-- build-depends: +-- QuickCheck >= 2.4, test-framework >= 0.4, test-framework-quickcheck2 >= 0.2, process, directory + +source-repository head + type: darcs + location: http://patch-tag.com/r/sclv/diff diff --git a/src/Data/Algorithm/Diff.hs b/src/Data/Algorithm/Diff.hs --- a/src/Data/Algorithm/Diff.hs +++ b/src/Data/Algorithm/Diff.hs @@ -38,10 +38,13 @@ data DL = DL {poi :: !Int, poj :: !Int, path::[DI]} deriving (Show, Eq) -instance Ord DL where x <= y = poi x <= poi y +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 = +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 @@ -95,10 +98,10 @@ 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 + go (Both x y : xs) = let (fs, rest) = goBoth xs (fxs, fys) = unzip fs in Both (x:fxs) (y:fys) : go rest - go [] = [] + go [] = [] goFirsts (First x : xs) = let (fs, rest) = goFirsts xs in (x:fs, rest) goFirsts xs = ([],xs) diff --git a/src/Data/Algorithm/DiffOutput.hs b/src/Data/Algorithm/DiffOutput.hs new file mode 100644 --- /dev/null +++ b/src/Data/Algorithm/DiffOutput.hs @@ -0,0 +1,80 @@ +----------------------------------------------------------------------------- +-- | +-- 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 + +-- | 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) <> 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) + +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)