module Data.Algorithm.DiffContext
( getContextDiff
, getContextDiffOld
, 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]]]
groupBy' :: (a -> a -> Bool) -> [a] -> [[a]]
groupBy' :: (a -> a -> Bool) -> [a] -> [[a]]
groupBy' a -> a -> Bool
_ [] = []
groupBy' a -> a -> Bool
eq (a
x : [a]
xs) = [a] -> [a] -> [[a]]
go [a
x] [a]
xs
where
go :: [a] -> [a] -> [[a]]
go (a
x : [a]
xs) (a
y : [a]
zs) | a -> a -> Bool
eq a
x a
y = [a] -> [a] -> [[a]]
go (a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs) [a]
zs
go [a]
g (a
y : [a]
zs) = [a] -> [a]
forall a. [a] -> [a]
reverse [a]
g [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [[a]]
go [a
y] [a]
zs
go [a]
g [] = [[a] -> [a]
forall a. [a] -> [a]
reverse [a]
g]
getContextDiff :: Eq a => Int -> [a] -> [a] -> ContextDiff a
getContextDiff :: Int -> [a] -> [a] -> ContextDiff a
getContextDiff Int
context [a]
a [a]
b =
(PolyDiff [a] [a] -> PolyDiff [a] [a] -> Bool)
-> [PolyDiff [a] [a]] -> ContextDiff a
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy' (\PolyDiff [a] [a]
a PolyDiff [a] [a]
b -> Bool -> Bool
not (PolyDiff [a] [a] -> Bool
forall a b. PolyDiff a b -> Bool
isBoth PolyDiff [a] [a]
a Bool -> Bool -> Bool
&& PolyDiff [a] [a] -> Bool
forall a b. PolyDiff a b -> Bool
isBoth PolyDiff [a] [a]
b)) ([PolyDiff [a] [a]] -> ContextDiff a)
-> [PolyDiff [a] [a]] -> ContextDiff a
forall a b. (a -> b) -> a -> b
$ [PolyDiff [a] [a]] -> [PolyDiff [a] [a]]
forall a a. [PolyDiff [a] [a]] -> [PolyDiff [a] [a]]
doPrefix ([PolyDiff [a] [a]] -> [PolyDiff [a] [a]])
-> [PolyDiff [a] [a]] -> [PolyDiff [a] [a]]
forall a b. (a -> b) -> a -> b
$ [a] -> [a] -> [PolyDiff [a] [a]]
forall a. Eq a => [a] -> [a] -> [Diff [a]]
getGroupedDiff [a]
a [a]
b
where
isBoth :: PolyDiff a b -> Bool
isBoth (Both {}) = Bool
True
isBoth PolyDiff a b
_ = Bool
False
doPrefix :: [PolyDiff [a] [a]] -> [PolyDiff [a] [a]]
doPrefix [] = []
doPrefix [Both [a]
_ [a]
_] = []
doPrefix (Both [a]
xs [a]
ys : [PolyDiff [a] [a]]
more) =
[a] -> [a] -> PolyDiff [a] [a]
forall a b. a -> b -> PolyDiff a b
Both (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
context)) [a]
xs)
(Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ys Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
context)) [a]
ys) PolyDiff [a] [a] -> [PolyDiff [a] [a]] -> [PolyDiff [a] [a]]
forall a. a -> [a] -> [a]
: [PolyDiff [a] [a]] -> [PolyDiff [a] [a]]
doSuffix [PolyDiff [a] [a]]
more
doPrefix (PolyDiff [a] [a]
d : [PolyDiff [a] [a]]
ds) = [PolyDiff [a] [a]] -> [PolyDiff [a] [a]]
doSuffix (PolyDiff [a] [a]
d PolyDiff [a] [a] -> [PolyDiff [a] [a]] -> [PolyDiff [a] [a]]
forall a. a -> [a] -> [a]
: [PolyDiff [a] [a]]
ds)
doSuffix :: [PolyDiff [a] [a]] -> [PolyDiff [a] [a]]
doSuffix [] = []
doSuffix [Both [a]
xs [a]
ys] = [[a] -> [a] -> PolyDiff [a] [a]
forall a b. a -> b -> PolyDiff a b
Both (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
context [a]
xs) (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
context [a]
ys)]
doSuffix (Both [a]
xs [a]
ys : [PolyDiff [a] [a]]
more)
| [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
context Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2 =
[a] -> [a] -> PolyDiff [a] [a]
forall a b. a -> b -> PolyDiff a b
Both [a]
xs [a]
ys PolyDiff [a] [a] -> [PolyDiff [a] [a]] -> [PolyDiff [a] [a]]
forall a. a -> [a] -> [a]
: [PolyDiff [a] [a]] -> [PolyDiff [a] [a]]
doPrefix [PolyDiff [a] [a]]
more
doSuffix (Both [a]
xs [a]
ys : [PolyDiff [a] [a]]
more) =
[a] -> [a] -> PolyDiff [a] [a]
forall a b. a -> b -> PolyDiff a b
Both (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
context [a]
xs) (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
context [a]
ys)
PolyDiff [a] [a] -> [PolyDiff [a] [a]] -> [PolyDiff [a] [a]]
forall a. a -> [a] -> [a]
: [PolyDiff [a] [a]] -> [PolyDiff [a] [a]]
doPrefix ([a] -> [a] -> PolyDiff [a] [a]
forall a b. a -> b -> PolyDiff a b
Both (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
context [a]
xs) (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
context [a]
ys) PolyDiff [a] [a] -> [PolyDiff [a] [a]] -> [PolyDiff [a] [a]]
forall a. a -> [a] -> [a]
: [PolyDiff [a] [a]]
more)
doSuffix (PolyDiff [a] [a]
d : [PolyDiff [a] [a]]
ds) = PolyDiff [a] [a]
d PolyDiff [a] [a] -> [PolyDiff [a] [a]] -> [PolyDiff [a] [a]]
forall a. a -> [a] -> [a]
: [PolyDiff [a] [a]] -> [PolyDiff [a] [a]]
doSuffix [PolyDiff [a] [a]]
ds
getContextDiffOld :: Eq a => Int -> [a] -> [a] -> ContextDiff a
getContextDiffOld :: Int -> [a] -> [a] -> ContextDiff a
getContextDiffOld Int
context [a]
a [a]
b =
[PolyDiff [a] [a]] -> ContextDiff a
forall a b. [PolyDiff a b] -> [[PolyDiff a b]]
group ([PolyDiff [a] [a]] -> ContextDiff a)
-> [PolyDiff [a] [a]] -> ContextDiff a
forall a b. (a -> b) -> a -> b
$ [PolyDiff [a] [a]] -> [PolyDiff [a] [a]]
forall a b. [PolyDiff a b] -> [PolyDiff a b]
swap ([PolyDiff [a] [a]] -> [PolyDiff [a] [a]])
-> [PolyDiff [a] [a]] -> [PolyDiff [a] [a]]
forall a b. (a -> b) -> a -> b
$ [PolyDiff [a] [a]] -> [PolyDiff [a] [a]]
forall a b. [PolyDiff a b] -> [PolyDiff a b]
trimTail ([PolyDiff [a] [a]] -> [PolyDiff [a] [a]])
-> [PolyDiff [a] [a]] -> [PolyDiff [a] [a]]
forall a b. (a -> b) -> a -> b
$ [PolyDiff [a] [a]] -> [PolyDiff [a] [a]]
forall a b. [PolyDiff a b] -> [PolyDiff a b]
trimHead ([PolyDiff [a] [a]] -> [PolyDiff [a] [a]])
-> [PolyDiff [a] [a]] -> [PolyDiff [a] [a]]
forall a b. (a -> b) -> a -> b
$ (PolyDiff [a] [a] -> [PolyDiff [a] [a]])
-> [PolyDiff [a] [a]] -> [PolyDiff [a] [a]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PolyDiff [a] [a] -> [PolyDiff [a] [a]]
forall a a. PolyDiff [a] [a] -> [PolyDiff [a] [a]]
split ([PolyDiff [a] [a]] -> [PolyDiff [a] [a]])
-> [PolyDiff [a] [a]] -> [PolyDiff [a] [a]]
forall a b. (a -> b) -> a -> b
$ [a] -> [a] -> [PolyDiff [a] [a]]
forall a. Eq a => [a] -> [a] -> [Diff [a]]
getGroupedDiff [a]
a [a]
b
where
split :: PolyDiff [a] [a] -> [PolyDiff [a] [a]]
split (Both [a]
xs [a]
ys) =
case [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs of
Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
context) -> [[a] -> [a] -> PolyDiff [a] [a]
forall a b. a -> b -> PolyDiff a b
Both (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
context [a]
xs) (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
context [a]
ys), [a] -> [a] -> PolyDiff [a] [a]
forall a b. a -> b -> PolyDiff a b
Both (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
context) [a]
xs) (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
context) [a]
ys)]
Int
_ -> [[a] -> [a] -> PolyDiff [a] [a]
forall a b. a -> b -> PolyDiff a b
Both [a]
xs [a]
ys]
split PolyDiff [a] [a]
x = [PolyDiff [a] [a]
x]
trimHead :: [PolyDiff a b] -> [PolyDiff a b]
trimHead [] = []
trimHead [Both a
_ b
_] = []
trimHead [Both a
_ b
_, Both a
_ b
_] = []
trimHead (Both a
_ b
_ : x :: PolyDiff a b
x@(Both a
_ b
_) : [PolyDiff a b]
more) = PolyDiff a b
x PolyDiff a b -> [PolyDiff a b] -> [PolyDiff a b]
forall a. a -> [a] -> [a]
: [PolyDiff a b]
more
trimHead [PolyDiff a b]
xs = [PolyDiff a b] -> [PolyDiff a b]
forall a b. [PolyDiff a b] -> [PolyDiff a b]
trimTail [PolyDiff a b]
xs
trimTail :: [PolyDiff a b] -> [PolyDiff a b]
trimTail [x :: PolyDiff a b
x@(Both a
_ b
_), Both a
_ b
_] = [PolyDiff a b
x]
trimTail (PolyDiff a b
x : [PolyDiff a b]
more) = PolyDiff a b
x PolyDiff a b -> [PolyDiff a b] -> [PolyDiff a b]
forall a. a -> [a] -> [a]
: [PolyDiff a b] -> [PolyDiff a b]
trimTail [PolyDiff a b]
more
trimTail [] = []
swap :: [PolyDiff a b] -> [PolyDiff a b]
swap (x :: PolyDiff a b
x@(Second b
_) : y :: PolyDiff a b
y@(First a
_) : [PolyDiff a b]
xs) = PolyDiff a b
y PolyDiff a b -> [PolyDiff a b] -> [PolyDiff a b]
forall a. a -> [a] -> [a]
: PolyDiff a b
x PolyDiff a b -> [PolyDiff a b] -> [PolyDiff a b]
forall a. a -> [a] -> [a]
: [PolyDiff a b] -> [PolyDiff a b]
swap [PolyDiff a b]
xs
swap (PolyDiff a b
x : [PolyDiff a b]
xs) = PolyDiff a b
x PolyDiff a b -> [PolyDiff a b] -> [PolyDiff a b]
forall a. a -> [a] -> [a]
: [PolyDiff a b] -> [PolyDiff a b]
swap [PolyDiff a b]
xs
swap [] = []
group :: [PolyDiff a b] -> [[PolyDiff a b]]
group [PolyDiff a b]
xs =
(PolyDiff a b -> PolyDiff a b -> Bool)
-> [PolyDiff a b] -> [[PolyDiff a b]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (\ PolyDiff a b
x PolyDiff a b
y -> Bool -> Bool
not (PolyDiff a b -> Bool
forall a b. PolyDiff a b -> Bool
isBoth PolyDiff a b
x Bool -> Bool -> Bool
&& PolyDiff a b -> Bool
forall a b. PolyDiff a b -> Bool
isBoth PolyDiff a b
y)) [PolyDiff a b]
xs
where
isBoth :: PolyDiff a b -> Bool
isBoth (Both a
_ b
_) = Bool
True
isBoth PolyDiff a b
_ = Bool
False
prettyContextDiff ::
Doc
-> Doc
-> (c -> Doc)
-> ContextDiff c
-> Doc
prettyContextDiff :: Doc -> Doc -> (c -> Doc) -> ContextDiff c -> Doc
prettyContextDiff Doc
_ Doc
_ c -> Doc
_ [] = Doc
empty
prettyContextDiff Doc
old Doc
new c -> Doc
prettyElem ContextDiff c
hunks =
[Doc] -> Doc
hcat ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc -> Doc) -> [Doc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Doc -> Doc -> Doc
forall a. Monoid a => a -> a -> a
`mappend` String -> Doc
text String
"\n") ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc
text String
"--- " Doc -> Doc -> Doc
forall a. Monoid a => a -> a -> a
`mappend` Doc
old Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:
String -> Doc
text String
"+++ " Doc -> Doc -> Doc
forall a. Monoid a => a -> a -> a
`mappend` Doc
new Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:
([PolyDiff [c] [c]] -> [Doc]) -> ContextDiff c -> [Doc]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [PolyDiff [c] [c]] -> [Doc]
forall (t :: * -> *). Foldable t => t (PolyDiff [c] [c]) -> [Doc]
prettyRun ContextDiff c
hunks)
where
prettyRun :: t (PolyDiff [c] [c]) -> [Doc]
prettyRun t (PolyDiff [c] [c])
hunk =
String -> Doc
text String
"@@" Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (PolyDiff [c] [c] -> [Doc]) -> t (PolyDiff [c] [c]) -> [Doc]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PolyDiff [c] [c] -> [Doc]
prettyChange t (PolyDiff [c] [c])
hunk
prettyChange :: PolyDiff [c] [c] -> [Doc]
prettyChange (Both [c]
ts [c]
_) = (c -> Doc) -> [c] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\ c
l -> String -> Doc
text String
" " Doc -> Doc -> Doc
forall a. Monoid a => a -> a -> a
`mappend` c -> Doc
prettyElem c
l) [c]
ts
prettyChange (First [c]
ts) = (c -> Doc) -> [c] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\ c
l -> String -> Doc
text String
"-" Doc -> Doc -> Doc
forall a. Monoid a => a -> a -> a
`mappend` c -> Doc
prettyElem c
l) [c]
ts
prettyChange (Second [c]
ts) = (c -> Doc) -> [c] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\ c
l -> String -> Doc
text String
"+" Doc -> Doc -> Doc
forall a. Monoid a => a -> a -> a
`mappend` c -> Doc
prettyElem c
l) [c]
ts