test-fun-0.1.0.0: Testable functions

Safe HaskellSafe
LanguageHaskell2010

Test.Fun.Internal.Types

Description

Representation of (higher-order) functions.

Warning

This is an internal module: it is not subject to any versioning policy, breaking changes can happen at any time. It is made available only for debugging. Otherwise, use Test.Fun.

If something here seems useful, please open an issue to export it from an external module.

Synopsis

Documentation

type FunName = String Source #

Name of a function.

type TypeName = String Source #

Name of a type.

type ConName = String Source #

Name of a constructor.

type ShowsPrec r = Int -> r -> String -> String Source #

The type of showsPrec.

data Concrete r Source #

Dictionary with shrinker and printer. Used as part of the representation of higher-order functions with (:->).

Constructors

Concrete 

Fields

hardConcrete :: Show r => Concrete r Source #

Trivial shrinker and default printer.

data a :-> r where infixr 1 Source #

Testable representation of functions (a -> r).

This representation supports random generation, shrinking, and printing, for property testing with QuickCheck or Hedgehog.

Higher-order functions can be represented.

Constructors

Const :: r -> a :-> r

Constant function, ignore the argument.

CoApply :: Concrete w -> w -> (w -> a) -> (b :-> ((a -> b) :-> r)) -> (a -> b) :-> r

Apply the argument (a -> b) to a value a, stored in some representation w, and describe what to do with the result b in another function.

Apply :: FunName -> (a -> b) -> (b :-> r) -> a :-> r

Apply some function to the argument a.

Case :: TypeName -> (a -> x) -> Branches x r -> r -> a :-> r

Pattern-match on the argument (in some ADT). The branches may be incomplete, in which case a default value r is used.

CaseInteger :: TypeName -> (a -> Integer) -> Bin r -> r -> a :-> r

Pattern-match on the argument (of some integral type).

Absurd :: (a -> Void) -> a :-> r

There is no value for the argument, so we're done.

ToShrink :: (a :-> r) -> a :-> r

Marker for truncating infinite representations.

Instances
Functor ((:->) a) Source # 
Instance details

Defined in Test.Fun.Internal.Types

Methods

fmap :: (a0 -> b) -> (a :-> a0) -> a :-> b #

(<$) :: a0 -> (a :-> b) -> a :-> a0 #

Foldable ((:->) a) Source # 
Instance details

Defined in Test.Fun.Internal.Types

Methods

fold :: Monoid m => (a :-> m) -> m #

foldMap :: Monoid m => (a0 -> m) -> (a :-> a0) -> m #

foldr :: (a0 -> b -> b) -> b -> (a :-> a0) -> b #

foldr' :: (a0 -> b -> b) -> b -> (a :-> a0) -> b #

foldl :: (b -> a0 -> b) -> b -> (a :-> a0) -> b #

foldl' :: (b -> a0 -> b) -> b -> (a :-> a0) -> b #

foldr1 :: (a0 -> a0 -> a0) -> (a :-> a0) -> a0 #

foldl1 :: (a0 -> a0 -> a0) -> (a :-> a0) -> a0 #

toList :: (a :-> a0) -> [a0] #

null :: (a :-> a0) -> Bool #

length :: (a :-> a0) -> Int #

elem :: Eq a0 => a0 -> (a :-> a0) -> Bool #

maximum :: Ord a0 => (a :-> a0) -> a0 #

minimum :: Ord a0 => (a :-> a0) -> a0 #

sum :: Num a0 => (a :-> a0) -> a0 #

product :: Num a0 => (a :-> a0) -> a0 #

Traversable ((:->) a) Source # 
Instance details

Defined in Test.Fun.Internal.Types

Methods

traverse :: Applicative f => (a0 -> f b) -> (a :-> a0) -> f (a :-> b) #

sequenceA :: Applicative f => (a :-> f a0) -> f (a :-> a0) #

mapM :: Monad m => (a0 -> m b) -> (a :-> a0) -> m (a :-> b) #

sequence :: Monad m => (a :-> m a0) -> m (a :-> a0) #

Show r => Show (a :-> r) Source #

Pretty-printed Show instance.

Instance details

Defined in Test.Fun.Internal.Orphan

Methods

showsPrec :: Int -> (a :-> r) -> ShowS #

show :: (a :-> r) -> String #

