extrapolate-0.4.1: generalize counter-examples of test properties

Copyright(c) 2017-2019 Rudy Matela
License3-Clause BSD (see the file LICENSE)
MaintainerRudy Matela <rudy@matela.com.br>
Safe HaskellNone
LanguageHaskell2010

Test.Extrapolate

Contents

Description

Extrapolate is a property-based testing library capable of reporting generalized counter-examples.

Consider the following faulty implementation of sort:

sort :: Ord a => [a] -> [a]
sort []      =  []
sort (x:xs)  =  sort (filter (< x) xs)
             ++ [x]
             ++ sort (filter (> x) xs)

When tests pass, Extrapolate works like a regular property-based testing library. See:

> check $ \xs -> sort (sort xs :: [Int]) == sort xs
+++ OK, passed 500 tests.

When tests fail, Extrapolate reports a fully defined counter-example and a generalization of failing inputs. See:

> check $ \xs -> length (sort xs :: [Int]) == length xs
*** Failed! Falsifiable (after 3 tests):
[0,0]

Generalization:
x:x:_

Conditional Generalization:
x:xs  when  elem x xs

Generalization: the property fails for any integer x and for any list _ at the tail.

Conditional Generalization: the property fails for a list x:xs whenever x is an element of xs

This hints at the actual source of the fault: our sort above discards repeated elements!

Synopsis

Checking properties

check :: Testable a => a -> IO () Source #

Checks a property printing results on stdout

> check $ \xs -> sort (sort xs) == sort (xs::[Int])
+++ OK, passed 360 tests.

> check $ \xs ys -> xs `union` ys == ys `union` (xs::[Int])
*** Failed! Falsifiable (after 4 tests):
[] [0,0]

Generalization:
[] (x:x:_)

checkResult :: Testable a => a -> IO Bool Source #

Check a property printing results on stdout and returning True on success.

There is no option to silence this function: for silence, you should use holds.

for :: Testable a => (WithOption a -> b) -> Int -> a -> b Source #

Use for to configure the number of tests performed by check.

> check `for` 10080 $ \xs -> sort (sort xs) == sort (xs :: [Int])
+++ OK, passed 10080 tests.

Don't forget the dollar ($)!

withBackground :: Testable a => (WithOption a -> b) -> [Expr] -> a -> b Source #

Use withBackground to provide additional functions to appear in side-conditions.

check `withBackground` [value "isSpace" isSpace] $ \xs -> unwords (words xs) == xs
*** Failed! Falsifiable (after 4 tests):
" "

Generalization:
' ':_

Conditional Generalization:
c:_  when  isSpace c

withConditionSize :: Testable a => (WithOption a -> b) -> Int -> a -> b Source #

Use withConditionSize to configure the maximum condition size allowed.

Generalizable types

class (Listable a, Express a, Name a, Show a) => Generalizable a where Source #

Extrapolate can generalize counter-examples of any types that are Generalizable.

Generalizable types must first be instances of

  • Listable, so Extrapolate knows how to enumerate values;
  • Express, so Extrapolate can represent then manipulate values;
  • Name, so Extrapolate knows how to name variables.

There are no required functions, so we can define instances with:

instance Generalizable OurType

However, it is desirable to define both background and subInstances.

The following example shows a datatype and its instance:

data Stack a = Stack a (Stack a) | Empty
instance Generalizable a => Generalizable (Stack a) where
  subInstances s  =  instances (argTy1of1 s)

To declare instances it may be useful to use type binding operators such as: argTy1of1, argTy1of2 and argTy2of2.

Instances can be automatically derived using deriveGeneralizable which will also automatically derivate Listable, Express and Name when needed.

Minimal complete definition

Nothing

Methods

background :: a -> [Expr] Source #

List of symbols allowed to appear in side-conditions. Defaults to []. See value.

subInstances :: a -> Instances -> Instances Source #

Computes a list of reified subtype instances. Defaults to id. See instances.

Instances
Generalizable Bool Source # 
Instance details

Defined in Test.Extrapolate.Generalizable

Methods

background :: Bool -> [Expr] Source #

subInstances :: Bool -> Instances -> Instances Source #

Generalizable Char Source # 
Instance details

Defined in Test.Extrapolate.Generalizable

Methods

background :: Char -> [Expr] Source #

subInstances :: Char -> Instances -> Instances Source #

Generalizable Int Source # 
Instance details

Defined in Test.Extrapolate.Generalizable

Methods

background :: Int -> [Expr] Source #

subInstances :: Int -> Instances -> Instances Source #

Generalizable Integer Source # 
Instance details

Defined in Test.Extrapolate.Generalizable

Methods

background :: Integer -> [Expr] Source #

subInstances :: Integer -> Instances -> Instances Source #

Generalizable Ordering Source # 
Instance details

Defined in Test.Extrapolate.Generalizable

Methods

background :: Ordering -> [Expr] Source #

subInstances :: Ordering -> Instances -> Instances Source #

Generalizable () Source # 
Instance details

Defined in Test.Extrapolate.Generalizable

Methods

background :: () -> [Expr] Source #

subInstances :: () -> Instances -> Instances Source #

Generalizable a => Generalizable [a] Source # 
Instance details

Defined in Test.Extrapolate.Generalizable

Methods

background :: [a] -> [Expr] Source #

subInstances :: [a] -> Instances -> Instances Source #

Generalizable a => Generalizable (Maybe a) Source # 
Instance details

Defined in Test.Extrapolate.Generalizable

Methods

background :: Maybe a -> [Expr] Source #

subInstances :: Maybe a -> Instances -> Instances Source #

(Integral a, Generalizable a) => Generalizable (Ratio a) Source # 
Instance details

Defined in Test.Extrapolate.Generalizable

Methods

background :: Ratio a -> [Expr] Source #

subInstances :: Ratio a -> Instances -> Instances Source #

(Generalizable a, Generalizable b) => Generalizable (Either a b) Source # 
Instance details

Defined in Test.Extrapolate.Generalizable

Methods

background :: Either a b -> [Expr] Source #

subInstances :: Either a b -> Instances -> Instances Source #

(Generalizable a, Generalizable b) => Generalizable (a, b) Source # 
Instance details

Defined in Test.Extrapolate.Generalizable

Methods

background :: (a, b) -> [Expr] Source #

subInstances :: (a, b) -> Instances -> Instances Source #

(Generalizable a, Generalizable b, Generalizable c) => Generalizable (a, b, c) Source # 
Instance details

Defined in Test.Extrapolate.Generalizable

Methods

background :: (a, b, c) -> [Expr] Source #

subInstances :: (a, b, c) -> Instances -> Instances Source #

(Generalizable a, Generalizable b, Generalizable c, Generalizable d) => Generalizable (a, b, c, d) Source # 
Instance details

Defined in Test.Extrapolate.Generalizable

Methods

background :: (a, b, c, d) -> [Expr] Source #

subInstances :: (a, b, c, d) -> Instances -> Instances Source #

(Generalizable a, Generalizable b, Generalizable c, Generalizable d, Generalizable e) => Generalizable (a, b, c, d, e) Source # 
Instance details

Defined in Test.Extrapolate.Generalizable

Methods

background :: (a, b, c, d, e) -> [Expr] Source #

subInstances :: (a, b, c, d, e) -> Instances -> Instances Source #

