-- | Module for presenting test results on the console.
--
-- Lifted in large part from: https://github.com/stoeffel/tasty-test-reporter
module Test.Reporter.Stdout
  ( report,
  )
where

import qualified Control.Exception as Exception
import qualified Data.ByteString as BS
import qualified Data.ByteString.Builder as Builder
import qualified Data.Text.Encoding as TE
import qualified GHC.Stack as Stack
import qualified List
import NriPrelude
import qualified System.Console.ANSI as ANSI
import qualified System.Directory
import System.FilePath ((</>))
import qualified System.IO
import qualified Test.Internal as Internal
import qualified Tuple
import qualified Prelude

report :: System.IO.Handle -> Internal.SuiteResult -> Prelude.IO ()
report :: Handle -> SuiteResult -> IO ()
report Handle
handle SuiteResult
results = do
  Bool
color <- Handle -> IO Bool
ANSI.hSupportsANSIColor Handle
handle
  let styled :: [SGR] -> Builder -> Builder
styled =
        if Bool
color
          then (\[SGR]
styles Builder
builder -> [SGR] -> Builder
sgr [SGR]
styles Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Builder
builder Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ [SGR] -> Builder
sgr [SGR
ANSI.Reset])
          else (\[SGR]
_ Builder
builder -> Builder
builder)
  Builder
reportByteString <- ([SGR] -> Builder -> Builder) -> SuiteResult -> IO Builder
renderReport [SGR] -> Builder -> Builder
styled SuiteResult
results
  Handle -> Builder -> IO ()
Builder.hPutBuilder Handle
handle Builder
reportByteString
  Handle -> IO ()
System.IO.hFlush Handle
handle

renderReport ::
  ([ANSI.SGR] -> Builder.Builder -> Builder.Builder) ->
  Internal.SuiteResult ->
  Prelude.IO Builder.Builder
