-----------------------------------------------------------------------------
-- |
-- 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
    ( getContextDiffNew
    , 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]]]

-- | See https://github.com/haskell/containers/issues/424
groupBy' :: (a -> a -> Bool) -> [a] -> [[a]]
groupBy' :: forall a. (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 forall a. a -> [a] -> [a]
: a
x forall a. a -> [a] -> [a]
: [a]
xs) [a]
zs
      go [a]
g (a
y : [a]
zs) = forall a. [a] -> [a]
reverse [a]
g forall a. a -> [a] -> [a]
: [a] -> [a] -> [[a]]
go [a
y] [a]
zs
      go [a]
g [] = [forall a. [a] -> [a]
reverse [a]
g]

-- | See https://github.com/seereason/Diff/commit/35596ca45fdd6ee2559cf610bef7a86b4617988a.
-- The original 'getContextDiff' omitted trailing context in diff hunks.
-- This new one corrects the issue.  Here is the example from the test
-- suite:
--
--     > prettyContextDiff (text "file1") (text "file2") text (getContextDiffOld 2 (lines textA) (lines textB))
--     --- file1
--     +++ file2
--     @@
--      a
--      b
--     -c
--     @@
--      d
--      e
--     @@
--      i
--      j
--     -k
--
--     > prettyContextDiff (text "file1") (text "file2") text (getContextDiff 2 (lines textA) (lines textB))
--     --- file1
--     +++ file2
--     @@
--      a
--      b
--     -c
--      d
--      e
--     @@
--      i
--      j
--     -k
getContextDiffNew ::
  Eq a
  => Maybe Int -- ^ Number of context elements, Nothing means infinite
  -> [a]
  -> [a]
  -> ContextDiff a
getContextDiffNew :: forall a. Eq a => Maybe Int -> [a] -> [a] -> ContextDiff a
getContextDiffNew Maybe Int
context [a]
a [a]
b =
    forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy' (\Diff [a]
a Diff [a]
b -> Bool -> Bool
not (forall {a} {b}. PolyDiff a b -> Bool
isBoth Diff [a]
a Bool -> Bool -> Bool
&& forall {a} {b}. PolyDiff a b -> Bool
isBoth Diff [a]
b)) forall a b. (a -> b) -> a -> b
$ forall {a} {a}. [PolyDiff [a] [a]] -> [PolyDiff [a] [a]]
doPrefix forall a b. (a -> b) -> a -> b
$ 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
      -- Handle the common text leading up to a diff.
      doPrefix :: [PolyDiff [a] [a]] -> [PolyDiff [a] [a]]
doPrefix [] = []
      doPrefix [Both [a]
_ [a]
_] = []
      doPrefix (Both [a]
xs [a]
ys : [PolyDiff [a] [a]]
more) =
          forall a b. a -> b -> PolyDiff a b
Both (forall b a. b -> (a -> b) -> Maybe a -> b
maybe [a]
xs (\Int
n -> forall a. Int -> [a] -> [a]
drop (forall a. Ord a => a -> a -> a
max Int
0 (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs forall a. Num a => a -> a -> a
- Int
n)) [a]
xs) Maybe Int
context)
               (forall b a. b -> (a -> b) -> Maybe a -> b
maybe [a]
ys (\Int
n -> forall a. Int -> [a] -> [a]
drop (forall a. Ord a => a -> a -> a
max Int
0 (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ys forall a. Num a => a -> a -> a
- Int
n)) [a]
ys) Maybe Int
context) forall a. a -> [a] -> [a]
: [PolyDiff [a] [a]] -> [PolyDiff [a] [a]]
doSuffix [PolyDiff [a] [a]]
more
      -- Prefix finished, do the diff then the following suffix
      doPrefix (PolyDiff [a] [a]
d : [PolyDiff [a] [a]]
ds) = [PolyDiff [a] [a]] -> [PolyDiff [a] [a]]
doSuffix (PolyDiff [a] [a]
d forall a. a -> [a] -> [a]
: [PolyDiff [a] [a]]
ds)
      -- Handle the common text following a diff.
      doSuffix :: [PolyDiff [a] [a]] -> [PolyDiff [a] [a]]