(Generalizable a, Generalizable b, Generalizable c, Generalizable d, Generalizable e, Generalizable f) => Generalizable (a, b, c, d, e, f) Source # 
Instance details

Defined in Test.Extrapolate.Generalizable

Methods

background :: (a, b, c, d, e, f) -> [Expr] Source #

subInstances :: (a, b, c, d, e, f) -> Instances -> Instances Source #

(Generalizable a, Generalizable b, Generalizable c, Generalizable d, Generalizable e, Generalizable f, Generalizable g) => Generalizable (a, b, c, d, e, f, g) Source # 
Instance details

Defined in Test.Extrapolate.Generalizable

Methods

background :: (a, b, c, d, e, f, g) -> [Expr] Source #

subInstances :: (a, b, c, d, e, f, g) -> Instances -> Instances Source #

(Generalizable a, Generalizable b, Generalizable c, Generalizable d, Generalizable e, Generalizable f, Generalizable g, Generalizable h) => Generalizable (a, b, c, d, e, f, g, h) Source # 
Instance details

Defined in Test.Extrapolate.Generalizable

Methods

background :: (a, b, c, d, e, f, g, h) -> [Expr] Source #

subInstances :: (a, b, c, d, e, f, g, h) -> Instances -> Instances Source #

instances :: Generalizable a => a -> Instances -> Instances Source #

Used in the definition of subInstances in Generalizable typeclass instances.

data Expr #

Values of type Expr represent objects or applications between objects. Each object is encapsulated together with its type and string representation. Values encoded in Exprs are always monomorphic.

An Expr can be constructed using:

  • val, for values that are Show instances;
  • value, for values that are not Show instances, like functions;
  • :$, for applications between Exprs.
> val False
False :: Bool
> value "not" not :$ val False
not False :: Bool

An Expr can be evaluated using evaluate, eval or evl.

> evl $ val (1 :: Int) :: Int
1
> evaluate $ val (1 :: Int) :: Maybe Bool
Nothing
> eval 'a' (val 'b')
'b'

Showing a value of type Expr will return a pretty-printed representation of the expression together with its type.

> show (value "not" not :$ val False)
"not False :: Bool"

Expr is like Dynamic but has support for applications and variables (:$, var).

The var underscore convention: Functions that manipulate Exprs usually follow the convention where a value whose String representation starts with '_' represents a variable.

Constructors

Value String Dynamic

a value enconded as String and Dynamic

Expr :$ Expr

function application between expressions

Instances
Eq Expr

O(n). Does not evaluate values when comparing, but rather uses their representation as strings and their types.

This instance works for ill-typed expressions.

Instance details

Defined in Data.Express.Core

Methods

(==) :: Expr -> Expr -> Bool #

(/=) :: Expr -> Expr -> Bool #

Ord Expr 
Instance details

Defined in Data.Express.Core

Methods

compare :: Expr -> Expr -> Ordering #

(<) :: Expr -> Expr -> Bool #

(<=) :: Expr -> Expr -> Bool #

(>) :: Expr -> Expr -> Bool #

(>=) :: Expr -> Expr -> Bool #

max :: Expr -> Expr -> Expr #

min :: Expr -> Expr -> Expr #

Show Expr 
Instance details

Defined in Data.Express.Core

Methods

showsPrec :: Int -> Expr -> ShowS #

show :: Expr -> String #

showList :: [Expr] -> ShowS #

value :: Typeable a => String -> a -> Expr #

O(1). It takes a string representation of a value and a value, returning an Expr with that terminal value. For instances of Show, it is preferable to use val.

> value "0" (0 :: Integer)
0 :: Integer
> value "'a'" 'a'
'a' :: Char
> value "True" True
True :: Bool
> value "id" (id :: Int -> Int)
id :: Int -> Int
> value "(+)" ((+) :: Int -> Int -> Int)
(+) :: Int -> Int -> Int
> value "sort" (sort :: [Bool] -> [Bool])
sort :: [Bool] -> [Bool]

val :: (Typeable a, Show a) => a -> Expr #

O(1). A shorthand for value for values that are Show instances.

> val (0 :: Int)
0 :: Int
> val 'a'
'a' :: Char
> val True
True :: Bool

Example equivalences to value:

val 0     =  value "0" 0
val 'a'   =  value "'a'" 'a'
val True  =  value "True" True

reifyEq :: (Typeable a, Eq a) => a -> [Expr] #

O(1). Reifies an Eq instance into a list of Exprs. The list will contain == and /= for the given type. (cf. mkEq, mkEquation)

> reifyEq (undefined :: Int)
[ (==) :: Int -> Int -> Bool
, (/=) :: Int -> Int -> Bool ]
> reifyEq (undefined :: Bool)
[ (==) :: Bool -> Bool -> Bool
, (/=) :: Bool -> Bool -> Bool ]
> reifyEq (undefined :: String)
[ (==) :: [Char] -> [Char] -> Bool
, (/=) :: [Char] -> [Char] -> Bool ]

reifyOrd :: (Typeable a, Ord a) => a -> [Expr] #

O(1). Reifies an Ord instance into a list of Exprs. The list will contain compare, <= and < for the given type. (cf. mkOrd, mkOrdLessEqual, mkComparisonLE, mkComparisonLT)

> reifyOrd (undefined :: Int)
[ (<=) :: Int -> Int -> Bool
, (<) :: Int -> Int -> Bool ]
> reifyOrd (undefined :: Bool)
[ (<=) :: Bool -> Bool -> Bool
, (<) :: Bool -> Bool -> Bool ]
> reifyOrd (undefined :: [Bool])
[ (<=) :: [Bool] -> [Bool] -> Bool
, (<) :: [Bool] -> [Bool] -> Bool ]

reifyEqOrd :: (Typeable a, Ord a) => a -> [Expr] #

O(1). Reifies Eq and Ord instances into a list of Expr.

Testable properties

class Typeable a => Testable a Source #

Minimal complete definition

resultiers, tinstances

Instances
Testable Bool Source # 
Instance details

Defined in Test.Extrapolate.Testable

Methods

resultiers :: Bool -> [[(Expr, Bool)]] Source #

tinstances :: Bool -> Instances Source #

options :: Bool -> Options Source #

Testable a => Testable (WithOption a) Source # 
Instance details

Defined in Test.Extrapolate.Testable

Methods

resultiers :: WithOption a -> [[(Expr, Bool)]] Source #

tinstances :: WithOption a -> Instances Source #

options :: WithOption a -> Options Source #

(Testable b, Generalizable a, Listable a) => Testable (a -> b) Source # 
Instance details

Defined in Test.Extrapolate.Testable

Methods

resultiers :: (a -> b) -> [[(Expr, Bool)]] Source #

tinstances :: (a -> b) -> Instances Source #

options :: (a -> b) -> Options Source #

Automatically deriving Generalizable instances

deriveGeneralizable :: Name -> DecsQ Source #

Derives a Generalizable instance for a given type Name.

If needed, this function also automatically derivates Listable, Express and Name instances using respectively deriveListable, deriveExpress and deriveName.

Consider the following Stack datatype:

data Stack a = Stack a (Stack a) | Empty

Writing

deriveGeneralizable ''Stack

will automatically derive the following Generalizable instance:

instance Generalizable a => Generalizable (Stack a) where
  instances s = this "s" s
              $ let Stack x y = Stack undefined undefined `asTypeOf` s
                in instances x
                 . instances y

