hedgehog-fn-0.5: Function generation for `hedgehog`

Safe HaskellNone
LanguageHaskell2010

Hedgehog.Function

Contents

Description

The general procedure for generating functions of type A -> B looks something like this:

{-# language DeriveGeneric #-}
{-# language TypeApplications #-}

import Hedgehog
import Hedgehog.Function

data A = ...
  deriving (Generic, ...)

instance Arg A
instance Vary A

genB :: MonadGen m => m B
genB = ...

prop_test :: Property
prop_test =
  property $ do
    f <- forAllFn $ fn @A genB
    ...

Here's an example of how to use the library to test the "fmap composition" law.

ScopedTypeVariables and TypeApplications are recommended for ease of use. RankNTypes is only necessary for this example.

{-# language RankNTypes #-}
{-# language ScopedTypeVariables, TypeApplications #-}

import Hedgehog
import Hedgehog.Function
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range

map_compose
  :: forall f a b c
   . ( Functor f
     , Show (f a)
     , Show a, Arg a, Vary a
     , Show b, Arg b, Vary b
     , Show c
     , Eq (f c)
     , Show (f c)
     )
  => (forall x. Gen x -> Gen (f x))
  -> Gen a
  -> Gen b
  -> Gen c
  -> Property
map_compose genF genA genB genC =
  property $ do
    g <- forAllFn $ fn @a genB
    f <- forAllFn $ fn @b genC
    xs <- forAll $ genF genA
    fmap (f . g) xs === fmap f (fmap g xs)

prop_map_list :: Property
prop_map_list =
  map_compose
    (Gen.list (Range.constant 0 100))
    Gen.bool
    Gen.bool
    Gen.bool

Synopsis

Documentation

data Fn a b Source #

The type of randomly-generated functions

Instances

(Show a, Show b) => Show (Fn a b) Source # 

Methods

showsPrec :: Int -> Fn a b -> ShowS #

show :: Fn a b -> String #

showList :: [Fn a b] -> ShowS #

Generation

forAllFn :: (Show a, Show b, Monad m) => Gen (Fn a b) -> PropertyT m (a -> b) Source #

Run the function generator to retrieve a function

apply :: Fn a b -> a -> b Source #

Evaluate an Fn

fn :: (Arg a, Vary a) => Gen b -> Gen (Fn a b) Source #

Generate a function

fnWith :: Arg a => CoGen a -> Gen b -> Gen (Fn a b) Source #

Generate a function using the user-supplied co-generator

Building

gbuild :: (Generic a, GArg (Rep a)) => (a -> c) -> a :-> c Source #

Reify a function whose domain has an instance of Generic

via :: Arg b => (a -> b) -> (b -> a) -> (a -> c) -> a :-> c Source #

Reify a function via an isomorphism.

If your function's domain has no instance of Generic then you can still reify it using an isomorphism to a better domain type. For example, the Arg instance for Integral uses an isomorphism from Integral a => a to (Bool, [Bool]), where the first element is the sign, and the second element is the bit-string.

Note: via f g will only be well-behaved if g . f = id and f . g = id

buildIntegral :: (Arg a, Integral a) => (a -> c) -> a :-> c Source #

Reify a function on Integrals

class Arg a where Source #

instance Arg A where allows functions which take As to be reified

Methods

build :: (a -> c) -> a :-> c Source #

build :: (Generic a, GArg (Rep a)) => (a -> c) -> a :-> c Source #

Instances

Arg Bool Source # 

Methods

build :: (Bool -> c) -> Bool :-> c Source #

Arg Int Source # 

Methods

build :: (Int -> c) -> Int :-> c Source #

Arg Int8 Source # 

Methods

build :: (Int8 -> c) -> Int8 :-> c Source #

Arg Int16 Source # 

Methods

build :: (Int16 -> c) -> Int16 :-> c Source #

Arg Int32 Source # 

Methods

build :: (Int32 -> c) -> Int32 :-> c Source #

Arg Int64 Source # 

Methods

build :: (Int64 -> c) -> Int64 :-> c Source #

Arg Integer Source # 

Methods

build :: (Integer -> c) -> Integer :-> c Source #

Arg Ordering Source # 

Methods

build :: (Ordering -> c) -> Ordering :-> c Source #

Arg () Source # 

Methods

build :: (() -> c) -> () :-> c Source #

Arg Void Source # 

Methods

build :: (Void -> c) -> Void :-> c Source #

Arg a => Arg [a] Source # 

Methods

build :: ([a] -> c) -> [a] :-> c Source #

Arg a => Arg (Maybe a) Source # 

Methods

build :: (Maybe a -> c) -> Maybe a :-> c Source #

(Arg a, Arg b) => Arg (Either a b) Source # 

Methods

build :: (Either a b -> c) -> Either a b :-> c Source #

(Arg a, Arg b) => Arg (a, b) Source # 

Methods

build :: ((a, b) -> c) -> (a, b) :-> c Source #

Varying

data CoGenT m a Source #

A CoGenT m a is used to perturb a GenT m b based on the value of the a. This way, the generated function will have a varying (but still deterministic) right hand side.

Co-generators can be built using Divisible and Decidable, but it is recommended to derive Generic and use the default instance of the Vary type class.

CoGenT m ~ Op (Endo (GenT m b))

Instances

Divisible (CoGenT m) Source # 

Methods

divide :: (a -> (b, c)) -> CoGenT m b -> CoGenT m c -> CoGenT m a #

conquer :: CoGenT m a #

Decidable (CoGenT m) Source # 

Methods

lose :: (a -> Void) -> CoGenT m a #

choose :: (a -> Either b c) -> CoGenT m b -> CoGenT m c -> CoGenT m a #

Contravariant (CoGenT m) Source # 

Methods

contramap :: (a -> b) -> CoGenT m b -> CoGenT m a #

(>$) :: b -> CoGenT m b -> CoGenT m a #

gvary :: (Generic a, GVary (Rep a)) => CoGenT m a Source #

Build a co-generator for a type which has a Generic instance

varyIntegral :: Integral a => CoGenT m a Source #

Build a co-generator for an Integral type

class Vary a where Source #

Vary provides a canonical co-generator for a type.

While technically there are many possible co-generators for a given type, we don't get any benefit from caring.

Methods

vary :: CoGenT m a Source #

vary :: (Generic a, GVary (Rep a)) => CoGenT m a Source #

Instances

Vary Bool Source # 

Methods

vary :: CoGenT m Bool Source #

Vary Int Source # 

Methods

vary :: CoGenT m Int Source #

Vary Int8 Source # 

Methods

vary :: CoGenT m Int8 Source #

Vary Int16 Source # 

Methods

vary :: CoGenT m Int16 Source #

Vary Int32 Source # 

Methods

vary :: CoGenT m Int32 Source #

Vary Int64 Source # 

Methods

vary :: CoGenT m Int64 Source #

Vary Integer Source # 

Methods

vary :: CoGenT m Integer Source #

Vary Ordering Source # 
Vary Word8 Source # 

Methods

vary :: CoGenT m Word8 Source #

Vary () Source # 

Methods

vary :: CoGenT m () Source #

Vary Void Source # 

Methods

vary :: CoGenT m Void Source #

Vary a => Vary [a] Source # 

Methods

vary :: CoGenT m [a] Source #

Vary a => Vary (Maybe a) Source # 

Methods

vary :: CoGenT m (Maybe a) Source #

(Vary a, Vary b) => Vary (Either a b) Source # 

Methods

vary :: CoGenT m (Either a b) Source #

(Vary a, Vary b) => Vary (a, b) Source # 

Methods

vary :: CoGenT m (a, b) Source #