-----------------------------------------------------------------------------
-- |
-- 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 :: [Diff [String]] -> [DiffOperation LineRange]
diffToLineRanges = LineNo -> LineNo -> [Diff [String]] -> [DiffOperation LineRange]
toLineRange LineNo
1 LineNo
1
   where
          toLineRange :: Int -> Int -> [Diff [String]] -> [DiffOperation LineRange]
          toLineRange :: LineNo -> LineNo -> [Diff [String]] -> [DiffOperation LineRange]
toLineRange LineNo
_ LineNo
_ []=[]
          toLineRange LineNo
leftLine LineNo
rightLine (Both [String]
ls [String]
_:[Diff [String]]
rs)=
                let lins :: LineNo
lins=forall (t :: * -> *) a. Foldable t => t a -> LineNo
length [String]
ls
                in  LineNo -> LineNo -> [Diff [String]] -> [DiffOperation LineRange]
toLineRange (LineNo
leftLineforall a. Num a => a -> a -> a
+LineNo
lins) (LineNo
rightLineforall a. Num a => a -> a -> a
+LineNo
lins) [Diff [String]]
rs
          toLineRange LineNo
leftLine LineNo
rightLine (Second [String]
lsS:First [String]
lsF:[Diff [String]]
rs)=
                LineNo
-> LineNo
-> [String]
-> [String]
-> [Diff [String]]
-> [DiffOperation LineRange]
toChange LineNo
leftLine LineNo
rightLine [String]
lsF [String]
lsS [Diff [String]]
rs
          toLineRange LineNo
leftLine LineNo
rightLine (First [String]
lsF:Second [String]
lsS:[Diff [String]]
rs)=
                LineNo
-> LineNo
-> [String]
-> [String]
-> [Diff [String]]
-> [DiffOperation LineRange]
toChange LineNo
leftLine LineNo
rightLine [String]
lsF [String]
lsS [Diff [String]]
rs
          toLineRange LineNo
leftLine LineNo
rightLine (Second [String]
lsS:[Diff [String]]
rs)=
                let linesS :: LineNo
linesS=forall (t :: * -> *) a. Foldable t => t a -> LineNo
length [String]
lsS
                    diff :: DiffOperation LineRange
diff=forall a. a -> LineNo -> DiffOperation a
Addition ((LineNo, LineNo) -> [String] -> LineRange
LineRange (LineNo
rightLine,LineNo
rightLineforall a. Num a => a -> a -> a
+LineNo
linesSforall a. Num a => a -> a -> a
-LineNo
1) [String]
lsS) (LineNo
leftLineforall a. Num a => a -> a -> a
-LineNo
1)
                in  DiffOperation LineRange
diff forall a. a -> [a] -> [a]
: LineNo -> LineNo -> [Diff [String]] -> [DiffOperation LineRange]
toLineRange LineNo
leftLine (LineNo
rightLineforall a. Num a => a -> a -> a
+LineNo
linesS) [Diff [String]]
rs
          toLineRange LineNo
leftLine LineNo
rightLine  (First [String]
lsF:[Diff [String]]
rs)=
                let linesF :: LineNo
linesF=forall (t :: * -> *) a. Foldable t => t a -> LineNo
length [String]
lsF
                    diff :: DiffOperation LineRange
diff=forall a. a -> LineNo -> DiffOperation a
Deletion ((LineNo, LineNo) -> [String] -> LineRange
LineRange (LineNo
leftLine,LineNo
leftLineforall a. Num a => a -> a -> a
+LineNo
linesFforall a. Num a => a -> a -> a
-LineNo
1) [String]
lsF) (LineNo
rightLineforall a. Num a => a -> a -> a
-LineNo
1)
                in  DiffOperation LineRange
diffforall a. a -> [a] -> [a]
: LineNo -> LineNo -> [Diff [String]] -> [DiffOperation LineRange]
toLineRange(LineNo
leftLineforall a. Num a => a -> a -> a
+LineNo
linesF) LineNo
rightLine [Diff [String]]
rs
          toChange :: LineNo
-> LineNo
-> [String]
-> [String]
-> [Diff [String]]
-> [DiffOperation LineRange]
toChange LineNo
leftLine LineNo
rightLine [String]
lsF [String]
lsS [Diff [String]]
rs=
                let linesS :: LineNo
