skeletest
Safe HaskellNone
LanguageGHC2021

Skeletest.Predicate

Synopsis

Documentation

data Predicate (m :: Type -> Type) a Source #

General

anything :: forall (m :: Type -> Type) a. Monad m => Predicate m a Source #

A predicate that matches any value

Ord

eq :: forall a (m :: Type -> Type). (Eq a, Monad m) => a -> Predicate m a Source #

A predicate checking if the input is equal to the given value

>>> 1 `shouldSatisfy` P.eq 1

gt :: forall a (m :: Type -> Type). (Ord a, Monad m) => a -> Predicate m a Source #

A predicate checking if the input is greater than the given value

>>> 1 `shouldSatisfy` P.gt 0

gte :: forall a (m :: Type -> Type). (Ord a, Monad m) => a -> Predicate m a Source #

A predicate checking if the input is greater than or equal to the given value

>>> 1 `shouldSatisfy` P.gte 0

lt :: forall a (m :: Type -> Type). (Ord a, Monad m) => a -> Predicate m a Source #

A predicate checking if the input is less than the given value

>>> 1 `shouldSatisfy` P.lt 10

lte :: forall a (m :: Type -> Type). (Ord a, Monad m) => a -> Predicate m a Source #

A predicate checking if the input is less than or equal to the given value

>>> 1 `shouldSatisfy` P.lte 10

Data types

just :: forall (m :: Type -> Type) a. Monad m => Predicate m a -> Predicate m (Maybe a) Source #

A predicate checking if the input is Just, wrapping a value matching the given predicate.

>>> Just 1 `shouldSatisfy` P.just (P.gt 0)

nothing :: forall (m :: Type -> Type) a. Monad m => Predicate m (Maybe a) Source #

A predicate checking if the input is Nothing

>>> Nothing `shouldSatisfy` P.nothing

left :: forall (m :: Type -> Type) a b. Monad m => Predicate m a -> Predicate m (Either a b) Source #

A predicate checking if the input is Left, wrapping a value matching the given predicate.

>>> Left 1 `shouldSatisfy` P.left (P.gt 0)

right :: forall (m :: Type -> Type) b a. Monad m => Predicate m b -> Predicate m (Either a b) Source #

A predicate checking if the input is Right, wrapping a value matching the given predicate.

>>> Right 1 `shouldSatisfy` P.right (P.gt 0)

list :: forall (m :: Type -> Type) a. Monad m => [Predicate m a] -> Predicate m [a] Source #

A predicate checking if the input is a list matching exactly the given predicates.

>>> [1, 2, 3] `shouldSatisfy` P.list [P.eq 1, P.eq 2, P.eq 3]
>>> [1, 2, 3] `shouldNotSatisfy` P.list [P.eq 1, P.eq 2]
>>> [1, 2, 3] `shouldNotSatisfy` P.list [P.eq 1, P.eq 2, P.eq 3, P.eq 4]

Since: 0.2.1

tup :: forall a (m :: Type -> Type). (IsPredTuple m a, Monad m) => ToPredTuple m a -> Predicate m a Source #

A predicate checking if the input matches a tuple matching the given predicates. Works for tuples up to 6 elements.

>>> (1, 10, "hello world") `shouldSatisfy` P.tup (P.eq 1, P.gt 2, P.hasPrefix "hello ")

con :: forall a (m :: Type -> Type). a -> Predicate m a Source #

A predicate checking if the input matches the given constructor.

It takes one argument, which is the constructor, except with all fields taking a Predicate instead of the normal value. Skeletest will rewrite the expression so it typechecks correctly.

>>> User "user1" "user1@example.com" `shouldSatisfy` P.con User{name = P.eq "user1", email = P.contains "@"}

Record fields that are omitted are not checked at all; i.e. P.con Foo{} and P.con Foo{a = P.anything} are equivalent.

Numeric

approx :: forall a (m :: Type -> Type). (Fractional a, Ord a, Monad m) => Tolerance -> a -> Predicate m a Source #

A predicate checking if the input is equal to the given value within some tolerance.

Useful for checking equality with floats, which might not be exactly equal. For more information, see: https://jvns.ca/blog/2023/01/13/examples-of-floating-point-problems/.

>>> (0.1 + 0.2) `shouldSatisfy` P.approx P.tol 0.3
>>> (0.1 + 0.2) `shouldSatisfy` P.approx P.tol{P.rel = Just 1e-6} 0.3
>>> (0.1 + 0.2) `shouldSatisfy` P.approx P.tol{P.abs = 1e-12} 0.3
>>> (0.1 + 0.2) `shouldSatisfy` P.approx P.tol{P.rel = Just 1e-6, P.abs = 1e-12} 0.3
>>> (0.1 + 0.2) `shouldSatisfy` P.approx P.tol{P.rel = Nothing} 0.3
>>> (0.1 + 0.2) `shouldSatisfy` P.approx P.tol{P.rel = Nothing, P.abs = 1e-12} 0.3

tol :: Tolerance Source #

The default tolerance for approx.

data Tolerance Source #

The tolerance to use in approx.

An input satisfies a tolerance if it's within the relative tolerance (rel * input) or the absolute tolerance of the reference value.

Constructors

Tolerance 

Fields

Combinators

(<<<) :: forall (m :: Type -> Type) a b. Monad m => Predicate m a -> (b -> a) -> Predicate m b infixr 1 Source #

