assert4hs-core-0.1.0: A set of assertion for writing more readable tests cases
Copyright(c) Pawel Nosal 2021
LicenseMIT
Maintainerp.nosal1986@gmail.com
Stabilityexperimental
Safe HaskellSafe-Inferred
LanguageHaskell2010
Extensions
  • BangPatterns
  • OverloadedStrings

Test.Fluent.Assertions

Description

This library aims to provide a set of combinators to assert arbitrary nested data structures. The inspiration of this library is AssertJ for Java, the composition of assertions was inspired by lens library.

Example:

 data Foo = Foo {name :: String, age :: Int} deriving (Show, Eq)

 assertThat (Foo "someName" 15) $
      isEqualTo (Foo "someN1ame" 15)
      . focus age
      . tag "age"
      . isGreaterThan 20

result in

 given Foo {name = "someName", age = 15} should be equal to Foo {name = "someN1ame", age = 15}
 Foo {name = "someName", age = 15}
 ╷
 │
 ╵
 Foo {name = "someN1ame", age = 15}
                   ▲
 [age] given 15 should be greater than 20
Synopsis

Assertions

Basic assertions

simpleAssertion Source #

Arguments

:: HasCallStack 
=> (a -> Bool)

A predicate that should be met by the subject under test

-> (a -> String)

A function that allows formatting an error message once the predicate is not met

-> Assertion a 

The simpleAssertion function is a building block of more complicated assertions.

It takes one predicate and function to format error message.

 myIsEqual x = simpleAssertion (== x) (\x' -> show x' <> " is not equal to " <> show x)

isEqualTo :: (Eq a, Show a, HasCallStack) => a -> Assertion a Source #

assert if subject under test is equal to given value

 assertThat 15 $ isEqualTo 16

result

 given 15 should be equal to 16
  ▼
 15
 ╷
 │
 ╵
 16
  ▲

isGreaterThan :: (Ord a, Show a, HasCallStack) => a -> Assertion a Source #

assert if the subject under test is greater than given value

 assertThat 15 $ isGreaterThan 16

result

 given 15 should be greater than 16

isLowerThan :: (Ord a, Show a, HasCallStack) => a -> Assertion a Source #

assert if the subject under test is lower than given value

 assertThat 16 $ isLowerThan 15

result

 given 16 should be lower than 15

contains :: (Foldable t, Eq a, Show a, HasCallStack) => a -> Assertion (t a) Source #

Assertion util functions

focus :: (a -> b) -> Assertion' a b Source #

allow changing subject under test using a transformation function

 assertThat "1    " $
           isNotEqualTo ""
             . focus length
             . isEqualTo 10

result

 given 5 should be equal to 10
 ▼
 5
 ╷
 │
 ╵
 10
 ▲▲

inside :: (b -> a) -> Assertion a -> Assertion b Source #

like focus, this function allow changing subject under test, it takes an assertion for modified value, then it allows us to continue assertion on the original value

  assertThat (Foo "someName" 15) $
                isEqualTo (Foo "someN1ame" 15)
              . inside age (tag "age" . isGreaterThan 20 . isLowerThan 10)
              . isEqualTo (Foo "someName" 15)

result

 given Foo {name = "someName", age = 15} should be equal to Foo {name = "someN1ame", age = 15}
       Foo {name = "someName", age = 15}
       ╷
       │
       ╵
       Foo {name = "someN1ame", age = 15}
                         ▲
       [age] given 15 should be greater than 20
       [age] given 15 should be lower than 10

tag :: String -> Assertion a Source #

this combinator allows marking following assertion with a given prefix

assertThat (Foo "someName" 15) $
  tag "foo" . isEqualTo (Foo "someN1ame" 15)
    . inside age (tag "age" . isGreaterThan 20 . isLowerThan 10)
    . tag "foo not equal"
    . isNotEqualTo (Foo "someName" 15)

result

 [foo] given Foo {name = "someName", age = 15} should be equal to Foo {name = "someN1ame", age = 15}
 Foo {name = "someName", age = 15}
 ╷
 │
 ╵
 Foo {name = "someN1ame", age = 15}
                   ▲
 [foo.age] given 15 should be greater than 20
 [foo.age] given 15 should be lower than 10
 [foo.not equal to] given Foo {name = "someName", age = 15} should be not equal to Foo {name = "someName", age = 15}
 Foo {name = "someName", age = 15}
 ╷
 │
 ╵
 Foo {name = "someName", age = 15}

forceError :: Assertion a -> Assertion a Source #

Sometimes it is handy to stop the assertions chain.

This combinator gets an assertion that should be forced, any following assertion will be not executed then

extracting :: HasCallStack => Assertion' (Maybe a) a
extracting = forceError isJust . focus Maybe.fromJust

Assertion configuration

defaultConfig :: AssertionConfig Source #

Default configuration used for assertThat and assertThatIO. - default timeout is set to 5 seconds

setAssertionTimeout :: Int -> AssertionConfig -> AssertionConfig Source #

Allow to modify timeout of single assertion

Types

Assertion defitions

type Assertion' a b = Assertion'' a a b b Source #

Assertion failure