{-@ LIQUID "--ple" @-}
{-@ LIQUID "--ple-with-undecided-guards" @-}
-- Import of the 'Data.Algorithm.Diff.Refinement' module is required for the
-- LiquidHaskell specifications in this module, but is unused in the actual code.
-- The following GHC option suppresses the unused import warning.
{-# OPTIONS_GHC -Wno-unused-imports #-}
-----------------------------------------------------------------------------
-- |
-- 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
    ( ContextDiff, Hunk
    , getContextDiff
    , prettyContextDiff
    , prettyContextDiffOld
    , getContextDiffNumbered
    , Numbered(Numbered), numbered, unnumber
    , unNumberContextDiff
    ) where

import Data.Algorithm.Diff (PolyDiff(..), Diff, getGroupedDiff)
import Data.Algorithm.Diff.Refinement (noStuttering, noFFSS, headIsFirst, headIsSecond)
import Data.Bifunctor
import Text.PrettyPrint (Doc, text, empty, hcat)

{-@ type ContextDiff c = [Hunk c] @-}
-- | A diff consisting of disjoint 'Hunk's.
type ContextDiff c = [Hunk c]

{-@ type Hunk c = { h : [ValidListDiff c c] | noStuttering h} @-}
-- | A 'Hunk' is a list of adjacent 'Diff's.
--
-- No two consecutive elements in a 'Hunk' are both applications
-- of 'First', 'Second', or 'Both', i.e. the list does not stutter
-- on 'Diff' constructors.
type Hunk c = [Diff [c]]

-- | Split a 'Diff' list at consecutive 'Both'-'Both' boundaries.
{-@ splitBothBoth :: {ds : [ValidListDiff c c] | noFFSS ds} -> [Hunk c] @-}
splitBothBoth :: [Diff [c]] -> [Hunk c]
splitBothBoth :: forall c. [Diff [c]] -> [[Diff [c]]]
splitBothBoth = Hunk c -> Hunk c -> [Hunk c]
forall c. Hunk c -> Hunk c -> [Hunk c]
go []
  where
    {-@ go
          :: g:Hunk c
          -> {xs : [ValidListDiff c c] | noFFSS xs && not (headAlike g xs) }
          -> [Hunk c] / [len xs]
      @-}
    go :: Hunk c -> [Diff [c]] -> [Hunk c]
    go :: forall c. Hunk c -> Hunk c -> [Hunk c]
go Hunk c
g (x :: Diff [c]
x@Both{} : y :: Diff [c]
y@Both{} : Hunk c
xs) = Hunk c -> Hunk c
forall a. [a] -> [a]
reverse (Diff [c]
xDiff [c] -> Hunk c -> Hunk c
forall a. a -> [a] -> [a]
:Hunk c
g) Hunk c -> [Hunk c] -> [Hunk c]
forall a. a -> [a] -> [a]
: Hunk c -> Hunk c -> [Hunk c]
forall c. Hunk c -> Hunk c -> [Hunk c]
go [] (Diff [c]
yDiff [c] -> Hunk c -> Hunk c
forall a. a -> [a] -> [a]
:Hunk c
xs)
      where
        lemma :: ()
lemma = Hunk c -> ()
forall c. Hunk c -> ()
lemmaReverseStuttering (Diff [c]
xDiff [c] -> Hunk c -> Hunk c
forall a. a -> [a] -> [a]
:Hunk c
g)
    go Hunk c
g (Diff [c]
x : Hunk c
xs) = Hunk c -> Hunk c -> [Hunk c]
forall c. Hunk c -> Hunk c -> [Hunk c]
go (Diff [c]
xDiff [c] -> Hunk c -> Hunk c
forall a. a -> [a] -> [a]
:Hunk c
g) Hunk c
xs
    go Hunk c
g [] = [Hunk c -> Hunk c
forall a. [a] -> [a]
reverse Hunk c
g]
      where
        lemma :: ()
lemma = Hunk c -> ()
forall c. Hunk c -> ()
lemmaReverseStuttering Hunk c
g

{-@ type ContextSize = Nat @-}
type ContextSize = Int

{-@ opaque-reflect reverse @-}

{-@ assume lemmaReverseStuttering
      :: xs:_ -> { noStuttering (reverse xs) = noStuttering xs } @-}
lemmaReverseStuttering :: Hunk c -> ()
lemmaReverseStuttering :: forall c. Hunk c -> ()
lemmaReverseStuttering Hunk c
_ = ()

{-@ reflect headAlike  @-}
headAlike :: Hunk c -> Hunk c -> Bool
headAlike :: forall c. Hunk c -> Hunk c -> Bool
headAlike (Both{} : [Diff [c]]
_) (Both{} : [Diff [c]]
_) = Bool
True
headAlike (First{} : [Diff [c]]
_) (First{} : [Diff [c]]
_) = Bool
True
headAlike (Second{} : [Diff [c]]
_) (Second{} : [Diff [c]]
_) = Bool
True
headAlike [Diff [c]]
_ [Diff [c]]
_ = Bool
False

data Numbered a = Numbered Int a deriving Int -> Numbered a -> ShowS
[Numbered a] -> ShowS
Numbered a -> String
(Int -> Numbered a -> ShowS)
-> (Numbered a -> String)
-> ([Numbered a] -> ShowS)
-> Show (Numbered a)
forall a. Show a => Int -> Numbered a -> ShowS
forall a. Show a => [Numbered a] -> ShowS
forall a. Show a => Numbered a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Numbered a -> ShowS
showsPrec :: Int -> Numbered a -> ShowS
$cshow :: forall a. Show a => Numbered a -> String
show :: Numbered a -> String
$cshowList :: forall a. Show a => [Numbered a] -> ShowS
showList :: [Numbered a] -> ShowS
Show
instance Eq a => Eq (Numbered a) where
  Numbered Int
_ a
a == :: Numbered a -> Numbered a -> Bool
== Numbered Int
_ a
b = a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b
instance Ord a => Ord (Numbered a) where
  compare :: Numbered a -> Numbered a -> Ordering
compare (Numbered Int
_ a
a) (Numbered Int
_ a
b) = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
a a
b

numbered :: [a] -> [Numbered a]
numbered :: forall a. [a] -> [Numbered a]
numbered [a]
xs = ((Int, a) -> Numbered a) -> [(Int, a)] -> [Numbered a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int -> a -> Numbered a) -> (Int, a) -> Numbered a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> a -> Numbered a
forall a. Int -> a -> Numbered a
Numbered) ([Int] -> [a] -> [(Int, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [a]
xs)

unnumber :: Numbered a -> a
unnumber :: forall a. Numbered a -> a
unnumber (Numbered Int
_ a
a) = a
a

-- |
-- > > let textA = ["a","b","c","d","e","f","g","h","i","j","k"]
-- > > let textB = ["a","b","d","e","f","g","h","i","j"]
-- > > let diff = getContextDiff (Just 2) textA textB
-- > > prettyContextDiff (text "file1") (text "file2") (text . unnumber) diff
-- > --- file1
-- > +++ file2
-- > @@ -1,5 +1,4 @@
-- >  a
-- >  b
-- > -c
-- >  d
-- >  e
-- > @@ -9,3 +8,2 @@
-- >  i
-- >  j
-- > -k
{-@
getContextDiff ::
  Eq a
  => Maybe ContextSize
  -> [a]
  -> [a]
  -> ContextDiff (Numbered a)
@-}
getContextDiff ::
  Eq a
  => Maybe ContextSize -- ^ Context size. 'Nothing' means returning a whole-diff 'Hunk'.
  -> [a]
  -> [a]
  -> ContextDiff (Numbered a)
getContextDiff :: forall a.
Eq a =>
Maybe Int -> [a] -> [a] -> ContextDiff (Numbered a)
getContextDiff Maybe Int
contextSize [a]
a [a]
b =
  Maybe Int
-> [Numbered a] -> [Numbered a] -> ContextDiff (Numbered a)
forall a.
Eq a =>
Maybe Int
-> [Numbered a] -> [Numbered a] -> ContextDiff (Numbered a)
getContextDiffNumbered Maybe Int
contextSize ([a] -> [Numbered a]
forall a. [a] -> [Numbered a]
numbered [a]
a) ([a] -> [Numbered a]
forall a. [a] -> [Numbered a]
numbered [a]
b)

-- | If for some reason you need the line numbers stripped from the
-- result of 'getContextDiff' for backwards compatibility.
{-@ unNumberContextDiff :: ContextDiff (Numbered a) -> [[Diff [a]]] @-}
unNumberContextDiff :: ContextDiff (Numbered a) -> ContextDiff a
unNumberContextDiff :: forall a. ContextDiff (Numbered a) -> ContextDiff a
unNumberContextDiff = (Hunk (Numbered a) -> Hunk a) -> [Hunk (Numbered a)] -> [Hunk a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Diff [Numbered a] -> Diff [a]) -> Hunk (Numbered a) -> Hunk a
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Numbered a] -> [a])
-> ([Numbered a] -> [a]) -> Diff [Numbered a] -> Diff [a]
forall a b c d.
(a -> b) -> (c -> d) -> PolyDiff a c -> PolyDiff b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ((Numbered a -> a) -> [Numbered a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Numbered a -> a
forall a. Numbered a -> a
unnumber) ((Numbered a -> a) -> [Numbered a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Numbered a -> a
forall a. Numbered a -> a
unnumber)))

