leancheck-0.6.1: Cholesterol-free property-based testing

Safe HaskellSafe
LanguageHaskell2010

Test.LeanCheck.Tiers

Contents

Description

LeanCheck is a simple enumerative property-based testing library.

This module provides advanced functions for manipulating tiers. Most definitions given here are exported by Test.LeanCheck, except: listCons, choices, setChoices and bagChoices.

Synopsis

Additional tiers constructors

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

Given a constructor that takes a list, return tiers of applications of this constructor.

This is basically a type-restricted version of cons1. You should use cons1 instead: this serves more as an illustration of how setCons and bagCons work (see source).

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

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]] Source #

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

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

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

maybeCons0 :: Maybe b -> [[b]] Source #

maybeCons1 :: Listable a => (a -> Maybe b) -> [[b]] Source #

maybeCons2 :: (Listable a, Listable b) => (a -> b -> Maybe c) -> [[c]] Source #

Products of tiers

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

Like ><, but over 3 lists of tiers.

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

Like productWith, but over 3 lists of tiers.

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

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

Tiers of lists

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

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]]
                     , ...
                     ]

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

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]]
  , ...
  ]

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

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

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

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]]
  , ...
  ]

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

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

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

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]]
  , ...
  ]

Tiers of pairs

distinctPairs :: [[a]] -> [[(a, a)]] Source #

Takes as argument tiers of element values; returns tiers of pairs with distinct element values.

When argument tiers have no repeated elements:

distinctPairs xss  =  xss >< xss  `suchThat` uncurry (/=)

distinctPairsWith :: (a -> a -> b) -> [[a]] -> [[b]] Source #

distinctPairs by a given function:

distinctPairsWith f = mapT (uncurry f) . distinctPairs

unorderedPairs :: [[a]] -> [[(a, a)]] Source #

Takes as argument tiers of element values; returns tiers of unordered pairs where, in enumeration order, the first element is less than or equal to the second.

The name of this function is perhaps a misnomer. But in mathematics, an unordered pair is a pair where you don't care about element order, e.g.: (1,2) = (2,1). This function will enumerate canonical versions of such pairs where the first element is less than the second.

The returned element pairs can be seen as bags with two elements.

When argument tiers are listed in Ord:

distinctPairs xss  =  xss >< xss  `suchThat` uncurry (<=)

unorderedPairsWith :: (a -> a -> b) -> [[a]] -> [[b]] Source #

unorderedPairs by a given function:

unorderedPairsWith f = mapT (uncurry f) . unorderedPairs

unorderedDistinctPairs :: [[a]] -> [[(a, a)]] Source #

Takes as argument tiers of element values; returns tiers of unordered pairs where, in enumeration order, the first element is strictly less than the second.

The returned element pairs can be seen as sets with two elements.

When argument tiers are listed in Ord:

distinctPairs xss  =  xss >< xss  `suchThat` uncurry (<)

unorderedDistinctPairsWith :: (a -> a -> b) -> [[a]] -> [[b]] Source #

unorderedPairs by a given function:

unorderedDistinctPairsWith f = mapT (uncurry f) . unorderedDistinctPairs

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

Delete the first occurence of an element in a tier.

For tiers without repetitions, the following holds:

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

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

Normalizes tiers by removing an empty tier from the end of a list of tiers.

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

Note this will only remove a single empty tier:

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

catMaybesT :: [[Maybe a]] -> [[a]] Source #

Concatenate tiers of maybes

mapMaybeT :: (a -> Maybe b) -> [[a]] -> [[b]] Source #

Tiers of choices

choices :: [[a]] -> [[(a, [[a]])]] Source #

Lists tiers of choices. Choices are pairs of values and tiers excluding that value.

choices [[False,True]] == [[(False,[[True]]),(True,[[False]])]]
choices [[1],[2],[3]]
  == [ [(1,[[],[2],[3]])]
     , [(2,[[1],[],[3]])]
     , [(3,[[1],[2],[]])] ]

Each choice is sized by the extracted element.

setChoices :: [[a]] -> [[(a, [[a]])]] Source #

Like choices but lists tiers of strictly ascending choices. Used to construct setsOf values.

setChoices [[False,True]] == [[(False,[[True]]),(True,[[]])]]
setChoices [[1],[2],[3]]
  == [ [(1,[[],[2],[3]])]
     , [(2,[[],[],[3]])]
     , [(3,[[],[],[]])]
     ]

bagChoices :: [[a]] -> [[(a, [[a]])]] Source #

Like choices but lists tiers of non-decreasing (ascending) choices. Used to construct bagsOf values.

bagChoices [[False,True]] =
  [ [(False,[[False,True]]), (True,[[True]])]
  ]
bagChoices [[1],[2],[3],...] =
  [ [(1,[[1],[2],[3],...])]
  , [(2,[[ ],[2],[3],...])]
  , [(3,[[ ],[ ],[3],...])]
  , ...
  ]