Copyright | (c) Joel Burget 2018-2019 |
---|---|
License | MIT |
Maintainer | joelburget@gmail.com |
Stability | experimental |
Safe Haskell | None |
Language | Haskell98 |
This module defines the core internals and interface of easytest.
Synopsis
- tests :: [Test] -> Test
- scope :: String -> Test -> Test
- skip :: Test -> Test
- example :: HasCallStack => PropertyT IO () -> Test
- unitTest :: HasCallStack => PropertyT IO () -> Test
- property :: HasCallStack => PropertyT IO () -> Test
- propertyWith :: HasCallStack => PropertyConfig -> PropertyT IO () -> Test
- matches :: HasCallStack => Prism' s a -> s -> PropertyT IO ()
- doesn'tMatch :: HasCallStack => Prism' s a -> s -> PropertyT IO ()
- pending :: String -> PropertyT IO ()
- crash :: HasCallStack => String -> PropertyT IO ()
- run :: Test -> IO Summary
- runOnly :: String -> Test -> IO Summary
- rerun :: Seed -> Test -> IO Summary
- rerunOnly :: String -> Seed -> Test -> IO Summary
- bracket :: IO a -> (a -> IO ()) -> (a -> PropertyT IO ()) -> PropertyT IO ()
- bracket_ :: IO a -> IO b -> PropertyT IO () -> PropertyT IO ()
- finally :: PropertyT IO () -> IO a -> PropertyT IO ()
- cabalTestSuite :: IO Summary -> IO ()
- type Prism s t a b = forall p f. (Choice p, Applicative f) => p a (f b) -> p s (f t)
- type Prism' s a = Prism s s a a
- data TestType
- data Test
- data Property
- data PropertyT (m :: Type -> Type) a
- class Monad m => MonadTest (m :: Type -> Type)
- (===) :: (MonadTest m, Eq a, Show a, HasCallStack) => a -> a -> m ()
- (/==) :: (MonadTest m, Eq a, Show a, HasCallStack) => a -> a -> m ()
- data Seed
- data Summary = Summary {}
- data PropertyConfig = PropertyConfig {}
- defaultConfig :: PropertyConfig
Structuring tests
scope :: String -> Test -> Test Source #
Label a test. Can be nested. A "." is placed between nested
scopes, so scope "foo" . scope "bar"
is equivalent to scope "foo.bar"
example :: HasCallStack => PropertyT IO () -> Test Source #
Run a unit test (same as unitTest
). Example:
>>>
run $ example $ 1 === 2
> ━━━ run ━━━ > ✗ (unnamed) failed after 1 test. > > ┏━━ tests/Suite.hs ━━━ > 26 ┃ main :: IO () > 27 ┃ main = do > 28 ┃ run $ example $ 1 === (2 :: Int) > ┃ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ > ┃ │ Failed (- lhs =/= + rhs) > ┃ │ - 1 > ┃ │ + 2 > > This failure can be reproduced by running: > > recheck (Size 0) (Seed 2914818620245020776 12314041441884757111) (unnamed) > > ✗ 1 failed.
unitTest :: HasCallStack => PropertyT IO () -> Test Source #
Run a unit test (same as example
). Example:
>>>
run $ unitTest $ 1 === 2
> ━━━ run ━━━ > ✗ (unnamed) failed after 1 test. > > ┏━━ tests/Suite.hs ━━━ > 26 ┃ main :: IO () > 27 ┃ main = do > 28 ┃ run $ unitTest $ 1 === (2 :: Int) > ┃ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ > ┃ │ Failed (- lhs =/= + rhs) > ┃ │ - 1 > ┃ │ + 2 > > This failure can be reproduced by running: > > recheck (Size 0) (Seed 2914818620245020776 12314041441884757111) (unnamed) > > ✗ 1 failed.
property :: HasCallStack => PropertyT IO () -> Test Source #
Run a property test. Example:
>>>
run $ scope "list reversal" $ property $ do
>.. list <- forAll $ Gen.list @_ @Int (Range.linear 0 100) >.. (Gen.element [0..100]) >.. reverse (reverse list) === list > ━━━ run ━━━ > ✓ list reversal passed 100 tests. > ✓ 1 succeeded.
propertyWith :: HasCallStack => PropertyConfig -> PropertyT IO () -> Test Source #
Run a property test with a custom configuration. This allows you to configure the propertyTestLimit
, propertyDiscardLimit
, propertyShrinkLimit
, or propertyShrinkRetries
. Example:
>>>
run $ scope "list reversal" $ propertyWith (defaultConfig { propertyTestLimit = 500 }) $ do
>.. list <- forAll $ Gen.list @_ @Int (Range.linear 0 100) >.. (Gen.element [0..100]) >.. reverse (reverse list) === list > ━━━ run ━━━ > ✓ list reversal passed 500 tests. > ✓ 1 succeeded.
Assertions for unit tests
matches :: HasCallStack => Prism' s a -> s -> PropertyT IO () Source #
Test whether a Prism
matches. Example:
>>>
main
> ━━━ run ━━━ > ✓ (unnamed) passed 1 test. > ✗ (unnamed) failed after 1 test. > > ┏━━ tests/Suite.hs ━━━ > 48 ┃ main :: IO () > 49 ┃ main = do > 50 ┃ _ <- run $ tests > 51 ┃ [ example $ matches _Left (Left 1 :: Either Int ()) > 52 ┃ , example $ matches _Left (Right () :: Either Int ()) > ┃ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ > 53 ┃ ] > 54 ┃ pure () > > Prism failed to match > > This failure can be reproduced by running: > > recheck (Size 0) (Seed 14003809197113786240 2614482618840800713) (unnamed) > > ✗ 1 failed, 1 succeeded.
Use with _Just
, _Nothing
, _Left
, _Right
, or Control.Lens.Prism
doesn'tMatch :: HasCallStack => Prism' s a -> s -> PropertyT IO () Source #
Running tests
runOnly :: String -> Test -> IO Summary Source #
Run all tests whose scope starts with the given prefix.
>>>
runOnly "components.a" tests
rerun :: Seed -> Test -> IO Summary Source #
Rerun all tests with the given seed
>>>
rerun (Seed 2914818620245020776 12314041441884757111) tests
rerunOnly :: String -> Seed -> Test -> IO Summary Source #
Rerun all tests with the given seed and whose scope starts with the given prefix
>>>
rerunOnly "components.a" (Seed 2914818620245020776 12314041441884757111) tests
Bracketed tests (requiring setup / teardown)
bracket :: IO a -> (a -> IO ()) -> (a -> PropertyT IO ()) -> PropertyT IO () Source #
Make a test with setup and teardown steps.
bracket_ :: IO a -> IO b -> PropertyT IO () -> PropertyT IO () Source #
A variant of bracket
where the return value from the setup step is not
required.
finally :: PropertyT IO () -> IO a -> PropertyT IO () Source #
A specialised variant of bracket
with just a teardown step.
Cabal test suite
cabalTestSuite :: IO Summary -> IO () Source #
Make this a cabal test suite for use with exitcode-stdio-1.0
test-suite
s.
This simply checks to see if any tests failed and if so exits with
exitFailure
.
Internal
type Prism s t a b = forall p f. (Choice p, Applicative f) => p a (f b) -> p s (f t) Source #
A prism embodies one constructor of a sum type (as a lens embodies one
part of a product type). See _Just
, _Nothing
, _Left
, and _Right
for examples. See Control.Lens.Prism for more explanation.
type Prism' s a = Prism s s a a Source #
A type-restricted prism. See Control.Lens.Prism for more explanation.
A set of unit- and property-tests
Hedgehog re-exports
A property test, along with some configurable limits like how many times to run the test.
data PropertyT (m :: Type -> Type) a #
The property monad transformer allows both the generation of test inputs and the assertion of expectations.
Instances
class Monad m => MonadTest (m :: Type -> Type) #
Instances
(===) :: (MonadTest m, Eq a, Show a, HasCallStack) => a -> a -> m () infix 4 #
Fails the test if the two arguments provided are not equal.
(/==) :: (MonadTest m, Eq a, Show a, HasCallStack) => a -> a -> m () infix 4 #
Fails the test if the two arguments provided are equal.
A summary of all the properties executed.
data PropertyConfig #
Configuration for a property test.
Instances
Eq PropertyConfig | |
Defined in Hedgehog.Internal.Property (==) :: PropertyConfig -> PropertyConfig -> Bool # (/=) :: PropertyConfig -> PropertyConfig -> Bool # | |
Ord PropertyConfig | |
Defined in Hedgehog.Internal.Property compare :: PropertyConfig -> PropertyConfig -> Ordering # (<) :: PropertyConfig -> PropertyConfig -> Bool # (<=) :: PropertyConfig -> PropertyConfig -> Bool # (>) :: PropertyConfig -> PropertyConfig -> Bool # (>=) :: PropertyConfig -> PropertyConfig -> Bool # max :: PropertyConfig -> PropertyConfig -> PropertyConfig # min :: PropertyConfig -> PropertyConfig -> PropertyConfig # | |
Show PropertyConfig | |
Defined in Hedgehog.Internal.Property showsPrec :: Int -> PropertyConfig -> ShowS # show :: PropertyConfig -> String # showList :: [PropertyConfig] -> ShowS # | |
Lift PropertyConfig | |
Defined in Hedgehog.Internal.Property lift :: PropertyConfig -> Q Exp # |
defaultConfig :: PropertyConfig #
The default configuration for a property test.