Safe Haskell | None |
---|---|
Language | GHC2021 |
Skeletest.Predicate
Synopsis
- data Predicate (m :: Type -> Type) a
- anything :: forall (m :: Type -> Type) a. Monad m => Predicate m a
- eq :: forall a (m :: Type -> Type). (Eq a, Monad m) => a -> Predicate m a
- gt :: forall a (m :: Type -> Type). (Ord a, Monad m) => a -> Predicate m a
- gte :: forall a (m :: Type -> Type). (Ord a, Monad m) => a -> Predicate m a
- lt :: forall a (m :: Type -> Type). (Ord a, Monad m) => a -> Predicate m a
- lte :: forall a (m :: Type -> Type). (Ord a, Monad m) => a -> Predicate m a
- just :: forall (m :: Type -> Type) a. Monad m => Predicate m a -> Predicate m (Maybe a)
- nothing :: forall (m :: Type -> Type) a. Monad m => Predicate m (Maybe a)
- left :: forall (m :: Type -> Type) a b. Monad m => Predicate m a -> Predicate m (Either a b)
- right :: forall (m :: Type -> Type) b a. Monad m => Predicate m b -> Predicate m (Either a b)
- list :: forall (m :: Type -> Type) a. Monad m => [Predicate m a] -> Predicate m [a]
- tup :: forall a (m :: Type -> Type). (IsPredTuple m a, Monad m) => ToPredTuple m a -> Predicate m a
- con :: forall a (m :: Type -> Type). a -> Predicate m a
- approx :: forall a (m :: Type -> Type). (Fractional a, Ord a, Monad m) => Tolerance -> a -> Predicate m a
- tol :: Tolerance
- data Tolerance = Tolerance {}
- (<<<) :: forall (m :: Type -> Type) a b. Monad m => Predicate m a -> (b -> a) -> Predicate m b
- (>>>) :: forall (m :: Type -> Type) b a. Monad m => (b -> a) -> Predicate m a -> Predicate m b
- not :: forall (m :: Type -> Type) a. Monad m => Predicate m a -> Predicate m a
- (&&) :: forall (m :: Type -> Type) a. Monad m => Predicate m a -> Predicate m a -> Predicate m a
- (||) :: forall (m :: Type -> Type) a. Monad m => Predicate m a -> Predicate m a -> Predicate m a
- and :: forall (m :: Type -> Type) a. Monad m => [Predicate m a] -> Predicate m a
- or :: forall (m :: Type -> Type) a. Monad m => [Predicate m a] -> Predicate m a
- any :: forall t (m :: Type -> Type) a. (Foldable t, Monad m) => Predicate m a -> Predicate m (t a)
- all :: forall t (m :: Type -> Type) a. (Foldable t, Monad m) => Predicate m a -> Predicate m (t a)
- elem :: forall a t (m :: Type -> Type). (Eq a, Foldable t, Monad m) => a -> Predicate m (t a)
- class HasSubsequences a where
- isPrefixOf :: a -> a -> Bool
- isInfixOf :: a -> a -> Bool
- isSuffixOf :: a -> a -> Bool
- hasPrefix :: forall a (m :: Type -> Type). (HasSubsequences a, Monad m) => a -> Predicate m a
- hasInfix :: forall a (m :: Type -> Type). (HasSubsequences a, Monad m) => a -> Predicate m a
- hasSuffix :: forall a (m :: Type -> Type). (HasSubsequences a, Monad m) => a -> Predicate m a
- returns :: MonadIO m => Predicate m a -> Predicate m (m a)
- throws :: (Exception e, MonadUnliftIO m) => Predicate m e -> Predicate m (m a)
- (===) :: (a -> b) -> (a -> b) -> IsoChecker a b
- isoWith :: (HasCallStack, Show a, Eq b) => Gen a -> Predicate PropertyM (IsoChecker a b)
- matchesSnapshot :: forall a (m :: Type -> Type). (Typeable a, MonadIO m) => Predicate m a
Documentation
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
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.
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
HasSubsequences Text Source # | |
Eq a => HasSubsequences [a] Source # | |
Defined in Skeletest.Internal.Predicate |
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
isoWith :: (HasCallStack, Show a, Eq b) => Gen a -> Predicate PropertyM (IsoChecker a b) Source #
See (===)
.