{-# LANGUAGE CPP #-}
module Test.Hspec.Core.Formatters.V2 (
silent
, checks
, specdoc
, progress
, failed_examples
, Formatter (..)
, Item(..)
, Result(..)
, FailureReason (..)
, FormatM
, formatterToFormat
, getSuccessCount
, getPendingCount
, getFailCount
, getTotalCount
, FailureRecord (..)
, getFailMessages
, usedSeed
, printTimes
, Seconds(..)
, getCPUTime
, getRealTime
, write
, writeLine
, writeTransient
, withInfoColor
, withSuccessColor
, withPendingColor
, withFailColor
, useDiff
, extraChunk
, missingChunk
, formatLocation
, formatException
) where
import Prelude ()
import Test.Hspec.Core.Compat hiding (First)
import Data.Maybe
import Test.Hspec.Core.Util
import Test.Hspec.Core.Clock
import Test.Hspec.Core.Spec (Location(..))
import Text.Printf
import Control.Monad.IO.Class
import Control.Exception
import Test.Hspec.Core.Formatters.Monad (
Formatter (..)
, Item(..)
, Result(..)
, FailureReason (..)
, FormatM
, getSuccessCount
, getPendingCount
, getFailCount
, getTotalCount
, FailureRecord (..)
, getFailMessages
, usedSeed
, printTimes
, getCPUTime
, getRealTime
, write
, writeLine
, writeTransient
, withInfoColor
, withSuccessColor
, withPendingColor
, withFailColor
, useDiff
, extraChunk
, missingChunk
)
import Test.Hspec.Core.Formatters.Internal (formatterToFormat)
import Test.Hspec.Core.Formatters.Diff
silent :: Formatter
silent :: Formatter
silent = Formatter :: FormatM ()
-> (Path -> FormatM ())
-> (Path -> FormatM ())
-> (Path -> Progress -> FormatM ())
-> (Path -> FormatM ())
-> (Path -> Item -> FormatM ())
-> FormatM ()
-> Formatter
Formatter {
formatterStarted :: FormatM ()
formatterStarted = () -> FormatM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
, formatterGroupStarted :: Path -> FormatM ()
formatterGroupStarted = \ Path
_ -> () -> FormatM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
, formatterGroupDone :: Path -> FormatM ()
formatterGroupDone = \ Path
_ -> () -> FormatM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
, formatterProgress :: Path -> Progress -> FormatM ()
formatterProgress = \ Path
_ Progress
_ -> () -> FormatM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
, formatterItemStarted :: Path -> FormatM ()
formatterItemStarted = \ Path
_ -> () -> FormatM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
, formatterItemDone :: Path -> Item -> FormatM ()
formatterItemDone = \ Path
_ Item
_ -> () -> FormatM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
, formatterDone :: FormatM ()
formatterDone = () -> FormatM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
}
checks :: Formatter
checks :: Formatter
checks = Formatter
specdoc {
formatterProgress :: Path -> Progress -> FormatM ()
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 :: Path -> FormatM ()
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 :: Path -> Item -> FormatM ()
formatterItemDone = \ ([[Char]]
nesting, [Char]
requirement) Item
item -> do
((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]
"✔")
Pending {} -> (FormatM () -> FormatM ()
forall a. FormatM a -> FormatM a
withPendingColor, [Char]
"‐")
Failure {} -> (FormatM () -> FormatM ()
forall a. FormatM a -> FormatM a
withFailColor, [Char]
"✘")
case Item -> Result
itemResult Item
item of
Success {} -> () -> FormatM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Failure {} -> () -> FormatM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
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] -> 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]
"" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
nesting) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [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 (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 ()) -> FormatM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Char] -> [[Char]]
lines [Char]
info) (([Char] -> FormatM ()) -> FormatM ())
-> ([Char] -> FormatM ()) -> FormatM ()
forall a b. (a -> b) -> a -> b
$ \ [Char]
s ->
[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]
"" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
nesting) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
s
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 :: FormatM ()
formatterStarted = do
[Char] -> FormatM ()
writeLine [Char]
""
, formatterGroupStarted :: Path -> FormatM ()
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 -> FormatM ()
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 :: Path -> Item -> FormatM ()
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] -> 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]
"" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
nesting) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [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 :: FormatM ()
formatterDone = FormatM ()
defaultFailedFormatter FormatM () -> FormatM () -> FormatM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FormatM ()
defaultFooter
} where
indentationFor :: t a -> [Char]
indentationFor t a
nesting = Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (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 ()) -> FormatM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Char] -> [[Char]]
lines [Char]
info) (([Char] -> FormatM ()) -> FormatM ())
-> ([Char] -> FormatM ()) -> FormatM ()
forall a b. (a -> b) -> a -> b
$ \ [Char]
s ->
[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]
"" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
nesting) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
s
where
dt :: Int
dt :: Int
dt = Double -> Int
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 -> FormatM ()
formatterItemDone = \ Path
_ Item
item -> 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"
}
failed_examples :: Formatter
failed_examples :: Formatter
failed_examples = Formatter
silent {
formatterDone :: FormatM ()
formatterDone = FormatM ()
defaultFailedFormatter FormatM () -> FormatM () -> FormatM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FormatM ()
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 (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 () -> Free FormatF Integer -> Free FormatF Integer
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Free FormatF Integer
usedSeed Free FormatF Integer -> (Integer -> FormatM ()) -> FormatM ()
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
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 :: * -> *) a. Monad m => a -> m a
return ()
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
ExpectedButGot Maybe [Char]
preface [Char]
expected [Char]
actual -> 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]
preface
Bool
b <- FormatM Bool
useDiff
let threshold :: Seconds
threshold = Seconds
2 :: Seconds
Maybe [Diff [Char]]
mchunks <- IO (Maybe [Diff [Char]]) -> Free FormatF (Maybe [Diff [Char]])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe [Diff [Char]]) -> Free FormatF (Maybe [Diff [Char]]))
-> IO (Maybe [Diff [Char]]) -> Free FormatF (Maybe [Diff [Char]])
forall a b. (a -> b) -> a -> b
$ if Bool
b
then Seconds -> IO [Diff [Char]] -> IO (Maybe [Diff [Char]])
forall a. Seconds -> IO a -> IO (Maybe a)
timeout Seconds
threshold ([Diff [Char]] -> IO [Diff [Char]]
forall a. a -> IO a
evaluate ([Diff [Char]] -> IO [Diff [Char]])
-> [Diff [Char]] -> IO [Diff [Char]]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [Diff [Char]]
diff [Char]
expected [Char]
actual)
else Maybe [Diff [Char]] -> IO (Maybe [Diff [Char]])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Diff [Char]]
forall a. Maybe a
Nothing
case Maybe [Diff [Char]]
mchunks of
Just [Diff [Char]]
chunks -> do
[Diff [Char]]
-> ([Char] -> FormatM ()) -> ([Char] -> FormatM ()) -> FormatM ()
forall {t :: * -> *}.
Foldable t =>
t (Diff [Char])
-> ([Char] -> FormatM ()) -> ([Char] -> FormatM ()) -> FormatM ()
writeDiff [Diff [Char]]
chunks [Char] -> FormatM ()
extraChunk [Char] -> FormatM ()
missingChunk
Maybe [Diff [Char]]
Nothing -> do
[Diff [Char]]
-> ([Char] -> FormatM ()) -> ([Char] -> FormatM ()) -> FormatM ()
forall {t :: * -> *}.
Foldable t =>
t (Diff [Char])
-> ([Char] -> FormatM ()) -> ([Char] -> FormatM ()) -> FormatM ()
writeDiff [[Char] -> Diff [Char]
forall a. a -> Diff a
First [Char]
expected, [Char] -> Diff [Char]
forall a. a -> Diff a
Second [Char]
actual] [Char] -> FormatM ()
write [Char] -> FormatM ()
write
where
indented :: ([Char] -> Free FormatF a) -> [Char] -> Free FormatF a
indented [Char] -> Free FormatF a
output [Char]
text = 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]
text of
([Char]
xs, [Char]
"") -> [Char] -> Free FormatF a
output [Char]
xs
([Char]
xs, Char
_ : [Char]
ys) -> [Char] -> Free FormatF a
output ([Char]
xs [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n") Free FormatF a -> FormatM () -> FormatM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> FormatM ()
write ([Char]
indentation [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" ") FormatM () -> Free FormatF a -> Free FormatF a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ([Char] -> Free FormatF a) -> [Char] -> Free FormatF a
indented [Char] -> Free FormatF a
output [Char]
ys
writeDiff :: t (Diff [Char])
-> ([Char] -> FormatM ()) -> ([Char] -> FormatM ()) -> FormatM ()
writeDiff t (Diff [Char])
chunks [Char] -> FormatM ()
extra [Char] -> FormatM ()
missing = 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]
"expected: ")
t (Diff [Char]) -> (Diff [Char] -> FormatM ()) -> FormatM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ t (Diff [Char])
chunks ((Diff [Char] -> FormatM ()) -> FormatM ())
-> (Diff [Char] -> FormatM ()) -> FormatM ()
forall a b. (a -> b) -> a -> b
$ \ Diff [Char]
chunk -> case Diff [Char]
chunk of
Both [Char]
a [Char]
_ -> ([Char] -> FormatM ()) -> [Char] -> FormatM ()
forall {a}. ([Char] -> Free FormatF a) -> [Char] -> Free FormatF a
indented [Char] -> FormatM ()
write [Char]
a
First [Char]
a -> ([Char] -> FormatM ()) -> [Char] -> FormatM ()
forall {a}. ([Char] -> Free FormatF a) -> [Char] -> Free FormatF a
indented [Char] -> FormatM ()
extra [Char]
a
Second [Char]
_ -> () -> FormatM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
[Char] -> FormatM ()
writeLine [Char]
""
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]
" but got: ")
t (Diff [Char]) -> (Diff [Char] -> FormatM ()) -> FormatM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ t (Diff [Char])
chunks ((Diff [Char] -> FormatM ()) -> FormatM ())
-> (Diff [Char] -> FormatM ()) -> FormatM ()
forall a b. (a -> b) -> a -> b
$ \ Diff [Char]
chunk -> case Diff [Char]
chunk of
Both [Char]
a [Char]
_ -> ([Char] -> FormatM ()) -> [Char] -> FormatM ()
forall {a}. ([Char] -> Free FormatF a) -> [Char] -> Free FormatF a
indented [Char] -> FormatM ()
write [Char]
a
First [Char]
_ -> () -> FormatM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Second [Char]
a -> ([Char] -> FormatM ()) -> [Char] -> FormatM ()
forall {a}. ([Char] -> Free FormatF a) -> [Char] -> Free FormatF a
indented [Char] -> FormatM ()
missing [Char]
a
[Char] -> FormatM ()
writeLine [Char]
""
Error Maybe [Char]
_ SomeException
e -> 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]
++) ([Char] -> [Char])
-> (SomeException -> [Char]) -> SomeException -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> [Char]
formatException) SomeException
e
[Char] -> FormatM ()
writeLine [Char]
""
[Char] -> FormatM ()
writeLine ([Char]
" To rerun use: --match " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
forall a. Show a => a -> [Char]
show (Path -> [Char]
joinPath Path
path))
where
indentation :: [Char]
indentation = [Char]
" "
indent :: [Char] -> FormatM ()
indent [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)
defaultFooter :: FormatM ()
= do
[Char] -> FormatM ()
writeLine ([Char] -> FormatM ()) -> Free FormatF [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])
-> Free FormatF [Char] -> Free FormatF ([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]) -> Free FormatF Seconds -> Free FormatF [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Free FormatF Seconds
getRealTime)
Free FormatF ([Char] -> [Char])
-> Free FormatF [Char] -> Free FormatF [Char]
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])
-> Free FormatF (Maybe Seconds) -> Free FormatF [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Free FormatF (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"
c :: FormatM a -> FormatM a
c | 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
c (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]
": "