{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE LambdaCase #-}
module Test.Hspec.Core.Formatters.V1.Internal (
-- * Formatters
  silent
, checks
, specdoc
, progress
, failed_examples

-- * Implementing a custom Formatter
-- |
-- A formatter is a set of actions.  Each action is evaluated when a certain
-- situation is encountered during a test run.
--
-- Actions live in the `FormatM` monad.  It provides access to the runner state
-- and primitives for appending to the generated report.
, Formatter (..)
, FailureReason (..)
, FormatM
, formatterToFormat

-- ** Accessing the runner state
, getSuccessCount
, getPendingCount
, getFailCount
, getTotalCount

, FailureRecord (..)
, getFailMessages
, usedSeed

, Seconds(..)
, getCPUTime
, getRealTime

-- ** Appending to the generated report
, write
, writeLine
, writeTransient

-- ** Dealing with colors
, withInfoColor
, withSuccessColor
, withPendingColor
, withFailColor

, useDiff
, extraChunk
, missingChunk

-- ** Helpers
, formatException
) where

import           Prelude ()
import           Test.Hspec.Core.Compat hiding (First)

import           Test.Hspec.Core.Util
import           Test.Hspec.Core.Clock
import           Test.Hspec.Core.Example (Location(..))
import           Text.Printf
import           Control.Monad.IO.Class

-- We use an explicit import list for "Test.Hspec.Formatters.Internal", to make
-- sure, that we only use the public API to implement formatters.
--
-- Everything imported here has to be re-exported, so that users can implement
-- their own formatters.
import Test.Hspec.Core.Formatters.V1.Monad (
    Formatter(..)
  , FailureReason(..)
  , FormatM

  , getSuccessCount
  , getPendingCount
  , getFailCount
  , getTotalCount

  , FailureRecord(..)
  , getFailMessages
  , usedSeed

  , getCPUTime
  , getRealTime

  , write
  , writeLine
  , writeTransient

  , withInfoColor
  , withSuccessColor
  , withPendingColor
  , withFailColor

  , useDiff
  , extraChunk
  , missingChunk
  )

import           Test.Hspec.Core.Format (FormatConfig, Format)

import           Test.Hspec.Core.Formatters.Diff
import qualified Test.Hspec.Core.Formatters.V2 as V2
import           Test.Hspec.Core.Formatters.V1.Monad (Item(..), Result(..), Environment(..), interpretWith)

formatterToFormat :: Formatter -> FormatConfig -> IO Format
formatterToFormat :: Formatter -> FormatConfig -> IO Format
formatterToFormat = Formatter -> FormatConfig -> IO Format
V2.formatterToFormat forall b c a. (b -> c) -> (a -> b) -> a -> c
. Formatter -> Formatter
legacyFormatterToFormatter

legacyFormatterToFormatter :: Formatter -> V2.Formatter
legacyFormatterToFormatter :: Formatter -> Formatter
legacyFormatterToFormatter Formatter{FormatM ()
[[Char]] -> [Char] -> FormatM ()
Path -> FormatM ()
Path -> [Char] -> FormatM ()
Path -> [Char] -> Maybe [Char] -> FormatM ()
Path -> [Char] -> FailureReason -> FormatM ()
Path -> Progress -> FormatM ()
footerFormatter :: Formatter -> FormatM ()
failedFormatter :: Formatter -> FormatM ()
examplePending :: Formatter -> Path -> [Char] -> Maybe [Char] -> FormatM ()
exampleFailed :: Formatter -> Path -> [Char] -> FailureReason -> FormatM ()
exampleSucceeded :: Formatter -> Path -> [Char] -> FormatM ()
exampleProgress :: Formatter -> Path -> Progress -> FormatM ()
exampleStarted :: Formatter -> Path -> FormatM ()
exampleGroupDone :: Formatter -> FormatM ()
exampleGroupStarted :: Formatter -> [[Char]] -> [Char] -> FormatM ()
headerFormatter :: Formatter -> FormatM ()
footerFormatter :: FormatM ()
failedFormatter :: FormatM ()
examplePending :: Path -> [Char] -> Maybe [Char] -> FormatM ()
exampleFailed :: Path -> [Char] -> FailureReason -> FormatM ()
exampleSucceeded :: Path -> [Char] -> FormatM ()
exampleProgress :: Path -> Progress -> FormatM ()
exampleStarted :: Path -> FormatM ()
exampleGroupDone :: FormatM ()
exampleGroupStarted :: [[Char]] -> [Char] -> FormatM ()
headerFormatter :: FormatM ()
..} = V2.Formatter {
  formatterStarted :: FormatM ()
V2.formatterStarted = forall a. FormatM a -> FormatM a
interpret FormatM ()
headerFormatter
, formatterGroupStarted :: Path -> FormatM ()
V2.formatterGroupStarted = forall a. FormatM a -> FormatM a
interpret forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [[Char]] -> [Char] -> FormatM ()
exampleGroupStarted
, formatterGroupDone :: Path -> FormatM ()
V2.formatterGroupDone = forall a. FormatM a -> FormatM a
interpret forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const FormatM ()
exampleGroupDone
, formatterProgress :: Path -> Progress -> FormatM ()
V2.formatterProgress = \ Path
path -> forall a. FormatM a -> FormatM a
interpret forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> Progress -> FormatM ()
exampleProgress Path
path
, formatterItemStarted :: Path -> FormatM ()
V2.formatterItemStarted = forall a. FormatM a -> FormatM a
interpret forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> FormatM ()
exampleStarted
, formatterItemDone :: Path -> Item -> FormatM ()
V2.formatterItemDone = \ Path
path Item
item -> forall a. FormatM a -> FormatM a
interpret forall a b. (a -> b) -> a -> b
$ do
    case Item -> Result
itemResult Item
item of
      Result
Success -> Path -> [Char] -> FormatM ()
exampleSucceeded Path
path (Item -> [Char]
itemInfo Item
item)
      Pending Maybe Location
_ Maybe [Char]
reason -> Path -> [Char] -> Maybe [Char] -> FormatM ()
examplePending Path
path (Item -> [Char]
itemInfo Item
item) Maybe [Char]
reason
      Failure Maybe Location
_ FailureReason
reason -> Path -> [Char] -> FailureReason -> FormatM ()
exampleFailed Path
path (Item -> [Char]
itemInfo Item
item) (FailureReason -> FailureReason
unliftFailureReason FailureReason
reason)
, formatterDone :: FormatM ()
V2.formatterDone = forall a. FormatM a -> FormatM a
interpret forall a b. (a -> b) -> a -> b
$ FormatM ()
failedFormatter forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FormatM ()
footerFormatter
}

unliftFailureRecord :: V2.FailureRecord -> FailureRecord
unliftFailureRecord :: FailureRecord -> FailureRecord
unliftFailureRecord V2.FailureRecord{Maybe Location
Path
FailureReason
failureRecordMessage :: FailureRecord -> FailureReason
failureRecordPath :: FailureRecord -> Path
failureRecordLocation :: FailureRecord -> Maybe Location
failureRecordMessage :: FailureReason
failureRecordPath :: Path
failureRecordLocation :: Maybe Location
..} = FailureRecord {
  Maybe Location
failureRecordLocation :: Maybe Location
failureRecordLocation :: Maybe Location
failureRecordLocation
, Path
failureRecordPath :: Path
failureRecordPath :: Path
failureRecordPath
, failureRecordMessage :: FailureReason
failureRecordMessage = FailureReason -> FailureReason
unliftFailureReason FailureReason
failureRecordMessage
}

unliftFailureReason :: V2.FailureReason -> FailureReason
unliftFailureReason :: FailureReason -> FailureReason
unliftFailureReason = \ case
  FailureReason
V2.NoReason -> FailureReason
NoReason
  V2.Reason [Char]
reason -> [Char] -> FailureReason
Reason [Char]
reason
  V2.ColorizedReason [Char]
reason -> [Char] -> FailureReason
Reason ([Char] -> [Char]
stripAnsi [Char]
reason)
  V2.ExpectedButGot Maybe [Char]
preface [Char]
expected [Char]
actual -> Maybe [Char] -> [Char] -> [Char] -> FailureReason
ExpectedButGot Maybe [Char]
preface [Char]
expected [Char]
actual
  V2.Error Maybe [Char]
info SomeException
e -> Maybe [Char] -> SomeException -> FailureReason
Error Maybe [Char]
info SomeException
e

interpret :: FormatM a -> V2.FormatM a
interpret :: forall a. FormatM a -> FormatM a
interpret = forall (m :: * -> *) a.
Monad m =>
Environment m -> FormatM a -> m a
interpretWith Environment {
  environmentGetSuccessCount :: FormatM Int
environmentGetSuccessCount = FormatM Int
V2.getSuccessCount
, environmentGetPendingCount :: FormatM Int
environmentGetPendingCount = FormatM Int
V2.getPendingCount
, environmentGetFailMessages :: FormatM [FailureRecord]
environmentGetFailMessages = forall a b. (a -> b) -> [a] -> [b]
map FailureRecord -> FailureRecord
unliftFailureRecord forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FormatM [FailureRecord]
V2.getFailMessages
, environmentUsedSeed :: FormatM Integer
environmentUsedSeed = FormatM Integer
V2.usedSeed
, environmentPrintTimes :: FormatM Bool
environmentPrintTimes = FormatM Bool
V2.printTimes
, environmentGetCPUTime :: FormatM (Maybe Seconds)
environmentGetCPUTime = FormatM (Maybe Seconds)
V2.getCPUTime
, environmentGetRealTime :: FormatM Seconds
environmentGetRealTime = FormatM Seconds
V2.getRealTime
, environmentWrite :: [Char] -> FormatM ()
environmentWrite = [Char] -> FormatM ()
V2.write
, environmentWriteTransient :: [Char] -> FormatM ()
environmentWriteTransient = [Char] -> FormatM ()
V2.writeTransient
, environmentWithFailColor :: forall a. FormatM a -> FormatM a
environmentWithFailColor = forall a. FormatM a -> FormatM a
V2.withFailColor
, environmentWithSuccessColor :: forall a. FormatM a -> FormatM a
environmentWithSuccessColor = forall a. FormatM a -> FormatM a
V2.withSuccessColor
, environmentWithPendingColor :: forall a. FormatM a -> FormatM a
environmentWithPendingColor = forall a. FormatM a -> FormatM a
V2.withPendingColor
, environmentWithInfoColor :: forall a. FormatM a -> FormatM a
environmentWithInfoColor = forall a. FormatM a -> FormatM a
V2.withInfoColor
, environmentUseDiff :: FormatM Bool
environmentUseDiff = FormatM Bool
V2.useDiff
, environmentExtraChunk :: [Char] -> FormatM ()
environmentExtraChunk = [Char] -> FormatM ()
V2.extraChunk
, environmentMissingChunk :: [Char] -> FormatM ()
environmentMissingChunk = [Char] -> FormatM ()
V2.missingChunk
, environmentLiftIO :: forall a. IO a -> FormatM a
environmentLiftIO = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
}

silent :: Formatter
silent :: Formatter
silent = Formatter {
  headerFormatter :: FormatM ()
headerFormatter     = forall (m :: * -> *). Applicative m => m ()
pass
, exampleGroupStarted :: [[Char]] -> [Char] -> FormatM ()
exampleGroupStarted = \[[Char]]
_ [Char]
_ -> forall (m :: * -> *). Applicative m => m ()
pass
, exampleGroupDone :: FormatM ()
exampleGroupDone    = forall (m :: * -> *). Applicative m => m ()
pass
, exampleStarted :: Path -> FormatM ()
exampleStarted      = \Path
_ -> forall (m :: * -> *). Applicative m => m ()
pass
, exampleProgress :: Path -> Progress -> FormatM ()
exampleProgress     = \Path
_ Progress
_ -> forall (m :: * -> *). Applicative m => m ()
pass
, exampleSucceeded :: Path -> [Char] -> FormatM ()
exampleSucceeded    = \ Path
_ [Char]
_ -> forall (m :: * -> *). Applicative m => m ()
pass
, exampleFailed :: Path -> [Char] -> FailureReason -> FormatM ()
exampleFailed       = \Path
_ [Char]
_ FailureReason
_ -> forall (m :: * -> *). Applicative m => m ()
pass
, examplePending :: Path -> [Char] -> Maybe [Char] -> FormatM ()
examplePending      = \Path
_ [Char]
_ Maybe [Char]
_ -> forall (m :: * -> *). Applicative m => m ()
pass
, failedFormatter :: FormatM ()
failedFormatter     = forall (m :: * -> *). Applicative m => m ()
pass
, footerFormatter :: FormatM ()
footerFormatter     = forall (m :: * -> *). Applicative m => m ()
pass
}

checks :: Formatter
checks :: Formatter
checks = Formatter
specdoc {
  exampleStarted :: Path -> FormatM ()
exampleStarted = \([[Char]]
nesting, [Char]
requirement) -> do
    [Char] -> FormatM ()
writeTransient forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *} {a}. Foldable t => t a -> [Char]
indentationFor [[Char]]
nesting forall a. [a] -> [a] -> [a]
++ [Char]
requirement forall a. [a] -> [a] -> [a]
++ [Char]
" [ ]"

, exampleProgress :: Path -> Progress -> FormatM ()
exampleProgress = \([[Char]]
nesting, [Char]
requirement) Progress
p -> do
    [Char] -> FormatM ()
writeTransient forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *} {a}. Foldable t => t a -> [Char]
indentationFor [[Char]]
nesting forall a. [a] -> [a] -> [a]
++ [Char]
requirement forall a. [a] -> [a] -> [a]
++ [Char]
" [" forall a. [a] -> [a] -> [a]
++ (forall {a} {a}. (Eq a, Num a, Show a, Show a) => (a, a) -> [Char]
formatProgress Progress
p) forall a. [a] -> [a] -> [a]
++ [Char]
"]"

