{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
module Test.Hspec.Core.Formatters.V2
(
silent
, checks
, specdoc
, progress
, failed_examples
, Formatter (..)
, Path
, Progress
, Location(..)
, Item(..)
, Result(..)
, FailureReason (..)
, FormatM
, formatterToFormat
, getConfig
, getConfigValue
, FormatConfig(..)
, getSuccessCount
, getPendingCount
, getFailCount
, getTotalCount
, getExpectedTotalCount
, FailureRecord (..)
, getFailMessages
, usedSeed
, printTimes
, Seconds(..)
, getCPUTime
, getRealTime
, write
, writeLine
, writeTransient
, withInfoColor
, withSuccessColor
, withPendingColor
, withFailColor
, outputUnicode
, useDiff
, diffContext
, externalDiffAction
, prettyPrint
, prettyPrintFunction
, extraChunk
, missingChunk
, unlessExpert
, formatLocation
, Util.formatException
#ifdef TEST
, Chunk(..)
, ColorChunk(..)
#endif
) where
import Prelude ()
import Test.Hspec.Core.Compat hiding (First)
import System.IO (hFlush, stdout)
import Test.Hspec.Core.Util hiding (formatException)
import qualified Test.Hspec.Core.Util as Util
import Test.Hspec.Core.Clock
import Test.Hspec.Core.Example (Location(..), Progress)
import Text.Printf
import Test.Hspec.Core.Formatters.Pretty.Unicode (ushow)
import Control.Monad.IO.Class
import Test.Hspec.Core.Formatters.Internal (
Formatter(..)
, Item(..)
, Result(..)
, FailureReason (..)
, FormatM
, formatterToFormat
, getConfig
, getConfigValue
, FormatConfig(..)
, getSuccessCount
, getPendingCount
, getFailCount
, getTotalCount
, getExpectedTotalCount
, FailureRecord (..)
, getFailMessages
, usedSeed
, printTimes
, getCPUTime
, getRealTime
, write
, writeLine
, writeTransient
, withInfoColor
, withSuccessColor
, withPendingColor
, withFailColor
, outputUnicode
, useDiff
, diffContext
, externalDiffAction
, prettyPrint
, prettyPrintFunction
, extraChunk
, missingChunk
, unlessExpert
)
import Test.Hspec.Core.Formatters.Diff
silent :: Formatter
silent :: Formatter
silent = Formatter {
formatterStarted :: FormatM ()
formatterStarted = FormatM ()
forall (m :: * -> *). Applicative m => m ()
pass
, formatterGroupStarted :: Path -> FormatM ()
formatterGroupStarted = \ Path
_ -> FormatM ()
forall (m :: * -> *). Applicative m => m ()
pass
, formatterGroupDone :: Path -> FormatM ()
formatterGroupDone = \ Path
_ -> FormatM ()
forall (m :: * -> *). Applicative m => m ()
pass
, formatterProgress :: Path -> Progress -> FormatM ()
formatterProgress = \ Path
_ Progress
_ -> FormatM ()
forall (m :: * -> *). Applicative m => m ()
pass
, formatterItemStarted :: Path -> FormatM ()
formatterItemStarted = \ Path
_ -> FormatM ()
forall (m :: * -> *). Applicative m => m ()
pass
, formatterItemDone :: Path -> Item -> FormatM ()
formatterItemDone = \ Path
_ Item
_ -> FormatM ()
forall (m :: * -> *). Applicative m => m ()
pass
, formatterDone :: FormatM ()
formatterDone = FormatM ()
forall (m :: * -> *). Applicative m => m ()
pass
}
checks :: Formatter
checks :: Formatter
checks = Formatter
specdoc {
formatterProgress = \([[Char]]
nesting, [Char]
requirement) Progress
p -> do
[Char] -> FormatM ()
writeTransient ([Char] -> FormatM ()) -> [Char] -> FormatM ()
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
forall {t :: * -> *} {a}. Foldable t => t a -> [Char]
indentationFor [[Char]]
nesting [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
requirement [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" [" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Progress -> [Char]
forall {a} {a}. (Eq a, Num a, Show a, Show a) => (a, a) -> [Char]
formatProgress Progress
p [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"]"
, formatterItemStarted = \([[Char]]
nesting, [Char]
requirement) -> do
[Char] -> FormatM ()
writeTransient ([Char] -> FormatM ()) -> [Char] -> FormatM ()
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
forall {t :: * -> *} {a}. Foldable t => t a -> [Char]
indentationFor [[Char]]
nesting [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
requirement [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" [ ]"
, formatterItemDone = \ ([[Char]]
nesting, [Char]
requirement) Item
item -> do
Bool
unicode <- FormatM Bool
outputUnicode
let fallback :: p -> p -> p
fallback p
a p
b = if Bool
unicode then p
a else p
b
((FormatM () -> FormatM ()) -> [Char] -> FormatM ())
-> (FormatM () -> FormatM (), [Char]) -> FormatM ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ([[Char]]
-> [Char]
-> Seconds
-> [Char]
-> (FormatM () -> FormatM ())
-> [Char]
-> FormatM ()
writeResult [[Char]]
nesting [Char]
requirement (Item -> Seconds
itemDuration Item
item) (Item -> [Char]
itemInfo Item
item)) ((FormatM () -> FormatM (), [Char]) -> FormatM ())
-> (FormatM () -> FormatM (), [Char]) -> FormatM ()
forall a b. (a -> b) -> a -> b
$ case Item -> Result
itemResult Item
item of
Success {} -> (FormatM () -> FormatM ()
forall a. FormatM a -> FormatM a
withSuccessColor, [Char] -> [Char] -> [Char]
forall {p}. p -> p -> p
fallback [Char]
"✔" [Char]
"v")
Pending {} -> (FormatM () -> FormatM ()
forall a. FormatM a -> FormatM a
withPendingColor, [Char] -> [Char] -> [Char]
forall {p}. p -> p -> p
fallback [Char]
"‐" [Char]
"-")
Failure {} -> (FormatM () -> FormatM ()
forall a. FormatM a -> FormatM a
withFailColor, [Char] -> [Char] -> [Char]
forall {p}. p -> p -> p
fallback [Char]
"✘" [Char]
"x")
case Item -> Result
itemResult Item
item of
Success {} -> FormatM ()
forall (m :: * -> *). Applicative m => m ()
pass
Failure {} -> FormatM ()
forall (m :: * -> *). Applicative m => m ()
pass
Pending Maybe Location
_ Maybe [Char]
reason -> FormatM () -> FormatM ()
forall a. FormatM a -> FormatM a
withPendingColor (FormatM () -> FormatM ()) -> FormatM () -> FormatM ()
forall a b. (a -> b) -> a -> b
$ do
[Char] -> [Char] -> FormatM ()
indentBy ([[Char]] -> [Char]
forall {t :: * -> *} {a}. Foldable t => t a -> [Char]
indentationFor ([Char]
"" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
nesting)) ([Char] -> FormatM ()) -> [Char] -> FormatM ()
forall a b. (a -> b) -> a -> b
$ [Char]
"# PENDING: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
"No reason given" Maybe [Char]
reason
} where
indentationFor :: t a -> [Char]
indentationFor t a
nesting = Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (t a -> Int
forall a. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
nesting Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2) Char
' '
writeResult :: [String] -> String -> Seconds -> String -> (FormatM () -> FormatM ()) -> String -> FormatM ()
writeResult :: [[Char]]
-> [Char]
-> Seconds
-> [Char]
-> (FormatM () -> FormatM ())
-> [Char]
-> FormatM ()
writeResult [[Char]]
nesting [Char]
requirement Seconds
duration [Char]
info FormatM () -> FormatM ()
withColor [Char]
symbol = do
Bool
shouldPrintTimes <- FormatM Bool
printTimes
[Char] -> FormatM ()
write ([Char] -> FormatM ()) -> [Char] -> FormatM ()
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
forall {t :: * -> *} {a}. Foldable t => t a -> [Char]
indentationFor [[Char]]
nesting [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
requirement [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" ["
FormatM () -> FormatM ()
withColor (FormatM () -> FormatM ()) -> FormatM () -> FormatM ()
forall a b. (a -> b) -> a -> b
$ [Char] -> FormatM ()
write [Char]
symbol
[Char] -> FormatM ()
writeLine ([Char] -> FormatM ()) -> [Char] -> FormatM ()
forall a b. (a -> b) -> a -> b
$ [Char]
"]" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ if Bool
shouldPrintTimes then [Char]
times else [Char]
""
[Char] -> [Char] -> FormatM ()
indentBy ([[Char]] -> [Char]
forall {t :: * -> *} {a}. Foldable t => t a -> [Char]
indentationFor ([Char]
"" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
nesting)) [Char]
info
where
dt :: Int
dt :: Int
dt = Seconds -> Int
toMilliseconds Seconds
duration
times :: [Char]
times
| Int
dt Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = [Char]
""
| Bool
otherwise = [Char]
" (" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
dt [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"ms)"
formatProgress :: (a, a) -> [Char]
formatProgress (a
current, a
total)
| a
total a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 = a -> [Char]
forall a. Show a => a -> [Char]
show a
current
| Bool
otherwise = a -> [Char]
forall a. Show a => a -> [Char]
show a
current [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"/" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
total
specdoc :: Formatter
specdoc :: Formatter
specdoc = Formatter
silent {
formatterStarted = do
writeLine ""
, formatterGroupStarted = \ ([[Char]]
nesting, [Char]
name) -> do
[Char] -> FormatM ()
writeLine ([[Char]] -> [Char]
forall {t :: * -> *} {a}. Foldable t => t a -> [Char]
indentationFor [[Char]]
nesting [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
name)
, formatterProgress = \Path
_ Progress
p -> do
[Char] -> FormatM ()
writeTransient (Progress -> [Char]
forall {a} {a}. (Eq a, Num a, Show a, Show a) => (a, a) -> [Char]
formatProgress Progress
p)
, formatterItemDone = \([[Char]]
nesting, [Char]
requirement) Item
item -> do
let duration :: Seconds
duration = Item -> Seconds
itemDuration Item
item
info :: [Char]
info = Item -> [Char]
itemInfo Item
item
case Item -> Result
itemResult Item
item of
Result
Success -> FormatM () -> FormatM ()
forall a. FormatM a -> FormatM a
withSuccessColor (FormatM () -> FormatM ()) -> FormatM () -> FormatM ()
forall a b. (a -> b) -> a -> b
$ do
[[Char]] -> [Char] -> Seconds -> [Char] -> FormatM ()
writeResult [[Char]]
nesting [Char]
requirement Seconds
duration [Char]
info
Pending Maybe Location
_ Maybe [Char]
reason -> FormatM () -> FormatM ()
forall a. FormatM a -> FormatM a
withPendingColor (FormatM () -> FormatM ()) -> FormatM () -> FormatM ()
forall a b. (a -> b) -> a -> b
$ do
[[Char]] -> [Char] -> Seconds -> [Char] -> FormatM ()
writeResult [[Char]]
nesting [Char]
requirement Seconds
duration [Char]
info
[Char] -> [Char] -> FormatM ()
indentBy ([[Char]] -> [Char]
forall {t :: * -> *} {a}. Foldable t => t a -> [Char]
indentationFor ([Char]
"" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
nesting)) ([Char] -> FormatM ()) -> [Char] -> FormatM ()
forall a b. (a -> b) -> a -> b
$ [Char]
"# PENDING: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
"No reason given" Maybe [Char]
reason
Failure {} -> FormatM () -> FormatM ()
forall a. FormatM a -> FormatM a
withFailColor (FormatM () -> FormatM ()) -> FormatM () -> FormatM ()
forall a b. (a -> b) -> a -> b
$ do
Int
n <- FormatM Int
getFailCount
[[Char]] -> [Char] -> Seconds -> [Char] -> FormatM ()
writeResult [[Char]]
nesting ([Char]
requirement [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" FAILED [" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"]") Seconds
duration [Char]
info
, formatterDone = defaultFailedFormatter >> defaultFooter
} where
indentationFor :: t a -> [Char]
indentationFor t a
nesting = Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (t a -> Int
forall a. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
nesting Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2) Char
' '
writeResult :: [[Char]] -> [Char] -> Seconds -> [Char] -> FormatM ()
writeResult [[Char]]
nesting [Char]
requirement (Seconds Double
duration) [Char]
info = do
Bool
shouldPrintTimes <- FormatM Bool
printTimes
[Char] -> FormatM ()
writeLine ([Char] -> FormatM ()) -> [Char] -> FormatM ()
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
forall {t :: * -> *} {a}. Foldable t => t a -> [Char]
indentationFor [[Char]]
nesting [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
requirement [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ if Bool
shouldPrintTimes then [Char]
times else [Char]
""
[Char] -> [Char] -> FormatM ()
indentBy ([[Char]] -> [Char]
forall {t :: * -> *} {a}. Foldable t => t a -> [Char]
indentationFor ([Char]
"" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
nesting)) [Char]
info
where
dt :: Int
dt :: Int
dt = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
duration Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000)
times :: [Char]
times
| Int
dt Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = [Char]
""
| Bool
otherwise = [Char]
" (" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
dt [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"ms)"
formatProgress :: (a, a) -> [Char]
formatProgress (a
current, a
total)
| a
total a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 = a -> [Char]
forall a. Show a => a -> [Char]
show a
current
| Bool
otherwise = a -> [Char]
forall a. Show a => a -> [Char]
show a
current [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"/" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
total
progress :: Formatter
progress :: Formatter
progress = Formatter
failed_examples {
formatterItemDone = \ Path
_ Item
item -> do
case Item -> Result
itemResult Item
item of
Success{} -> FormatM () -> FormatM ()
forall a. FormatM a -> FormatM a
withSuccessColor (FormatM () -> FormatM ()) -> FormatM () -> FormatM ()
forall a b. (a -> b) -> a -> b
$ [Char] -> FormatM ()
write [Char]
"."
Pending{} -> FormatM () -> FormatM ()
forall a. FormatM a -> FormatM a
withPendingColor (FormatM () -> FormatM ()) -> FormatM () -> FormatM ()
forall a b. (a -> b) -> a -> b
$ [Char] -> FormatM ()
write [Char]
"."
Failure{} -> FormatM () -> FormatM ()
forall a. FormatM a -> FormatM a
withFailColor (FormatM () -> FormatM ()) -> FormatM () -> FormatM ()
forall a b. (a -> b) -> a -> b
$ [Char] -> FormatM ()
write [Char]
"F"
IO () -> FormatM ()
forall a. IO a -> FormatM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FormatM ()) -> IO () -> FormatM ()
forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
hFlush Handle
stdout
}
failed_examples :: Formatter
failed_examples :: Formatter
failed_examples = Formatter
silent {
formatterDone = defaultFailedFormatter >> defaultFooter
}
defaultFailedFormatter :: FormatM ()
defaultFailedFormatter :: FormatM ()
defaultFailedFormatter = do
[Char] -> FormatM ()
writeLine [Char]
""
[FailureRecord]
failures <- FormatM [FailureRecord]
getFailMessages
Bool -> FormatM () -> FormatM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([FailureRecord] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FailureRecord]
failures) (FormatM () -> FormatM ()) -> FormatM () -> FormatM ()
forall a b. (a -> b) -> a -> b
$ do
[Char] -> FormatM ()
writeLine [Char]
"Failures:"
[Char] -> FormatM ()
writeLine [Char]
""
[(Int, FailureRecord)]
-> ((Int, FailureRecord) -> FormatM ()) -> FormatM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Int] -> [FailureRecord] -> [(Int, FailureRecord)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [FailureRecord]
failures) (((Int, FailureRecord) -> FormatM ()) -> FormatM ())
-> ((Int, FailureRecord) -> FormatM ()) -> FormatM ()
forall a b. (a -> b) -> a -> b
$ \(Int, FailureRecord)
x -> do
(Int, FailureRecord) -> FormatM ()
formatFailure (Int, FailureRecord)
x
[Char] -> FormatM ()
writeLine [Char]
""
[Char] -> FormatM ()
write [Char]
"Randomized with seed " FormatM () -> FormatM Integer -> FormatM Integer
forall a b. FormatM a -> FormatM b -> FormatM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FormatM Integer
usedSeed FormatM Integer -> (Integer -> FormatM ()) -> FormatM ()
forall a b. FormatM a -> (a -> FormatM b) -> FormatM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> FormatM ()
writeLine ([Char] -> FormatM ())
-> (Integer -> [Char]) -> Integer -> FormatM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> [Char]
forall a. Show a => a -> [Char]
show
[Char] -> FormatM ()
writeLine [Char]
""
where
formatFailure :: (Int, FailureRecord) -> FormatM ()
formatFailure :: (Int, FailureRecord) -> FormatM ()
formatFailure (Int
n, FailureRecord Maybe Location
mLoc Path
path FailureReason
reason) = do
Bool
unicode <- FormatM Bool
outputUnicode
Maybe Location -> (Location -> FormatM ()) -> FormatM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Location
mLoc ((Location -> FormatM ()) -> FormatM ())
-> (Location -> FormatM ()) -> FormatM ()
forall a b. (a -> b) -> a -> b
$ \Location
loc -> do
FormatM () -> FormatM ()
forall a. FormatM a -> FormatM a
withInfoColor (FormatM () -> FormatM ()) -> FormatM () -> FormatM ()
forall a b. (a -> b) -> a -> b
$ [Char] -> FormatM ()
writeLine ([Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Location -> [Char]
formatLocation Location
loc)
[Char] -> FormatM ()
write ([Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
") ")
[Char] -> FormatM ()
writeLine (Path -> [Char]
formatRequirement Path
path)
case FailureReason
reason of
FailureReason
NoReason -> FormatM ()
forall (m :: * -> *). Applicative m => m ()
pass
Reason [Char]
err -> FormatM () -> FormatM ()
forall a. FormatM a -> FormatM a
withFailColor (FormatM () -> FormatM ()) -> FormatM () -> FormatM ()
forall a b. (a -> b) -> a -> b
$ [Char] -> FormatM ()
indent [Char]
err
ColorizedReason [Char]
err -> [Char] -> FormatM ()
indent [Char]
err
ExpectedButGot Maybe [Char]
preface [Char]
expected_ [Char]
actual_ -> do
Maybe ([Char] -> [Char] -> ([Char], [Char]))
pretty <- FormatM (Maybe ([Char] -> [Char] -> ([Char], [Char])))
prettyPrintFunction
let
([Char]
expected, [Char]
actual) = case Maybe ([Char] -> [Char] -> ([Char], [Char]))
pretty of
Just [Char] -> [Char] -> ([Char], [Char])
f -> [Char] -> [Char] -> ([Char], [Char])
f [Char]
expected_ [Char]
actual_
Maybe ([Char] -> [Char] -> ([Char], [Char]))
Nothing -> ([Char]
expected_, [Char]
actual_)
([Char] -> FormatM ()) -> Maybe [Char] -> FormatM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [Char] -> FormatM ()
indent Maybe [Char]
preface
Bool
b <- FormatM Bool
useDiff
let threshold :: Seconds
threshold = Seconds
2 :: Seconds
Maybe ([Char] -> [Char] -> IO ())
mExternalDiff <- FormatM (Maybe ([Char] -> [Char] -> IO ()))
externalDiffAction
case Maybe ([Char] -> [Char] -> IO ())
mExternalDiff of
Just [Char] -> [Char] -> IO ()
externalDiff -> do
IO () -> FormatM ()
forall a. IO a -> FormatM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FormatM ()) -> IO () -> FormatM ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> IO ()
externalDiff [Char]
expected [Char]
actual
Maybe ([Char] -> [Char] -> IO ())
Nothing -> do
Maybe Int
context <- FormatM (Maybe Int)
diffContext
Maybe [LineDiff]
mchunks <- IO (Maybe [LineDiff]) -> FormatM (Maybe [LineDiff])
forall a. IO a -> FormatM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe [LineDiff]) -> FormatM (Maybe [LineDiff]))
-> IO (Maybe [LineDiff]) -> FormatM (Maybe [LineDiff])
forall a b. (a -> b) -> a -> b
$ if Bool
b
then Seconds -> IO [LineDiff] -> IO (Maybe [LineDiff])
forall a. Seconds -> IO a -> IO (Maybe a)
timeout Seconds
threshold ([LineDiff] -> IO [LineDiff]
forall a. a -> IO a
evaluate ([LineDiff] -> IO [LineDiff]) -> [LineDiff] -> IO [LineDiff]
forall a b. (a -> b) -> a -> b
$ Maybe Int -> [Char] -> [Char] -> [LineDiff]
lineDiff Maybe Int
context [Char]
expected [Char]
actual)
else Maybe [LineDiff] -> IO (Maybe [LineDiff])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [LineDiff]
forall a. Maybe a
Nothing
case Maybe [LineDiff]
mchunks of
Just [LineDiff]
chunks -> do
[LineDiff]
-> ([Char] -> FormatM ()) -> ([Char] -> FormatM ()) -> FormatM ()
writeDiff [LineDiff]
chunks [Char] -> FormatM ()
extraChunk [Char] -> FormatM ()
missingChunk
Maybe [LineDiff]
Nothing -> do
[LineDiff]
-> ([Char] -> FormatM ()) -> ([Char] -> FormatM ()) -> FormatM ()
writeDiff [[[Char]] -> LineDiff
LinesFirst ([Char] -> [[Char]]
splitLines [Char]
expected), [[Char]] -> LineDiff
LinesSecond ([Char] -> [[Char]]
splitLines [Char]
actual)] [Char] -> FormatM ()
write [Char] -> FormatM ()
write
where
writeDiff :: [LineDiff] -> (String -> FormatM ()) -> (String -> FormatM ()) -> FormatM ()
writeDiff :: [LineDiff]
-> ([Char] -> FormatM ()) -> ([Char] -> FormatM ()) -> FormatM ()
writeDiff [LineDiff]
chunks [Char] -> FormatM ()
extra [Char] -> FormatM ()
missing = do
[Char] -> [Chunk] -> ([Char] -> FormatM ()) -> FormatM ()
writeChunks [Char]
"expected: " ([LineDiff] -> [Chunk]
expectedChunks [LineDiff]
chunks) [Char] -> FormatM ()
extra
[Char] -> [Chunk] -> ([Char] -> FormatM ()) -> FormatM ()
writeChunks [Char]
" but got: " ([LineDiff] -> [Chunk]
actualChunks [LineDiff]
chunks) [Char] -> FormatM ()
missing
writeChunks :: String -> [Chunk] -> (String -> FormatM ()) -> FormatM ()
writeChunks :: [Char] -> [Chunk] -> ([Char] -> FormatM ()) -> FormatM ()
writeChunks [Char]
pre [Chunk]
chunks [Char] -> FormatM ()
colorize = do
FormatM () -> FormatM ()
forall a. FormatM a -> FormatM a
withFailColor (FormatM () -> FormatM ()) -> FormatM () -> FormatM ()
forall a b. (a -> b) -> a -> b
$ [Char] -> FormatM ()
write ([Char]
indentation [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
pre)
FormatM () -> [Chunk] -> FormatM ()
go FormatM ()
forall (m :: * -> *). Applicative m => m ()
pass [Chunk]
chunks
where
indentation_ :: [Char]
indentation_ :: [Char]
indentation_ = [Char]
indentation [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate ([Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
pre) Char
' '
go :: FormatM () -> [Chunk] -> FormatM ()
go :: FormatM () -> [Chunk] -> FormatM ()
go FormatM ()
indent_ = \ case
[] -> FormatM ()
forall (m :: * -> *). Applicative m => m ()
pass
Chunk
c : [Chunk]
cs -> do
FormatM ()
indent_
case Chunk
c of
Original [Char]
a -> [Char] -> FormatM ()
write [Char]
a
Modified [Char]
a -> [Char] -> FormatM ()
colorize [Char]
a
Info [Char]
text -> FormatM () -> FormatM ()
forall a. FormatM a -> FormatM a
withInfoColor (FormatM () -> FormatM ()) -> FormatM () -> FormatM ()
forall a b. (a -> b) -> a -> b
$ [Char] -> FormatM ()
write [Char]
text
ModifiedChunks [ColorChunk]
xs -> [ColorChunk] -> (ColorChunk -> FormatM ()) -> FormatM ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [ColorChunk]
xs ((ColorChunk -> FormatM ()) -> FormatM ())
-> (ColorChunk -> FormatM ()) -> FormatM ()
forall a b. (a -> b) -> a -> b
$ \ case
PlainChunk [Char]
a -> [Char] -> FormatM ()
write [Char]
a
ColorChunk [Char]
a -> [Char] -> FormatM ()
colorize [Char]
a
[Char] -> FormatM ()
write [Char]
"\n"
FormatM () -> [Chunk] -> FormatM ()
go ([Char] -> FormatM ()
write [Char]
indentation_) [Chunk]
cs
Error Maybe [Char]
info SomeException
e -> do
([Char] -> FormatM ()) -> Maybe [Char] -> FormatM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [Char] -> FormatM ()
indent Maybe [Char]
info
SomeException -> [Char]
formatException <- (FormatConfig -> SomeException -> [Char])
-> FormatM (SomeException -> [Char])
forall a. (FormatConfig -> a) -> FormatM a
getConfigValue FormatConfig -> SomeException -> [Char]
formatConfigFormatException
FormatM () -> FormatM ()
forall a. FormatM a -> FormatM a
withFailColor (FormatM () -> FormatM ())
-> ([Char] -> FormatM ()) -> [Char] -> FormatM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> FormatM ()
indent ([Char] -> FormatM ()) -> [Char] -> FormatM ()
forall a b. (a -> b) -> a -> b
$ [Char]
"uncaught exception: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SomeException -> [Char]
formatException SomeException
e
FormatM () -> FormatM ()
unlessExpert (FormatM () -> FormatM ()) -> FormatM () -> FormatM ()
forall a b. (a -> b) -> a -> b
$ do
let path_ :: [Char]
path_ = (if Bool
unicode then [Char] -> [Char]
ushow else [Char] -> [Char]
forall a. Show a => a -> [Char]
show) (Path -> [Char]
joinPath Path
path)
[Char] -> FormatM ()
writeLine [Char]
""
Integer
seed <- FormatM Integer
usedSeed
[Char] -> FormatM ()
writeLine ([Char]
" To rerun use: --match " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
path_ [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" --seed " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
seed)
where
indentation :: [Char]
indentation = [Char]
" "
indent :: [Char] -> FormatM ()
indent = [Char] -> [Char] -> FormatM ()
indentBy [Char]
indentation
indentBy :: String -> String -> FormatM ()
indentBy :: [Char] -> [Char] -> FormatM ()
indentBy [Char]
indentation [Char]
message = do
[[Char]] -> ([Char] -> FormatM ()) -> FormatM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Char] -> [[Char]]
lines [Char]
message) (([Char] -> FormatM ()) -> FormatM ())
-> ([Char] -> FormatM ()) -> FormatM ()
forall a b. (a -> b) -> a -> b
$ \ [Char]
line -> do
[Char] -> FormatM ()
writeLine ([Char]
indentation [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
line)
data Chunk = Original String | Modified String | Info String | ModifiedChunks [ColorChunk]
deriving (Chunk -> Chunk -> Bool
(Chunk -> Chunk -> Bool) -> (Chunk -> Chunk -> Bool) -> Eq Chunk
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Chunk -> Chunk -> Bool
== :: Chunk -> Chunk -> Bool
$c/= :: Chunk -> Chunk -> Bool
/= :: Chunk -> Chunk -> Bool
Eq, Int -> Chunk -> [Char] -> [Char]
[Chunk] -> [Char] -> [Char]
Chunk -> [Char]
(Int -> Chunk -> [Char] -> [Char])
-> (Chunk -> [Char]) -> ([Chunk] -> [Char] -> [Char]) -> Show Chunk
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> Chunk -> [Char] -> [Char]
showsPrec :: Int -> Chunk -> [Char] -> [Char]
$cshow :: Chunk -> [Char]
show :: Chunk -> [Char]
$cshowList :: [Chunk] -> [Char] -> [Char]
showList :: [Chunk] -> [Char] -> [Char]
Show)
expectedChunks :: [LineDiff] -> [Chunk]
expectedChunks :: [LineDiff] -> [Chunk]
expectedChunks = (LineDiff -> [Chunk]) -> [LineDiff] -> [Chunk]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((LineDiff -> [Chunk]) -> [LineDiff] -> [Chunk])
-> (LineDiff -> [Chunk]) -> [LineDiff] -> [Chunk]
forall a b. (a -> b) -> a -> b
$ \ case
LinesBoth [[Char]]
a -> ([Char] -> Chunk) -> [[Char]] -> [Chunk]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Chunk
Original [[Char]]
a
LinesFirst [[Char]]
a -> ([Char] -> Chunk) -> [[Char]] -> [Chunk]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Chunk
Modified [[Char]]
a
LinesSecond [[Char]]
_ -> []
LinesOmitted Int
n -> [[Char] -> Chunk
Info ([Char] -> Chunk) -> [Char] -> Chunk
forall a b. (a -> b) -> a -> b
$ Int -> [Char]
formatOmittedLines Int
n]
SingleLineDiff [Diff]
diffs -> Chunk -> [Chunk]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (Chunk -> [Chunk])
-> ((Diff -> Maybe ColorChunk) -> Chunk)
-> (Diff -> Maybe ColorChunk)
-> [Chunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ColorChunk] -> Chunk
ModifiedChunks ([ColorChunk] -> Chunk)
-> ((Diff -> Maybe ColorChunk) -> [ColorChunk])
-> (Diff -> Maybe ColorChunk)
-> Chunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Diff -> Maybe ColorChunk) -> [Diff] -> [ColorChunk])
-> [Diff] -> (Diff -> Maybe ColorChunk) -> [ColorChunk]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Diff -> Maybe ColorChunk) -> [Diff] -> [ColorChunk]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [Diff]
diffs ((Diff -> Maybe ColorChunk) -> [Chunk])
-> (Diff -> Maybe ColorChunk) -> [Chunk]
forall a b. (a -> b) -> a -> b
$ \ case
First [Char]
a -> ColorChunk -> Maybe ColorChunk
forall a. a -> Maybe a
Just (ColorChunk -> Maybe ColorChunk) -> ColorChunk -> Maybe ColorChunk
forall a b. (a -> b) -> a -> b
$ [Char] -> ColorChunk
ColorChunk [Char]
a
Second [Char]
_ -> Maybe ColorChunk
forall a. Maybe a
Nothing
Both [Char]
a -> ColorChunk -> Maybe ColorChunk
forall a. a -> Maybe a
Just (ColorChunk -> Maybe ColorChunk) -> ColorChunk -> Maybe ColorChunk
forall a b. (a -> b) -> a -> b
$ [Char] -> ColorChunk
PlainChunk [Char]
a
actualChunks :: [LineDiff] -> [Chunk]
actualChunks :: [LineDiff] -> [Chunk]
actualChunks = (LineDiff -> [Chunk]) -> [LineDiff] -> [Chunk]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((LineDiff -> [Chunk]) -> [LineDiff] -> [Chunk])
-> (LineDiff -> [Chunk]) -> [LineDiff] -> [Chunk]
forall a b. (a -> b) -> a -> b
$ \ case
LinesBoth [[Char]]
a -> ([Char] -> Chunk) -> [[Char]] -> [Chunk]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Chunk
Original [[Char]]
a
LinesFirst [[Char]]
_ -> []
LinesSecond [[Char]]
a -> ([Char] -> Chunk) -> [[Char]] -> [Chunk]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Chunk
Modified [[Char]]
a
LinesOmitted Int
n -> [[Char] -> Chunk
Info ([Char] -> Chunk) -> [Char] -> Chunk
forall a b. (a -> b) -> a -> b
$ Int -> [Char]
formatOmittedLines Int
n]
SingleLineDiff [Diff]
diffs -> Chunk -> [Chunk]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (Chunk -> [Chunk])
-> ((Diff -> Maybe ColorChunk) -> Chunk)
-> (Diff -> Maybe ColorChunk)
-> [Chunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ColorChunk] -> Chunk
ModifiedChunks ([ColorChunk] -> Chunk)
-> ((Diff -> Maybe ColorChunk) -> [ColorChunk])
-> (Diff -> Maybe ColorChunk)
-> Chunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Diff -> Maybe ColorChunk) -> [Diff] -> [ColorChunk])
-> [Diff] -> (Diff -> Maybe ColorChunk) -> [ColorChunk]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Diff -> Maybe ColorChunk) -> [Diff] -> [ColorChunk]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [Diff]
diffs ((Diff -> Maybe ColorChunk) -> [Chunk])
-> (Diff -> Maybe ColorChunk) -> [Chunk]
forall a b. (a -> b) -> a -> b
$ \ case
First [Char]
_ -> Maybe ColorChunk
forall a. Maybe a
Nothing
Second [Char]
a -> ColorChunk -> Maybe ColorChunk
forall a. a -> Maybe a
Just (ColorChunk -> Maybe ColorChunk) -> ColorChunk -> Maybe ColorChunk
forall a b. (a -> b) -> a -> b
$ [Char] -> ColorChunk
ColorChunk [Char]
a
Both [Char]
a -> ColorChunk -> Maybe ColorChunk
forall a. a -> Maybe a
Just (ColorChunk -> Maybe ColorChunk) -> ColorChunk -> Maybe ColorChunk
forall a b. (a -> b) -> a -> b
$ [Char] -> ColorChunk
PlainChunk [Char]
a
data ColorChunk = PlainChunk String | ColorChunk String
deriving (ColorChunk -> ColorChunk -> Bool
(ColorChunk -> ColorChunk -> Bool)
-> (ColorChunk -> ColorChunk -> Bool) -> Eq ColorChunk
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ColorChunk -> ColorChunk -> Bool
== :: ColorChunk -> ColorChunk -> Bool
$c/= :: ColorChunk -> ColorChunk -> Bool
/= :: ColorChunk -> ColorChunk -> Bool
Eq, Int -> ColorChunk -> [Char] -> [Char]
[ColorChunk] -> [Char] -> [Char]
ColorChunk -> [Char]
(Int -> ColorChunk -> [Char] -> [Char])
-> (ColorChunk -> [Char])
-> ([ColorChunk] -> [Char] -> [Char])
-> Show ColorChunk
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> ColorChunk -> [Char] -> [Char]
showsPrec :: Int -> ColorChunk -> [Char] -> [Char]
$cshow :: ColorChunk -> [Char]
show :: ColorChunk -> [Char]
$cshowList :: [ColorChunk] -> [Char] -> [Char]
showList :: [ColorChunk] -> [Char] -> [Char]
Show)
formatOmittedLines :: Int -> String
formatOmittedLines :: Int -> [Char]
formatOmittedLines Int
n = [Char]
"@@ " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" lines omitted @@"
defaultFooter :: FormatM ()
= do
[Char] -> FormatM ()
writeLine ([Char] -> FormatM ()) -> FormatM [Char] -> FormatM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
(++)
([Char] -> [Char] -> [Char])
-> FormatM [Char] -> FormatM ([Char] -> [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> Seconds -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"Finished in %1.4f seconds" (Seconds -> [Char]) -> FormatM Seconds -> FormatM [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FormatM Seconds
getRealTime)
FormatM ([Char] -> [Char]) -> FormatM [Char] -> FormatM [Char]
forall a b. FormatM (a -> b) -> FormatM a -> FormatM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([Char] -> (Seconds -> [Char]) -> Maybe Seconds -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"" ([Char] -> Seconds -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
", used %1.4f seconds of CPU time") (Maybe Seconds -> [Char])
-> FormatM (Maybe Seconds) -> FormatM [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FormatM (Maybe Seconds)
getCPUTime)
Int
fails <- FormatM Int
getFailCount
Int
pending <- FormatM Int
getPendingCount
Int
total <- FormatM Int
getTotalCount
let
output :: [Char]
output =
Int -> [Char] -> [Char]
pluralize Int
total [Char]
"example"
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
", " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char] -> [Char]
pluralize Int
fails [Char]
"failure"
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ if Int
pending Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then [Char]
"" else [Char]
", " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
pending [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" pending"
color :: FormatM a -> FormatM a
color
| Int
fails Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 = FormatM a -> FormatM a
forall a. FormatM a -> FormatM a
withFailColor
| Int
pending Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 = FormatM a -> FormatM a
forall a. FormatM a -> FormatM a
withPendingColor
| Bool
otherwise = FormatM a -> FormatM a
forall a. FormatM a -> FormatM a
withSuccessColor
FormatM () -> FormatM ()
forall a. FormatM a -> FormatM a
color (FormatM () -> FormatM ()) -> FormatM () -> FormatM ()
forall a b. (a -> b) -> a -> b
$ [Char] -> FormatM ()
writeLine [Char]
output
formatLocation :: Location -> String
formatLocation :: Location -> [Char]
formatLocation (Location [Char]
file Int
line Int
column) = [Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
":" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
line [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
":" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
column [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": "