-- | Create a diff of separate 'Hunk's, each containing a sequence
-- of differing elements surrounded by common elements for context.
--
-- The context size determines when to merge adjacent hunks:
-- two hunks are merged when the number of common elements between them does not
-- exceed twice the context size. Furthermore, if @contextSize@ is 'Nothing'
-- a single hunk with the whole diff is produced.
{-@
getContextDiffNumbered ::
  Eq a
  => Maybe ContextSize
  -> [Numbered a]
  -> [Numbered a]
  -> ContextDiff (Numbered a)
@-}
getContextDiffNumbered ::
  Eq a
  => Maybe ContextSize -- ^ Context size. 'Nothing' means returning a whole-diff 'Hunk'.
  -> [Numbered a]
  -> [Numbered a]
  -> ContextDiff (Numbered a)
getContextDiffNumbered :: forall a.
Eq a =>
Maybe Int
-> [Numbered a] -> [Numbered a] -> ContextDiff (Numbered a)
getContextDiffNumbered Maybe Int
Nothing [Numbered a]
a0 [Numbered a]
b0 = [[Numbered a] -> [Numbered a] -> Hunk (Numbered a)
forall a. Eq a => [a] -> [a] -> [Diff [a]]
getGroupedDiff [Numbered a]
a0 [Numbered a]
b0]
getContextDiffNumbered (Just Int
contextSize) [Numbered a]
a0 [Numbered a]
b0 =
    -- The 'Diff' list is grouped into 'Hunks' that begin and end
    -- with matching ('Both') text, having non-matching ('First' and 'Second')
    -- text in the middle. Note that a non-trivial partition can only happen after
    -- the matching text has been reduced to become consecutive 'Both' values
    -- corresponding to a hunk's suffix and the following hunk prefix.
    Hunk (Numbered a) -> [Hunk (Numbered a)]
