{-# LANGUAGE CPP #-}
{-# LANGUAGE ViewPatterns #-}
module Test.Hspec.Core.Formatters.Diff (
Diff (..)
, diff
#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 | Omitted Int
deriving (Diff -> Diff -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Diff -> Diff -> Bool
$c/= :: Diff -> Diff -> Bool
== :: Diff -> Diff -> Bool
$c== :: Diff -> Diff -> Bool
Eq, Int -> Diff -> ShowS
[Diff] -> ShowS
Diff -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Diff] -> ShowS
$cshowList :: [Diff] -> ShowS
show :: Diff -> [Char]
$cshow :: Diff -> [Char]
showsPrec :: Int -> Diff -> ShowS
$cshowsPrec :: Int -> Diff -> ShowS
Show)
splitLines :: String -> [String]
splitLines :: [Char] -> [[Char]]
splitLines = [Char] -> [[Char]]
go
where
go :: [Char] -> [[Char]]
go [Char]
xs = case forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
'\n') [Char]
xs of
([Char]
ys, Char
'\n' : [Char]
zs) -> ([Char]
ys forall a. [a] -> [a] -> [a]
++ [Char
'\n']) forall a. a -> [a] -> [a]
: [Char] -> [[Char]]
go [Char]
zs
([Char]
"", [Char]
"") -> []
([Char], [Char])
_ -> [[Char]
xs]
data TrimMode = FirstChunck | Chunck | LastChunck
trim :: Int -> [Diff] -> [Diff]
trim :: Int -> [Diff] -> [Diff]
trim Int
context = \ [Diff]
chunks -> case [Diff]
chunks of
[] -> []
Diff
x : [Diff]
xs -> TrimMode -> Diff -> [Diff] -> [Diff]
trimChunk TrimMode
FirstChunck Diff
x ([Diff] -> [Diff]
go [Diff]
xs)
where
omitThreshold :: Int
omitThreshold = Int
3
go :: [Diff] -> [Diff]
go [Diff]
chunks = case [Diff]
chunks of
[] -> []
[Diff
x] -> TrimMode -> Diff -> [Diff] -> [Diff]
trimChunk TrimMode
LastChunck Diff
x []
Diff
x : [Diff]
xs -> TrimMode -> Diff -> [Diff] -> [Diff]
trimChunk TrimMode
Chunck Diff
x ([Diff] -> [Diff]
go [Diff]
xs)
trimChunk :: TrimMode -> Diff -> [Diff] -> [Diff]
trimChunk TrimMode
mode Diff
chunk = case Diff
chunk of
Both [Char]
xs | Int
omitted forall a. Ord a => a -> a -> Bool
>= Int
omitThreshold -> forall {t :: * -> *}. Foldable t => t [Char] -> [Diff] -> [Diff]
keep [[Char]]
start forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Diff
Omitted Int
omitted forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {t :: * -> *}. Foldable t => t [Char] -> [Diff] -> [Diff]
keep [[Char]]
end
where
omitted :: Int
omitted :: Int
omitted = Int
n forall a. Num a => a -> a -> a
- Int
keepStart forall a. Num a => a -> a -> a
- Int
keepEnd
keepStart :: Int
keepStart :: Int
keepStart = case TrimMode
mode of
TrimMode
FirstChunck -> Int
0
TrimMode
_ -> forall a. Enum a => a -> a
succ Int
context
keepEnd :: Int
keepEnd :: Int
keepEnd = case TrimMode
mode of
TrimMode
LastChunck -> Int
0
TrimMode
_ -> if [Char]
xs forall a. Eq a => [a] -> [a] -> Bool
`endsWith` [Char]
"\n" then Int
context else forall a. Enum a => a -> a
succ Int
context
n :: Int
n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
allLines
allLines :: [String]
allLines :: [[Char]]
allLines = [Char] -> [[Char]]
splitLines [Char]
xs
start :: [String]
start :: [[Char]]
start = forall a. Int -> [a] -> [a]
take Int
keepStart [[Char]]
allLines
end :: [String]
end :: [[Char]]
end = forall a. Int -> [a] -> [a]
drop (Int
keepStart forall a. Num a => a -> a -> a
+ Int
omitted) [[Char]]
allLines
Diff
_ -> (Diff
chunk forall a. a -> [a] -> [a]
:)
keep :: t [Char] -> [Diff] -> [Diff]
keep t [Char]
xs
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null t [Char]
xs = forall a. a -> a
id
| Bool
otherwise = ([Char] -> Diff
Both (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat t [Char]
xs) forall a. a -> [a] -> [a]
:)
diff :: Maybe Int -> String -> String -> [Diff]
diff :: Maybe Int -> [Char] -> [Char] -> [Diff]
diff Maybe Int
context [Char]
expected [Char]
actual = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id Int -> [Diff] -> [Diff]
trim Maybe Int
context forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Diff [Char] -> Diff
toDiff forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) forall a b. (a -> b) -> a -> b
$ forall t. Eq t => [t] -> [t] -> [Diff [t]]
Diff.getGroupedDiff ([Char] -> [[Char]]
partition [Char]
expected) ([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 = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [[Char]]
mergeBackslashes forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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]
"\\" forall a. [a] -> [a] -> [a]
++ [Char]
escape) forall a. a -> [a] -> [a]
: [Char]
ys forall a. a -> [a] -> [a]
: [[Char]] -> [[Char]]
mergeBackslashes [[Char]]
zs
[Char]
z : [[Char]]
zs -> [Char]
z 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 forall a. (a -> Bool) -> [a] -> ([a], [a])
break a -> Bool
p [a]
xs of
([a]
y, [a]
ys) -> forall a b. (a -> b) -> [a] -> [b]
map forall (m :: * -> *) a. Monad m => a -> m a
return [a]
y forall a. [a] -> [a] -> [a]
++ case forall a. (a -> Bool) -> [a] -> ([a], [a])
span a -> Bool
p [a]
ys of
([a]
z, [a]
zs) -> [a]
z forall {t :: * -> *} {a}. Foldable t => t a -> [t a] -> [t a]
`cons` forall a. (a -> Bool) -> [a] -> [[a]]
breakList a -> Bool
p [a]
zs
where
cons :: t a -> [t a] -> [t a]
cons t a
x
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
x = forall a. a -> a
id
| Bool
otherwise = (t a
x 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 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum (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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit [Char]
xs of
([Char]
"", [Char]
_) -> forall a. Maybe a
Nothing
([Char], [Char])
r -> 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]
"\\"
]