linesS=forall (t :: * -> *) a. Foldable t => t a -> LineNo
length [String]
lsS
                    linesF :: LineNo
linesF=forall (t :: * -> *) a. Foldable t => t a -> LineNo
length [String]
lsF
                in  forall a. a -> a -> DiffOperation a
Change ((LineNo, LineNo) -> [String] -> LineRange
LineRange (LineNo
leftLine,LineNo
leftLineforall a. Num a => a -> a -> a
+LineNo
linesFforall a. Num a => a -> a -> a
-LineNo
1) [String]
lsF) ((LineNo, LineNo) -> [String] -> LineRange
LineRange (LineNo
rightLine,LineNo
rightLineforall a. Num a => a -> a -> a
+LineNo
linesSforall a. Num a => a -> a -> a
-LineNo
1) [String]
lsS)
                        forall a. a -> [a] -> [a]
: LineNo -> LineNo -> [Diff [String]] -> [DiffOperation LineRange]
toLineRange (LineNo
leftLineforall a. Num a => a -> a -> a
+LineNo
linesF) (LineNo
rightLineforall a. Num a => a -> a -> a
+LineNo
linesS) [Diff [String]]
rs

-- | pretty print the differences. The output is similar to the output of the diff utility
ppDiff :: [Diff [String]] -> String
ppDiff :: [Diff [String]] -> String
ppDiff [Diff [String]]
gdiff =
   let  diffLineRanges :: [DiffOperation LineRange]
diffLineRanges = [Diff [String]] -> [DiffOperation LineRange]
diffToLineRanges [Diff [String]]
gdiff
   in
        Doc -> String
render ([DiffOperation LineRange] -> Doc
prettyDiffs [DiffOperation LineRange]
diffLineRanges) forall a. [a] -> [a] -> [a]
++ String
"\n"


-- | pretty print of diff operations
prettyDiffs :: [DiffOperation LineRange] -> Doc
prettyDiffs :: [DiffOperation LineRange] -> Doc
prettyDiffs [] = Doc
empty
prettyDiffs (DiffOperation LineRange
d : [DiffOperation LineRange]
rest) = DiffOperation LineRange -> Doc
prettyDiff DiffOperation LineRange
d Doc -> Doc -> Doc
$$ [DiffOperation LineRange] -> Doc
prettyDiffs [DiffOperation LineRange]
rest
    where
      prettyDiff :: DiffOperation LineRange -> Doc
prettyDiff (Deletion LineRange
inLeft LineNo
lineNoRight) =
          (LineNo, LineNo) -> Doc
prettyRange (LineRange -> (LineNo, LineNo)
lrNumbers LineRange
inLeft) forall a. Monoid a => a -> a -> a
`mappend` Char -> Doc
char Char
'd' forall a. Monoid a => a -> a -> a
`mappend` LineNo -> Doc
int LineNo
lineNoRight Doc -> Doc -> Doc
$$
          Char -> [String] -> Doc
prettyLines Char
'<' (LineRange -> [String]
lrContents LineRange
inLeft)
      prettyDiff (Addition LineRange
inRight LineNo
lineNoLeft) =
          LineNo -> Doc
int LineNo
lineNoLeft forall a. Monoid a => a -> a -> a
`mappend` Char -> Doc
char Char
'a' forall a. Monoid a => a -> a -> a
`mappend` (LineNo, LineNo) -> Doc
prettyRange (LineRange -> (LineNo, LineNo)
lrNumbers LineRange
inRight) Doc -> Doc -> Doc
$$
          Char -> [String] -> Doc
prettyLines Char
'>' (LineRange -> [String]
lrContents LineRange
inRight)
      prettyDiff (Change LineRange
inLeft LineRange
inRight) =
          (LineNo, LineNo) -> Doc
prettyRange (LineRange -> (LineNo, LineNo)
lrNumbers LineRange
inLeft) forall a. Monoid a => a -> a -> a
`mappend` Char -> Doc
char Char
'c' forall a. Monoid a => a -> a -> a
`mappend` (LineNo, LineNo) -> Doc
prettyRange (LineRange -> (LineNo, LineNo)
lrNumbers LineRange
inRight) Doc -> Doc -> Doc
$$
          Char -> [String] -> Doc
prettyLines Char
'<' (LineRange -> [String]
lrContents LineRange
inLeft) Doc -> Doc -> Doc
$$
          String -> Doc