forall c. [Diff [c]] -> [[Diff [c]]]
splitBothBoth (Hunk (Numbered a) -> [Hunk (Numbered a)])
-> Hunk (Numbered a) -> [Hunk (Numbered a)]
forall a b. (a -> b) -> a -> b
$ Hunk (Numbered a) -> Hunk (Numbered a)
forall c. Hunk c -> Hunk c
doPrefix (Hunk (Numbered a) -> Hunk (Numbered a))
-> Hunk (Numbered a) -> Hunk (Numbered a)
forall a b. (a -> b) -> a -> b
$ [Numbered a] -> [Numbered a] -> Hunk (Numbered a)
forall a. Eq a => [a] -> [a] -> [Diff [a]]
getGroupedDiff [Numbered a]
a0 [Numbered a]
b0
    where
      -- | Handle the common text leading up to a diff.
      --
      -- Postcondition: The @a@ elements in @doPrefix h@ are a subset of those in @h@,
      -- in the same order. Additionaly, 'First' and 'Second' diffs
      -- are identical in both lists.
      --
      -- The difference between input and output is that some 'Both' diffs might
      -- be split into two other 'Both' diffs. This happens when their contents
      -- are too large compared with the contex size, resulting in some @a@
      -- elements being dropped.
      {-@ doPrefix ::  h : Hunk c
                   -> {v : [ValidListDiff c c] | noFFSS v
                       && (headIsFirst h <=> headIsFirst v)
                       && (headIsSecond h <=> headIsSecond v)} / [len h, 0] @-}
      doPrefix :: Hunk c -> [Diff [c]]
      doPrefix :: forall c. Hunk c -> Hunk c
