Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Utilities for Incipit programs using hedgehog.
Synopsis
- runTest :: Sem TestStack a -> TestT IO a
- runTestDebug :: Sem TestStack a -> TestT IO a
- runTestTrace :: Sem TestStack a -> TestT IO a
- runTestLevel :: Severity -> Sem TestStack a -> TestT IO a
- runTestFrozen :: Sem TestStack a -> TestT IO a
- runTestFrozenDebug :: Sem TestStack a -> TestT IO a
- runTestFrozenTrace :: Sem TestStack a -> TestT IO a
- runTestFrozenLevel :: Severity -> Sem TestStack a -> TestT IO a
- testTime :: Time
- stopTest :: forall err r. Show err => HasCallStack => Member (Error TestError) r => InterpreterFor (Stop err) r
- resumeTest :: forall err eff r. Show err => HasCallStack => Members [eff !! err, Error TestError] r => InterpreterFor eff r
- unitTest :: TestName -> UnitTest -> TestTree
- unitTestTimes :: TestLimit -> TestName -> UnitTest -> TestTree
- defaultMain :: TestTree -> IO ()
- testGroup :: TestName -> [TestTree] -> TestTree
- data TestTree
- data Failure
- type TestStack = ConcTestStack ++ [Test, Fail, Error TestError, Hedgehog IO, Error Failure, Embed IO, Resource, Final IO]
- newtype TestError = TestError Text
Test runners
runTestLevel :: Severity -> Sem TestStack a -> TestT IO a Source #
Run the test stack as a TestT
with the specified log level.
runTestFrozen :: Sem TestStack a -> TestT IO a Source #
Run the test stack as a TestT
with a log level of Crit
and ChronosTime
frozen at testTime
.
runTestFrozenDebug :: Sem TestStack a -> TestT IO a Source #
Run the test stack as a TestT
with a log level of Debug
and ChronosTime
frozen at testTime
.
runTestFrozenTrace :: Sem TestStack a -> TestT IO a Source #
Run the test stack as a TestT
with a log level of Trace
and ChronosTime
frozen at testTime
.
runTestFrozenLevel :: Severity -> Sem TestStack a -> TestT IO a Source #
Run the test stack as a TestT
with the specified log level, with ChronosTime
frozen at testTime
.
The time at which the combinators ending in Frozen
run the ChronosTime
effect.
Resumable to TestError conversion
stopTest :: forall err r. Show err => HasCallStack => Member (Error TestError) r => InterpreterFor (Stop err) r Source #
resumeTest :: forall err eff r. Show err => HasCallStack => Members [eff !! err, Error TestError] r => InterpreterFor eff r Source #
Reexports of ubiquitous names
defaultMain :: TestTree -> IO () #
Parse the command line arguments and run the tests.
When the tests finish, this function calls exitWith
with the exit code
that indicates whether any tests have failed. Most external systems
(stack, cabal, travis-ci, jenkins etc.) rely on the exit code to detect
whether the tests pass. If you want to do something else after
defaultMain
returns, you need to catch the exception and then re-throw
it. Example:
import Test.Tasty import Test.Tasty.HUnit import System.Exit import Control.Exception test = testCase "Test 1" (2 @?= 3) main = defaultMain test `catch` (\e -> do if e == ExitSuccess then putStrLn "Yea" else putStrLn "Nay" throwIO e)
The main data structure defining a test suite.
It consists of individual test cases and properties, organized in named groups which form a tree-like hierarchy.
There is no generic way to create a test case. Instead, every test
provider (tasty-hunit, tasty-smallcheck etc.) provides a function to
turn a test case into a TestTree
.
Groups can be created using testGroup
.
Details on where and why a test failed.
type TestStack = ConcTestStack ++ [Test, Fail, Error TestError, Hedgehog IO, Error Failure, Embed IO, Resource, Final IO] Source #
The entirety of the effects handled by this module's interpreters.