{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}

-- | This module allows us to diff two 'Text' values.
module Ormolu.Diff.Text
  ( TextDiff,
    diffText,
    printTextDiff,
  )
where

import Control.Monad
import qualified Data.Algorithm.Diff as D
import Data.Maybe (listToMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import Ormolu.Terminal

----------------------------------------------------------------------------
-- Types

-- | Result of diffing two 'Text's.
data TextDiff = TextDiff FilePath DiffList
  deriving (TextDiff -> TextDiff -> Bool
(TextDiff -> TextDiff -> Bool)
-> (TextDiff -> TextDiff -> Bool) -> Eq TextDiff
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextDiff -> TextDiff -> Bool
$c/= :: TextDiff -> TextDiff -> Bool
== :: TextDiff -> TextDiff -> Bool
$c== :: TextDiff -> TextDiff -> Bool
Eq)

instance Show TextDiff where
  show :: TextDiff -> String
show (TextDiff String
path DiffList
_) = String
"TextDiff " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
path String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" _"

-- | List of lines tagged by 'D.Both', 'D.First', or 'D.Second'.
type DiffList = [D.Diff [Text]]

-- | Similar to 'DiffList', but with line numbers assigned.
type DiffList' = [D.Diff [(Int, Int, Text)]]

-- | Diff hunk.
data Hunk = Hunk
  { Hunk -> Int
hunkFirstStartLine :: Int,
    Hunk -> Int
hunkFirstLength :: Int,
    Hunk -> Int
hunkSecondStartLine :: Int,
    Hunk -> Int
hunkSecondLength :: Int,
    Hunk -> DiffList
hunkDiff :: DiffList
  }

----------------------------------------------------------------------------
-- API

-- | Diff two texts and produce a 'TextDiff'.
diffText ::
  -- | Text before
  Text ->
  -- | Text after
  Text ->
  -- | Path to use
  FilePath ->
  -- | The resulting diff or 'Nothing' if the inputs are identical
  Maybe TextDiff
diffText :: Text -> Text -> String -> Maybe TextDiff
diffText Text
a Text
b String
path =
  if (PolyDiff [Text] [Text] -> Bool) -> DiffList -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all PolyDiff [Text] [Text] -> Bool
forall a b. PolyDiff a b -> Bool
isBoth DiffList
xs
    then Maybe TextDiff
forall a. Maybe a
Nothing
    else TextDiff -> Maybe TextDiff
forall a. a -> Maybe a
Just (String -> DiffList -> TextDiff
TextDiff String
path DiffList
xs)
  where
    xs :: DiffList
xs = [Text] -> [Text] -> DiffList
forall a. Eq a => [a] -> [a] -> [Diff [a]]
D.getGroupedDiff (Text -> [Text]
lines' Text
a) (Text -> [Text]
lines' Text
b)
    isBoth :: PolyDiff a b -> Bool
isBoth = \case
      D.Both a
_ b
_ -> Bool
True
      D.First a
_ -> Bool
False
      D.Second b
_ -> Bool
False
    -- T.lines ignores trailing blank lines
    lines' :: Text -> [Text]
lines' = Text -> Text -> [Text]
T.splitOn Text
"\n"

-- | Print the given 'TextDiff' as a 'Term' action. This function tries to
-- mimic the style of @git diff@.
printTextDiff :: TextDiff -> Term ()
printTextDiff :: TextDiff -> Term ()
printTextDiff (TextDiff String
path DiffList
xs) = do
  (Term () -> Term ()
forall a. Term a -> Term a
bold (Term () -> Term ()) -> (String -> Term ()) -> String -> Term ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Term ()
putS) String
path
  Term ()
newline
  [Hunk] -> (Hunk -> Term ()) -> Term ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (DiffList' -> [Hunk]
toHunks (DiffList -> DiffList'
assignLines DiffList
xs)) ((Hunk -> Term ()) -> Term ()) -> (Hunk -> Term ()) -> Term ()
forall a b. (a -> b) -> a -> b
$ \Hunk {Int
DiffList
hunkDiff :: DiffList
hunkSecondLength :: Int
hunkSecondStartLine :: Int
hunkFirstLength :: Int
hunkFirstStartLine :: Int
hunkDiff :: Hunk -> DiffList
hunkSecondLength :: Hunk -> Int
hunkSecondStartLine :: Hunk -> Int
hunkFirstLength :: Hunk -> Int
hunkFirstStartLine :: Hunk -> Int
..} -> do
    Term () -> Term ()
forall a. Term a -> Term a
cyan (Term () -> Term ()) -> Term () -> Term ()
forall a b. (a -> b) -> a -> b
$ do
      Text -> Term ()
put Text
"@@ -"
      String -> Term ()
putS (Int -> String
forall a. Show a => a -> String
show Int
hunkFirstStartLine)
      Text -> Term ()
put Text
","
      String -> Term ()
putS (Int -> String
forall a. Show a => a -> String
show Int
hunkFirstLength)
      Text -> Term ()
put Text
" +"
      String -> Term ()
putS (Int -> String
forall a. Show a => a -> String
show Int
hunkSecondStartLine)
      Text -> Term ()
put Text
","
      String -> Term ()
putS (Int -> String
forall a. Show a => a -> String
show Int
hunkSecondLength)
      Text -> Term ()
put Text
" @@"
    Term ()
newline
    DiffList -> (PolyDiff [Text] [Text] -> Term ()) -> Term ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ DiffList
hunkDiff ((PolyDiff [Text] [Text] -> Term ()) -> Term ())
-> (PolyDiff [Text] [Text] -> Term ()) -> Term ()
forall a b. (a -> b) -> a -> b
$ \case
      D.Both [Text]
ys [Text]
_ ->
        [Text] -> (Text -> Term ()) -> Term ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Text]
