module Data.Algorithm.DiffOutput where
import Data.Algorithm.Diff
import Text.PrettyPrint
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+linesS1) lsS) (leftLine1)
in diff : toLineRange leftLine (rightLine+linesS) rs
toLineRange leftLine rightLine (First lsF:rs)=
let linesF=length lsF
diff=Deletion (LineRange (leftLine,leftLine+linesF1) lsF) (rightLine1)
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+linesF1) lsF) (LineRange (rightLine,rightLine+linesS1) lsS)
: toLineRange (leftLine+linesF) (rightLine+linesS) rs
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)