doPrefix [] = []
      -- Trailing common elements are no prefix.
      -- This case corresponds to when both input lists are identical, so the
      -- resulting 'ContextDiff' is empty.
      doPrefix [Both [c]
_ [c]
_] = []
      -- Do the prefix and then make the suffix.
      doPrefix (Both [c]
xs [c]
ys : [Diff [c]]
more) =
        [c] -> [c] -> Diff [c]
forall a b. a -> b -> PolyDiff a b
Both (Int -> [c] -> [c]
forall a. Int -> [a] -> [a]
drop ([c] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [c]
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
contextSize) [c]
xs)
             (Int -> [c] -> [c]
forall a. Int -> [a] -> [a]
drop ([c] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [c]
ys Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
contextSize) [c]
ys) Diff [c] -> [Diff [c]] -> [Diff [c]]
forall a. a -> [a] -> [a]
: [Diff [c]] -> [Diff [c]]
forall c. Hunk c -> Hunk c
doSuffix [Diff [c]]
more
      -- Prefix finished, do the diff then the following suffix.
      doPrefix (Diff [c]
d : [Diff [c]]
ds) = Diff [c]
d Diff [c] -> [Diff [c]] -> [Diff [c]]
forall a. a -> [a] -> [a]
: [Diff [c]] -> [Diff [c]]
forall c. Hunk c -> Hunk c
doSuffix [Diff [c]]
ds

      -- | Handle the common text following a diff.
      --
      -- Precondition: The input does not start with a 'Both' diff. Otherwise,
      -- it behaves like @doPrefix@.
      {-@ doSuffix ::  h : Hunk c
                   -> {v : [ValidListDiff c c] | noFFSS v
                       && (headIsFirst h <=> headIsFirst v)
                       && (headIsSecond h <=> headIsSecond v)} / [len h, 1] @-}
      doSuffix :: Hunk c -> [Diff [c]]
      doSuffix :: forall c. Hunk c -> Hunk c
doSuffix [] = []
      -- A trailing suffix.
      doSuffix [Both [c]
xs [c]
ys] = [[c] -> [c] -> Diff [c]
forall a b. a -> b -> PolyDiff a b
Both (Int -> [c] -> [c]
forall a. Int -> [a] -> [a]
take Int
contextSize [c]
xs) (Int -> [c] -> [c]
forall a. Int -> [a] -> [a]
take Int
contextSize [c]
ys)]
      -- If the common text is too short compared with the context,
      -- we preserve it and continue. As the following element cannot be a 'Both'
      -- as well, this effectively places the common text in the inner part of the diff.
      -- Otherwise, we split it into a suffix and prefix
      -- (resulting in some elements excluded from the diff in the middle).
      doSuffix (Both [c]
xs [c]
ys : [Diff [c]]
more)
        | [c] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [c]
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
contextSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2 =
            [c] -> [c] -> Diff [c]
forall a b. a -> b -> PolyDiff a b
Both [c]
xs [c]
ys Diff [c] -> [Diff [c]] -> [Diff [c]]
forall a. a -> [a] -> [a]
: [Diff [c]] -> [Diff [c]]
forall c. Hunk c -> Hunk c
doPrefix [Diff [c]]
more
        | Bool
