{-# 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
(Diff -> Diff -> Bool) -> (Diff -> Diff -> Bool) -> Eq Diff
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 -> String
(Int -> Diff -> ShowS)
-> (Diff -> String) -> ([Diff] -> ShowS) -> Show Diff
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Diff] -> ShowS
$cshowList :: [Diff] -> ShowS
show :: Diff -> String
$cshow :: Diff -> String
showsPrec :: Int -> Diff -> ShowS
$cshowsPrec :: Int -> Diff -> ShowS
Show)
splitLines :: String -> [String]
splitLines :: String -> [String]
splitLines = String -> [String]
go
where
go :: String -> [String]
go String
xs = case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n') String
xs of
(String
ys, Char
'\n' : String
zs) -> (String
ys String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
'\n']) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
go String
zs
(String
"", String
"") -> []
(String, String)
_ -> [String
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 String
xs | Int
omitted Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
omitThreshold -> [String] -> [Diff] -> [Diff]
forall (t :: * -> *). Foldable t => t String -> [Diff] -> [Diff]
keep [String]
start ([Diff] -> [Diff]) -> ([Diff] -> [Diff]) -> [Diff] -> [Diff]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Diff
Omitted Int
omitted Diff -> [Diff] -> [Diff]
forall a. a -> [a] -> [a]
:) ([Diff] -> [Diff]) -> ([Diff] -> [Diff]) -> [Diff] -> [Diff]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [Diff] -> [Diff]
forall (t :: * -> *). Foldable t => t String -> [Diff] -> [Diff]
keep [String]
end
where
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
FirstChunck -> Int
0
TrimMode
_ -> Int -> Int
forall a. Enum a => a -> a
succ Int
context
keepEnd :: Int
keepEnd :: Int
keepEnd = case TrimMode
mode of
TrimMode
LastChunck -> Int
0
TrimMode
_ -> if String
xs String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`endsWith` String
"\n" then Int
context else Int -> Int
forall a. Enum a => a -> a
succ Int
context
n :: Int
n :: Int
n = [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
allLines
allLines :: [String]
allLines :: [String]
allLines = String -> [String]
splitLines String
xs
start :: [String]
start :: [String]
start = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
keepStart [String]
allLines
end :: [String]
end :: [String]
end = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop (Int
keepStart Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
omitted) [String]
allLines
Diff
_ -> (Diff
chunk Diff -> [Diff] -> [Diff]
forall a. a -> [a] -> [a]
:)
keep :: t String -> [Diff] -> [Diff]
keep t String
xs
| t String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t String
xs = [Diff] -> [Diff]
forall a. a -> a
id
| Bool
otherwise = (String -> Diff
Both (t String -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat t String
xs) Diff -> [Diff] -> [Diff]
forall a. a -> [a] -> [a]
:)
diff :: Maybe Int -> String -> String -> [Diff]
diff :: Maybe Int -> String -> String -> [Diff]
diff Maybe Int
context String
expected String
actual = ([Diff] -> [Diff])
-> (Int -> [Diff] -> [Diff]) -> Maybe Int -> [Diff] -> [Diff]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Diff] -> [Diff]
forall a. a -> a
id Int -> [Diff] -> [Diff]
trim Maybe Int
context ([Diff] -> [Diff]) -> [Diff] -> [Diff]
forall a b. (a -> b) -> a -> b
$ (Diff [String] -> Diff) -> [Diff [String]] -> [Diff]
forall a b. (a -> b) -> [a] -> [b]
map (Diff String -> Diff
toDiff (Diff String -> Diff)
-> (Diff [String] -> Diff String) -> Diff [String] -> Diff
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> String) -> Diff [String] -> Diff String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) ([Diff [String]] -> [Diff]) -> [Diff [String]] -> [Diff]
forall a b. (a -> b) -> a -> b
$ [String] -> [String] -> [Diff [String]]
forall t. Eq t => [t] -> [t] -> [Diff [t]]
Diff.getGroupedDiff (String -> [String]
partition String
expected) (String -> [String]
partition String
actual)
toDiff :: Diff.Diff String -> Diff
toDiff :: Diff String -> Diff
toDiff Diff String
d = case Diff String
d of
Diff.First String
xs -> String -> Diff
First String
xs
Diff.Second String
xs -> String -> Diff
Second String
xs
Diff.Both String
xs String
_ -> String -> Diff
Both String
xs
partition :: String -> [String]
partition :: String -> [String]
partition = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
mergeBackslashes ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> [String]
forall a. (a -> Bool) -> [a] -> [[a]]
breakList Char -> Bool
isAlphaNum
where
mergeBackslashes :: [String] -> [String]
mergeBackslashes :: [String] -> [String]
mergeBackslashes [String]
xs = case [String]
xs of
[Char
'\\'] : (String -> Maybe (String, String)
splitEscape -> Just (String
escape, String
ys)) : [String]
zs -> (String
"\\" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
escape) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
ys String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String]
mergeBackslashes [String]
zs
String
z : [String]
zs -> String
z String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String]
mergeBackslashes [String]
zs
[] -> []
breakList :: (a -> Bool) -> [a] -> [[a]]
breakList :: (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 (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 (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 :: String -> Maybe (String, String)
splitEscape String
xs = String -> Maybe (String, String)
splitNumericEscape String
xs Maybe (String, String)
-> Maybe (String, String) -> Maybe (String, String)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ([Maybe (String, String)] -> Maybe (String, String)
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([Maybe (String, String)] -> Maybe (String, String))
-> [Maybe (String, String)] -> Maybe (String, String)
forall a b. (a -> b) -> a -> b
$ (String -> Maybe (String, String))
-> [String] -> [Maybe (String, String)]
forall a b. (a -> b) -> [a] -> [b]
map String -> Maybe (String, String)
split [String]
escapes)
where
split :: String -> Maybe (String, String)
split :: String -> Maybe (String, String)
split String
escape = (,) String
escape (String -> (String, String))
-> Maybe String -> Maybe (String, String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
escape String
xs
splitNumericEscape :: String -> Maybe (String, String)
splitNumericEscape :: String -> Maybe (String, String)
splitNumericEscape String
xs = case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit String
xs of
(String
"", String
_) -> Maybe (String, String)
forall a. Maybe a
Nothing
(String, String)
r -> (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just (String, String)
r
escapes :: [String]
escapes :: [String]
escapes = [
String
"ACK"
, String
"CAN"
, String
"DC1"
, String
"DC2"
, String
"DC3"
, String
"DC4"
, String
"DEL"
, String
"DLE"
, String
"ENQ"
, String
"EOT"
, String
"ESC"
, String
"ETB"
, String
"ETX"
, String
"NAK"
, String
"NUL"
, String
"SOH"
, String
"STX"
, String
"SUB"
, String
"SYN"
, String
"EM"
, String
"FS"
, String
"GS"
, String
"RS"
, String
"SI"
, String
"SO"
, String
"US"
, String
"a"
, String
"b"
, String
"f"
, String
"n"
, String
"r"
, String
"t"
, String
"v"
, String
"&"
, String
"'"
, String
"\""
, String
"\\"
]