{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ViewPatterns #-}
module Test.Hspec.Core.Formatters.Diff (
  Diff (..)
, diff

, LineDiff(..)
, lineDiff

, splitLines

#ifdef TEST
, partition
, breakList
#endif
) where

import           Prelude ()
import           Test.Hspec.Core.Compat hiding (First)

import           Data.Char
import qualified Data.Algorithm.Diff as Diff

data Diff = First String | Second String | Both String
  deriving (Diff -> Diff -> Bool
(Diff -> Diff -> Bool) -> (Diff -> Diff -> Bool) -> Eq Diff
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Diff -> Diff -> Bool
== :: Diff -> Diff -> Bool
$c/= :: Diff -> Diff -> Bool
/= :: Diff -> Diff -> Bool
Eq, Int -> Diff -> ShowS
[Diff] -> ShowS
Diff -> [Char]
(Int -> Diff -> ShowS)
-> (Diff -> [Char]) -> ([Diff] -> ShowS) -> Show Diff
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Diff -> ShowS
showsPrec :: Int -> Diff -> ShowS
$cshow :: Diff -> [Char]
show :: Diff -> [Char]
$cshowList :: [Diff] -> ShowS
showList :: [Diff] -> ShowS
Show)

data LineDiff =
    LinesFirst [String]
  | LinesSecond [String]
  | LinesBoth [String]
  | SingleLineDiff [Diff]
  | LinesOmitted Int
  deriving (LineDiff -> LineDiff -> Bool
(LineDiff -> LineDiff -> Bool)
-> (LineDiff -> LineDiff -> Bool) -> Eq LineDiff
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LineDiff -> LineDiff -> Bool
== :: LineDiff -> LineDiff -> Bool
$c/= :: LineDiff -> LineDiff -> Bool
/= :: LineDiff -> LineDiff -> Bool
Eq, Int -> LineDiff -> ShowS
[LineDiff] -> ShowS
LineDiff -> [Char]
(Int -> LineDiff -> ShowS)
-> (LineDiff -> [Char]) -> ([LineDiff] -> ShowS) -> Show LineDiff
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LineDiff -> ShowS
showsPrec :: Int -> LineDiff -> ShowS
$cshow :: LineDiff -> [Char]
show :: LineDiff -> [Char]
$cshowList :: [LineDiff] -> ShowS
showList :: [LineDiff] -> ShowS
Show)

lineDiff :: Maybe Int -> String -> String -> [LineDiff]
lineDiff :: Maybe Int -> [Char] -> [Char] -> [LineDiff]
lineDiff Maybe Int
context [Char]
expected [Char]
actual = ([LineDiff] -> [LineDiff])
-> (Int -> [LineDiff] -> [LineDiff])
-> Maybe Int
-> [LineDiff]
-> [LineDiff]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [LineDiff] -> [LineDiff]
forall a. a -> a
id Int -> [LineDiff] -> [LineDiff]
applyContext Maybe Int
context ([LineDiff] -> [LineDiff]) -> [LineDiff] -> [LineDiff]
forall a b. (a -> b) -> a -> b
$ [LineDiff] -> [LineDiff]
singleLineDiffs [LineDiff]
diffs
  where
    diffs :: [LineDiff]
    diffs :: [LineDiff]
diffs = [[Char]] -> [[Char]] -> [Diff [[Char]]]
forall t. Eq t => [t] -> [t] -> [Diff [t]]
Diff.getGroupedDiff [[Char]]
expectedLines [[Char]]
actualLines [Diff [[Char]]] -> (Diff [[Char]] -> LineDiff) -> [LineDiff]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ case
      Diff.First [[Char]]
xs -> [[Char]] -> LineDiff
LinesFirst [[Char]]
xs
      Diff.Second [[Char]]
xs -> [[Char]] -> LineDiff
LinesSecond [[Char]]
xs
      Diff.Both [[Char]]
xs [[Char]]
_ -> [[Char]] -> LineDiff
LinesBoth [[Char]]
xs

    expectedLines :: [String]
    expectedLines :: [[Char]]
expectedLines = [Char] -> [[Char]]
splitLines [Char]
expected

    actualLines :: [String]
    actualLines :: [[Char]]
actualLines = [Char] -> [[Char]]
splitLines [Char]
actual

singleLineDiffs :: [LineDiff] -> [LineDiff]
singleLineDiffs :: [LineDiff] -> [LineDiff]
singleLineDiffs = [LineDiff] -> [LineDiff]
go
  where
    go :: [LineDiff] -> [LineDiff]
go = \ case
      [] -> []
      LinesFirst [[Char]
first_] : LinesSecond [[Char]
second_] : [LineDiff]
xs -> [Diff] -> LineDiff
SingleLineDiff ([Char] -> [Char] -> [Diff]
diff [Char]
first_ [Char]
second_) LineDiff -> [LineDiff] -> [LineDiff]
forall a. a -> [a] -> [a]
: [LineDiff] -> [LineDiff]
go [LineDiff]
xs
      LineDiff
x : [LineDiff]
xs -> LineDiff
x LineDiff -> [LineDiff] -> [LineDiff]
forall a. a -> [a] -> [a]
: [LineDiff] -> [LineDiff]
go [LineDiff]
xs

splitLines :: String -> [String]
splitLines :: [Char] -> [[Char]]
splitLines = [Char] -> [[Char]]
go
  where
    go :: String -> [String]
    go :: [Char] -> [[Char]]
go [Char]
xs = case (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n') [Char]
xs of
      ([Char]
ys, Char
'\n' : [Char]
zs) -> [Char]
ys [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [Char] -> [[Char]]
go [Char]
zs
      ([Char], [Char])
_ -> [[Char]
xs]

data TrimMode = FirstChunk | Chunk | LastChunk

applyContext :: Int -> [LineDiff] -> [LineDiff]
applyContext :: Int -> [LineDiff] -> [LineDiff]
applyContext Int
context = \ [LineDiff]
diffs -> case [LineDiff]
diffs of
  [] -> []
  LineDiff
x : [LineDiff]
xs -> TrimMode -> LineDiff -> [LineDiff] -> [LineDiff]
trimChunk TrimMode
FirstChunk LineDiff
x ([LineDiff] -> [LineDiff]
go [LineDiff]
xs)
  where
    omitThreshold :: Int
    omitThreshold :: Int
omitThreshold = Int
3

    go :: [LineDiff] -> [LineDiff]
    go :: [LineDiff] -> [LineDiff]
go [LineDiff]
diffs = case [LineDiff]
diffs of
      [] -> []
      [LineDiff
x] -> TrimMode -> LineDiff -> [LineDiff] -> [LineDiff]
trimChunk TrimMode
LastChunk LineDiff
x []
      LineDiff
x : [LineDiff]
xs -> TrimMode -> LineDiff -> [LineDiff] -> [LineDiff]
trimChunk TrimMode
Chunk LineDiff
x ([LineDiff] -> [LineDiff]
go [LineDiff]
xs)

    trimChunk :: TrimMode -> LineDiff -> [LineDiff] -> [LineDiff]
    trimChunk :: TrimMode -> LineDiff -> [LineDiff] -> [LineDiff]
trimChunk TrimMode
mode LineDiff
chunk = case LineDiff
chunk of
      LinesBoth [[Char]]
allLines | Bool
meetsThreshold -> [[Char]] -> [LineDiff] -> [LineDiff]
keep [[Char]]
start ([LineDiff] -> [LineDiff])
-> ([LineDiff] -> [LineDiff]) -> [LineDiff] -> [LineDiff]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> LineDiff
LinesOmitted Int
omitted LineDiff -> [LineDiff] -> [LineDiff]
forall a. a -> [a] -> [a]
:) ([LineDiff] -> [LineDiff])
-> ([LineDiff] -> [LineDiff]) -> [LineDiff] -> [LineDiff]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [LineDiff] -> [LineDiff]
keep [[Char]]
end
        where
          meetsThreshold :: Bool
          meetsThreshold :: Bool
meetsThreshold = Int
omitThreshold Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
omitted

          lastLineHasNL :: Bool
lastLineHasNL = case (TrimMode
mode, [[Char]] -> [[Char]]
forall a. [a] -> [a]
reverse [[Char]]
allLines) of
            (TrimMode
LastChunk, [Char]
"" : [[Char]]
_) -> Bool
True
            (TrimMode, [[Char]])
_ -> Bool
False

          omitted :: Int
          omitted :: Int
omitted = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
keepStart Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
keepEnd

          keepStart :: Int
          keepStart :: Int
keepStart = case TrimMode
mode of
            TrimMode
FirstChunk -> Int
0
            TrimMode
_ -> Int
context

          keepEnd :: Int
          keepEnd :: Int
keepEnd = case TrimMode
mode of
            TrimMode
LastChunk -> Int
0
            TrimMode
_ -> Int
context

          n :: Int
          n :: Int
n = [[Char]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
allLines Int -> Int -> Int
forall a. Num a => a -> a -> a
- case Bool
lastLineHasNL of
            Bool
False -> Int
0
            Bool
True -> Int
1

          start :: [String]
          start :: [[Char]]
start = Int -> [[Char]] -> [[Char]]
forall a. Int -> [a] -> [a]
take Int
keepStart [[Char]]
allLines

          end :: [String]
          end :: [[Char]]
end = Int -> [[Char]] -> [[Char]]
forall a. Int -> [a] -> [a]
drop (Int
keepStart Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
omitted) [[Char]]
allLines

      LineDiff
_ -> (LineDiff
chunk LineDiff -> [LineDiff] -> [LineDiff]
forall a. a -> [a] -> [a]
:)

keep :: [String] -> [LineDiff] -> [LineDiff]
keep :: [[Char]] -> [LineDiff] -> [LineDiff]
keep [[Char]]
xs
  | [[Char]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
xs = [LineDiff] -> [LineDiff]
forall a. a -> a
id
  | Bool
otherwise = ([[Char]] -> LineDiff
LinesBoth [[Char]]
xs LineDiff -> [LineDiff] -> [LineDiff]
forall a. a -> [a] -> [a]
:)

diff :: String -> String -> [Diff]
diff :: [Char] -> [Char] -> [Diff]
diff [Char]
expected [Char]
actual = [Diff]
diffs
  where
    diffs :: [Diff]
    diffs :: [Diff]
diffs = (Diff [[Char]] -> Diff) -> [Diff [[Char]]] -> [Diff]
forall a b. (a -> b) -> [a] -> [b]
map (Diff [Char] -> Diff
toDiff (Diff [Char] -> Diff)
-> (Diff [[Char]] -> Diff [Char]) -> Diff [[Char]] -> Diff
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([[Char]] -> [Char]) -> Diff [[Char]] -> Diff [Char]
forall a b. (a -> b) -> Diff a -> Diff b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) ([Diff [[Char]]] -> [Diff]) -> [Diff [[Char]]] -> [Diff]
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [[Char]] -> [Diff [[Char]]]
forall t. Eq t => [t] -> [t] -> [Diff [t]]
Diff.getGroupedDiff [[Char]]
expectedChunks [[Char]]
actualChunks

    expectedChunks :: [String]
    expectedChunks :: [[Char]]
expectedChunks = [Char] -> [[Char]]
partition [Char]
expected

    actualChunks :: [String]
    actualChunks :: [[Char]]
actualChunks = [Char] -> [[Char]]
partition [Char]
actual

toDiff :: Diff.Diff String -> Diff
toDiff :: Diff [Char] -> Diff
toDiff Diff [Char]
d = case Diff [Char]
d of
  Diff.First [Char]
xs -> [Char] -> Diff
First [Char]
xs
  Diff.Second [Char]
xs -> [Char] -> Diff
Second [Char]
xs
  Diff.Both [Char]
xs [Char]
_ -> [Char] -> Diff
Both [Char]
xs

partition :: String -> [String]
partition :: [Char] -> [[Char]]
partition = ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([Char] -> Bool) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([[Char]] -> [[Char]])
-> ([Char] -> [[Char]]) -> [Char] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [[Char]]
mergeBackslashes ([[Char]] -> [[Char]])
-> ([Char] -> [[Char]]) -> [Char] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> [Char] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [[a]]
breakList Char -> Bool
isAlphaNum
  where
    mergeBackslashes :: [String] -> [String]
    mergeBackslashes :: [[Char]] -> [[Char]]
mergeBackslashes [[Char]]
xs = case [[Char]]
xs of
      [Char
'\\'] : ([Char] -> Maybe ([Char], [Char])
splitEscape -> Just ([Char]
escape, [Char]
ys)) : [[Char]]
zs -> ([Char]
"\\" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
escape) [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [Char]
ys [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]] -> [[Char]]
mergeBackslashes [[Char]]
zs
      [Char]
z : [[Char]]
zs -> [Char]
z [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]] -> [[Char]]
mergeBackslashes [[Char]]
zs
      [] -> []

breakList :: (a -> Bool) -> [a] -> [[a]]
breakList :: forall a. (a -> Bool) -> [a] -> [[a]]
breakList a -> Bool
_ [] = []
breakList a -> Bool
p [a]
xs = case (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break a -> Bool
p [a]
xs of
  ([a]
y, [a]
ys) -> (a -> [a]) -> [a] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map a -> [a]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [a]
y [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++ case (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span a -> Bool
p [a]
ys of
    ([a]
z, [a]
zs) -> [a]
z [a] -> [[a]] -> [[a]]
forall {t :: * -> *} {a}. Foldable t => t a -> [t a] -> [t a]
`cons` (a -> Bool) -> [a] -> [[a]]
forall a. (a -> Bool) -> [a] -> [[a]]
breakList a -> Bool
p [a]
zs
  where
    cons :: t a -> [t a] -> [t a]
cons t a
x
      | t a -> Bool
forall a. t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
x = [t a] -> [t a]
forall a. a -> a
id
      | Bool
otherwise = (t a
x t a -> [t a] -> [t a]
forall a. a -> [a] -> [a]
:)

splitEscape :: String -> Maybe (String, String)
splitEscape :: [Char] -> Maybe ([Char], [Char])
splitEscape [Char]
xs = [Char] -> Maybe ([Char], [Char])
splitNumericEscape [Char]
xs Maybe ([Char], [Char])
-> Maybe ([Char], [Char]) -> Maybe ([Char], [Char])
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Maybe ([Char], [Char])] -> Maybe ([Char], [Char])
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum (([Char] -> Maybe ([Char], [Char]))
-> [[Char]] -> [Maybe ([Char], [Char])]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Maybe ([Char], [Char])
split [[Char]]
escapes)
  where
    split :: String -> Maybe (String, String)
    split :: [Char] -> Maybe ([Char], [Char])
split [Char]
escape = (,) [Char]
escape ([Char] -> ([Char], [Char]))
-> Maybe [Char] -> Maybe ([Char], [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> [Char] -> Maybe [Char]
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix [Char]
escape [Char]
xs

splitNumericEscape :: String -> Maybe (String, String)
splitNumericEscape :: [Char] -> Maybe ([Char], [Char])
splitNumericEscape [Char]
xs = case (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit [Char]
xs of
  ([Char]
"", [Char]
_) -> Maybe ([Char], [Char])
forall a. Maybe a
Nothing
  ([Char], [Char])
r -> ([Char], [Char]) -> Maybe ([Char], [Char])
forall a. a -> Maybe a
Just ([Char], [Char])
r

escapes :: [String]
escapes :: [[Char]]
escapes = [
    [Char]
"ACK"
  , [Char]
"CAN"
  , [Char]
"DC1"
  , [Char]
"DC2"
  , [Char]
"DC3"
  , [Char]
"DC4"
  , [Char]
"DEL"
  , [Char]
"DLE"
  , [Char]
"ENQ"
  , [Char]
"EOT"
  , [Char]
"ESC"
  , [Char]
"ETB"
  , [Char]
"ETX"
  , [Char]
"NAK"
  , [Char]
"NUL"
  , [Char]
"SOH"
  , [Char]
"STX"
  , [Char]
"SUB"
  , [Char]
"SYN"
  , [Char]
"EM"
  , [Char]
"FS"
  , [Char]
"GS"
  , [Char]
"RS"
  , [Char]
"SI"
  , [Char]
"SO"
  , [Char]
"US"
  , [Char]
"a"
  , [Char]
"b"
  , [Char]
"f"
  , [Char]
"n"
  , [Char]
"r"
  , [Char]
"t"
  , [Char]
"v"
  , [Char]
"&"
  , [Char]
"'"
  , [Char]
"\""
  , [Char]
"\\"
  ]