doSuffix [] = []
      doSuffix [Both [a]
xs [a]
ys] = [forall a b. a -> b -> PolyDiff a b
Both (forall b a. b -> (a -> b) -> Maybe a -> b
maybe [a]
xs (\Int
n -> forall a. Int -> [a] -> [a]
take Int
n [a]
xs) Maybe Int
context) (forall b a. b -> (a -> b) -> Maybe a -> b
maybe [a]
ys (\Int
n -> forall a. Int -> [a] -> [a]
take Int
n [a]
ys) Maybe Int
context)]
      doSuffix (Both [a]
xs [a]
ys : [PolyDiff [a] [a]]
more)
          | forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (\Int
n -> forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs forall a. Ord a => a -> a -> Bool
<= Int
n forall a. Num a => a -> a -> a
* Int
2) Maybe Int
context =
              forall a b. a -> b -> PolyDiff a b
Both [a]
xs [a]
ys 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) =
          forall a b. a -> b -> PolyDiff a b
Both (forall b a. b -> (a -> b) -> Maybe a -> b
maybe [a]
xs (\Int
n -> forall a. Int -> [a] -> [a]
take Int
n [a]
xs) Maybe Int
context) (forall b a. b -> (a -> b) -> Maybe a -> b
maybe [a]
ys (\Int
n -> forall a. Int -> [a] -> [a]
take Int
n [a]
ys) Maybe Int
context)
                   forall a. a -> [a] -> [a]
: [PolyDiff [a] [a]] -> [PolyDiff [a] [a]]
doPrefix (forall a b. a -> b -> PolyDiff a b
Both (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (\Int
n -> forall a. Int -> [a] -> [a]
drop Int
n [a]
xs) Maybe Int
context) (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (\Int
n -> forall a. Int -> [a] -> [a]
drop Int
n [a]
ys) Maybe Int
context) forall a. a -> [a] -> [a]
: [PolyDiff [a] [a]]
more)
      doSuffix (PolyDiff [a] [a]
d : [PolyDiff [a] [a]]
ds) = PolyDiff [a] [a]
d forall a. a -> [a] -> [a]
: [PolyDiff [a] [a]] -> [PolyDiff [a] [a]]
doSuffix [PolyDiff [a] [a]]
ds

getContextDiff :: Eq a => Int -> [a] -> [a] -> ContextDiff a
getContextDiff :: forall a. Eq a => Int -> [a] -> [a] -> ContextDiff a
getContextDiff Int
context [a]
a [a]
b = forall a. Eq a => Maybe Int -> [a] -> [a] -> ContextDiff a
getContextDiffNew (forall a. a -> Maybe a
Just Int
context) [a]
a [a]
b

-- | 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.
getContextDiffOld :: Eq a => Int -> [a] -> [a] -> ContextDiff a
getContextDiffOld :: forall a. Eq a => Int -> [a] -> [a] -> ContextDiff a
getContextDiffOld Int
context [a]
a [a]
b =
    forall {a} {b}. [PolyDiff a b] -> [[PolyDiff a b]]