, exampleSucceeded :: Path -> [Char] -> FormatM ()
exampleSucceeded = \([[Char]]
nesting, [Char]
requirement) [Char]
info -> do
    [[Char]] -> [Char] -> [Char] -> FormatM () -> FormatM ()
writeResult [[Char]]
nesting [Char]
requirement [Char]
info forall a b. (a -> b) -> a -> b
$ forall a. FormatM a -> FormatM a
withSuccessColor forall a b. (a -> b) -> a -> b
$ [Char] -> FormatM ()
write [Char]
"✔"

, exampleFailed :: Path -> [Char] -> FailureReason -> FormatM ()
exampleFailed = \([[Char]]
nesting, [Char]
requirement) [Char]
info FailureReason
_ -> do
    [[Char]] -> [Char] -> [Char] -> FormatM () -> FormatM ()
writeResult [[Char]]
nesting [Char]
requirement [Char]
info forall a b. (a -> b) -> a -> b
$ forall a. FormatM a -> FormatM a
withFailColor forall a b. (a -> b) -> a -> b
$ [Char] -> FormatM ()
write [Char]
"✘"

, examplePending :: Path -> [Char] -> Maybe [Char] -> FormatM ()
examplePending = \([[Char]]
nesting, [Char]
requirement) [Char]
info Maybe [Char]
reason -> do
    [[Char]] -> [Char] -> [Char] -> FormatM () -> FormatM ()