A predicate checking if the input matches the given predicate, after applying the given function.

>>> "hello" `shouldSatisfy` (P.eq 5 P.<<< length)

(>>>) :: forall (m :: Type -> Type) b a. Monad m => (b -> a) -> Predicate m a -> Predicate m b infixr 1 Source #

Same as <<<, except with the arguments flipped.

>>> "hello" `shouldSatisfy` (length P.>>> P.eq 5)

not :: forall (m :: Type -> Type) a. Monad m => Predicate m a -> Predicate m a Source #

A predicate checking if the input does not match the given predicate

>>> Just 2 `shouldSatisfy` P.just (P.not (P.eq 1))

(&&) :: forall (m :: Type -> Type) a. Monad m => Predicate m a -> Predicate m a -> Predicate m a Source #

A predicate checking if the input matches both of the given predicates

>>> 1 `shouldSatisfy` P.gt 0 P.&& P.lt 2

(||) :: forall (m :: Type -> Type) a. Monad m => Predicate m a -> Predicate m a -> Predicate m a Source #

A predicate checking if the input matches one of the given predicates

>>> 1 `shouldSatisfy` P.lt 5 P.|| P.gt 10

and :: forall (m :: Type -> Type) a. Monad m => [Predicate m a] -> Predicate m a Source #

A predicate checking if the input matches all of the given predicates

>>> 1 `shouldSatisfy` P.and [P.gt 0, P.lt 2]

or :: forall (m :: Type -> Type) a. Monad m => [Predicate m a] -> Predicate m a Source #

A predicate checking if the input matches any of the given predicates

>>> 1 `shouldSatisfy` P.or [P.lt 5, P.gt 10]

Containers

any :: forall t (m :: Type -> Type) a. (Foldable t, Monad m) => Predicate m a -> Predicate m (t a) Source #

A predicate checking if the input is a list-like type where some element matches the given predicate.

>>> [1, 2, 3] `shouldSatisfy` P.any (P.eq 1)

all :: forall t (m :: Type -> Type) a. (Foldable t, Monad m) => Predicate m a -> Predicate m (t a) Source #

A predicate checking if the input is a list-like type where all elements match the given predicate.

>>> [1, 2, 3] `shouldSatisfy` P.all (P.gt 0)

elem :: forall a t (m :: Type -> Type). (Eq a, Foldable t, Monad m) => a -> Predicate m (t a) Source #

A predicate checking if the input is a list-like type where the given element is present. Equivalent to P.any . P.eq.

>>> [1, 2, 3] `shouldSatisfy` P.elem 1

Subsequences

class HasSubsequences a where Source #

Methods

isPrefixOf :: a -> a -> Bool Source #

isInfixOf :: a -> a -> Bool Source #

isSuffixOf :: a -> a -> Bool Source #

Instances

Instances details
HasSubsequences Text Source # 
Instance details

Defined in Skeletest.Internal.Predicate

Eq a => HasSubsequences [a] Source # 
Instance details

Defined in Skeletest.Internal.Predicate

Methods

isPrefixOf :: [a] -> [a] -> Bool Source #

isInfixOf :: [a] -> [a] -> Bool Source #

isSuffixOf :: [a] -> [a] -> Bool Source #

hasPrefix :: forall a (m :: Type -> Type). (HasSubsequences a, Monad m) => a -> Predicate m a Source #

A predicate checking if the input has the given prefix

>>> [1, 2, 3] `shouldSatisfy` P.hasPrefix [1, 2]
>>> "hello world" `shouldSatisfy` P.hasPrefix "hello "

hasInfix :: forall a (m :: Type -> Type). (HasSubsequences a, Monad m) => a -> Predicate m a Source #

A predicate checking if the input contains the given subsequence

>>> [1, 2, 3] `shouldSatisfy` P.hasInfix [2]
>>> "hello world" `shouldSatisfy` P.hasInfix "ello"

hasSuffix :: forall a (m :: Type -> Type). (HasSubsequences a, Monad m) => a -> Predicate m a Source #

A predicate checking if the input has the given suffix

>>> [1, 2, 3] `shouldSatisfy` P.hasSuffix [2, 3]
>>> "hello world" `shouldSatisfy` P.hasSuffix " world"

IO

returns :: MonadIO m => Predicate m a -> Predicate m (m a) Source #

A predicate checking if the input is an IO action that returns a value matching the given predicate.

>>> pure 1 `shouldSatisfy` P.returns (P.eq 1)

throws :: (Exception e, MonadUnliftIO m) => Predicate m e -> Predicate m (m a) Source #

A predicate checking if the input is an IO action that throws an exception matching the given predicate.

>>> throwIO MyException `shouldSatisfy` P.throws (P.eq MyException)

Functions

(===) :: (a -> b) -> (a -> b) -> IsoChecker a b infix 2 Source #

Verify if two functions are isomorphic.

prop "reverse . reverse === id" $ do
  let genList = Gen.list (Gen.linear 0 10) $ Gen.int (Gen.linear 0 1000)
  (reverse . reverse) P.=== id `shouldSatisfy` P.isoWith genList

Snapshot testing

matchesSnapshot :: forall a (m :: Type -> Type). (Typeable a, MonadIO m) => Predicate m a Source #

A predicate checking if the input matches the snapshot. See the "Snapshot tests" section in the README.

>>> user `shouldSatisfy` P.matchesSnapshot