This function needs the TemplateHaskell extension.

deriveGeneralizableIfNeeded :: Name -> DecsQ Source #

Same as deriveGeneralizable but does not warn when instance already exists (deriveGeneralizable is preferable).

deriveGeneralizableCascading :: Name -> DecsQ Source #

Derives a Generalizable instance for a given type Name cascading derivation of type arguments as well.

Typeclasses required by Generalizable

class Name a where #

If we were to come up with a variable name for the given type what name would it be?

An instance for a given type Ty is simply given by:

instance Name Ty where name _ = "x"

Examples:

> name (undefined :: Int)
"x"
> name (undefined :: Bool)
"p"
> name (undefined :: [Int])
"xs"

This is then used to generate an infinite list of variable names:

> names (undefined :: Int)
["x", "y", "z", "x'", "y'", "z'", "x''", "y''", "z''", ...]
> names (undefined :: Bool)
["p", "q", "r", "p'", "q'", "r'", "p''", "q''", "r''", ...]
> names (undefined :: [Int])
["xs", "ys", "zs", "xs'", "ys'", "zs'", "xs''", "ys''", ...]

Minimal complete definition

Nothing

Methods

name :: a -> String #

O(1).

Returns a name for a variable of the given argument's type.

> name (undefined :: Int)
"x"
> name (undefined :: [Bool])
"ps"
> name (undefined :: [Maybe Integer])
"mxs"

The default definition is:

name _ = "x"
Instances
Name Bool
name (undefined :: Bool) = "p"
names (undefined :: Bool) = ["p", "q", "r", "p'", "q'", ...]
Instance details

Defined in Data.Express.Name

Methods

name :: Bool -> String #

Name Char
name (undefined :: Char) = "c"
names (undefined :: Char) = ["c", "d", "e", "c'", "d'", ...]
Instance details

Defined in Data.Express.Name

Methods

name :: Char -> String #

Name Double
name (undefined :: Double) = "x"
names (undefined :: Double) = ["x", "y", "z", "x'", ...]
Instance details

Defined in Data.Express.Name

Methods

name :: Double -> String #

Name Float
name (undefined :: Float) = "x"
names (undefined :: Float) = ["x", "y", "z", "x'", ...]
Instance details

Defined in Data.Express.Name

Methods

name :: Float -> String #

Name Int
name (undefined :: Int) = "x"
names (undefined :: Int) = ["x", "y", "z", "x'", "y'", ...]
Instance details

Defined in Data.Express.Name

Methods

name :: Int -> String #

Name Integer
name (undefined :: Integer) = "x"
names (undefined :: Integer) = ["x", "y", "z", "x'", ...]
Instance details

Defined in Data.Express.Name

Methods

name :: Integer -> String #

Name Ordering
name (undefined :: Ordering) = "o"
names (undefined :: Ordering) = ["o", "p", "q", "o'", ...]
Instance details

Defined in Data.Express.Name

Methods

name :: Ordering -> String #

Name Word 
Instance details

Defined in Data.Express.Name

Methods

name :: Word -> String #

Name ()
name (undefined :: ()) = "u"
names (undefined :: ()) = ["u", "v", "w", "u'", "v'", ...]
Instance details

Defined in Data.Express.Name

Methods

name :: () -> String #

Name a => Name [a]
names (undefined :: [Int]) = ["xs", "ys", "zs", "xs'", ...]
names (undefined :: [Bool]) = ["ps", "qs", "rs", "ps'", ...]
Instance details

Defined in Data.Express.Name

Methods

name :: [a] -> String #

Name a => Name (Maybe a)
names (undefined :: Maybe Int) = ["mx", "mx1", "mx2", ...]
nemes (undefined :: Maybe Bool) = ["mp", "mp1", "mp2", ...]
Instance details

Defined in Data.Express.Name

Methods

name :: Maybe a -> String #

Name (Ratio a)
name (undefined :: Rational) = "q"
names (undefined :: Rational) = ["q", "r", "s", "q'", ...]
Instance details

Defined in Data.Express.Name

Methods

name :: Ratio a -> String #

Name (a -> b)
names (undefined :: ()->()) = ["f", "g", "h", "f'", ...]
names (undefined :: Int->Int) = ["f", "g", "h", ...]
Instance details

Defined in Data.Express.Name

Methods

name :: (a -> b) -> String #

(Name a, Name b) => Name (Either a b)
names (undefined :: Either Int Int) = ["exy", "exy1", ...]
names (undefined :: Either Int Bool) = ["exp", "exp1", ...]
Instance details

Defined in Data.Express.Name

Methods

name :: Either a b -> String #

(Name a, Name b) => Name (a, b)
names (undefined :: (Int,Int)) = ["xy", "zw", "xy'", ...]
names (undefined :: (Bool,Bool)) = ["pq", "rs", "pq'", ...]
Instance details

Defined in Data.Express.Name

Methods

name :: (a, b) -> String #

(Name a, Name b, Name c) => Name (a, b, c)
names (undefined :: (Int,Int,Int)) = ["xyz","uvw", ...]
names (undefined :: (Int,Bool,Char)) = ["xpc", "xpc1", ...]
Instance details

Defined in Data.Express.Name

Methods

name :: (a, b, c) -> String #

(Name a, Name b, Name c, Name d) => Name (a, b, c, d)
names (undefined :: ((),(),(),())) = ["uuuu", "uuuu1", ...]
names (undefined :: (Int,Int,Int,Int)) = ["xxxx", ...]
Instance details

Defined in Data.Express.Name

Methods

name :: (a, b, c, d) -> String #

(Name a, Name b, Name c, Name d, Name e) => Name (a, b, c, d, e) 
Instance details

Defined in Data.Express.Name

Methods

name :: (a, b, c, d, e) -> String #

(Name a, Name b, Name c, Name d, Name e, Name f) => Name (a, b, c, d, e, f) 
Instance details

Defined in Data.Express.Name

Methods

name :: (a, b, c, d, e, f) -> String #

(Name a, Name b, Name c, Name d, Name e, Name f, Name g) => Name (a, b, c, d, e, f, g) 
Instance details

Defined in Data.Express.Name

Methods

name :: (a, b, c, d, e, f, g) -> String #

(Name a, Name b, Name c, Name d, Name e, Name f, Name g, Name h) => Name (a, b, c, d, e, f, g, h) 
Instance details

Defined in Data.Express.Name

Methods

name :: (a, b, c, d, e, f, g, h) -> String #

(Name a, Name b, Name c, Name d, Name e, Name f, Name g, Name h, Name i) => Name (a, b, c, d, e, f, g, h, i) 
Instance details

Defined in Data.Express.Name

Methods

name :: (a, b, c, d, e, f, g, h, i) -> String #

(Name a, Name b, Name c, Name d, Name e, Name f, Name g, Name h, Name i, Name j) => Name (a, b, c, d, e, f, g, h, i, j) 
Instance details

Defined in Data.Express.Name

Methods

name :: (a, b, c, d, e, f, g, h, i, j) -> String #

(Name a, Name b, Name c, Name d, Name e, Name f, Name g, Name h, Name i, Name j, Name k) => Name (a, b, c, d, e, f, g, h, i, j, k) 
Instance details

Defined in Data.Express.Name

Methods

name :: (a, b, c, d, e, f, g, h, i, j, k) -> String #

