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

-- | 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.
getContextDiff :: Eq a => Int -> [a] -> [a] -> ContextDiff a
getContextDiff :: Int -> [a] -> [a] -> ContextDiff a
getContextDiff context :: Int
context a :: [a]
a b :: [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
      -- 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 xs :: [a]
xs ys :: [a]
ys) =
          case [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs of
            n :: Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> (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)]
            _ -> [[a] -> [a] -> PolyDiff [a] [a]
forall a b. a -> b -> PolyDiff a b
Both [a]
xs [a]
ys]
      split x :: 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 _ _] = []
      trimHead [Both _ _, Both _ _] = []
      trimHead (Both _ _ : x :: PolyDiff a b
x@(Both _ _) : more :: [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 xs :: [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 _ _), Both _ _] = [PolyDiff a b
x]
      trimTail (x :: PolyDiff a b
x : more :: [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 [] = []
      -- 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 _) : y :: PolyDiff a b
y@(First _) : xs :: [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 (x :: PolyDiff a b
x : xs :: [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 [] = []
      -- Split the list wherever we see adjacent Both constructors
      group :: [PolyDiff a b] -> [[PolyDiff a b]]
group xs :: [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 (\ x :: PolyDiff a b
x y :: 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 _ _) = Bool
True
            isBoth _ = 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 :: Doc -> Doc -> (c -> Doc) -> ContextDiff c -> Doc
prettyContextDiff _ _ _ [] = Doc
empty
prettyContextDiff old :: Doc
old new :: Doc
new prettyElem :: c -> Doc
prettyElem hunks :: 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 "\n") ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc
text "--- " Doc -> Doc -> Doc
forall a. Monoid a => a -> a -> a
`mappend` Doc
old Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:
                                 String -> Doc
text "+++ " 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
      -- Pretty print a run of adjacent changes
      prettyRun :: t (PolyDiff [c] [c]) -> [Doc]
prettyRun hunk :: t (PolyDiff [c] [c])
hunk =
          String -> Doc
text "@@" 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

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