text String
"---" Doc -> Doc -> Doc
$$
          Char -> [String] -> Doc
prettyLines Char
'>' (LineRange -> [String]
lrContents LineRange
inRight)
      prettyRange :: (LineNo, LineNo) -> Doc
prettyRange (LineNo
start, LineNo
end) =
          if LineNo
start forall a. Eq a => a -> a -> Bool
== LineNo
end then LineNo -> Doc
int LineNo
start else LineNo -> Doc
int LineNo
start forall a. Monoid a => a -> a -> a
`mappend` Doc
comma forall a. Monoid a => a -> a -> a
`mappend` LineNo -> Doc
int LineNo
end
      prettyLines :: Char -> [String] -> Doc
prettyLines Char
start [String]
lins =
          [Doc] -> Doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map (\String
l -> Char -> Doc
char Char
start Doc -> Doc -> Doc
<+> String -> Doc
text String
l) [String]
lins)

-- | Parse pretty printed Diffs as DiffOperations
parsePrettyDiffs :: String -> [DiffOperation LineRange]
parsePrettyDiffs :: String -> [DiffOperation LineRange]
parsePrettyDiffs = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. [DiffOperation LineRange] -> [String] -> [DiffOperation LineRange]
doParse [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
  where
    doParse :: [DiffOperation LineRange] -> [String] -> [DiffOperation LineRange]
doParse [DiffOperation LineRange]
diffs [] = [DiffOperation LineRange]
diffs
    doParse [DiffOperation LineRange]
diffs [String]
s =
        let (Maybe (DiffOperation LineRange)
mnd,[String]
r) = [String] -> (Maybe (DiffOperation LineRange), [String])
parseDiff [String]
s
        in case Maybe (DiffOperation LineRange)
mnd of
            Just DiffOperation LineRange
nd -> [DiffOperation LineRange] -> [String] -> [DiffOperation LineRange]
doParse (DiffOperation LineRange
ndforall a. a -> [a] -> [a]
:[DiffOperation LineRange]
diffs) [String]
r
            Maybe (DiffOperation LineRange)
_          -> [DiffOperation LineRange] -> [String] -> [DiffOperation LineRange]
doParse [DiffOperation LineRange]
diffs [String]
r
    parseDiff :: [String] -> (Maybe (DiffOperation LineRange), [String])
parseDiff [] = (forall a. Maybe a
Nothing,[])
    parseDiff (String
h:[String]
rs) = let
        ((LineNo, LineNo)
r1,String
hrs1) = String -> ((LineNo, LineNo), String)
parseRange String
h
        in case String
hrs1 of
                (Char
'd':String
hrs2) -> (LineNo, LineNo)
-> String
-> [String]
-> (Maybe (DiffOperation LineRange), [String])
parseDel (LineNo, LineNo)
r1 String
hrs2 [String]
rs
                (Char
'a':String
hrs2) -> forall {b}.
(LineNo, b)
-> String
-> [String]
-> (Maybe (DiffOperation LineRange), [String])
parseAdd (LineNo, LineNo)
r1 String
hrs2 [String]
rs
                (Char
'c':String
hrs2) -> (LineNo, LineNo)
-> String
-> [String]
-> (Maybe (DiffOperation LineRange), [String])
parseChange (LineNo, LineNo)
r1 String
hrs2 [String]
rs
                String
_ -> (forall a. Maybe a
Nothing,[String]
rs)
    parseDel :: (LineNo, LineNo)
-> String
-> [String]
-> (Maybe (DiffOperation LineRange), [String])
parseDel (LineNo, LineNo)
r1 String
hrs2 [String]
rs = let
        ((LineNo, LineNo)
r2,String
_) = String -> ((LineNo, LineNo), String)
parseRange String
hrs2
        ([String]
ls,[String]
rs2) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"<") [String]
rs
        in (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> LineNo -> DiffOperation a
Deletion ((LineNo, LineNo) -> [String] -> LineRange
LineRange (LineNo, LineNo)
r1 (forall a b. (a -> b) -> [a] -> [b]
map (forall a. LineNo -> [a] -> [a]
drop LineNo
2) [String]
ls)) (forall a b. (a, b) -> a
fst (LineNo, LineNo)
r2), [String]
rs2)
    parseAdd :: (LineNo, b)
