Copyright | 2018 Automattic Inc. |
---|---|
License | GPL-3 |
Maintainer | Nathan Bloomfield (nbloomf@gmail.com) |
Stability | experimental |
Portability | POSIX |
Safe Haskell | Safe |
Language | Haskell2010 |
In this module we define assertions as first class objects and some helper functions for creating and manipulating them.
- data Assertion
- success :: AssertionStatement -> AssertionComment -> Assertion
- failure :: AssertionStatement -> AssertionComment -> Assertion
- newtype AssertionStatement = AssertionStatement {}
- newtype AssertionComment = AssertionComment {}
- data AssertionResult
- isSuccess :: Assertion -> Bool
- printAssertion :: Assertion -> String
- class Assert m where
- data AssertionSummary = AssertionSummary {
- numSuccesses :: Integer
- numFailures :: Integer
- failures :: [Assertion]
- successes :: [Assertion]
- summarize :: [Assertion] -> AssertionSummary
- summarizeAll :: [AssertionSummary] -> AssertionSummary
- printSummary :: AssertionSummary -> IO ()
- assertSuccessIf :: (Monad m, Assert m) => Bool -> AssertionStatement -> AssertionComment -> m ()
- assertSuccess :: (Monad m, Assert m) => AssertionComment -> m ()
- assertFailure :: (Monad m, Assert m) => AssertionComment -> m ()
- assertTrue :: (Monad m, Assert m) => Bool -> AssertionComment -> m ()
- assertFalse :: (Monad m, Assert m) => Bool -> AssertionComment -> m ()
- assertEqual :: (Monad m, Assert m, Eq t, Show t) => t -> t -> AssertionComment -> m ()
- assertNotEqual :: (Monad m, Assert m, Eq t, Show t) => t -> t -> AssertionComment -> m ()
- assertIsSubstring :: (Monad m, Assert m, Eq a, Show a) => [a] -> [a] -> AssertionComment -> m ()
- assertIsNotSubstring :: (Monad m, Assert m, Eq a, Show a) => [a] -> [a] -> AssertionComment -> m ()
- assertIsNamedSubstring :: (Monad m, Assert m, Eq a, Show a) => [a] -> ([a], String) -> AssertionComment -> m ()
- assertIsNotNamedSubstring :: (Monad m, Assert m, Eq a, Show a) => [a] -> ([a], String) -> AssertionComment -> m ()
Assertions
:: AssertionStatement | Statement being asserted (the what) |
-> AssertionComment | An additional comment (the why) |
-> Assertion |
Construct a successful assertion.
:: AssertionStatement | Statement being asserted (the what) |
-> AssertionComment | An additional comment (the why) |
-> Assertion |
Construct a failed assertion.
newtype AssertionStatement Source #
Human-readable statement which may be true or false.
newtype AssertionComment Source #
Human-readable explanation for why an assertion is made.
data AssertionResult Source #
Type representing the result (success or failure) of an evaluated assertion.
printAssertion :: Assertion -> String Source #
Basic string representation of an assertion.
The Assert
Class
Assertions are made and evaluated inside some context, represented by the Assert
class.
assert :: Assertion -> m () Source #
Make an assertion. Typically m
is a monad, and the Assert
instance handles the assertion in m
by e.g. logging it, changing state, etc.
Assert (WebDriverT m) Source # | |
Assertion Summaries
data AssertionSummary Source #
Assertion
s are the most granular kind of "test" this library deals with. Typically we'll be interested in sets of many assertions. A single test case will include one or more assertions, which for reporting purposes we'd like to summarize. The summary for a list of assertions will include the number of successes, the number of failures, and the actual failures. Modeled this way assertion summaries form a monoid, which is handy.
AssertionSummary | |
|
summarizeAll :: [AssertionSummary] -> AssertionSummary Source #
Summarize a list of AssertionSummary
s.
printSummary :: AssertionSummary -> IO () Source #
Very basic string representation of an AssertionSummary
.
Basic Assertions
:: (Monad m, Assert m) | |
=> Bool | |
-> AssertionStatement | Statement being asserted (the what) |
-> AssertionComment | An additional comment (the why) |
-> m () |
Generic boolean assertion; asserts success if Bool
is true and failure otherwise.
:: (Monad m, Assert m) | |
=> AssertionComment | An additional comment (the why) |
-> m () |
Assertion that always succeeds.
:: (Monad m, Assert m) | |
=> AssertionComment | An additional comment (the why) |
-> m () |
Assertion that always fails.
:: (Monad m, Assert m) | |
=> Bool | |
-> AssertionComment | An additional comment (the why) |
-> m () |
Succeeds if Bool
is True
.
:: (Monad m, Assert m) | |
=> Bool | |
-> AssertionComment | An additional comment (the why) |
-> m () |
Succeeds if Bool
is False
.
:: (Monad m, Assert m, Eq t, Show t) | |
=> t | |
-> t | |
-> AssertionComment | An additional comment (the why) |
-> m () |
Succeeds if the given t
s are equal according to their Eq
instance.
:: (Monad m, Assert m, Eq t, Show t) | |
=> t | |
-> t | |
-> AssertionComment | An additional comment (the why) |
-> m () |
Succeeds if the given t
s are not equal according to their Eq
instance.
:: (Monad m, Assert m, Eq a, Show a) | |
=> [a] | |
-> [a] | |
-> AssertionComment | An additional comment (the why) |
-> m () |
Succeeds if the first list is an infix of the second, according to their Eq
instance.
:: (Monad m, Assert m, Eq a, Show a) | |
=> [a] | |
-> [a] | |
-> AssertionComment | An additional comment (the why) |
-> m () |
Succeeds if the first list is not an infix of the second, according to their Eq
instance.
assertIsNamedSubstring Source #
:: (Monad m, Assert m, Eq a, Show a) | |
=> [a] | |
-> ([a], String) | |
-> AssertionComment | An additional comment (the why) |
-> m () |
Succeeds if the first list is an infix of the second, named list, according to their Eq
instance. This is similar to assertIsSubstring
, except that the "name" of the second list argument is used in reporting failures. Handy if the second list is very large -- say the source of a webpage.
assertIsNotNamedSubstring Source #
:: (Monad m, Assert m, Eq a, Show a) | |
=> [a] | |
-> ([a], String) | |
-> AssertionComment | An additional comment (the why) |
-> m () |
Succeeds if the first list is not an infix of the second, named list, according to their Eq
instance. This is similar to assertIsNotSubstring
, except that the "name" of the second list argument is used in reporting failures. Handy if the second list is very large -- say the source of a webpage.