group forall a b. (a -> b) -> a -> b
$ forall {a} {b}. [PolyDiff a b] -> [PolyDiff a b]
swap forall a b. (a -> b) -> a -> b
$ forall {a} {b}. [PolyDiff a b] -> [PolyDiff a b]
trimTail forall a b. (a -> b) -> a -> b
$ forall {a} {b}. [PolyDiff a b] -> [PolyDiff a b]
trimHead forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {a} {a}. PolyDiff [a] [a] -> [PolyDiff [a] [a]]
split forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a] -> [Diff [a]]
getGroupedDiff [a]
a [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 :: PolyDiff [a] [a] -> [PolyDiff [a] [a]]
split (Both [a]
xs [a]
ys) =
          case forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs of
            Int
n | Int
n forall a. Ord a => a -> a -> Bool
> (Int
2 forall a. Num a => a -> a -> a
* Int
context) -> [forall a b. a -> b -> PolyDiff a b
Both (forall a. Int -> [a] -> [a]
take Int
context [a]
xs) (forall a. Int -> [a] -> [a]
take Int
context [a]
ys), forall a b. a -> b -> PolyDiff a b
Both (forall a. Int -> [a] -> [a]
drop (Int
n forall a. Num a => a -> a -> a
- Int
context) [a]
xs) (forall a. Int -> [a] -> [a]
drop (Int
n forall a. Num a => a -> a -> a
- Int
context) [a]
ys)]
            Int
_ -> [forall a b. a -> b -> PolyDiff a b
Both [a]
xs [a]
ys]
      split PolyDiff [a] [a]
x = [PolyDiff [a] [a]
x]
      -- If split created a pair of Both runs at the beginning or end
      -- of the diff, remove the outermost.
      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 forall a. a -> [a] -> [a]
: [PolyDiff a b]
more
      trimHead [PolyDiff a b]
xs = 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 forall a. a -> [a] -> [a]
: [PolyDiff a b] -> [PolyDiff a b]
trimTail [PolyDiff a b]
more
      trimTail [] = []
      -- If we see Second before First swap them so that the deletions
      -- appear before the additions.
      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 forall a. a -> [a] -> [a]
: PolyDiff a b
x 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 forall a. a -> [a] -> [a]
: [PolyDiff a b] -> [PolyDiff a b]
swap [PolyDiff a b]
xs
      swap [] = []
      -- Split the list wherever we see adjacent Both constructors
      group :: [PolyDiff a b] -> [[PolyDiff a b]]
group [PolyDiff a b]
xs =
          forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (\ PolyDiff a b
x PolyDiff a b
y -> Bool -> Bool
not (forall {a} {b}. PolyDiff a b -> Bool
isBoth PolyDiff a b
x Bool -> Bool -> 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

-- | 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 :: forall c. Doc -> Doc -> (c -> Doc) -> ContextDiff c -> Doc
prettyContextDiff Doc
_ Doc
_ c -> Doc
_ [] = Doc
empty
prettyContextDiff Doc
old Doc
new c -> Doc
prettyElem [[Diff [c]]]
hunks =
    [Doc] -> Doc
hcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. Monoid a => a -> a -> a
`mappend` String -> Doc
text String
"\n") forall a b. (a -> b) -> a -> b
$ (String -> Doc
text String
"--- " forall a. Monoid a => a -> a -> a
`mappend` Doc
old forall a. a -> [a] -> [a]
:
                                 String -> Doc
text String
"+++ " forall a. Monoid a => a -> a -> a
`mappend` Doc
new forall a. a -> [a] -> [a]
:
                                 forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {t :: * -> *}. Foldable t => t (Diff [c]) -> [Doc]
prettyRun [[Diff [c]]]
hunks)
    where
      -- Pretty print a run of adjacent changes
      prettyRun :: t (Diff [c]) -> [Doc]
prettyRun t (Diff [c])
hunk =
          String -> Doc
text String
"@@" forall a. a -> [a] -> [a]
: forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Diff [c] -> [Doc]
prettyChange t (Diff [c])
hunk

      -- Pretty print a single change (e.g. one line of a text file)
      prettyChange :: Diff [c] -> [Doc]
prettyChange (Both [c]
ts [c]
_) = forall a b. (a -> b) -> [a] -> [b]
map (\ c
l -> String -> Doc
text String
" " forall a. Monoid a => a -> a -> a
`mappend` c -> Doc
prettyElem c
l) [c]
ts
      prettyChange (First [c]
ts)  = forall a b. (a -> b) -> [a] -> [b]
map (\ c
l -> String -> Doc
text String
"-" forall a. Monoid a => a -> a -> a
`mappend` c -> Doc
prettyElem c
l) [c]
ts
      prettyChange (Second [c]
ts) = forall a b. (a -> b) -> [a] -> [b]
map (\ c
l -> String -> Doc
text String
"+" forall a. Monoid a => a -> a -> a
`mappend` c -> Doc
prettyElem c
l) [c]
ts