(Name a, Name b, Name c, Name d, Name e, Name f, Name g, Name h, Name i, Name j, Name k, Name l) => Name (a, b, c, d, e, f, g, h, i, j, k, l) 
Instance details

Defined in Data.Express.Name

Methods

name :: (a, b, c, d, e, f, g, h, i, j, k, l) -> String #

class Typeable a => Express a where #

Express typeclass instances provide an expr function that allows values to be deeply encoded as applications of Exprs.

expr False  =  val False
expr (Just True)  =  value "Just" (Just :: Bool -> Maybe Bool) :$ val True

The function expr can be contrasted with the function val:

  • val always encodes values as atomic Value Exprs -- shallow encoding.
  • expr ideally encodes expressions as applications (:$) between Value Exprs -- deep encoding.

Depending on the situation, one or the other may be desirable.

Instances can be automatically derived using the TH function deriveExpress.

The following example shows a datatype and its instance:

data Stack a = Stack a (Stack a) | Empty
instance Express a => Express (Stack a) where
  expr s@(Stack x y) = value "Stack" (Stack ->>: s) :$ expr x :$ expr y
  expr s@Empty       = value "Empty" (Empty   -: s)

To declare expr it may be useful to use auxiliary type binding operators: -:, ->:, ->>:, ....

For types with atomic values, just declare expr = val

Methods

expr :: a -> Expr #

Instances
Express Bool 
Instance details

Defined in Data.Express.Express

Methods

expr :: Bool -> Expr #

Express Char 
Instance details

Defined in Data.Express.Express

Methods

expr :: Char -> Expr #

Express Int 
Instance details

Defined in Data.Express.Express

Methods

expr :: Int -> Expr #

Express Integer 
Instance details

Defined in Data.Express.Express

Methods

expr :: Integer -> Expr #

Express Ordering 
Instance details

Defined in Data.Express.Express

Methods

expr :: Ordering -> Expr #

Express () 
Instance details

Defined in Data.Express.Express

Methods

expr :: () -> Expr #

Express a => Express [a] 
Instance details

Defined in Data.Express.Express

Methods

expr :: [a] -> Expr #

Express a => Express (Maybe a) 
Instance details

Defined in Data.Express.Express

Methods

expr :: Maybe a -> Expr #

(Integral a, Show a, Express a) => Express (Ratio a) 
Instance details

Defined in Data.Express.Express

Methods

expr :: Ratio a -> Expr #

(Express a, Express b) => Express (Either a b) 
Instance details

Defined in Data.Express.Express

Methods

expr :: Either a b -> Expr #

(Express a, Express b) => Express (a, b) 
Instance details

Defined in Data.Express.Express

Methods

expr :: (a, b) -> Expr #

(Express a, Express b, Express c) => Express (a, b, c) 
Instance details

Defined in Data.Express.Express

Methods

expr :: (a, b, c) -> Expr #

(Express a, Express b, Express c, Express d) => Express (a, b, c, d) 
Instance details

Defined in Data.Express.Express

Methods

expr :: (a, b, c, d) -> Expr #

(Express a, Express b, Express c, Express d, Express e) => Express (a, b, c, d, e) 
Instance details

Defined in Data.Express.Express

Methods

expr :: (a, b, c, d, e) -> Expr #

(Express a, Express b, Express c, Express d, Express e, Express f) => Express (a, b, c, d, e, f) 
Instance details

Defined in Data.Express.Express

Methods

expr :: (a, b, c, d, e, f) -> Expr #

(Express a, Express b, Express c, Express d, Express e, Express f, Express g) => Express (a, b, c, d, e, f, g) 
Instance details

Defined in Data.Express.Express

Methods

expr :: (a, b, c, d, e, f, g) -> Expr #

(Express a, Express b, Express c, Express d, Express e, Express f, Express g, Express h) => Express (a, b, c, d, e, f, g, h) 
Instance details

Defined in Data.Express.Express

Methods

expr :: (a, b, c, d, e, f, g, h) -> Expr #

(Express a, Express b, Express c, Express d, Express e, Express f, Express g, Express h, Express i) => Express (a, b, c, d, e, f, g, h, i) 
Instance details

Defined in Data.Express.Express

Methods

expr :: (a, b, c, d, e, f, g, h, i) -> Expr #

(Express a, Express b, Express c, Express d, Express e, Express f, Express g, Express h, Express i, Express j) => Express (a, b, c, d, e, f, g, h, i, j) 
Instance details

Defined in Data.Express.Express

Methods

expr :: (a, b, c, d, e, f, g, h, i, j) -> Expr #

(Express a, Express b, Express c, Express d, Express e, Express f, Express g, Express h, Express i, Express j, Express k) => Express (a, b, c, d, e, f, g, h, i, j, k) 
Instance details

Defined in Data.Express.Express

Methods

expr :: (a, b, c, d, e, f, g, h, i, j, k) -> Expr #

(Express a, Express b, Express c, Express d, Express e, Express f, Express g, Express h, Express i, Express j, Express k, Express l) => Express (a, b, c, d, e, f, g, h, i, j, k, l) 
Instance details

Defined in Data.Express.Express

Methods

expr :: (a, b, c, d, e, f, g, h, i, j, k, l) -> Expr #

Other useful modules

listsOfLength :: Int -> [[a]] -> [[[a]]] #

Takes as argument an integer length and tiers of element values; returns tiers of lists of element values of the given length.

listsOfLength 3 [[0],[1],[2],[3],[4]...] =
  [ [[0,0,0]]
  , [[0,0,1],[0,1,0],[1,0,0]]
  , [[0,0,2],[0,1,1],[0,2,0],[1,0,1],[1,1,0],[2,0,0]]
  , ...
  ]

setsOf :: [[a]] -> [[[a]]] #

Takes as argument tiers of element values; returns tiers of size-ordered lists of elements without repetition.

setsOf [[0],[1],[2],...] =
  [ [[]]
  , [[0]]
  , [[1]]
  , [[0,1],[2]]
  , [[0,2],[3]]
  , [[0,3],[1,2],[4]]
  , [[0,1,2],[0,4],[1,3],[5]]
  , ...
  ]

Can be used in the constructor of specialized Listable instances. For Set (from Data.Set), we would have:

instance Listable a => Listable (Set a) where
  tiers = mapT fromList $ setsOf tiers

bagsOf :: [[a]] -> [[[a]]] #

Takes as argument tiers of element values; returns tiers of size-ordered lists of elements possibly with repetition.

bagsOf [[0],[1],[2],...] =
  [ [[]]
  , [[0]]
  , [[0,0],[1]]
  , [[0,0,0],[0,1],[2]]
  , [[0,0,0,0],[0,0,1],[0,2],[1,1],[3]]
  , [[0,0,0,0,0],[0,0,0,1],[0,0,2],[0,1,1],[0,3],[1,2],[4]]
  , ...
  ]

noDupListsOf :: [[a]] -> [[[a]]] #

Takes as argument tiers of element values; returns tiers of lists with no repeated elements.

noDupListsOf [[0],[1],[2],...] ==
  [ [[]]
  , [[0]]
  , [[1]]
  , [[0,1],[1,0],[2]]
  , [[0,2],[2,0],[3]]
  , ...
  ]

normalizeT :: [[a]] -> [[a]] #

Normalizes tiers by removing up to 12 empty tiers from the end of a list of tiers.