otherwise =
            [c] -> [c] -> Diff [c]
forall a b. a -> b -> PolyDiff a b
Both (Int -> [c] -> [c]
forall a. Int -> [a] -> [a]
take Int
contextSize [c]
xs) (Int -> [c] -> [c]
forall a. Int -> [a] -> [a]
take Int
contextSize [c]
ys) Diff [c] -> [Diff [c]] -> [Diff [c]]
forall a. a -> [a] -> [a]
:
            [Diff [c]] -> [Diff [c]]
forall c. Hunk c -> Hunk c
doPrefix ([c] -> [c] -> Diff [c]
forall a b. a -> b -> PolyDiff a b
Both (Int -> [c] -> [c]
forall a. Int -> [a] -> [a]
drop Int
contextSize [c]
xs) (Int -> [c] -> [c]
forall a. Int -> [a] -> [a]
drop Int
contextSize [c]
ys) Diff [c] -> [Diff [c]] -> [Diff [c]]
forall a. a -> [a] -> [a]
: [Diff [c]]
more)
      -- 'First' and 'Second' elements are no suffix, preserve them and continue looking.
      doSuffix (Diff [c]
d : [Diff [c]]
ds) = Diff [c]
d Diff [c] -> [Diff [c]] -> [Diff [c]]
forall a. a -> [a] -> [a]
: [Diff [c]] -> [Diff [c]]
forall c. Hunk c -> Hunk c
doSuffix [Diff [c]]
ds

-- | Pretty print a ContextDiff in the manner of diff -u.
prettyContextDiff ::
       Doc            -- ^ Document 1 name
    -> Doc            -- ^ Document 2 name
    -> (Numbered c -> Doc)     -- ^ Element pretty printer
    -> ContextDiff (Numbered c)
    -> Doc
prettyContextDiff :: forall c.
Doc
-> Doc -> (Numbered c -> Doc) -> ContextDiff (Numbered c) -> Doc
prettyContextDiff Doc
_ Doc
_ Numbered c -> Doc
_ [] = Doc
empty
prettyContextDiff Doc
old Doc
new Numbered c -> Doc
prettyElem [Hunk (Numbered 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. Semigroup a => a -> a -> a
<> 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. Semigroup a => a -> a -> a
<> Doc
old Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:
                                 String -> Doc
text String
"+++ " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
new Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:
                                 (Hunk (Numbered c) -> [Doc]) -> [Hunk (Numbered c)] -> [Doc]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Hunk (Numbered c) -> [Doc]
prettyRun [Hunk (Numbered c)]
hunks)
    where
      -- Pretty print a run of adjacent changes
      prettyRun :: Hunk (Numbered c) -> [Doc]
prettyRun Hunk (Numbered c)
hunk =
        String -> Doc
text (String
"@@ " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Hunk (Numbered c) -> String
forall {a} {a}. [PolyDiff [Numbered a] [Numbered a]] -> String
formatHunk Hunk (Numbered c)
hunk String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" @@") Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (PolyDiff [Numbered c] [Numbered c] -> [Doc])
-> Hunk (Numbered c) -> [Doc]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PolyDiff [Numbered c] [Numbered c] -> [Doc]
prettyChange Hunk (Numbered c)
hunk

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

      formatHunk :: [PolyDiff [Numbered a] [Numbered a]] -> String
formatHunk [PolyDiff [Numbered a] [Numbered a]]
hunk = String
"-" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Int] -> String
formatRun ([PolyDiff [Numbered a] [Numbered a]] -> [Int]
forall {a} {b}. [PolyDiff [Numbered a] b] -> [Int]
firsts [PolyDiff [Numbered a] [Numbered a]]
hunk) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" +" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Int] -> String
formatRun ([PolyDiff [Numbered a] [Numbered a]] -> [Int]
forall {a} {a}. [PolyDiff a [Numbered a]] -> [Int]
seconds [PolyDiff [Numbered a] [Numbered a]]
hunk)

      formatRun :: [Int] -> String
      formatRun :: [Int] -> String
