module Test.Reporter.Stdout
( report,
)
where
import qualified Control.Exception as Exception
import qualified Data.ByteString as BS
import qualified GHC.Stack as Stack
import qualified List
import NriPrelude
import qualified System.IO
import qualified Test.Internal as Internal
import Test.Reporter.Internal (black, green, grey, red, yellow)
import qualified Test.Reporter.Internal
import qualified Text
import Text.Colour (chunk)
import qualified Text.Colour
import qualified Tuple
import qualified Prelude
report :: System.IO.Handle -> Internal.SuiteResult -> Prelude.IO ()
report :: Handle -> SuiteResult -> IO ()
report Handle
handle SuiteResult
results = do
TerminalCapabilities
terminalCapabilities <- Handle -> IO TerminalCapabilities
Text.Colour.getTerminalCapabilitiesFromHandle Handle
handle
List Chunk
reportChunks <- SuiteResult -> IO (List Chunk)
renderReport SuiteResult
results
TerminalCapabilities -> Handle -> List Chunk -> IO ()
Text.Colour.hPutChunksWith TerminalCapabilities
terminalCapabilities Handle
handle List Chunk
reportChunks
Handle -> IO ()
System.IO.hFlush Handle
handle
renderReport :: Internal.SuiteResult -> Prelude.IO (List (Text.Colour.Chunk))
renderReport :: SuiteResult -> IO (List Chunk)
renderReport SuiteResult
results =
case SuiteResult
results of
Internal.AllPassed [SingleTest TracingSpan]
passed ->
let amountPassed :: Int
amountPassed = [SingleTest TracingSpan] -> Int
forall a. List a -> Int
List.length [SingleTest TracingSpan]
passed
in List Chunk -> IO (List Chunk)
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure
[ Chunk -> Chunk
green (Chunk -> Chunk
Text.Colour.underline Chunk
"TEST RUN PASSED"),
Chunk
"\n\n",
Chunk -> Chunk
black (Text -> Chunk
chunk (Text -> Chunk) -> Text -> Chunk
forall a b. (a -> b) -> a -> b
<| Text
"Passed: " Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Int -> Text
Text.fromInt Int
amountPassed),
Chunk
"\n"
]
Internal.OnlysPassed [SingleTest TracingSpan]
passed [SingleTest NotRan]
skipped ->
let amountPassed :: Int
amountPassed = [SingleTest TracingSpan] -> Int
forall a. List a -> Int
List.length [SingleTest TracingSpan]
passed
amountSkipped :: Int
amountSkipped = [SingleTest NotRan] -> Int
forall a. List a -> Int
List.length [SingleTest NotRan]
skipped
in List Chunk -> IO (List Chunk)
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure
(List Chunk -> IO (List Chunk)) -> List Chunk -> IO (List Chunk)
forall a b. (a -> b) -> a -> b
<| List (List Chunk) -> List Chunk
forall a. List (List a) -> List a
List.concat
[ (SingleTest TracingSpan -> List Chunk)
-> [SingleTest TracingSpan] -> List Chunk
forall a b. (a -> List b) -> List a -> List b
List.concatMap
( \SingleTest TracingSpan
only ->
(Chunk -> Chunk) -> SingleTest TracingSpan -> List Chunk
forall a. (Chunk -> Chunk) -> SingleTest a -> List Chunk
prettyPath Chunk -> Chunk
yellow SingleTest TracingSpan
only
List Chunk -> List Chunk -> List Chunk
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ [ Chunk
"This test passed, but there is a `Test.only` in your test.\n",
Chunk
"I failed the test, because it's easy to forget to remove `Test.only`.\n",
Chunk
"\n\n"
]
)
[SingleTest TracingSpan]
passed,
[ Chunk -> Chunk
yellow (Chunk -> Chunk
Text.Colour.underline (Chunk
"TEST RUN INCOMPLETE")),
Chunk -> Chunk
yellow Chunk
" because there is an `only` in your tests.",
Chunk
"\n\n",
Chunk -> Chunk
black (Text -> Chunk
chunk (Text -> Chunk) -> Text -> Chunk
forall a b. (a -> b) -> a -> b
<| Text
"Passed: " Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Int -> Text
Text.fromInt Int
amountPassed),
Chunk
"\n",
Chunk -> Chunk
black (Text -> Chunk
chunk (Text -> Chunk) -> Text -> Chunk
forall a b. (a -> b) -> a -> b
<| Text
"Skipped: " Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Int -> Text
Text.fromInt Int
amountSkipped),
Chunk
"\n"
]
]
Internal.PassedWithSkipped [SingleTest TracingSpan]
passed [SingleTest NotRan]
skipped ->
let amountPassed :: Int
amountPassed = [SingleTest TracingSpan] -> Int
forall a. List a -> Int
List.length [SingleTest TracingSpan]
passed
amountSkipped :: Int
amountSkipped = [SingleTest NotRan] -> Int
forall a. List a -> Int
List.length [SingleTest NotRan]
skipped
in List Chunk -> IO (List Chunk)
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure
(List Chunk -> IO (List Chunk)) -> List Chunk -> IO (List Chunk)
forall a b. (a -> b) -> a -> b
<| List (List Chunk) -> List Chunk
forall a. List (List a) -> List a
List.concat
[ (SingleTest NotRan -> List Chunk)
-> [SingleTest NotRan] -> List Chunk
forall a b. (a -> List b) -> List a -> List b
List.concatMap
( \SingleTest NotRan
only ->
(Chunk -> Chunk) -> SingleTest NotRan -> List Chunk
forall a. (Chunk -> Chunk) -> SingleTest a -> List Chunk
prettyPath Chunk -> Chunk
yellow SingleTest NotRan
only
List Chunk -> List Chunk -> List Chunk
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ [ Chunk
"This test was skipped.",
Chunk
"\n\n"
]
)
[SingleTest NotRan]
skipped,
[ Chunk -> Chunk
yellow (Chunk -> Chunk
Text.Colour.underline Chunk
"TEST RUN INCOMPLETE"),
Chunk -> Chunk
yellow
( Text -> Chunk
chunk (Text -> Chunk) -> Text -> Chunk
forall a b. (a -> b) -> a -> b
<| case [SingleTest NotRan] -> Int
forall a. List a -> Int
List.length [SingleTest NotRan]
skipped of
Int
1 -> Text
" because 1 test was skipped"
Int
n -> Text
" because " Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Int -> Text
Text.fromInt Int
n Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
" tests were skipped"
),
Chunk
"\n\n",
Chunk -> Chunk
black (Text -> Chunk
chunk (Text -> Chunk) -> Text -> Chunk
forall a b. (a -> b) -> a -> b
<| Text
"Passed: " Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Int -> Text
Text.fromInt Int
amountPassed),
Chunk
"\n",
Chunk -> Chunk
black (Text -> Chunk
chunk (Text -> Chunk) -> Text -> Chunk
forall a b. (a -> b) -> a -> b
<| Text
"Skipped: " Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Int -> Text
Text.fromInt Int
amountSkipped),
Chunk
"\n"
]
]
Internal.TestsFailed [SingleTest TracingSpan]
passed [SingleTest NotRan]
skipped [SingleTest (TracingSpan, Failure)]
failed -> do
let amountPassed :: Int
amountPassed = [SingleTest TracingSpan] -> Int
forall a. List a -> Int
List.length [SingleTest TracingSpan]
passed
let amountFailed :: Int
amountFailed = [SingleTest (TracingSpan, Failure)] -> Int
forall a. List a -> Int
List.length [SingleTest (TracingSpan, Failure)]
failed
let amountSkipped :: Int
amountSkipped = [SingleTest NotRan] -> Int
forall a. List a -> Int
List.length [SingleTest NotRan]
skipped
let failures :: List (SingleTest Failure)
failures = (SingleTest (TracingSpan, Failure) -> SingleTest Failure)
-> [SingleTest (TracingSpan, Failure)] -> List (SingleTest Failure)
forall a b. (a -> b) -> List a -> List b
List.map (((TracingSpan, Failure) -> Failure)
-> SingleTest (TracingSpan, Failure) -> SingleTest Failure
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map (TracingSpan, Failure) -> Failure
forall a b. (a, b) -> b
Tuple.second) [SingleTest (TracingSpan, Failure)]
failed
[Maybe (SrcLoc, ByteString)]
srcLocs <- (SingleTest Failure -> IO (Maybe (SrcLoc, ByteString)))
-> List (SingleTest Failure) -> IO [Maybe (SrcLoc, ByteString)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Prelude.traverse SingleTest Failure -> IO (Maybe (SrcLoc, ByteString))
Test.Reporter.Internal.readSrcLoc List (SingleTest Failure)
failures
let failuresSrcs :: List (List Chunk)
failuresSrcs = (Maybe (SrcLoc, ByteString) -> List Chunk)
-> [Maybe (SrcLoc, ByteString)] -> List (List Chunk)
forall a b. (a -> b) -> List a -> List b
List.map Maybe (SrcLoc, ByteString) -> List Chunk
renderFailureInFile [Maybe (SrcLoc, ByteString)]
srcLocs
List Chunk -> IO (List Chunk)
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure
(List Chunk -> IO (List Chunk)) -> List Chunk -> IO (List Chunk)
forall a b. (a -> b) -> a -> b
<| List (List Chunk) -> List Chunk
forall a. List (List a) -> List a
List.concat
[ List (List Chunk) -> List Chunk
forall a. List (List a) -> List a
List.concat
(List (List Chunk) -> List Chunk)
-> List (List Chunk) -> List Chunk
forall a b. (a -> b) -> a -> b
<| (List Chunk -> SingleTest Failure -> List Chunk)
-> List (List Chunk)
-> List (SingleTest Failure)
-> List (List Chunk)
forall a b result.
(a -> b -> result) -> List a -> List b -> List result
List.map2
( \List Chunk
srcLines SingleTest Failure
test ->
(Chunk -> Chunk) -> SingleTest Failure -> List Chunk
forall a. (Chunk -> Chunk) -> SingleTest a -> List Chunk
prettyPath Chunk -> Chunk
red SingleTest Failure
test
List Chunk -> List Chunk -> List Chunk
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ List Chunk
srcLines
List Chunk -> List Chunk -> List Chunk
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ [SingleTest Failure -> Chunk
testFailure SingleTest Failure
test, Chunk
"\n\n"]
)
List (List Chunk)
failuresSrcs
List (SingleTest Failure)
failures,
[ Chunk -> Chunk
red (Chunk -> Chunk
Text.Colour.underline Chunk
"TEST RUN FAILED"),
Chunk
"\n\n",
Chunk -> Chunk
black (Text -> Chunk
chunk (Text -> Chunk) -> Text -> Chunk
forall a b. (a -> b) -> a -> b
<| Text
"Passed: " Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Int -> Text
Text.fromInt Int
amountPassed),
Chunk
"\n"
],
if Int
amountSkipped Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then []
else
[ Chunk -> Chunk
black (Text -> Chunk
chunk (Text -> Chunk) -> Text -> Chunk
forall a b. (a -> b) -> a -> b
<| Text
"Skipped: " Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Int -> Text
Text.fromInt Int
amountSkipped),
Chunk
"\n"
],
[Chunk -> Chunk
black (Text -> Chunk
chunk (Text -> Chunk) -> Text -> Chunk
forall a b. (a -> b) -> a -> b
<| Text
"Failed: " Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Int -> Text
Text.fromInt Int
amountFailed), Chunk
"\n"]
]
SuiteResult
Internal.NoTestsInSuite ->
List Chunk -> IO (List Chunk)
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure
[ Chunk -> Chunk
yellow (Chunk -> Chunk
Text.Colour.underline Chunk
"TEST RUN INCOMPLETE"),
Chunk -> Chunk
yellow Chunk
" because the test suite is empty.",
Chunk
"\n"
]
renderFailureInFile :: Maybe (Stack.SrcLoc, BS.ByteString) -> List Text.Colour.Chunk
renderFailureInFile :: Maybe (SrcLoc, ByteString) -> List Chunk
renderFailureInFile Maybe (SrcLoc, ByteString)
maybeSrcLoc =
case Maybe (SrcLoc, ByteString)
maybeSrcLoc of
Just (SrcLoc
loc, ByteString
src) -> SrcLoc -> ByteString -> List Chunk
Test.Reporter.Internal.renderSrcLoc SrcLoc
loc ByteString
src
Maybe (SrcLoc, ByteString)
Nothing -> []
prettyPath :: (Text.Colour.Chunk -> Text.Colour.Chunk) -> Internal.SingleTest a -> List Text.Colour.Chunk
prettyPath :: (Chunk -> Chunk) -> SingleTest a -> List Chunk
prettyPath Chunk -> Chunk
style SingleTest a
test =
List (List Chunk) -> List Chunk
forall a. List (List a) -> List a
List.concat
[ case SingleTest a -> Maybe SrcLoc
forall a. SingleTest a -> Maybe SrcLoc
Internal.loc SingleTest a
test of
Maybe SrcLoc
Nothing -> []
Just SrcLoc
loc ->
[ Chunk -> Chunk
grey
(Chunk -> Chunk) -> Chunk -> Chunk
forall a b. (a -> b) -> a -> b
<| Text -> Chunk
chunk
( Text
"↓ "
Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ List Char -> Text
Text.fromList (SrcLoc -> List Char
Stack.srcLocFile SrcLoc
loc)
Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
":"
Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Int -> Text
Text.fromInt (Int -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (SrcLoc -> Int
Stack.srcLocStartLine SrcLoc
loc))
Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
"\n"
)
],
[ Chunk -> Chunk
grey
( Text -> Chunk
chunk
(Text -> Chunk) -> Text -> Chunk
forall a b. (a -> b) -> a -> b
<| (Text -> Text) -> [Text] -> Text
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Prelude.foldMap
(\Text
text -> Text
"↓ " Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
text Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
"\n")
(SingleTest a -> [Text]
forall a. SingleTest a -> [Text]
Internal.describes SingleTest a
test)
),
Chunk -> Chunk
style (Text -> Chunk
chunk (Text
"✗ " Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ SingleTest a -> Text
forall a. SingleTest a -> Text
Internal.name SingleTest a
test)),
Chunk
"\n"
]
]
testFailure :: Internal.SingleTest Internal.Failure -> Text.Colour.Chunk
testFailure :: SingleTest Failure -> Chunk
testFailure SingleTest Failure
test =
Text -> Chunk
chunk
(Text -> Chunk) -> Text -> Chunk
forall a b. (a -> b) -> a -> b
<| case SingleTest Failure -> Failure
forall a. SingleTest a -> a
Internal.body SingleTest Failure
test of
Internal.FailedAssertion Text
msg Maybe SrcLoc
_ -> Text
msg
Internal.ThrewException SomeException
exception ->
Text
"Test threw an exception\n"
Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ List Char -> Text
Text.fromList (SomeException -> List Char
forall e. Exception e => e -> List Char
Exception.displayException SomeException
exception)
Failure
Internal.TookTooLong -> Text
"Test timed out"
Internal.TestRunnerMessedUp Text
msg ->
Text
"Test runner encountered an unexpected error:\n"
Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
msg
Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
"\n"
Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
"This is a bug.\n\n"
Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
"If you have some time to report the bug it would be much appreciated!\n"
Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
"You can do so here: https://github.com/NoRedInk/haskell-libraries/issues"