normalizeT [xs0,xs1,...,xsN,[]]     =  [xs0,xs1,...,xsN]
normalizeT [xs0,xs1,...,xsN,[],[]]  =  [xs0,xs1,...,xsN]

The arbitrary limit of 12 tiers is necessary as this function would loop if there is an infinite trail of empty tiers.

deleteT :: Eq a => a -> [[a]] -> [[a]] #

Delete the first occurence of an element in a tier.

For normalized lists-of-tiers without repetitions, the following holds:

deleteT x = normalizeT . (`suchThat` (/= x))

products :: [[[a]]] -> [[[a]]] #

Takes the product of N lists of tiers, producing lists of length N.

Alternatively, takes as argument a list of lists of tiers of elements; returns lists combining elements of each list of tiers.

products [xss]  =  mapT (:[]) xss
products [xss,yss]  =  mapT (\(x,y) -> [x,y]) (xss >< yss)
products [xss,yss,zss]  =  product3With (\x y z -> [x,y,z]) xss yss zss

listsOf :: [[a]] -> [[[a]]] #

Takes as argument tiers of element values; returns tiers of lists of elements.

listsOf [[]]  =  [[[]]]
listsOf [[x]]  =  [ [[]]
                  , [[x]]
                  , [[x,x]]
                  , [[x,x,x]]
                  , ...
                  ]
listsOf [[x],[y]]  =  [ [[]]
                      , [[x]]
                      , [[x,x],[y]]
                      , [[x,x,x],[x,y],[y,x]]
                      , ...
                      ]

productMaybeWith :: (a -> b -> Maybe c) -> [[a]] -> [[b]] -> [[c]] #

Take the product of lists of tiers by a function returning a Maybe value discarding Nothing values.

product3With :: (a -> b -> c -> d) -> [[a]] -> [[b]] -> [[c]] -> [[d]] #

Like productWith, but over 3 lists of tiers.

noDupListCons :: Listable a => ([a] -> b) -> [[b]] #

Given a constructor that takes a list with no duplicate elements, return tiers of applications of this constructor.

mapCons :: (Listable a, Listable b) => ([(a, b)] -> c) -> [[c]] #

Given a constructor that takes a map of elements (encoded as a list), lists tiers of applications of this constructor

So long as the underlying Listable enumerations have no repetitions, this will generate no repetitions.

This allows defining an efficient implementation of tiers that does not repeat maps given by:

  tiers = mapCons fromList

setCons :: Listable a => ([a] -> b) -> [[b]] #

Given a constructor that takes a set of elements (as a list), lists tiers of applications of this constructor.

A naive Listable instance for the Set (of Data.Set) would read:

instance Listable a => Listable (Set a) where
  tiers = cons0 empty \/ cons2 insert

The above instance has a problem: it generates repeated sets. A more efficient implementation that does not repeat sets is given by:

  tiers = setCons fromList

Alternatively, you can use setsOf direclty.

bagCons :: Listable a => ([a] -> b) -> [[b]] #

Given a constructor that takes a bag of elements (as a list), lists tiers of applications of this constructor.

For example, a Bag represented as a list.

bagCons Bag

deriveListableCascading :: Name -> DecsQ #

Derives a Listable instance for a given type Name cascading derivation of type arguments as well.

Consider the following series of datatypes:

data Position = CEO | Manager | Programmer

data Person = Person
            { name :: String
            , age :: Int
            , position :: Position
            }

data Company = Company
             { name :: String
             , employees :: [Person]
             }

Writing

deriveListableCascading ''Company

will automatically derive the following three Listable instances:

instance Listable Position where
  tiers = cons0 CEO \/ cons0 Manager \/ cons0 Programmer

instance Listable Person where
  tiers = cons3 Person

instance Listable Company where
  tiers = cons2 Company

deriveListable :: Name -> DecsQ #

Derives a Listable instance for a given type Name.

Consider the following Stack datatype:

data Stack a = Stack a (Stack a) | Empty

Writing

deriveListable ''Stack

will automatically derive the following Listable instance:

instance Listable a => Listable (Stack a) where
  tiers = cons2 Stack \/ cons0 Empty

Warning: if the values in your type need to follow a data invariant, the derived instance won't respect it. Use this only on "free" datatypes.

Needs the TemplateHaskell extension.

addWeight :: [[a]] -> Int -> [[a]] #

Adds to the weight of a constructor or tiers.

instance Listable <Type> where
  tiers  =  ...
         \/ cons<N> <Cons>  `addWeight`  <W>
         \/ ...

Typically used as an infix operator when defining Listable instances:

> [ xs, ys, zs, ... ] `addWeight` 1
[ [], xs, ys, zs, ... ]
> [ xs, ys, zs, ... ] `addWeight` 2
[ [], [], xs, ys, zs, ... ]
> [ [], xs, ys, zs, ... ] `addWeight` 3
[ [], [], [], [], xs, ys, zs, ... ]

`addWeight` n is equivalent to n applications of delay.

ofWeight :: [[a]] -> Int -> [[a]] #

Resets the weight of a constructor or tiers.

> [ [], [], ..., xs, ys, zs, ... ] `ofWeight` 1
[ [], xs, ys, zs, ... ]
> [ xs, ys, zs, ... ] `ofWeight` 2
[ [], [], xs, ys, zs, ... ]
> [ [], xs, ys, zs, ... ] `ofWeight` 3
[ [], [], [], xs, ys, zs, ... ]

Typically used as an infix operator when defining Listable instances:

instance Listable <Type> where
  tiers  =  ...
         \/ cons<N> <Cons>  `ofWeight`  <W>
         \/ ...

Warning: do not apply `ofWeight` 0 to recursive data structure constructors. In general this will make the list of size 0 infinite, breaking the tier invariant (each tier must be finite).

`ofWeight` n is equivalent to reset followed by n applications of delay.

cons12 :: (Listable a, Listable b, Listable c, Listable d, Listable e, Listable f, Listable g, Listable h, Listable i, Listable j, Listable k, Listable l) => (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m) -> [[m]] #

cons11 :: (Listable a, Listable b, Listable c, Listable d, Listable e, Listable f, Listable g, Listable h, Listable i, Listable j, Listable k) => (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l) -> [[l]] #

cons10 :: (Listable a, Listable b, Listable c, Listable d, Listable e, Listable f, Listable g, Listable h, Listable i, Listable j) => (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k) -> [[k]] #

cons9 :: (Listable a, Listable b, Listable c, Listable d, Listable e, Listable f, Listable g, Listable h, Listable i) => (a -> b -> c -> d -> e -> f -> g -> h -> i -> j) -> [[j]] #

cons8 :: (Listable a, Listable b, Listable c, Listable d, Listable e, Listable f, Listable g, Listable h) => (a -> b -> c -> d -> e -> f -> g -> h -> i) -> [[i]] #

cons7 :: (Listable a, Listable b, Listable c, Listable d, Listable e, Listable f, Listable g) => (a -> b -> c -> d -> e -> f -> g -> h) -> [[h]] #

cons6 :: (Listable a, Listable b, Listable c, Listable d, Listable e, Listable f) => (a -> b -> c -> d -> e -> f -> g) -> [[g]] #

(==>) :: Bool -> Bool -> Bool infixr 0 #

Boolean implication operator. Useful for defining conditional properties:

prop_something x y = condition x y ==> something x y

Examples:

> prop_addMonotonic x y  =  y > 0 ==> x + y > x
> check prop_addMonotonic
+++ OK, passed 200 tests.

exists :: Testable a => Int -> a -> Bool #

There exists an assignment of values that satisfies a property up to a number of test values?

exists 1000 $ \x -> x > 10

fails :: Testable a => Int -> a -> Bool #

Does a property fail for a number of test values?

fails 1000 $ \xs -> xs ++ ys == ys ++ xs

holds :: Testable a => Int -> a -> Bool #

Does a property hold up to a number of test values?

holds 1000 $ \xs -> length (sort xs) == length xs

witness :: Testable a => Int -> a -> Maybe [String] #

Up to a number of tests to a property, returns Just the first witness or Nothing if there is none.

> witness 1000 (\x -> x > 1 && x < 77 && 77 `rem` x == 0)
Just ["7"]

witnesses :: Testable a => Int -> a -> [[String]] #

Lists all witnesses up to a number of tests to a property.

> witnesses 1000 (\x -> x > 1 && x < 77 && 77 `rem` x == 0)
[["7"],["11"]]

(><) :: [[a]] -> [[b]] -> [[(a, b)]] infixr 8 #

Take a tiered product of lists of tiers.

[t0,t1,t2,...] >< [u0,u1,u2,...]  =
  [ t0**u0
  , t0**u1 ++ t1**u0
  , t0**u2 ++ t1**u1 ++ t2**u0
  , ...       ...       ...       ...
  ]
  where xs ** ys = [(x,y) | x <- xs, y <- ys]

Example:

[[0],[1],[2],...] >< [[0],[1],[2],...]  =
  [ [(0,0)]
  , [(1,0),(0,1)]
  , [(2,0),(1,1),(0,2)]
  , [(3,0),(2,1),(1,2),(0,3)]
  , ...
  ]

