{-# OPTIONS_GHC -fno-warn-deprecations #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NamedFieldPuns #-}
-- |
-- Stability: stable
--
-- This module contains formatters that can be used with `hspecWith`:
--
-- @
-- import Test.Hspec
-- import Test.Hspec.Api.Formatters.V1
--
-- main :: IO ()
-- main = hspecWith (useFormatter ("my-formatter", formatter) defaultConfig) spec
--
-- formatter :: Formatter
-- formatter = ...
--
-- spec :: Spec
-- spec = ...
-- @
module Test.Hspec.Api.Formatters.V2 (

-- * Register a formatter
  registerFormatter
, useFormatter
, formatterToFormat

-- * 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 (..)
, Path
, Progress
, Location(..)
, Item(..)
, Result(..)
, FailureReason (..)
, FormatM

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

, FailureRecord (..)
, getFailMessages
, usedSeed

, printTimes

, Seconds(..)
, getCPUTime
, getRealTime

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

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

, outputUnicode

, useDiff
, diffContext
, externalDiffAction
, prettyPrint
, prettyPrintFunction
, extraChunk
, missingChunk

-- ** Helpers
, formatLocation
, formatException

-- * Re-exports
, SpecWith
, Config
, modifyConfig
) where

import           Test.Hspec.Core.Format (FormatConfig, Format)
import           Test.Hspec.Core.Formatters.V1 (FailureRecord(..))
import           Test.Hspec.Api.Format.V1.Internal
import qualified Test.Hspec.Api.Formatters.V3 as V3
import           Test.Hspec.Api.Formatters.V3 hiding (
    registerFormatter
  , useFormatter
  , formatterToFormat

  , silent
  , checks
  , specdoc
  , progress
  , failed_examples

  , Formatter(..)
  , Item(..)
  , Result(..)
  , FailureReason(..)

  , FailureRecord(..)
  , getFailMessages
  )

-- |
-- Make a formatter available for use with @--format@.
registerFormatter :: (String, Formatter) -> Config -> Config
registerFormatter :: (String, Formatter) -> Config -> Config
registerFormatter (String, Formatter)
formatter = (String, Formatter) -> Config -> Config
V3.registerFormatter (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Formatter -> Formatter
liftFormatter (String, Formatter)
formatter)

-- |
-- Make a formatter available for use with @--format@ and use it by default.
useFormatter :: (String, Formatter) -> Config -> Config
useFormatter :: (String, Formatter) -> Config -> Config
useFormatter (String, Formatter)
formatter = (String, Formatter) -> Config -> Config
V3.useFormatter (Formatter -> Formatter
liftFormatter forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String, Formatter)
formatter)

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

silent :: Formatter
silent :: Formatter
silent = Formatter -> Formatter
unliftFormatter Formatter
V3.silent

checks :: Formatter
checks :: Formatter
checks = Formatter -> Formatter
unliftFormatter Formatter
V3.checks

specdoc :: Formatter
specdoc :: Formatter
specdoc = Formatter -> Formatter
unliftFormatter Formatter
V3.specdoc

progress :: Formatter
progress :: Formatter
progress = Formatter -> Formatter
unliftFormatter Formatter
V3.progress

failed_examples :: Formatter
failed_examples :: Formatter
failed_examples = Formatter -> Formatter
unliftFormatter Formatter
V3.failed_examples

data Formatter = Formatter {
-- | evaluated before a test run
  Formatter -> FormatM ()
formatterStarted :: FormatM ()

-- | evaluated before each spec group
, Formatter -> Path -> FormatM ()
formatterGroupStarted :: Path -> FormatM ()

-- | evaluated after each spec group
, Formatter -> Path -> FormatM ()
formatterGroupDone :: Path -> FormatM ()

-- | used to notify the progress of the currently evaluated example
, Formatter -> Path -> Progress -> FormatM ()
formatterProgress :: Path -> Progress -> FormatM ()

-- | evaluated before each spec item
, Formatter -> Path -> FormatM ()
formatterItemStarted :: Path -> FormatM ()

-- | evaluated after each spec item
, Formatter -> Path -> Item -> FormatM ()
formatterItemDone :: Path -> Item -> FormatM ()

-- | evaluated after a test run
, Formatter -> FormatM ()
formatterDone :: FormatM ()
}

-- | Get the list of accumulated failure messages.
getFailMessages :: FormatM [FailureRecord]
getFailMessages :: FormatM [FailureRecord]
getFailMessages = 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]
V3.getFailMessages