writeResult [[Char]]
nesting [Char]
requirement [Char]
info forall a b. (a -> b) -> a -> b
$ forall a. FormatM a -> FormatM a
withPendingColor forall a b. (a -> b) -> a -> b
$ [Char] -> FormatM ()
write [Char]
"‐"

    forall a. FormatM a -> FormatM a
withPendingColor forall a b. (a -> b) -> a -> b
$ do
      [Char] -> FormatM ()
writeLine forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *} {a}. Foldable t => t a -> [Char]
indentationFor ([Char]
"" forall a. a -> [a] -> [a]
: [[Char]]
nesting) forall a. [a] -> [a] -> [a]
++ [Char]
"# PENDING: " forall a. [a] -> [a] -> [a]
++ forall a. a -> Maybe a -> a
fromMaybe [Char]
"No reason given" Maybe [Char]
reason
} where
    indentationFor :: t a -> [Char]
indentationFor t a
nesting = forall a. Int -> a -> [a]
replicate (forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
nesting forall a. Num a => a -> a -> a
* Int
2) Char
' '

    writeResult :: [String] -> String -> String -> FormatM () -> FormatM ()
    writeResult :: [[Char]] -> [Char] -> [Char] -> FormatM () -> FormatM ()
writeResult [[Char]]
nesting [Char]
requirement [Char]
info FormatM ()
action = do
      [Char] -> FormatM ()
write forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *} {a}. Foldable t => t a -> [Char]
indentationFor [[Char]]
nesting forall a. [a] -> [a] -> [a]
++ [Char]
requirement forall a. [a] -> [a] -> [a]
++ [Char]
" ["
      FormatM ()
action
      [Char] -> FormatM ()
writeLine [Char]
"]"
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Char] -> [[Char]]
lines [Char]
info) forall a b. (a -> b) -> a -> b
$ \ [Char]
s ->
        [Char] -> FormatM ()
writeLine forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *} {a}. Foldable t => t a -> [Char]
indentationFor ([Char]
"" forall a. a -> [a] -> [a]
: [[Char]]
nesting) forall a. [a] -> [a] -> [a]
++ [Char]
s

    formatProgress :: (a, a) -> [Char]
formatProgress (a
current, a
total)
      | a
total forall a. Eq a => a -> a -> Bool
== a
0 = forall a. Show a => a -> [Char]
show a
current
      | Bool
otherwise  = forall a. Show a => a -> [Char]
show a
current forall a. [a] -> [a] -> [a]
++ [Char]
"/" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show a
total

specdoc :: Formatter
specdoc :: Formatter
specdoc = Formatter
silent {

  headerFormatter :: FormatM ()
headerFormatter = do
    [Char] -> FormatM ()
writeLine [Char]
""

, exampleGroupStarted :: [[Char]] -> [Char] -> FormatM ()
exampleGroupStarted = \[[Char]]
nesting [Char]
name -> do
    [Char] -> FormatM ()
writeLine (forall {t :: * -> *} {a}. Foldable t => t a -> [Char]
indentationFor [[Char]]
nesting forall a. [a] -> [a] -> [a]
++ [Char]
name)

, exampleProgress :: Path -> Progress -> FormatM ()
exampleProgress = \Path
_ Progress
p -> do
    [Char] -> FormatM ()
writeTransient (forall {a} {a}. (Eq a, Num a, Show a, Show a) => (a, a) -> [Char]
formatProgress Progress
p)

, exampleSucceeded :: Path -> [Char] -> FormatM ()
exampleSucceeded = \([[Char]]
nesting, [Char]
requirement) [Char]
info -> forall a. FormatM a -> FormatM a
withSuccessColor forall a b. (a -> b) -> a -> b
$ do
    [Char] -> FormatM ()
writeLine forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *} {a}. Foldable t => t a -> [Char]
indentationFor [[Char]]
nesting forall a. [a] -> [a] -> [a]
++ [Char]
requirement
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Char] -> [[Char]]
lines [Char]
info) forall a b. (a -> b) -> a -> b
$ \ [Char]
s ->
      [Char] -> FormatM ()