(\\//) :: [[a]] -> [[a]] -> [[a]] infixr 7 #

Interleave tiers --- sum of two tiers enumerations. When in doubt, use \/ instead.

[xs,ys,zs,...] \/ [as,bs,cs,...]  =  [xs+|as, ys+|bs, zs+|cs, ...]

(\/) :: [[a]] -> [[a]] -> [[a]] infixr 7 #

Append tiers --- sum of two tiers enumerations.

[xs,ys,zs,...] \/ [as,bs,cs,...]  =  [xs++as, ys++bs, zs++cs, ...]

(+|) :: [a] -> [a] -> [a] infixr 5 #

Lazily interleaves two lists, switching between elements of the two. Union/sum of the elements in the lists.

[x,y,z,...] +| [a,b,c,...]  =  [x,a,y,b,z,c,...]

suchThat :: [[a]] -> (a -> Bool) -> [[a]] #

Tiers of values that follow a property.

Typically used in the definition of Listable tiers:

instance Listable <Type> where
  tiers  =  ...
         \/ cons<N> `suchThat` <condition>
         \/ ...

Examples:

> tiers `suchThat` odd
[[], [1], [-1], [], [], [3], [-3], [], [], [5], ...]
> tiers `suchThat` even
[[0], [], [], [2], [-2], [], [], [4], [-4], [], ...]

This function is just a flipped version of filterT.

reset :: [[a]] -> [[a]] #

Resets any delays in a list-of tiers. Conceptually this function makes a constructor "weightless", assuring the first tier is non-empty.

reset [[], [], ..., xs, ys, zs, ...]  =  [xs, ys, zs, ...]
reset [[], xs, ys, zs, ...]  =  [xs, ys, zs, ...]
reset [[], [], ..., [x], [y], [z], ...]  =  [[x], [y], [z], ...]

Typically used when defining Listable instances:

instance Listable <Type> where
  tiers  =  ...
         \/ reset (cons<N> <Constructor>)
         \/ ...

Be careful: do not apply reset to recursive data structure constructors. In general this will make the list of size 0 infinite, breaking the tiers invariant (each tier must be finite).

delay :: [[a]] -> [[a]] #

Delays the enumeration of tiers. Conceptually this function adds to the weight of a constructor.

delay [xs, ys, zs, ... ]  =  [[], xs, ys, zs, ...]
delay [[x,...], [y,...], ...]  =  [[], [x,...], [y,...], ...]

Typically used when defining Listable instances:

instance Listable <Type> where
  tiers  =  ...
         \/ delay (cons<N> <Constructor>)
         \/ ...

cons5 :: (Listable a, Listable b, Listable c, Listable d, Listable e) => (a -> b -> c -> d -> e -> f) -> [[f]] #

Returns tiers of applications of a 5-argument constructor.

Test.LeanCheck.Basic defines cons6 up to cons12. Those are exported by default from Test.LeanCheck, but are hidden from the Haddock documentation.

cons4 :: (Listable a, Listable b, Listable c, Listable d) => (a -> b -> c -> d -> e) -> [[e]] #

Returns tiers of applications of a 4-argument constructor.

cons3 :: (Listable a, Listable b, Listable c) => (a -> b -> c -> d) -> [[d]] #

Returns tiers of applications of a 3-argument constructor.

cons2 :: (Listable a, Listable b) => (a -> b -> c) -> [[c]] #

Given a constructor with two Listable arguments, return tiers of applications of this constructor. By default, returned values will have size/weight of 1.

cons1 :: Listable a => (a -> b) -> [[b]] #

Given a constructor with one Listable argument, return tiers of applications of this constructor. By default, returned values will have size/weight of 1.

cons0 :: a -> [[a]] #

Given a constructor with no arguments, returns tiers of all possible applications of this constructor. Since in this case there is only one possible application (to no arguments), only a single value, of size/weight 0, will be present in the resulting list of tiers.

concatMapT :: (a -> [[b]]) -> [[a]] -> [[b]] #

concatMap over tiers

concatT :: [[[[a]]]] -> [[a]] #

concat tiers of tiers

filterT :: (a -> Bool) -> [[a]] -> [[a]] #

filter tiers

filterT p [xs, yz, zs, ...]  =  [filter p xs, filter p ys, filter p zs]
filterT odd tiers  =  [[], [1], [-1], [], [], [3], [-3], [], [], [5], ...]

mapT :: (a -> b) -> [[a]] -> [[b]] #

map over tiers

mapT f [[x], [y,z], [w,...], ...]  =  [[f x], [f y, f z], [f w, ...], ...]
mapT f [xs, ys, zs, ...]  =  [map f xs, map f ys, map f zs]

tiersFloating :: Fractional a => [[a]] #

Tiers of Floating values. This can be used as the implementation of tiers for Floating types.

This function is equivalent to tiersFractional with positive and negative infinities included: 10 and -10.

tiersFloating :: [[Float]] =
  [ [0.0]
  , [1.0]
  , [-1.0, Infinity]
  , [ 0.5,  2.0, -Infinity]
  , [-0.5, -2.0]
  , [ 0.33333334,  3.0]
  , [-0.33333334, -3.0]
  , [ 0.25,  0.6666667,  1.5,  4.0]
  , [-0.25, -0.6666667, -1.5, -4.0]
  , [ 0.2,  5.0]
  , [-0.2, -5.0]
  , [ 0.16666667,  0.4,  0.75,  1.3333334,  2.5,  6.0]
  , [-0.16666667, -0.4, -0.75, -1.3333334, -2.5, -6.0]
  , ...
  ]

NaN and -0 are excluded from this enumeration.

tiersFractional :: Fractional a => [[a]] #

Tiers of Fractional values. This can be used as the implementation of tiers for Fractional types.

tiersFractional :: [[Rational]]  =
  [ [  0  % 1]
  , [  1  % 1]
  , [(-1) % 1]
  , [  1  % 2,   2  % 1]
  , [(-1) % 2, (-2) % 1]
  , [  1  % 3,   3  % 1]
  , [(-1) % 3, (-3) % 1]
  , [  1  % 4,   2  % 3,   3  % 2,   4  % 1]
  , [(-1) % 4, (-2) % 3, (-3) % 2, (-4) % 1]
  , [  1  % 5,   5  % 1]
  , [(-1) % 5, (-5) % 1]
  , [  1  % 6,   2 % 5,    3  % 4,   4  % 3,   5  % 2,   6  % 1]
  , [(-1) % 6, (-2) % 5, (-3) % 4, (-4) % 3, (-5) % 2, (-6) % 1]
  , ...
  ]

listIntegral :: (Ord a, Num a) => [a] #

Tiers of Integral values. Can be used as a default implementation of list for Integral types.

For types with negative values, like Int, the list starts with 0 then intercalates between positives and negatives.

listIntegral  =  [0, 1, -1, 2, -2, 3, -3, 4, -4, ...]

For types without negative values, like Word, the list starts with 0 followed by positives of increasing magnitude.

listIntegral  =  [0, 1, 2, 3, 4, 5, 6, 7, 8, 9, ...]

This function will not work for types that throw errors when the result of an arithmetic operation is negative such as Natural. For these, use [0..] as the list implementation.

toTiers :: [a] -> [[a]] #

Takes a list of values xs and transform it into tiers on which each tier is occupied by a single element from xs.

> toTiers [x, y, z, ...]
[ [x], [y], [z], ...]

To convert back to a list, just concat.

class Listable a where #

A type is Listable when there exists a function that is able to list (ideally all of) its values.

Ideally, instances should be defined by a tiers function that returns a (potentially infinite) list of finite sub-lists (tiers): the first sub-list contains elements of size 0, the second sub-list contains elements of size 1 and so on. Size here is defined by the implementor of the type-class instance.

For algebraic data types, the general form for tiers is

tiers = cons<N> ConstructorA
     \/ cons<N> ConstructorB
     \/ ...
     \/ cons<N> ConstructorZ

where N is the number of arguments of each constructor A...Z.

Here is a datatype with 4 constructors and its listable instance:

data MyType  =  MyConsA
             |  MyConsB Int
             |  MyConsC Int Char
             |  MyConsD String

instance Listable MyType where
  tiers =  cons0 MyConsA
        \/ cons1 MyConsB
        \/ cons2 MyConsC
        \/ cons1 MyConsD

The instance for Hutton's Razor is given by:

data Expr  =  Val Int
           |  Add Expr Expr

instance Listable Expr where
  tiers  =  cons1 Val
         \/ cons2 Add

Instances can be alternatively defined by list. In this case, each sub-list in tiers is a singleton list (each succeeding element of list has +1 size).

The function deriveListable from Test.LeanCheck.Derive can automatically derive instances of this typeclass.

A Listable instance for functions is also available but is not exported by default. Import Test.LeanCheck.Function if you need to test higher-order properties.

Minimal complete definition

list | tiers

Methods

tiers :: [[a]] #

list :: [a] #

Instances
Listable Bool
tiers :: [[Bool]] = [[False,True]]
list :: [[Bool]] = [False,True]
Instance details

Defined in Test.LeanCheck.Core

Methods

tiers :: [[Bool]] #

list :: [Bool] #

Listable Char
list :: [Char] = ['a', ' ', 'b', 'A', 'c', '\', 'n', 'd', ...]
Instance details

Defined in Test.LeanCheck.Core

Methods

tiers :: [[Char]] #

list :: [Char] #

Listable Double

NaN and -0 are not included in the list of Doubles.

list :: [Double]  =  [0.0, 1.0, -1.0, Infinity, 0.5, 2.0, ...]
Instance details

Defined in Test.LeanCheck.Core

Methods

tiers :: [[Double]] #

list :: [Double] #

Listable Float

NaN and -0 are not included in the list of Floats.

list :: [Float] =
  [ 0.0
  , 1.0, -1.0, Infinity
  , 0.5, 2.0, -Infinity, -0.5, -2.0
  , 0.33333334, 3.0, -0.33333334, -3.0
  , 0.25, 0.6666667, 1.5, 4.0, -0.25, -0.6666667, -1.5, -4.0
  , ...
  ]
Instance details

Defined in Test.LeanCheck.Core

Methods

tiers :: [[Float]] #

list :: [Float] #

Listable Int
tiers :: [[Int]] = [[0], [1], [-1], [2], [-2], [3], [-3], ...]
list :: [Int] = [0, 1, -1, 2, -2, 3, -3, 4, -4, 5, -5, 6, ...]
Instance details

Defined in Test.LeanCheck.Core

Methods

tiers :: [[Int]] #

list :: [Int] #

Listable Integer
list :: [Int] = [0, 1, -1, 2, -2, 3, -3, 4, -4, 5, -5, 6, ...]
Instance details

Defined in Test.LeanCheck.Core

Methods

tiers :: [[Integer]] #

list :: [Integer] #

Listable Ordering
list :: [Ordering]  = [LT, EQ, GT]
Instance details

Defined in Test.LeanCheck.Core

Methods

tiers :: [[Ordering]] #

list :: [Ordering] #

Listable ()
list :: [()]  =  [()]
tiers :: [[()]]  =  [[()]]
Instance details

Defined in Test.LeanCheck.Core

Methods

tiers :: [[()]] #

list :: [()] #

Listable Int1 
Instance details

Defined in Test.LeanCheck.Utils.Types

Methods

tiers :: [[Int1]] #

list :: [Int1] #

Listable Int2 
Instance details

Defined in Test.LeanCheck.Utils.Types

Methods

tiers :: [[Int2]] #

list :: [Int2] #

Listable Int3 
Instance details

Defined in Test.LeanCheck.Utils.Types

Methods

tiers :: [[Int3]] #

list :: [Int3] #

Listable Int4 
Instance details

Defined in Test.LeanCheck.Utils.Types

Methods

tiers :: [[Int4]] #

list :: [Int4] #

Listable Word1 
Instance details

Defined in Test.LeanCheck.Utils.Types

Methods

tiers :: [[Word1]] #

list :: [Word1] #

Listable Word2 
Instance details

Defined in Test.LeanCheck.Utils.Types

Methods

tiers :: [[Word2]] #

list :: [Word2] #

Listable Word3 
Instance details

Defined in Test.LeanCheck.Utils.Types

Methods

tiers :: [[Word3]] #

list :: [Word3] #

Listable Word4 
Instance details

Defined in Test.LeanCheck.Utils.Types

Methods

tiers :: [[Word4]] #

list :: [Word4] #

Listable Natural 
Instance details

Defined in Test.LeanCheck.Utils.Types

Methods

tiers :: [[Natural]] #

list :: [Natural] #

Listable Nat 
Instance details

Defined in Test.LeanCheck.Utils.Types

Methods

tiers :: [[Nat]] #

list :: [Nat] #

Listable Nat1 
Instance details

Defined in Test.LeanCheck.Utils.Types

Methods

tiers :: [[Nat1]] #

list :: [Nat1] #

Listable Nat2 
Instance details

Defined in Test.LeanCheck.Utils.Types

Methods

tiers :: [[Nat2]] #

list :: [Nat2] #

Listable Nat3 
Instance details

Defined in Test.LeanCheck.Utils.Types

Methods

tiers :: [[Nat3]] #

list :: [Nat3] #

Listable Nat4 
Instance details

Defined in Test.LeanCheck.Utils.Types

Methods

tiers :: [[Nat4]] #

list :: [Nat4] #

Listable Nat5 
Instance details

Defined in Test.LeanCheck.Utils.Types

Methods

tiers :: [[Nat5]] #

list :: [Nat5] #

Listable Nat6 
Instance details

Defined in Test.LeanCheck.Utils.Types

Methods

tiers :: [[Nat6]] #

list :: [Nat6] #

Listable Nat7 
Instance details

Defined in Test.LeanCheck.Utils.Types

Methods

tiers :: [[Nat7]] #

list :: [Nat7] #

Listable Space 
Instance details

Defined in Test.LeanCheck.Utils.Types

Methods

tiers :: [[Space]] #

list :: [Space] #

Listable Lower 
Instance details

Defined in Test.LeanCheck.Utils.Types

Methods

tiers :: [[Lower]] #

list :: [Lower] #

Listable Upper 
Instance details

Defined in Test.LeanCheck.Utils.Types

Methods

tiers :: [[Upper]] #

list :: [Upper] #

Listable Alpha 
Instance details

Defined in Test.LeanCheck.Utils.Types

Methods

tiers :: [[Alpha]] #

list :: [Alpha] #

Listable Digit 
Instance details

Defined in Test.LeanCheck.Utils.Types

Methods

tiers :: [[Digit]] #

list :: [Digit] #

Listable AlphaNum 
Instance details

Defined in Test.LeanCheck.Utils.Types

Methods

tiers :: [[AlphaNum]] #

list :: [AlphaNum] #

Listable Letter 
Instance details

Defined in Test.LeanCheck.Utils.Types

Methods

tiers :: [[Letter]] #

list :: [Letter] #

Listable Spaces 
Instance details

Defined in Test.LeanCheck.Utils.Types

Methods

tiers :: [[Spaces]] #

list :: [Spaces] #

Listable Lowers 
Instance details

Defined in Test.LeanCheck.Utils.Types

Methods

tiers :: [[Lowers]] #

list :: [Lowers] #

Listable Uppers 
Instance details

Defined in Test.LeanCheck.Utils.Types

Methods

tiers :: [[Uppers]] #

list :: [Uppers] #

Listable Alphas 
Instance details

Defined in Test.LeanCheck.Utils.Types

Methods

tiers :: [[Alphas]] #

list :: [Alphas] #

Listable Digits 
Instance details

Defined in Test.LeanCheck.Utils.Types

Methods

tiers :: [[Digits]] #

list :: [Digits] #

Listable AlphaNums 
Instance details

Defined in Test.LeanCheck.Utils.Types

Methods

tiers :: [[AlphaNums]] #

list :: [AlphaNums] #

Listable Letters 
Instance details

Defined in Test.LeanCheck.Utils.Types

Methods

tiers :: [[Letters]] #

list :: [Letters] #

Listable a => Listable [a]
tiers :: [[ [Int] ]] = [ [ [] ]
                       , [ [0] ]
                       , [ [0,0], [1] ]
                       , [ [0,0,0], [0,1], [1,0], [-1] ]
                       , ... ]
list :: [ [Int] ] = [ [], [0], [0,0], [1], [0,0,0], ... ]
Instance details

Defined in Test.LeanCheck.Core

Methods

tiers :: [[[a]]] #

list :: [[a]] #

Listable a => Listable (Maybe a)
tiers :: [[Maybe Int]] = [[Nothing], [Just 0], [Just 1], ...]
tiers :: [[Maybe Bool]] = [[Nothing], [Just False, Just True]]
Instance details

Defined in Test.LeanCheck.Core

Methods

tiers :: [[Maybe a]] #

list :: [Maybe a] #

Listable a => Listable (NoDup a) 
Instance details

Defined in Test.LeanCheck.Utils.Types

Methods

tiers :: [[NoDup a]] #

list :: [NoDup a] #

Listable a => Listable (Bag a) 
Instance details

Defined in Test.LeanCheck.Utils.Types

Methods

tiers :: [[Bag a]] #

list :: [Bag a] #

Listable a => Listable (Set a) 
Instance details

Defined in Test.LeanCheck.Utils.Types

Methods

tiers :: [[Set a]] #

list :: [Set a] #

(Integral a, Bounded a) => Listable (X a)

Extremily large integers are intercalated with small integers.

list :: [X Int] = map X
  [ 0, 1, -1, maxBound,   minBound
     , 2, -2, maxBound-1, minBound+1
     , 3, -3, maxBound-2, minBound+2
     , ... ]
Instance details

Defined in Test.LeanCheck.Utils.Types

Methods

tiers :: [[X a]] #

list :: [X a] #

(Integral a, Bounded a) => Listable (Xs a)

Lists with elements of the X type.

Instance details

Defined in Test.LeanCheck.Utils.Types

Methods

tiers :: [[Xs a]] #

list :: [Xs a] #

(Listable a, Listable b) => Listable (Either a b)
tiers :: [[Either Bool Bool]] =
  [[Left False, Right False, Left True, Right True]]
tiers :: [[Either Int Int]] = [ [Left 0, Right 0]
                              , [Left 1, Right 1]
                              , [Left (-1), Right (-1)]
                              , [Left 2, Right 2]
                              , ... ]
Instance details

Defined in Test.LeanCheck.Core

Methods

tiers :: [[Either a b]] #

list :: [Either a b] #

(Listable a, Listable b) => Listable (a, b)
tiers :: [[(Int,Int)]] =
[ [(0,0)]
, [(0,1),(1,0)]
, [(0,-1),(1,1),(-1,0)]
, ...]
list :: [(Int,Int)] = [ (0,0), (0,1), (1,0), (0,-1), (1,1), ...]
Instance details

Defined in Test.LeanCheck.Core

Methods

tiers :: [[(a, b)]] #

list :: [(a, b)] #

(Listable a, Listable b) => Listable (Map a b) 
Instance details

Defined in Test.LeanCheck.Utils.Types

Methods

tiers :: [[Map a b]] #

list :: [Map a b] #

(Listable a, Listable b, Listable c) => Listable (a, b, c)
list :: [(Int,Int,Int)] = [ (0,0,0), (0,0,1), (0,1,0), ...]
Instance details

Defined in Test.LeanCheck.Core

Methods

tiers :: [[(a, b, c)]] #

list :: [(a, b, c)] #

(Listable a, Listable b, Listable c, Listable d) => Listable (a, b, c, d) 
Instance details

Defined in Test.LeanCheck.Core

Methods

tiers :: [[(a, b, c, d)]] #

list :: [(a, b, c, d)] #

(Listable a, Listable b, Listable c, Listable d, Listable e) => Listable (a, b, c, d, e) 
Instance details

Defined in Test.LeanCheck.Core

Methods

tiers :: [[(a, b, c, d, e)]] #

list :: [(a, b, c, d, e)] #