ys ((Text -> Term ()) -> Term ()) -> (Text -> Term ()) -> Term ()
forall a b. (a -> b) -> a -> b
$ \Text
y -> do
          Bool -> Term () -> Term ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
y) (Term () -> Term ()) -> Term () -> Term ()
forall a b. (a -> b) -> a -> b
$
            Text -> Term ()
put Text
"  "
          Text -> Term ()
put Text
y
          Term ()
newline
      D.First [Text]
ys ->
        [Text] -> (Text -> Term ()) -> Term ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Text]
ys ((Text -> Term ()) -> Term ()) -> (Text -> Term ()) -> Term ()
forall a b. (a -> b) -> a -> b
$ \Text
y -> Term () -> Term ()
forall a. Term a -> Term a
red (Term () -> Term ()) -> Term () -> Term ()
forall a b. (a -> b) -> a -> b
$ do
          Text -> Term ()
put Text
"-"
          Bool -> Term () -> Term ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
y) (Term () -> Term ()) -> Term () -> Term ()
forall a b. (a -> b) -> a -> b
$
            Text -> Term ()
put Text
" "
          Text -> Term ()
put Text
y
          Term ()
newline
      D.Second [Text]
ys ->
        [Text] -> (Text -> Term ()) -> Term ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Text]
ys ((Text -> Term ()) -> Term ()) -> (Text -> Term ()) -> Term ()
forall a b. (a -> b) -> a -> b
$ \Text
y -> Term () -> Term ()
forall a. Term a -> Term a
green (Term () -> Term ()) -> Term () -> Term ()
forall a b. (a -> b) -> a -> b
$ do
          Text -> Term ()
put Text
"+"
          Bool -> Term () -> Term ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
y) (Term () -> Term ()) -> Term () -> Term ()
forall a b. (a -> b) -> a -> b
$
            Text -> Term ()
put Text
" "
          Text -> Term ()
put Text
y
          Term ()
newline

----------------------------------------------------------------------------
-- Helpers

-- | Assign lines to a 'DiffList'.
assignLines :: DiffList -> DiffList'
assignLines :: DiffList -> DiffList'
assignLines = Int -> Int -> (DiffList' -> DiffList') -> DiffList -> DiffList'
forall a c.
Int
-> Int
-> ([PolyDiff [(Int, Int, a)] [(Int, Int, a)]] -> c)
-> [PolyDiff [a] [a]]
-> c
go Int
1 Int
1 DiffList' -> DiffList'
forall a. a -> a
id
  where
    go :: Int
-> Int
-> ([PolyDiff [(Int, Int, a)] [(Int, Int, a)]] -> c)
-> [PolyDiff [a] [a]]
-> c
go Int
_ Int
_ [PolyDiff [(Int, Int, a)] [(Int, Int, a)]] -> c
acc [] = [PolyDiff [(Int, Int, a)] [(Int, Int, a)]] -> c
acc []
    go !Int
firstLine !Int
secondLine [PolyDiff [(Int, Int, a)] [(Int, Int, a)]] -> c
acc (PolyDiff [a] [a]
x : [PolyDiff [a] [a]]
xs) =
      case PolyDiff [a] [a]