-> String
-> [String]
-> (Maybe (DiffOperation LineRange), [String])
parseAdd (LineNo, b)
r1 String
hrs2 [String]
rs = let
        ((LineNo, LineNo)
r2,String
_) = String -> ((LineNo, LineNo), String)
parseRange String
hrs2
        ([String]
ls,[String]
rs2) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
">") [String]
rs
        in (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> LineNo -> DiffOperation a
Addition ((LineNo, LineNo) -> [String] -> LineRange
LineRange (LineNo, LineNo)
r2 (forall a b. (a -> b) -> [a] -> [b]
map (forall a. LineNo -> [a] -> [a]
drop LineNo
2) [String]
ls)) (forall a b. (a, b) -> a
fst (LineNo, b)
r1), [String]
rs2)
    parseChange :: (LineNo, LineNo)
-> String
-> [String]
-> (Maybe (DiffOperation LineRange), [String])
parseChange (LineNo, LineNo)
r1 String
hrs2 [String]
rs = let
        ((LineNo, LineNo)
r2,String
_) = String -> ((LineNo, LineNo), String)
parseRange String
hrs2
        ([String]
ls1,[String]
rs2) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"<") [String]
rs
        in case [String]
rs2 of
            (String
"---":[String]
rs3) -> let
                ([String]
ls2,[String]
rs4) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
">") [String]
rs3
                in (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> DiffOperation a
Change ((LineNo, LineNo) -> [String] -> LineRange
LineRange (LineNo, LineNo)
r1 (forall a b. (a -> b) -> [a] -> [b]
map (forall a. LineNo -> [a] -> [a]
drop LineNo
2) [String]
ls1)) ((LineNo, LineNo) -> [String] -> LineRange
LineRange (LineNo, LineNo)
r2 (forall a b. (a -> b) -> [a] -> [b]
map (forall a. LineNo -> [a] -> [a]
drop LineNo
2) [String]
ls2)), [String]
rs4)
            [String]
_ -> (forall a. Maybe a
Nothing,[String]
rs2)
    parseRange :: String -> ((LineNo, LineNo),String)
    parseRange :: String -> ((LineNo, LineNo), String)
parseRange String
l = let
        (String
fstLine,String
rs) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit String
l
        (String
sndLine,String
rs3) = case String
rs of
                                    (Char
',':String
rs2) -> forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit String
rs2
                                    String
_ -> (String
fstLine,String
rs)
        in ((forall a. Read a => String -> a
read String
fstLine,forall a. Read a => String -> a
read String
sndLine),String
rs3)

-- | Line number alias
type LineNo = Int

-- | Line Range: start, end and contents
data LineRange = LineRange { LineRange -> (LineNo, LineNo)
lrNumbers :: (LineNo, LineNo)
                           , LineRange -> [String]
lrContents :: [String]
                           }
            deriving (LineNo -> LineRange -> ShowS
[LineRange] -> ShowS
LineRange -> String
forall a.
(LineNo -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LineRange] -> ShowS
$cshowList :: [LineRange] -> ShowS
show :: LineRange -> String
$cshow :: LineRange -> String
showsPrec :: LineNo -> LineRange -> ShowS
$cshowsPrec :: LineNo -> LineRange -> ShowS
Show,ReadPrec [LineRange]
ReadPrec LineRange
LineNo -> ReadS LineRange
ReadS [LineRange]
forall a.
(LineNo -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LineRange]
$creadListPrec :: ReadPrec [LineRange]
readPrec :: ReadPrec LineRange
$creadPrec :: ReadPrec LineRange
readList :: ReadS [LineRange]
$creadList :: ReadS [LineRange]
readsPrec :: LineNo -> ReadS LineRange
$creadsPrec :: LineNo -> ReadS LineRange
Read,LineRange -> LineRange -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LineRange -> LineRange -> Bool
$c/= :: LineRange -> LineRange -> Bool
== :: LineRange -> LineRange -> Bool
$c== :: LineRange -> LineRange -> Bool
Eq,Eq LineRange
LineRange -> LineRange -> Bool
LineRange -> LineRange -> Ordering
LineRange -> LineRange -> LineRange
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LineRange -> LineRange -> LineRange
$cmin :: LineRange -> LineRange -> LineRange
max :: LineRange -> LineRange -> LineRange
$cmax :: LineRange -> LineRange -> LineRange
>= :: LineRange -> LineRange -> Bool
$c>= :: LineRange -> LineRange -> Bool
> :: LineRange -> LineRange -> Bool
$c> :: LineRange -> LineRange -> Bool
<= :: LineRange -> LineRange -> Bool
$c<= :: LineRange -> LineRange -> Bool
< :: LineRange -> LineRange -> Bool
$c< :: LineRange -> LineRange -> Bool
compare :: LineRange -> LineRange -> Ordering
$ccompare :: LineRange -> LineRange -> Ordering
Ord)