formatRun [] = String
"-0,0"
      formatRun [Int
n] = Int -> String
forall a. Show a => a -> String
show Int
n
      formatRun ns :: [Int]
ns@(Int
n : [Int]
_) = Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"," String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show ([Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
ns)

      firsts :: [PolyDiff [Numbered a] b] -> [Int]
firsts (Both [Numbered a]
ns b
_ : [PolyDiff [Numbered a] b]
more) = (Numbered a -> Int) -> [Numbered a] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Numbered Int
n a
_) -> Int
n) [Numbered a]
ns [Int] -> [Int] -> [Int]
forall a. Semigroup a => a -> a -> a
<> [PolyDiff [Numbered a] b] -> [Int]
firsts [PolyDiff [Numbered a] b]
more
      firsts (First [Numbered a]
ns : [PolyDiff [Numbered a] b]
more) = (Numbered a -> Int) -> [Numbered a] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Numbered Int
n a
_) -> Int
n) [Numbered a]
ns [Int] -> [Int] -> [Int]
forall a. Semigroup a => a -> a -> a
<> [PolyDiff [Numbered a] b] -> [Int]
firsts [PolyDiff [Numbered a] b]
more
      firsts (Second b
_ : [PolyDiff [Numbered a] b]
more) = [PolyDiff [Numbered a] b] -> [Int]
firsts [PolyDiff [Numbered a] b]
more
      firsts [] = []

      seconds :: [PolyDiff a [Numbered a]] -> [Int]
seconds (Both a
_ [Numbered a]
ns : [PolyDiff a [Numbered a]]
more) = (Numbered a -> Int) -> [Numbered a] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Numbered Int
n a
_) -> Int
n) [Numbered a]
ns [Int] -> [Int] -> [Int]
forall a. Semigroup a => a -> a -> a
<> [PolyDiff a [Numbered a]] -> [Int]
seconds [PolyDiff a [Numbered a]]
more
      seconds (First a
_ : [PolyDiff a [Numbered a]]
more) = [PolyDiff a [Numbered a]] -> [Int]
seconds [PolyDiff a [Numbered a]]
more
      seconds (Second [Numbered a]
ns : [PolyDiff a [Numbered a]]
more) = (Numbered a -> Int) -> [Numbered a] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Numbered Int
n a
_) -> Int
n) [Numbered a]
ns [Int] -> [Int] -> [Int]
forall a. Semigroup a => a -> a -> a
<> [PolyDiff a [Numbered a]] -> [Int]
seconds [PolyDiff a [Numbered a]]
more
      seconds [] = []

-- | Pretty print without line numbers.
prettyContextDiffOld ::
       Doc            -- ^ Document 1 name
    -> Doc            -- ^ Document 2 name
    -> (c -> Doc)     -- ^ Element pretty printer
    -> ContextDiff c
    -> Doc
prettyContextDiffOld :: forall c. Doc -> Doc -> (c -> Doc) -> ContextDiff c -> Doc
prettyContextDiffOld Doc
_ Doc
_ c -> Doc
_ [] = Doc
empty
prettyContextDiffOld Doc
old Doc
new c -> Doc
prettyElem [Hunk 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. Semigroup a => a -> a -> a
<> 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. Semigroup a => a -> a -> a
<> Doc
old Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:
                                 String -> Doc
text String
"+++ " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
new Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:
                                 (Hunk c -> [Doc]) -> [Hunk c] -> [Doc]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Hunk c -> [Doc]
forall {t :: * -> *}. Foldable t => t (PolyDiff [c] [c]) -> [Doc]
prettyRun [Hunk c]
hunks)
    where
      -- Pretty print a run of adjacent changes
      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

      -- Pretty print a single change (e.g. one line of a text file)
      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. Semigroup a => a -> a -> a
<> 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. Semigroup a => a -> a -> a
<> 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. Semigroup a => a -> a -> a
<> c -> Doc
prettyElem c
l) [c]
ts