writeLine forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *} {a}. Foldable t => t a -> [Char]
indentationFor ([Char]
"" forall a. a -> [a] -> [a]
: [[Char]]
nesting) forall a. [a] -> [a] -> [a]
++ [Char]
s

, exampleFailed :: Path -> [Char] -> FailureReason -> FormatM ()
exampleFailed = \([[Char]]
nesting, [Char]
requirement) [Char]
info FailureReason
_ -> forall a. FormatM a -> FormatM a
withFailColor forall a b. (a -> b) -> a -> b
$ do
    Int
n <- FormatM Int
getFailCount
    [Char] -> FormatM ()
writeLine forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *} {a}. Foldable t => t a -> [Char]
indentationFor [[Char]]
nesting forall a. [a] -> [a] -> [a]
++ [Char]
requirement forall a. [a] -> [a] -> [a]
++ [Char]
" FAILED [" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
n forall a. [a] -> [a] -> [a]
++ [Char]
"]"
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Char] -> [[Char]]
lines [Char]
info) forall a b. (a -> b) -> a -> b
$ \ [Char]
s ->
      [Char] -> FormatM ()
writeLine forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *} {a}. Foldable t => t a -> [Char]
indentationFor ([Char]
"" forall a. a -> [a] -> [a]
: [[Char]]
nesting) forall a. [a] -> [a] -> [a]
++ [Char]
s