x of
        D.Both [a]
a [a]
b ->
          let firstInc :: Int
firstInc = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
a
              secondInc :: Int
secondInc = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
b
              a' :: [(Int, Int, a)]
a' =
                (Int -> Int -> a -> (Int, Int, a))
-> [Int] -> [Int] -> [a] -> [(Int, Int, a)]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3
                  (,,)
                  ((Int -> Int) -> Int -> [Int]
forall a. (a -> a) -> a -> [a]
iterate (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
firstLine)
                  ((Int -> Int) -> Int -> [Int]
forall a. (a -> a) -> a -> [a]
iterate (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
secondLine)
                  [a]
a
           in Int
-> Int
-> ([PolyDiff [(Int, Int, a)] [(Int, Int, a)]] -> c)
-> [PolyDiff [a] [a]]
-> c
go
                (Int
firstLine Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
firstInc)
                (Int
secondLine Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
secondInc)
                ([PolyDiff [(Int, Int, a)] [(Int, Int, a)]] -> c
acc ([PolyDiff [(Int, Int, a)] [(Int, Int, a)]] -> c)
-> ([PolyDiff [(Int, Int, a)] [(Int, Int, a)]]
    -> [PolyDiff [(Int, Int, a)] [(Int, Int, a)]])
-> [PolyDiff [(Int, Int, a)] [(Int, Int, a)]]
-> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([(Int, Int, a)]
-> [(Int, Int, a)] -> PolyDiff [(Int, Int, a)] [(Int, Int, a)]
forall a b. a -> b -> PolyDiff a b
D.Both [(Int, Int, a)]
a' [(Int, Int, a)]
a') PolyDiff [(Int, Int, a)] [(Int, Int, a)]
-> [PolyDiff [(Int, Int, a)] [(Int, Int, a)]]
-> [PolyDiff [(Int, Int, a)] [(Int, Int, a)]]
forall a. a -> [a] -> [a]
:))
                [PolyDiff [a] [a]]
xs
        D.First [a]
a ->
          let firstInc :: Int
firstInc = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
a
              a' :: [(Int, Int, a)]
a' =
                (Int -> Int -> a -> (Int, Int, a))
-> [Int] -> [Int] -> [a] -> [(Int, Int, a)]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3
                  (,,)
                  ((Int -> Int) -> Int -> [Int]
forall a. (a -> a) -> a -> [a]
iterate (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
firstLine)
                  (Int -> [Int]
forall a. a -> [a]
repeat Int
secondLine)
                  [a]
a
           in Int
-> Int
-> ([PolyDiff [(Int, Int, a)] [(Int, Int, a)]] -> c)
-> [PolyDiff [a] [a]]
-> c
go
                (Int
firstLine Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
firstInc)
                Int
secondLine
                ([PolyDiff [(Int, Int, a)] [(Int, Int, a)]] -> c
acc ([PolyDiff [(Int, Int, a)] [(Int, Int, a)]] -> c)
-> ([PolyDiff [(Int, Int, a)] [(Int, Int, a)]]
    -> [PolyDiff [(Int, Int, a)] [(Int, Int, a)]])
-> [PolyDiff [(Int, Int, a)] [(Int, Int, a)]]
-> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([(Int, Int, a)] -> PolyDiff [(Int, Int, a)] [(Int, Int, a)]
forall a b. a -> PolyDiff a b
D.First [(Int, Int, a)]
a') PolyDiff [(Int, Int, a)] [(Int, Int, a)]
-> [PolyDiff [(Int, Int, a)] [(Int, Int, a)]]
-> [PolyDiff [(Int, Int, a)] [(Int, Int, a)]]
forall a. a -> [a] -> [a]
:))
                [PolyDiff [a] [a]]
xs
        D.Second [a]
b ->
          let secondInc :: Int
secondInc = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
b
              b' :: [(Int, Int, a)]
b' =
                (Int -> Int -> a -> (Int, Int, a))
-> [Int] -> [Int] -> [a] -> [(Int, Int, a)]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3
                  (,,)
                  (Int -> [Int]
forall a. a -> [a]
repeat Int
firstLine)
                  ((Int -> Int) -> Int -> [Int]
forall a. (a -> a) -> a -> [a]
iterate (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
secondLine)
                  [a]
b
           in Int
-> Int
-> ([PolyDiff [(Int, Int, a)] [(Int, Int, a)]] -> c)
-> [PolyDiff [a] [a]]
-> c
go
                Int
firstLine
                (Int
secondLine Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
secondInc)
                ([PolyDiff [(Int, Int, a)] [(Int, Int, a)]] -> c
acc ([PolyDiff [(Int, Int, a)] [(Int, Int, a)]] -> c)
-> ([PolyDiff [(Int, Int, a)] [(Int, Int, a)]]
    -> [PolyDiff [(Int, Int, a)] [(Int, Int, a)]])
-> [PolyDiff [(Int, Int, a)] [(Int, Int, a)]]
-> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([(Int, Int, a)] -> PolyDiff [(Int, Int, a)] [(Int, Int, a)]
forall a b. b -> PolyDiff a b
D.Second [(Int, Int, a)]
b') PolyDiff [(Int, Int, a)] [(Int, Int, a)]
-> [PolyDiff [(Int, Int, a)] [(Int, Int, a)]]
-> [PolyDiff [(Int, Int, a)] [(Int, Int, a)]]
forall a. a -> [a] -> [a]
:))
                [PolyDiff [a] [a]]
xs

-- | Form 'Hunk's from a 'DiffList''.
toHunks :: DiffList' -> [Hunk]
toHunks :: DiffList' -> [Hunk]
toHunks = Int
-> Bool
-> ([Hunk] -> [Hunk])
-> (DiffList' -> DiffList')
-> [(Int, Int, Text)]
-> DiffList'
-> [Hunk]
go Int
0 Bool
False [Hunk] -> [Hunk]
forall a. a -> a
id DiffList' -> DiffList'
forall a. a -> a
id []
  where
    -- How many lines of context (that is, lines present in both texts) to
    -- show per hunk.
    margin :: Int
margin = Int
3
    go ::
      Int ->
      Bool ->
      ([Hunk] -> [Hunk]) ->
      (DiffList' -> DiffList') ->
      [(Int, Int, Text)] ->
      DiffList' ->
      [Hunk]
    go :: Int
-> Bool
-> ([Hunk] -> [Hunk])
-> (DiffList' -> DiffList')
-> [(Int, Int, Text)]
-> DiffList'
-> [Hunk]
go !Int
n Bool
gotChanges [Hunk] -> [Hunk]
hunksAcc DiffList' -> DiffList'
currentAcc [(Int, Int, Text)]
bothHistory = \case
      [] ->
        if Bool
gotChanges
          then
            let p :: [(Int, Int, Text)]
p = [(Int, Int, Text)] -> [(Int, Int, Text)]
forall a. [a] -> [a]
reverse (Int -> [(Int, Int, Text)] -> [(Int, Int, Text)]
forall a. Int -> [a] -> [a]
take Int
margin [(Int, Int, Text)]
bothHistory)
                currentAcc' :: DiffList' -> DiffList'
currentAcc' = [(Int, Int, Text)]
-> (DiffList' -> DiffList') -> DiffList' -> DiffList'
forall a c.
[a] -> ([PolyDiff [a] [a]] -> c) -> [PolyDiff [a] [a]] -> c
addBothAfter [(Int, Int, Text)]
p DiffList' -> DiffList'
currentAcc
             in case DiffList' -> Maybe Hunk
formHunk (DiffList' -> DiffList'
currentAcc' []) of
                  Maybe Hunk
Nothing -> [Hunk] -> [Hunk]
hunksAcc []
                  Just Hunk
hunk -> [Hunk] -> [Hunk]
hunksAcc [Hunk
hunk]
          else [Hunk] -> [Hunk]
hunksAcc []
      (Diff [(Int, Int, Text)]
x : DiffList'
xs) ->
        case Diff [(Int, Int, Text)]
x of
          D.Both [(Int, Int, Text)]
a [(Int, Int, Text)]
_ ->
            let currentAcc' :: DiffList' -> DiffList'
currentAcc' = [(Int, Int, Text)]
-> (DiffList' -> DiffList') -> DiffList' -> DiffList'
forall a c.
[a] -> ([PolyDiff [a] [a]] -> c) -> [PolyDiff [a] [a]] -> c
addBothAfter [(Int, Int, Text)]
p DiffList' -> DiffList'
currentAcc
                p :: [(Int, Int, Text)]
p = [(Int, Int, Text)] -> [(Int, Int, Text)]
forall a. [a] -> [a]
reverse (Int -> [(Int, Int, Text)] -> [(Int, Int, Text)]
forall a. Int -> [a] -> [a]
drop (Int
n' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
margin) [(Int, Int, Text)]
bothHistory')
                hunksAcc' :: [Hunk] -> [Hunk]
hunksAcc' =
                  case DiffList' -> Maybe Hunk
formHunk (DiffList' -> DiffList'
currentAcc' []) of
                    Maybe Hunk
Nothing -> [Hunk] -> [Hunk]
hunksAcc
                    Just Hunk
hunk -> [Hunk] -> [Hunk]
hunksAcc ([Hunk] -> [Hunk]) -> ([Hunk] -> [Hunk]) -> [Hunk] -> [Hunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Hunk
hunk Hunk -> [Hunk] -> [Hunk]
forall a. a -> [a] -> [a]
:)
                bothHistory' :: [(Int, Int, Text)]
bothHistory' = [(Int, Int, Text)] -> [(Int, Int, Text)]
forall a. [a] -> [a]
reverse [(Int, Int, Text)]
a [(Int, Int, Text)] -> [(Int, Int, Text)] -> [(Int, Int, Text)]
forall a. [a] -> [a] -> [a]
++ [(Int, Int, Text)]
bothHistory
                lena :: Int
lena = [(Int, Int, Text)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, Int, Text)]
a
                n' :: Int
n' = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lena
             in if Bool
gotChanges Bool -> Bool -> Bool
&& Int
n' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
margin Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2
                  then Int
-> Bool
-> ([Hunk] -> [Hunk])
-> (DiffList' -> DiffList')
-> [(Int, Int, Text)]
-> DiffList'
-> [Hunk]
go Int
0 Bool
False [Hunk] -> [Hunk]
hunksAcc' DiffList' -> DiffList'
forall a. a -> a
id [(Int, Int, Text)]
bothHistory' DiffList'
xs
                  else Int
-> Bool
-> ([Hunk] -> [Hunk])
-> (DiffList' -> DiffList')
-> [(Int, Int, Text)]
-> DiffList'
-> [Hunk]
go Int
n' Bool
gotChanges [Hunk] -> [Hunk]
hunksAcc DiffList' -> DiffList'
currentAcc [(Int, Int, Text)]
bothHistory' DiffList'
xs
          Diff [(Int, Int, Text)]
piece ->
            if Bool
gotChanges
              then
                let p :: [(Int, Int, Text)]
p = [(Int, Int, Text)] -> [(Int, Int, Text)]
forall a. [a] -> [a]
reverse [(Int, Int, Text)]
bothHistory
                    currentAcc' :: DiffList' -> DiffList'
currentAcc' = DiffList' -> DiffList'
currentAcc (DiffList' -> DiffList')
-> (DiffList' -> DiffList') -> DiffList' -> DiffList'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, Int, Text)]
-> (DiffList' -> DiffList') -> DiffList' -> DiffList'
forall a a.
[a] -> (a -> [PolyDiff [a] [a]]) -> a -> [PolyDiff [a] [a]]
addBothBefore [(Int, Int, Text)]
p (Diff [(Int, Int, Text)]
piece Diff [(Int, Int, Text)] -> DiffList' -> DiffList'
forall a. a -> [a] -> [a]
:)
                 in Int
-> Bool
-> ([Hunk] -> [Hunk])
-> (DiffList' -> DiffList')
-> [(Int, Int, Text)]
-> DiffList'
-> [Hunk]
go Int
0 Bool
True [Hunk] -> [Hunk]
hunksAcc DiffList' -> DiffList'
currentAcc' [] DiffList'
xs
              else
                let p :: [(Int, Int, Text)]
p = [(Int, Int, Text)] -> [(Int, Int, Text)]
forall a. [a] -> [a]
reverse (Int -> [(Int, Int, Text)] -> [(Int, Int, Text)]
forall a. Int -> [a] -> [a]
take Int
margin [(Int, Int, Text)]
bothHistory)
                    currentAcc' :: DiffList' -> DiffList'
currentAcc' = [(Int, Int, Text)]
-> (DiffList' -> DiffList') -> DiffList' -> DiffList'
forall a a.
[a] -> (a -> [PolyDiff [a] [a]]) -> a -> [PolyDiff [a] [a]]
addBothBefore [(Int, Int, Text)]
p (Diff [(Int, Int, Text)]
piece Diff [(Int, Int, Text)] -> DiffList' -> DiffList'
forall a. a -> [a] -> [a]
:)
                 in Int
-> Bool
-> ([Hunk] -> [Hunk])
-> (DiffList' -> DiffList')
-> [(Int, Int, Text)]
-> DiffList'
-> [Hunk]
go Int
0 Bool
True [Hunk] -> [Hunk]
hunksAcc DiffList' -> DiffList'
currentAcc' [] DiffList'
xs
    addBothBefore :: [a] -> (a -> [PolyDiff [a] [a]]) -> a -> [PolyDiff [a] [a]]
addBothBefore [] a -> [PolyDiff [a] [a]]
acc = a -> [PolyDiff [a] [a]]
acc
    addBothBefore [a]
p a -> [PolyDiff [a] [a]]
acc = ([a] -> [a] -> PolyDiff [a] [a]
forall a b. a -> b -> PolyDiff a b
D.Both [a]
p [a]
p PolyDiff [a] [a] -> [PolyDiff [a] [a]] -> [PolyDiff [a] [a]]
forall a. a -> [a] -> [a]
:) ([PolyDiff [a] [a]] -> [PolyDiff [a] [a]])
-> (a -> [PolyDiff [a] [a]]) -> a -> [PolyDiff [a] [a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [PolyDiff [a] [a]]
acc
    addBothAfter :: [a] -> ([PolyDiff [a] [a]] -> c) -> [PolyDiff [a] [a]] -> c
addBothAfter [] [PolyDiff [a] [a]] -> c
acc = [PolyDiff [a] [a]] -> c
acc
    addBothAfter [a]
p [PolyDiff [a] [a]] -> c
acc = [PolyDiff [a] [a]] -> c
acc ([PolyDiff [a] [a]] -> c)
-> ([PolyDiff [a] [a]] -> [PolyDiff [a] [a]])
-> [PolyDiff [a] [a]]
-> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> [a] -> PolyDiff [a] [a]
forall a b. a -> b -> PolyDiff a b
D.Both [a]
p [a]
p PolyDiff [a] [a] -> [PolyDiff [a] [a]] -> [PolyDiff [a] [a]]
forall a. a -> [a] -> [a]
:)

-- | Form a 'Hunk'.
formHunk :: DiffList' -> Maybe Hunk
formHunk :: DiffList' -> Maybe Hunk
formHunk DiffList'
xsRaw = do
  let xs :: DiffList'
xs = DiffList' -> DiffList'
trimEmpty DiffList'
xsRaw
  Int
hunkFirstStartLine <- DiffList' -> Maybe (Diff [(Int, Int, Text)])
forall a. [a] -> Maybe a
listToMaybe DiffList'
xs Maybe (Diff [(Int, Int, Text)])
-> (Diff [(Int, Int, Text)] -> Maybe Int) -> Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Diff [(Int, Int, Text)] -> Maybe Int
forall a. Diff [(Int, Int, a)] -> Maybe Int
firstStartLine
  let hunkFirstLength :: Int
hunkFirstLength = DiffList' -> Int
forall a. [Diff [(Int, Int, a)]] -> Int
firstLength DiffList'
xs
  Int
hunkSecondStartLine <- DiffList' -> Maybe (Diff [(Int, Int, Text)])
forall a. [a] -> Maybe a
listToMaybe DiffList'
xs Maybe (Diff [(Int, Int, Text)])
-> (Diff [(Int, Int, Text)] -> Maybe Int) -> Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Diff [(Int, Int, Text)] -> Maybe Int
forall a. Diff [(Int, Int, a)] -> Maybe Int
secondStartLine
  let hunkSecondLength :: Int
hunkSecondLength = DiffList' -> Int
forall a. [Diff [(Int, Int, a)]] -> Int
secondLength DiffList'
xs
      hunkDiff :: DiffList
hunkDiff = ([(Int, Int, Text)] -> [Text]) -> DiffList' -> DiffList
forall a b. (a -> b) -> [Diff a] -> [Diff b]
mapDiff (((Int, Int, Text) -> Text) -> [(Int, Int, Text)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, Int, Text) -> Text
third) DiffList'
xs
  Hunk -> Maybe Hunk
forall (m :: * -> *) a. Monad m => a -> m a
return Hunk :: Int -> Int -> Int -> Int -> DiffList -> Hunk
Hunk {Int
DiffList
hunkDiff :: DiffList
hunkSecondLength :: Int
hunkSecondStartLine :: Int
hunkFirstLength :: Int
hunkFirstStartLine :: Int
hunkDiff :: DiffList
hunkSecondLength :: Int
hunkSecondStartLine :: Int
hunkFirstLength :: Int
hunkFirstStartLine :: Int
..}

-- | Trim empty “both” lines from beginning and end of a 'DiffList''.
trimEmpty :: DiffList' -> DiffList'
trimEmpty :: DiffList' -> DiffList'
trimEmpty = Bool -> (DiffList' -> DiffList') -> DiffList' -> DiffList'
forall c. Bool -> (DiffList' -> c) -> DiffList' -> c
go Bool
True DiffList' -> DiffList'
forall a. a -> a
id
  where
    go :: Bool -> (DiffList' -> c) -> DiffList' -> c
go Bool
isFirst DiffList' -> c
acc = \case
      [] -> DiffList' -> c
acc []
      [D.Both [(Int, Int, Text)]
x [(Int, Int, Text)]
_] ->
        let x' :: [(Int, Int, Text)]
x' = [(Int, Int, Text)] -> [(Int, Int, Text)]
forall a. [a] -> [a]
reverse ([(Int, Int, Text)] -> [(Int, Int, Text)])
-> [(Int, Int, Text)] -> [(Int, Int, Text)]
forall a b. (a -> b) -> a -> b
$ ((Int, Int, Text) -> Bool)
-> [(Int, Int, Text)] -> [(Int, Int, Text)]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Text -> Bool
T.null (Text -> Bool)
-> ((Int, Int, Text) -> Text) -> (Int, Int, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int, Text) -> Text
third) ([(Int, Int, Text)] -> [(Int, Int, Text)]
forall a. [a] -> [a]
reverse [(Int, Int, Text)]
x)
         in Bool -> (DiffList' -> c) -> DiffList' -> c
go Bool
False (DiffList' -> c
acc (DiffList' -> c) -> (DiffList' -> DiffList') -> DiffList' -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Int, Int, Text)] -> [(Int, Int, Text)] -> Diff [(Int, Int, Text)]
forall a b. a -> b -> PolyDiff a b
D.Both [(Int, Int, Text)]
x' [(Int, Int, Text)]
x' Diff [(Int, Int, Text)] -> DiffList' -> DiffList'
forall a. a -> [a] -> [a]
:)) []
      (D.Both [(Int, Int, Text)]
x [(Int, Int, Text)]
_ : DiffList'
xs) ->
        let x' :: [(Int, Int, Text)]
x' = ((Int, Int, Text) -> Bool)
-> [(Int, Int, Text)] -> [(Int, Int, Text)]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Text -> Bool
T.null (Text -> Bool)
-> ((Int, Int, Text) -> Text) -> (Int, Int, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int, Text) -> Text
third) [(Int, Int, Text)]
x
         in if Bool
isFirst
              then Bool -> (DiffList' -> c) -> DiffList' -> c
go Bool
False (DiffList' -> c
acc (DiffList' -> c) -> (DiffList' -> DiffList') -> DiffList' -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Int, Int, Text)] -> [(Int, Int, Text)] -> Diff [(Int, Int, Text)]
forall a b. a -> b -> PolyDiff a b
D.Both [(Int, Int, Text)]
x' [(Int, Int, Text)]
x' Diff [(Int, Int, Text)] -> DiffList' -> DiffList'
forall a. a -> [a] -> [a]
:)) DiffList'
xs
              else Bool -> (DiffList' -> c) -> DiffList' -> c
go Bool
False (DiffList' -> c
acc (DiffList' -> c) -> (DiffList' -> DiffList') -> DiffList' -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Int, Int, Text)] -> [(Int, Int, Text)] -> Diff [(Int, Int, Text)]
forall a b. a -> b -> PolyDiff a b
D.Both [(Int, Int, Text)]
x [(Int, Int, Text)]
x Diff [(Int, Int, Text)] -> DiffList' -> DiffList'
forall a. a -> [a] -> [a]
:)) DiffList'
xs
      (Diff [(Int, Int, Text)]
x : DiffList'
xs) ->
        Bool -> (DiffList' -> c) -> DiffList' -> c
go Bool
False (DiffList' -> c
acc (DiffList' -> c) -> (DiffList' -> DiffList') -> DiffList' -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Diff [(Int, Int, Text)]
x Diff [(Int, Int, Text)] -> DiffList' -> DiffList'
forall a. a -> [a] -> [a]
:)) DiffList'
xs

firstStartLine :: D.Diff [(Int, Int, a)] -> Maybe Int
firstStartLine :: Diff [(Int, Int, a)] -> Maybe Int
firstStartLine = \case
  D.Both ((Int
x, Int
_, a
_) : [(Int, Int, a)]
_) [(Int, Int, a)]
_ -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
x
  D.First ((Int
x, Int
_, a
_) : [(Int, Int, a)]
_) -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
x
  D.Second ((Int
x, Int
_, a
_) : [(Int, Int, a)]
_) -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
x
  Diff [(Int, Int, a)]
_ -> Maybe Int
forall a. Maybe a
Nothing

firstLength :: [D.Diff [(Int, Int, a)]] -> Int
firstLength :: [Diff [(Int, Int, a)]] -> Int
firstLength = Int -> [Diff [(Int, Int, a)]] -> Int
forall (t :: * -> *) a b.
Foldable t =>
Int -> [PolyDiff (t a) b] -> Int
go Int
0
  where
    go :: Int -> [PolyDiff (t a) b] -> Int
go Int
n [] = Int
n
    go !Int
n (PolyDiff (t a) b
x : [PolyDiff (t a) b]
xs) = case PolyDiff (t a) b
x of
      D.Both t a
as b
_ -> Int -> [PolyDiff (t a) b] -> Int
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
as) [PolyDiff (t a) b]
xs
      D.First t a
as -> Int -> [PolyDiff (t a) b] -> Int
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
as) [PolyDiff (t a) b]
xs
      D.Second b
_ -> Int -> [PolyDiff (t a) b] -> Int
go Int
n [PolyDiff (t a) b]
xs

secondStartLine :: D.Diff [(Int, Int, a)] -> Maybe Int
secondStartLine :: Diff [(Int, Int, a)] -> Maybe Int
secondStartLine = \case
  D.Both ((Int
_, Int
x, a
_) : [(Int, Int, a)]
_) [(Int, Int, a)]
_ -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
x
  D.First ((Int
_, Int
x, a
_) : [(Int, Int, a)]
_) -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
x
  D.Second ((Int
_, Int
x, a
_) : [(Int, Int, a)]
_) -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
x
  Diff [(Int, Int, a)]
_ -> Maybe Int
forall a. Maybe a
Nothing

secondLength :: [D.Diff [(Int, Int, a)]] -> Int
secondLength :: [Diff [(Int, Int, a)]] -> Int
secondLength = Int -> [Diff [(Int, Int, a)]] -> Int
forall (t :: * -> *) (t :: * -> *) a a.
(Foldable t, Foldable t) =>
Int -> [PolyDiff (t a) (t a)] -> Int
go Int
0
  where
    go :: Int -> [PolyDiff (t a) (t a)] -> Int
go Int
n [] = Int
n
    go !Int
n (PolyDiff (t a) (t a)
x : [PolyDiff (t a) (t a)]
xs) = case PolyDiff (t a) (t a)
x of
      D.Both t a
as t a
_ -> Int -> [PolyDiff (t a) (t a)] -> Int
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
as) [PolyDiff (t a) (t a)]
xs
      D.First t a