renderReport :: ([SGR] -> Builder -> Builder) -> SuiteResult -> IO Builder
renderReport [SGR] -> Builder -> Builder
styled 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 Builder -> IO Builder
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure
            ( [SGR] -> Builder -> Builder
styled [SGR
green, SGR
underlined] Builder
"TEST RUN PASSED"
                Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Builder
"\n\n"
                Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ [SGR] -> Builder -> Builder
styled [SGR
black] (Builder
"Passed:    " Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Int -> Builder
Builder.int64Dec Int
amountPassed)
                Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Builder
"\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 Builder -> IO Builder
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure
            ( (SingleTest TracingSpan -> Builder)
-> [SingleTest TracingSpan] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Prelude.foldMap
                ( \SingleTest TracingSpan
only ->
                    ([SGR] -> Builder -> Builder)
-> [SGR] -> SingleTest TracingSpan -> Builder
forall a.
([SGR] -> Builder -> Builder) -> [SGR] -> SingleTest a -> Builder
prettyPath [SGR] -> Builder -> Builder
styled [SGR
yellow] SingleTest TracingSpan
only
                      Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Builder
"This test passed, but there is a `Test.only` in your test.\n"
                      Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Builder
"I failed the test, because it's easy to forget to remove `Test.only`.\n"
                      Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Builder
"\n\n"
                )
                [SingleTest TracingSpan]
passed
                Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ [SGR] -> Builder -> Builder
styled [SGR
yellow, SGR
underlined] Builder
"TEST RUN INCOMPLETE"
                Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ [SGR] -> Builder -> Builder
styled [SGR
yellow] Builder
" because there is an `only` in your tests."
                Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Builder
"\n\n"
                Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ [SGR] -> Builder -> Builder
styled [SGR
black] (Builder
"Passed:    " Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Int -> Builder
Builder.int64Dec Int
amountPassed)
                Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Builder
"\n"
                Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ [SGR] -> Builder -> Builder
styled [SGR
black] (Builder
"Skipped:   " Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Int -> Builder
Builder.int64Dec Int
amountSkipped)
                Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Builder
"\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 Builder -> IO Builder
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure
            ( (SingleTest NotRan -> Builder) -> [SingleTest NotRan] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Prelude.foldMap
                ( \SingleTest NotRan
only ->
                    ([SGR] -> Builder -> Builder)
-> [SGR] -> SingleTest NotRan -> Builder
forall a.
([SGR] -> Builder -> Builder) -> [SGR] -> SingleTest a -> Builder
prettyPath [SGR] -> Builder -> Builder
styled [SGR
yellow] SingleTest NotRan
only
                      Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Builder
"This test was skipped."
                      Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Builder
"\n\n"
                )
                [SingleTest NotRan]
skipped
                Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ [SGR] -> Builder -> Builder
styled [SGR
yellow, SGR
underlined] Builder
"TEST RUN INCOMPLETE"
                Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ [SGR] -> Builder -> Builder
styled
                  [SGR
yellow]
                  ( case [SingleTest NotRan] -> Int
forall a. List a -> Int
List.length [SingleTest NotRan]
skipped of
                      Int
1 -> Builder
" because 1 test was skipped"
                      Int
n -> Builder
" because " Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Int -> Builder
Builder.int64Dec Int
n Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Builder
" tests were skipped"
                  )
                Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Builder
"\n\n"
                Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ [SGR] -> Builder -> Builder
styled [SGR
black] (Builder
"Passed:    " Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Int -> Builder
Builder.int64Dec Int
amountPassed)
                Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Builder
"\n"
                Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ [SGR] -> Builder -> Builder
styled [SGR
black] (Builder
"Skipped:   " Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Int -> Builder
Builder.int64Dec Int
amountSkipped)
                Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Builder
"\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
      [Builder]
failuresSrcs <- (SingleTest Failure -> IO Builder)
-> List (SingleTest Failure) -> IO [Builder]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Prelude.traverse (([SGR] -> Builder -> Builder) -> SingleTest Failure -> IO Builder
renderFailureInFile [SGR] -> Builder -> Builder
styled) List (SingleTest Failure)
failures
      Builder -> IO Builder
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure
        ( ((Builder, SingleTest Failure) -> Builder)
-> [(Builder, SingleTest Failure)] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Prelude.foldMap
            ( \(Builder
srcLines, SingleTest Failure
test) ->
                ([SGR] -> Builder -> Builder)
-> [SGR] -> SingleTest Failure -> Builder
forall a.
([SGR] -> Builder -> Builder) -> [SGR] -> SingleTest a -> Builder
prettyPath [SGR] -> Builder -> Builder
styled [SGR
red] SingleTest Failure
test
                  Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Builder
srcLines
                  Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ SingleTest Failure -> Builder
testFailure SingleTest Failure
test
                  Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Builder
"\n\n"
            )
            ((Builder -> SingleTest Failure -> (Builder, SingleTest Failure))
-> [Builder]
-> List (SingleTest Failure)
-> [(Builder, SingleTest Failure)]
forall a b result.
(a -> b -> result) -> List a -> List b -> List result
List.map2 (,) [Builder]
failuresSrcs List (SingleTest Failure)
failures)
            Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ [SGR] -> Builder -> Builder
styled [SGR
red, SGR
underlined] Builder
"TEST RUN FAILED"
            Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Builder
"\n\n"
            Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ [SGR] -> Builder -> Builder
styled [SGR
black] (Builder
"Passed:    " Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Int -> Builder
Builder.int64Dec Int
amountPassed)
            Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Builder
"\n"
            Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ ( if Int
amountSkipped Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                   then Builder
""
                   else
                     [SGR] -> Builder -> Builder
styled [SGR
black] (Builder
"Skipped:   " Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Int -> Builder
Builder.int64Dec Int
amountSkipped)
                       Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Builder
"\n"
               )
            Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ [SGR] -> Builder -> Builder
styled [SGR
black] (Builder
"Failed:    " Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Int -> Builder
Builder.int64Dec Int
amountFailed)
            Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Builder
"\n"
        )
    SuiteResult
Internal.NoTestsInSuite ->
      Builder -> IO Builder
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure
        ( [SGR] -> Builder -> Builder
styled [SGR
yellow, SGR
underlined] Builder
"TEST RUN INCOMPLETE"
            Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ [SGR] -> Builder -> Builder
styled [SGR
yellow] (Builder
" because the test suite is empty.")
            Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Builder
"\n"
        )

extraLinesOnFailure :: Int
extraLinesOnFailure :: Int
extraLinesOnFailure = Int
2

renderFailureInFile ::
  ([ANSI.SGR] -> Builder.Builder -> Builder.Builder) ->
  Internal.SingleTest Internal.Failure ->
  Prelude.IO Builder.Builder
renderFailureInFile :: ([SGR] -> Builder -> Builder) -> SingleTest Failure -> IO Builder
renderFailureInFile [SGR] -> Builder -> Builder
styled SingleTest Failure
test =
  case SingleTest Failure -> Failure
forall a. SingleTest a -> a
Internal.body SingleTest Failure
test of
    Internal.FailedAssertion Text
_ (Just SrcLoc
loc) -> do
      FilePath
cwd <- IO FilePath
System.Directory.getCurrentDirectory
      let path :: FilePath
path = FilePath
cwd FilePath -> FilePath -> FilePath
</> SrcLoc -> FilePath
Stack.srcLocFile SrcLoc
loc
      Bool
exists <- FilePath -> IO Bool
System.Directory.doesFileExist FilePath
path
      if Bool
exists
        then do
          ByteString
contents <- FilePath -> IO ByteString
BS.readFile FilePath
path
          let startLine :: Int
startLine = Int -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (SrcLoc -> Int
Stack.srcLocStartLine SrcLoc
loc)
          let lines :: [Builder]
lines =
                ByteString
contents
                  ByteString -> (ByteString -> [ByteString]) -> [ByteString]
forall a b. a -> (a -> b) -> b
|> Word8 -> ByteString -> [ByteString]
BS.split Word8
10 -- splitting newlines
                  [ByteString] -> ([ByteString] -> [ByteString]) -> [ByteString]
forall a b. a -> (a -> b) -> b
|> Int -> [ByteString] -> [ByteString]
forall a. Int -> List a -> List a
List.drop (Int
startLine Int -> Int -> Int
forall number. Num number => number -> number -> number
- Int
extraLinesOnFailure Int -> Int -> Int
forall number. Num number => number -> number -> number
- Int
1)
                  [ByteString] -> ([ByteString] -> [ByteString]) -> [ByteString]
forall a b. a -> (a -> b) -> b
|> Int -> [ByteString] -> [ByteString]
forall a. Int -> List a -> List a
List.take (Int
extraLinesOnFailure Int -> Int -> Int
forall number. Num number => number -> number -> number
* Int
2 Int -> Int -> Int
forall number. Num number => number -> number -> number
+ Int
1)
                  [ByteString] -> ([ByteString] -> [Builder]) -> [Builder]
forall a b. a -> (a -> b) -> b
|> (Int -> ByteString -> Builder) -> [ByteString] -> [Builder]
forall a b. (Int -> a -> b) -> List a -> List b
List.indexedMap
                    ( \Int
i ByteString
l ->
                        Int -> Builder
Builder.intDec
                          ( Int -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral
                              (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
<| Int
startLine Int -> Int -> Int
forall number. Num number => number -> number -> number
+ Int
i Int -> Int -> Int
forall number. Num number => number -> number -> number
- Int
extraLinesOnFailure
                          )
                          Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Builder
": "
                          Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ ByteString -> Builder
Builder.byteString ByteString
l
                    )
          Builder -> IO Builder
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (Builder -> IO Builder) -> Builder -> IO Builder
forall a b. (a -> b) -> a -> b
<| case [Builder]
lines of
            [] -> Builder
""
            [Builder]
lines' ->
              Builder
"\n"
                Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Builder
"Expectation failed at "
                Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ FilePath -> Builder
Builder.stringUtf8 (SrcLoc -> FilePath
Stack.srcLocFile SrcLoc
loc)
                Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Builder
":"
                Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Int -> Builder
Builder.intDec (SrcLoc -> Int
Stack.srcLocStartLine SrcLoc
loc)
                Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Builder
"\n"
                Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ ((Int, Builder) -> Builder) -> [(Int, Builder)] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Prelude.foldMap
                  ( \(Int
nr, Builder
line) ->
                      if Int
nr Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
extraLinesOnFailure
                        then [SGR] -> Builder -> Builder
styled [SGR
red] (Builder
"✗ " Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Builder
line) Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Builder
"\n"
                        else Builder
"  " Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ [SGR] -> Builder -> Builder
styled [SGR
dullGrey] Builder
line Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Builder
"\n"
                  )
                  ((Int -> Builder -> (Int, Builder)) -> [Builder] -> [(Int, Builder)]
forall a b. (Int -> a -> b) -> List a -> List b
List.indexedMap (,) [Builder]
lines')
                Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Builder
"\n"
        else Builder -> IO Builder
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure Builder
""
    Failure
_ -> Builder -> IO Builder
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure Builder
""

prettyPath ::
  ([ANSI.SGR] -> Builder.Builder -> Builder.Builder) ->
  [ANSI.SGR] ->
  Internal.SingleTest a ->
  Builder.Builder
prettyPath :: ([SGR] -> Builder -> Builder) -> [SGR] -> SingleTest a -> Builder
prettyPath [SGR] -> Builder -> Builder
styled [SGR]
styles SingleTest a
test =
  ( case SingleTest a -> Maybe SrcLoc
forall a. SingleTest a -> Maybe SrcLoc
Internal.loc SingleTest a
test of
      Maybe SrcLoc
Nothing -> Builder
""
      Just SrcLoc
loc ->
        [SGR] -> Builder -> Builder
styled
          [SGR
grey]
          ( Builder
"↓ "
              Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ FilePath -> Builder
Builder.stringUtf8 (SrcLoc -> FilePath
Stack.srcLocFile SrcLoc
loc)
              Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Builder
":"
              Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Int -> Builder
Builder.intDec (SrcLoc -> Int
Stack.srcLocStartLine SrcLoc
loc)
              Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Builder
"\n"
          )
  )
    Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ (Text -> Builder) -> [Text] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Prelude.foldMap
      (\Text
text -> [SGR] -> Builder -> Builder
styled [SGR
grey] (Builder
"↓ " Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text -> Builder
TE.encodeUtf8Builder Text
text) Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Builder
"\n")
      (SingleTest a -> [Text]
forall a. SingleTest a -> [Text]
Internal.describes SingleTest a
test)
    Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ [SGR] -> Builder -> Builder
styled [SGR]
styles (Builder
"✗ " Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text -> Builder
TE.encodeUtf8Builder (SingleTest a -> Text
forall a. SingleTest a -> Text
Internal.name SingleTest a
test))
    Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Builder
"\n"

testFailure :: Internal.SingleTest Internal.Failure -> Builder.Builder
testFailure :: SingleTest Failure -> Builder
testFailure SingleTest Failure
test =
  case SingleTest Failure -> Failure
forall a. SingleTest a -> a
Internal.body SingleTest Failure
test of
    Internal.FailedAssertion Text
msg Maybe SrcLoc
_ ->
      Text -> Builder
TE.encodeUtf8Builder Text
msg
    Internal.ThrewException SomeException
exception ->
      Builder
"Test threw an exception\n"
        Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ FilePath -> Builder
Builder.stringUtf8 (SomeException -> FilePath
forall e. Exception e => e -> FilePath
Exception.displayException SomeException
exception)
    Failure
Internal.TookTooLong ->
      Builder
"Test timed out"
    Internal.TestRunnerMessedUp Text
msg ->
      Builder
"Test runner encountered an unexpected error:\n"
        Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text -> Builder
TE.encodeUtf8Builder Text
msg
        Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Builder
"\n"
        Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Builder
"This is a bug.\n\n"
        Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Builder
"If you have some time to report the bug it would be much appreciated!\n"
        Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Builder
"You can do so here: https://github.com/NoRedInk/haskell-libraries/issues"

sgr :: [ANSI.SGR] -> Builder.Builder
sgr :: [SGR] -> Builder
sgr = FilePath -> Builder
Builder.stringUtf8 (FilePath -> Builder) -> ([SGR] -> FilePath) -> [SGR] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
<< [SGR] -> FilePath
ANSI.setSGRCode

red :: ANSI.SGR
red :: SGR
red = ConsoleLayer -> ColorIntensity -> Color -> SGR
ANSI.SetColor ConsoleLayer
ANSI.Foreground ColorIntensity
ANSI.Dull Color
ANSI.Red

yellow :: ANSI.SGR
yellow :: SGR
yellow = ConsoleLayer -> ColorIntensity -> Color -> SGR
ANSI.SetColor ConsoleLayer
ANSI.Foreground ColorIntensity
ANSI.Dull Color
ANSI.Yellow

green :: ANSI.SGR
green :: SGR
green = ConsoleLayer -> ColorIntensity -> Color -> SGR
ANSI.SetColor ConsoleLayer
ANSI.Foreground ColorIntensity
ANSI.Dull Color
ANSI.Green

grey :: ANSI.SGR
grey :: SGR
grey = ConsoleLayer -> ColorIntensity -> Color -> SGR
ANSI.SetColor ConsoleLayer
ANSI.Foreground ColorIntensity
ANSI.Vivid Color
ANSI.Black

dullGrey :: ANSI.SGR
dullGrey :: SGR
dullGrey = ConsoleLayer -> ColorIntensity -> Color -> SGR
ANSI.SetColor ConsoleLayer
ANSI.Foreground ColorIntensity
ANSI.Dull Color
ANSI.Black

black :: ANSI.SGR
black :: SGR
black = ConsoleLayer -> ColorIntensity -> Color -> SGR
ANSI.SetColor ConsoleLayer
ANSI.Foreground ColorIntensity
ANSI.Dull Color
ANSI.White

underlined :: ANSI.SGR
underlined :: SGR
underlined = Underlining -> SGR
ANSI.SetUnderlining Underlining
ANSI.SingleUnderline