, examplePending :: Path -> [Char] -> Maybe [Char] -> FormatM ()
examplePending = \([[Char]]
nesting, [Char]
requirement) [Char]
info Maybe [Char]
reason -> forall a. FormatM a -> FormatM a
withPendingColor forall a b. (a -> b) -> a -> b
$ do
    [Char] -> FormatM ()
writeLine forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *} {a}. Foldable t => t a -> [Char]
indentationFor [[Char]]
nesting forall a. [a] -> [a] -> [a]
++ [Char]
requirement
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Char] -> [[Char]]
lines [Char]
info) forall a b. (a -> b) -> a -> b
$ \ [Char]
s ->
      [Char] -> FormatM ()
writeLine forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *} {a}. Foldable t => t a -> [Char]
indentationFor ([Char]
"" forall a. a -> [a] -> [a]
: [[Char]]
nesting) forall a. [a] -> [a] -> [a]
++ [Char]
s
    [Char] -> FormatM ()
writeLine forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *} {a}. Foldable t => t a -> [Char]
indentationFor ([Char]
"" forall a. a -> [a] -> [a]
: [[Char]]
nesting) forall a. [a] -> [a] -> [a]
++ [Char]
"# PENDING: " forall a. [a] -> [a] -> [a]
++ forall a. a -> Maybe a -> a
fromMaybe [Char]
"No reason given" Maybe [Char]
reason

, failedFormatter :: FormatM ()
failedFormatter = FormatM ()
defaultFailedFormatter

, footerFormatter :: FormatM ()
footerFormatter = FormatM ()
defaultFooter
} where
    indentationFor :: t a -> [Char]
indentationFor t a
nesting = forall a. Int -> a -> [a]
replicate (forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
nesting forall a. Num a => a -> a -> a
* Int
2) Char
' '
    formatProgress :: (a, a) -> [Char]
formatProgress (a
current, a
total)
      | a
total forall a. Eq a => a -> a -> Bool
== a
0 = forall a. Show a => a -> [Char]
show a
current
      | Bool
otherwise  = forall a. Show a => a -> [Char]
show a
current forall a. [a] -> [a] -> [a]
++ [Char]
"/" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show a
total


progress :: Formatter
progress :: Formatter
progress = Formatter
silent {
  exampleSucceeded :: Path -> [Char] -> FormatM ()
exampleSucceeded = \Path
_ [Char]
_ -> forall a. FormatM a -> FormatM a
withSuccessColor forall a b. (a -> b) -> a -> b
$ [Char] -> FormatM ()
write [Char]
"."
, exampleFailed :: Path -> [Char] -> FailureReason -> FormatM ()
exampleFailed    = \Path
_ [Char]
_ FailureReason
_ -> forall a. FormatM a -> FormatM a
withFailColor    forall a b. (a -> b) -> a -> b
$ [Char] -> FormatM ()
write [Char]
"F"
, examplePending :: Path -> [Char] -> Maybe [Char] -> FormatM ()
examplePending   = \Path
_ [Char]
_ Maybe [Char]
_ -> forall a. FormatM a -> FormatM a
withPendingColor forall a b. (a -> b) -> a -> b
$ [Char] -> FormatM ()
write [Char]
"."
, failedFormatter :: FormatM ()
failedFormatter  = FormatM ()
defaultFailedFormatter
, footerFormatter :: FormatM ()
footerFormatter  = FormatM ()
defaultFooter
}