liftFormatter :: Formatter -> V3.Formatter
liftFormatter :: Formatter -> Formatter
liftFormatter Formatter{FormatM ()
Path -> FormatM ()
Path -> Progress -> FormatM ()
Path -> Item -> FormatM ()
formatterDone :: FormatM ()
formatterItemDone :: Path -> Item -> FormatM ()
formatterItemStarted :: Path -> FormatM ()
formatterProgress :: Path -> Progress -> FormatM ()
formatterGroupDone :: Path -> FormatM ()
formatterGroupStarted :: Path -> FormatM ()
formatterStarted :: FormatM ()
formatterDone :: Formatter -> FormatM ()
formatterItemDone :: Formatter -> Path -> Item -> FormatM ()
formatterItemStarted :: Formatter -> Path -> FormatM ()
formatterProgress :: Formatter -> Path -> Progress -> FormatM ()
formatterGroupDone :: Formatter -> Path -> FormatM ()
formatterGroupStarted :: Formatter -> Path -> FormatM ()
formatterStarted :: Formatter -> FormatM ()
..} = V3.Formatter{
  FormatM ()
formatterStarted :: FormatM ()
formatterStarted :: FormatM ()
formatterStarted
, Path -> FormatM ()
formatterGroupStarted :: Path -> FormatM ()
formatterGroupStarted :: Path -> FormatM ()
formatterGroupStarted
, Path -> FormatM ()
formatterGroupDone :: Path -> FormatM ()
formatterGroupDone :: Path -> FormatM ()
formatterGroupDone
, Path -> Progress -> FormatM ()
formatterProgress :: Path -> Progress -> FormatM ()
formatterProgress :: Path -> Progress -> FormatM ()
formatterProgress
, Path -> FormatM ()
formatterItemStarted :: Path -> FormatM ()
formatterItemStarted :: Path -> FormatM ()
formatterItemStarted
, formatterItemDone :: Path -> Item -> FormatM ()
formatterItemDone = \ Path
path -> Path -> Item -> FormatM ()
formatterItemDone Path
path forall b c a. (b -> c) -> (a -> b) -> a -> c
. Item -> Item
unliftItem
, FormatM ()
formatterDone :: FormatM ()
formatterDone :: FormatM ()
formatterDone
}

unliftFormatter :: V3.Formatter -> Formatter
unliftFormatter :: Formatter -> Formatter
unliftFormatter V3.Formatter{FormatM ()
Path -> FormatM ()
Path -> Progress -> FormatM ()
Path -> Item -> FormatM ()
formatterDone :: FormatM ()
formatterItemDone :: Path -> Item -> FormatM ()
formatterItemStarted :: Path -> FormatM ()
formatterProgress :: Path -> Progress -> FormatM ()
formatterGroupDone :: Path -> FormatM ()
formatterGroupStarted :: Path -> FormatM ()
formatterStarted :: FormatM ()
formatterDone :: Formatter -> FormatM ()
formatterItemDone :: Formatter -> Path -> Item -> FormatM ()
formatterItemStarted :: Formatter -> Path -> FormatM ()
formatterProgress :: Formatter -> Path -> Progress -> FormatM ()
formatterGroupDone :: Formatter -> Path -> FormatM ()
formatterGroupStarted :: Formatter -> Path -> FormatM ()
formatterStarted :: Formatter -> FormatM ()
..} = Formatter{
  FormatM ()
formatterStarted :: FormatM ()
formatterStarted :: FormatM ()
formatterStarted
, Path -> FormatM ()
formatterGroupStarted :: Path -> FormatM ()
formatterGroupStarted :: Path -> FormatM ()
formatterGroupStarted
, Path -> FormatM ()
formatterGroupDone :: Path -> FormatM ()
formatterGroupDone :: Path -> FormatM ()
formatterGroupDone
, Path -> Progress -> FormatM ()
formatterProgress :: Path -> Progress -> FormatM ()
formatterProgress :: Path -> Progress -> FormatM ()
formatterProgress
, Path -> FormatM ()
formatterItemStarted :: Path -> FormatM ()
formatterItemStarted :: Path -> FormatM ()
formatterItemStarted
, formatterItemDone :: Path -> Item -> FormatM ()
formatterItemDone = \ Path
path -> Path -> Item -> FormatM ()
formatterItemDone Path
path forall b c a. (b -> c) -> (a -> b) -> a -> c
. Item -> Item
liftItem
, FormatM ()
formatterDone :: FormatM ()
formatterDone :: FormatM ()
formatterDone
}

unliftFailureRecord :: V3.FailureRecord -> FailureRecord
unliftFailureRecord :: FailureRecord -> FailureRecord
unliftFailureRecord V3.FailureRecord{Maybe Location
Path
FailureReason
failureRecordLocation :: FailureRecord -> Maybe Location
failureRecordPath :: FailureRecord -> Path
failureRecordMessage :: FailureRecord -> FailureReason
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
}