_ -> Int -> [PolyDiff (t a) (t a)] -> Int
go Int
n [PolyDiff (t a) (t a)]
xs
      D.Second t a
as -> Int -> [PolyDiff (t a) (t a)] -> Int
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
as) [PolyDiff (t a) (t a)]
xs

mapDiff :: (a -> b) -> [D.Diff a] -> [D.Diff b]
mapDiff :: (a -> b) -> [Diff a] -> [Diff b]
mapDiff a -> b
f = (Diff a -> Diff b) -> [Diff a] -> [Diff b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Diff a -> Diff b) -> [Diff a] -> [Diff b])
-> (Diff a -> Diff b) -> [Diff a] -> [Diff b]
forall a b. (a -> b) -> a -> b
$ \case
  D.Both a
a a
b -> b -> b -> Diff b
forall a b. a -> b -> PolyDiff a b
D.Both (a -> b
f a
a) (a -> b
f a
b)
  D.First a
a -> b -> Diff b
forall a b. a -> PolyDiff a b
D.First (a -> b
f a
a)
  D.Second a
b -> b -> Diff b
forall a b. b -> PolyDiff a b
D.Second (a -> b
f a
b)

third :: (Int, Int, Text) -> Text
third :: (Int, Int, Text) -> Text
third (Int
_, Int
_, Text
x) = Text
x