failed_examples :: Formatter
failed_examples :: Formatter
failed_examples   = Formatter
silent {
  failedFormatter :: FormatM ()
failedFormatter = FormatM ()
defaultFailedFormatter
, footerFormatter :: FormatM ()
footerFormatter = FormatM ()
defaultFooter
}

defaultFailedFormatter :: FormatM ()
defaultFailedFormatter :: FormatM ()
defaultFailedFormatter = do
  [Char] -> FormatM ()
writeLine [Char]
""

  [FailureRecord]
failures <- FormatM [FailureRecord]
getFailMessages

  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FailureRecord]
failures) forall a b. (a -> b) -> a -> b
$ do
    [Char] -> FormatM ()
writeLine [Char]
"Failures:"
    [Char] -> FormatM ()
writeLine [Char]
""

    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [FailureRecord]
failures) 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 " forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Free FormatF Integer
usedSeed forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> FormatM ()
writeLine forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Location
mLoc forall a b. (a -> b) -> a -> b
$ \Location
loc -> do
        forall a. FormatM a -> FormatM a
withInfoColor forall a b. (a -> b) -> a -> b
$ [Char] -> FormatM ()
writeLine (Location -> [Char]
formatLoc Location
loc)
      [Char] -> FormatM ()
write ([Char]
"  " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
n forall a. [a] -> [a] -> [a]
++ [Char]
") ")
      [Char] -> FormatM ()
writeLine (Path -> [Char]
formatRequirement Path
path)
      case FailureReason
reason of
        FailureReason
NoReason -> forall (m :: * -> *). Applicative m => m ()
pass
        Reason [Char]
err -> forall a. FormatM a -> FormatM a
withFailColor forall a b. (a -> b) -> a -> b
$ [Char] -> FormatM ()
indent [Char]
err
        ExpectedButGot Maybe [Char]
preface [Char]
expected [Char]
actual -> do
          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]
mchunks <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ if Bool
b
            then forall a. Seconds -> IO a -> IO (Maybe a)
timeout Seconds
threshold (forall a. a -> IO a
evaluate forall a b. (a -> b) -> a -> b
$ Maybe Int -> [Char] -> [Char] -> [Diff]
diff forall a. Maybe a
Nothing [Char]
expected [Char]
actual)
            else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

          case Maybe [Diff]
mchunks of
            Just [Diff]
chunks -> do
              forall {t :: * -> *}.
Foldable t =>
t Diff
-> ([Char] -> FormatM ()) -> ([Char] -> FormatM ()) -> FormatM ()
writeDiff [Diff]
chunks [Char] -> FormatM ()
extraChunk [Char] -> FormatM ()
missingChunk
            Maybe [Diff]
Nothing -> do
              forall {t :: * -> *}.
Foldable t =>
t Diff
-> ([Char] -> FormatM ()) -> ([Char] -> FormatM ()) -> FormatM ()
writeDiff [[Char] -> Diff
First [Char]
expected, [Char] -> Diff
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 forall a. (a -> Bool) -> [a] -> ([a], [a])
break (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 forall a. [a] -> [a] -> [a]
++ [Char]
"\n") forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> FormatM ()
write ([Char]
indentation forall a. [a] -> [a] -> [a]
++ [Char]
"          ") 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] -> FormatM ()) -> ([Char] -> FormatM ()) -> FormatM ()
writeDiff t Diff
chunks [Char] -> FormatM ()
extra [Char] -> FormatM ()
missing = do
              forall a. FormatM a -> FormatM a
withFailColor forall a b. (a -> b) -> a -> b
$ [Char] -> FormatM ()
write ([Char]
indentation forall a. [a] -> [a] -> [a]
++ [Char]
"expected: ")
              forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ t Diff
chunks forall a b. (a -> b) -> a -> b
$ \ case
                Both [Char]
a -> forall {a}. ([Char] -> Free FormatF a) -> [Char] -> Free FormatF a
indented [Char] -> FormatM ()
write [Char]
a
                First [Char]