-- | Diff Operation  representing changes to apply
data DiffOperation a = Deletion a LineNo
            | Addition a LineNo
            | Change a a
            deriving (LineNo -> DiffOperation a -> ShowS
forall a. Show a => LineNo -> DiffOperation a -> ShowS
forall a. Show a => [DiffOperation a] -> ShowS
forall a. Show a => DiffOperation a -> String
forall a.
(LineNo -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DiffOperation a] -> ShowS
$cshowList :: forall a. Show a => [DiffOperation a] -> ShowS
show :: DiffOperation a -> String
$cshow :: forall a. Show a => DiffOperation a -> String
showsPrec :: LineNo -> DiffOperation a -> ShowS
$cshowsPrec :: forall a. Show a => LineNo -> DiffOperation a -> ShowS
Show,ReadPrec [DiffOperation a]
ReadPrec (DiffOperation a)
ReadS [DiffOperation a]
forall a. Read a => ReadPrec [DiffOperation a]
forall a. Read a => ReadPrec (DiffOperation a)
forall a. Read a => LineNo -> ReadS (DiffOperation a)
forall a. Read a => ReadS [DiffOperation a]
forall a.
(LineNo -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DiffOperation a]
$creadListPrec :: forall a. Read a => ReadPrec [DiffOperation a]
readPrec :: ReadPrec (DiffOperation a)
$creadPrec :: forall a. Read a => ReadPrec (DiffOperation a)
readList :: ReadS [DiffOperation a]
$creadList :: forall a. Read a => ReadS [DiffOperation a]
readsPrec :: LineNo -> ReadS (DiffOperation a)
$creadsPrec :: forall a. Read a => LineNo -> ReadS (DiffOperation a)
Read,DiffOperation a -> DiffOperation a -> Bool
forall a. Eq a => DiffOperation a -> DiffOperation a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DiffOperation a -> DiffOperation a -> Bool
$c/= :: forall a. Eq a => DiffOperation a -> DiffOperation a -> Bool
== :: DiffOperation a -> DiffOperation a -> Bool
$c== :: forall a. Eq a => DiffOperation a -> DiffOperation a -> Bool
Eq,DiffOperation a -> DiffOperation a -> Bool
DiffOperation a -> DiffOperation a -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (DiffOperation a)
forall a. Ord a => DiffOperation a -> DiffOperation a -> Bool
forall a. Ord a => DiffOperation a -> DiffOperation a -> Ordering
forall a.
Ord a =>
DiffOperation a -> DiffOperation a -> DiffOperation a
min :: DiffOperation a -> DiffOperation a -> DiffOperation a
$cmin :: forall a.
Ord a =>
DiffOperation a -> DiffOperation a -> DiffOperation a
max :: DiffOperation a -> DiffOperation a -> DiffOperation a
$cmax :: forall a.
Ord a =>
DiffOperation a -> DiffOperation a -> DiffOperation a
>= :: DiffOperation a -> DiffOperation a -> Bool
$c>= :: forall a. Ord a => DiffOperation a -> DiffOperation a -> Bool
> :: DiffOperation a -> DiffOperation a -> Bool
$c> :: forall a. Ord a => DiffOperation a -> DiffOperation a -> Bool
<= :: DiffOperation a -> DiffOperation a -> Bool
$c<= :: forall a. Ord a => DiffOperation a -> DiffOperation a -> Bool
< :: DiffOperation a -> DiffOperation a -> Bool
$c< :: forall a. Ord a => DiffOperation a -> DiffOperation a -> Bool
compare :: DiffOperation a -> DiffOperation a -> Ordering
$ccompare :: forall a. Ord a => DiffOperation a -> DiffOperation a -> Ordering
Ord)