showList :: [a :-> r] -> ShowS #

data Branches x r where Source #

Representation of the branches of a Case.

Constructors

Fail :: Branches x r 
Alt :: !(Branches x r) -> !(Branches y r) -> Branches (Either x y) r 
Pat :: ConName -> !(Fields x r) -> Branches x r 
Instances
Functor (Branches x) Source # 
Instance details

Defined in Test.Fun.Internal.Types

Methods

fmap :: (a -> b) -> Branches x a -> Branches x b #

(<$) :: a -> Branches x b -> Branches x a #

Foldable (Branches x) Source # 
Instance details

Defined in Test.Fun.Internal.Types

Methods

fold :: Monoid m => Branches x m -> m #

foldMap :: Monoid m => (a -> m) -> Branches x a -> m #

foldr :: (a -> b -> b) -> b -> Branches x a -> b #

foldr' :: (a -> b -> b) -> b -> Branches x a -> b #

foldl :: (b -> a -> b) -> b -> Branches x a -> b #

foldl' :: (b -> a -> b) -> b -> Branches x a -> b #

foldr1 :: (a -> a -> a) -> Branches x a -> a #

foldl1 :: (a -> a -> a) -> Branches x a -> a #

toList :: Branches x a -> [a] #

null :: Branches x a -> Bool #

length :: Branches x a -> Int #

elem :: Eq a => a -> Branches x a -> Bool #

maximum :: Ord a => Branches x a -> a #

minimum :: Ord a => Branches x a -> a #

sum :: Num a => Branches x a -> a #

product :: Num a => Branches x a -> a #

Traversable (Branches x) Source # 
Instance details

Defined in Test.Fun.Internal.Types

Methods

traverse :: Applicative f => (a -> f b) -> Branches x a -> f (Branches x b) #

sequenceA :: Applicative f => Branches x (f a) -> f (Branches x a) #

mapM :: Monad m => (a -> m b) -> Branches x a -> m (Branches x b) #

sequence :: Monad m => Branches x (m a) -> m (Branches x a) #

data Fields x r where Source #

Representation of one branch of a Case.

Constructors

NoField :: r -> Fields () r 
Field :: !(Fields x (y :-> r)) -> Fields (x, y) r 
Instances
Functor (Fields x) Source # 
Instance details

Defined in Test.Fun.Internal.Types

Methods

fmap :: (a -> b) -> Fields x a -> Fields x b #

(<$) :: a -> Fields x b -> Fields x a #

Foldable (Fields x) Source # 
Instance details

Defined in Test.Fun.Internal.Types

Methods

fold :: Monoid m => Fields x m -> m #

foldMap :: Monoid m => (a -> m) -> Fields x a -> m #

foldr :: (a -> b -> b) -> b -> Fields x a -> b #

foldr' :: (a -> b -> b) -> b -> Fields x a -> b #

foldl :: (b -> a -> b) -> b -> Fields x a -> b #

foldl' :: (b -> a -> b) -> b -> Fields x a -> b #

foldr1 :: (a -> a -> a) -> Fields x a -> a #

foldl1 :: (a -> a -> a) -> Fields x a -> a #

toList :: Fields x a -> [a] #

null :: Fields x a -> Bool #

length :: Fields x a -> Int #

elem :: Eq a => a -> Fields x a -> Bool #

maximum :: Ord a => Fields x a -> a #

minimum :: Ord a => Fields x a -> a #

sum :: Num a => Fields x a -> a #

product :: Num a => Fields x a -> a #

Traversable (Fields x) Source # 
Instance details

Defined in Test.Fun.Internal.Types

Methods

traverse :: Applicative f => (a -> f b) -> Fields x a -> f (Fields x b) #

sequenceA :: Applicative f => Fields x (f a) -> f (Fields x a) #

mapM :: Monad m => (a -> m b) -> Fields x a -> m (Fields x b) #

sequence :: Monad m => Fields x (m a) -> m (Fields x a) #

data Bin r Source #

Representation of branches of a CaseInteger.

Constructors

BinEmpty 
BinAlt (Maybe r) (Bin r) (Bin r) 
BinToShrink (Bin r) 
Instances
Functor Bin Source # 
Instance details

Defined in Test.Fun.Internal.Types

Methods

fmap :: (a -> b) -> Bin a -> Bin b #