a -> forall {a}. ([Char] -> Free FormatF a) -> [Char] -> Free FormatF a
indented [Char] -> FormatM ()
extra [Char]
a
                Second [Char]
_ -> forall (m :: * -> *). Applicative m => m ()
pass
                Omitted Int
_ -> forall (m :: * -> *). Applicative m => m ()
pass
              [Char] -> FormatM ()
writeLine [Char]
""

              forall a. FormatM a -> FormatM a
withFailColor forall a b. (a -> b) -> a -> b
$ [Char] -> FormatM ()
write ([Char]
indentation forall a. [a] -> [a] -> [a]
++ [Char]
" but got: ")
              forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ t Diff
chunks forall a b. (a -> b) -> a -> b
$ \ case
                Both [Char]
a -> forall {a}. ([Char] -> Free FormatF a) -> [Char] -> Free FormatF a
indented [Char] -> FormatM ()
write [Char]
a
                First [Char]
_ -> forall (m :: * -> *). Applicative m => m ()
pass
                Second [Char]
a -> forall {a}. ([Char] -> Free FormatF a) -> [Char] -> Free FormatF a
indented [Char] -> FormatM ()
missing [Char]
a
                Omitted Int
_ -> forall (m :: * -> *). Applicative m => m ()
pass
              [Char] -> FormatM ()
writeLine [Char]
""

        Error Maybe [Char]
_ SomeException
e -> forall a. FormatM a -> FormatM a
withFailColor forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> FormatM ()
indent forall a b. (a -> b) -> a -> b
$ (([Char]
"uncaught exception: " forall a. [a] -> [a] -> [a]
++) 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 " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (Path -> [Char]
joinPath Path
path))
      where
        indentation :: [Char]
indentation = [Char]
"       "
        indent :: [Char] -> FormatM ()
indent [Char]
message = do
          forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Char] -> [[Char]]
lines [Char]
message) forall a b. (a -> b) -> a -> b
$ \[Char]
line -> do
            [Char] -> FormatM ()
writeLine ([Char]
indentation forall a. [a] -> [a] -> [a]
++ [Char]
line)
        formatLoc :: Location -> [Char]
formatLoc (Location [Char]
file Int
line Int
column) = [Char]
"  " forall a. [a] -> [a] -> [a]
++ [Char]
file forall a. [a] -> [a] -> [a]
++ [Char]
":" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
line forall a. [a] -> [a] -> [a]
++ [Char]
":" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
column forall a. [a] -> [a] -> [a]
++ [Char]
": "

defaultFooter :: FormatM ()
defaultFooter :: FormatM ()
defaultFooter = do

  [Char] -> FormatM ()
writeLine forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. [a] -> [a] -> [a]
(++)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall r. PrintfType r => [Char] -> r
printf [Char]
"Finished in %1.4f seconds" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FormatM Seconds
getRealTime)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"" (forall r. PrintfType r => [Char] -> r
printf [Char]
", used %1.4f seconds of CPU time") 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"
      forall a. [a] -> [a] -> [a]
++ [Char]
", " forall a. [a] -> [a] -> [a]
++ Int -> [Char] -> [Char]
pluralize Int
fails [Char]
"failure"
      forall a. [a] -> [a] -> [a]
++ if Int
pending forall a. Eq a => a -> a -> Bool
== Int
0 then [Char]
"" else [Char]
", " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
pending forall a. [a] -> [a] -> [a]
++ [Char]
" pending"
    c :: FormatM a -> FormatM a
c | Int
fails forall a. Eq a => a -> a -> Bool
/= Int
0   = forall a. FormatM a -> FormatM a
withFailColor
      | Int
pending forall a. Eq a => a -> a -> Bool
/= Int
0 = forall a. FormatM a -> FormatM a
withPendingColor
      | Bool
otherwise    = forall a. FormatM a -> FormatM a
withSuccessColor
  forall a. FormatM a -> FormatM a
c forall a b. (a -> b) -> a -> b
$ [Char] -> FormatM ()
writeLine [Char]
output