(<$) :: a -> Bin b -> Bin a #

Foldable Bin Source # 
Instance details

Defined in Test.Fun.Internal.Types

Methods

fold :: Monoid m => Bin m -> m #

foldMap :: Monoid m => (a -> m) -> Bin a -> m #

foldr :: (a -> b -> b) -> b -> Bin a -> b #

foldr' :: (a -> b -> b) -> b -> Bin a -> b #

foldl :: (b -> a -> b) -> b -> Bin a -> b #

foldl' :: (b -> a -> b) -> b -> Bin a -> b #

foldr1 :: (a -> a -> a) -> Bin a -> a #

foldl1 :: (a -> a -> a) -> Bin a -> a #

toList :: Bin a -> [a] #

null :: Bin a -> Bool #

length :: Bin a -> Int #

elem :: Eq a => a -> Bin a -> Bool #

maximum :: Ord a => Bin a -> a #

minimum :: Ord a => Bin a -> a #

sum :: Num a => Bin a -> a #

product :: Num a => Bin a -> a #

Traversable Bin Source # 
Instance details

Defined in Test.Fun.Internal.Types

Methods

traverse :: Applicative f => (a -> f b) -> Bin a -> f (Bin b) #

sequenceA :: Applicative f => Bin (f a) -> f (Bin a) #

mapM :: Monad m => (a -> m b) -> Bin a -> m (Bin b) #

sequence :: Monad m => Bin (m a) -> m (Bin a) #

Eq r => Eq (Bin r) Source # 
Instance details

Defined in Test.Fun.Internal.Types

Methods

(==) :: Bin r -> Bin r -> Bool #

(/=) :: Bin r -> Bin r -> Bool #

Ord r => Ord (Bin r) Source # 
Instance details

Defined in Test.Fun.Internal.Types

Methods

compare :: Bin r -> Bin r -> Ordering #

(<) :: Bin r -> Bin r -> Bool #

(<=) :: Bin r -> Bin r -> Bool #

(>) :: Bin r -> Bin r -> Bool #

(>=) :: Bin r -> Bin r -> Bool #

max :: Bin r -> Bin r -> Bin r #

min :: Bin r -> Bin r -> Bin r #

Show r => Show (Bin r) Source # 
Instance details

Defined in Test.Fun.Internal.Types

Methods

showsPrec :: Int -> Bin r -> ShowS #

show :: Bin r -> String #

showList :: [Bin r] -> ShowS #

coapply :: Concrete w -> w -> (w -> a) -> (b :-> ((a -> b) :-> r)) -> (a -> b) :-> r Source #

apply :: FunName -> (a -> b) -> (b :-> r) -> a :-> r Source #

case_ :: TypeName -> (a -> x) -> Branches x r -> r -> a :-> r Source #

caseInteger :: TypeName -> (a -> Integer) -> Bin r -> r -> a :-> r Source #

alt :: Branches x r -> Branches y r -> Branches (Either x y) r Source #

binAlt :: r -> Bin r -> Bin r -> Bin r Source #

applyFun :: (a :-> r) -> a -> r Source #

Evaluate a representation into the function it represents.

applyFun2 :: (a :-> (b :-> r)) -> a -> b -> r Source #

Apply a binary function representation.

applyFun3 :: (a :-> (b :-> (c :-> r))) -> a -> b -> c -> r Source #

Apply a ternary function representation.

applyBranches :: r -> Branches x r -> x -> r Source #

applyFields :: Fields x r -> x -> r Source #

applyBin :: r -> Bin r -> Integer -> r Source #

applyBin' :: r -> Bin r -> Integer -> r Source #

clearFun :: (r -> r) -> a -> (a :-> r) -> a :-> r Source #

Remove ToShrink nodes from evaluating a given argument a.

clearBranches :: forall x r. (r -> r) -> Branches x r -> x -> Maybe (Branches x r) Source #

clearFields :: (r -> r) -> Fields x r -> x -> Fields x r Source #

clearBin :: (r -> r) -> Bin r -> Integer -> Maybe (Bin r) Source #

clearBin' :: (r -> r) -> Integer -> Bin r -> Maybe (Bin r) Source #

truncateFun :: Int -> (r -> t) -> t -> (a :-> r) -> a :-> t Source #

truncateBin :: Int -> (r -> s) -> Bin r -> Bin s Source #