gencheck (empty) → 0.1

raw patch · 18 files changed

+2029/−0 lines, 18 filesdep +basedep +combinatdep +containerssetup-changed

Dependencies added: base, combinat, containers, ieee754, memoize, random, template-haskell, transformers

Files

License.txt +7/−0
Setup.hs +4/−0
Test/GenCheck.lhs +42/−0
Test/GenCheck/Base/Base.lhs +25/−0
Test/GenCheck/Base/Datum.lhs +23/−0
Test/GenCheck/Base/LabelledPartition.lhs +133/−0
Test/GenCheck/Base/Verdict.lhs +29/−0
Test/GenCheck/Generator/BaseEnum.lhs +115/−0
Test/GenCheck/Generator/BaseGens.lhs +260/−0
Test/GenCheck/Generator/EnumStrat.lhs +112/−0
Test/GenCheck/Generator/Enumeration.lhs +370/−0
Test/GenCheck/Generator/Generator.lhs +134/−0
Test/GenCheck/Generator/StructureGens.lhs +90/−0
Test/GenCheck/Generator/Substitution.lhs +194/−0
Test/GenCheck/System/Result.lhs +116/−0
Test/GenCheck/System/SimpleCheck.lhs +207/−0
Test/GenCheck/System/TestSuite.lhs +106/−0
gencheck.cabal +62/−0

+ License.txt view

@@ -0,0 +1,7 @@+Copyright (c) 2012, Gordon J. Uszkay All rights reserved.+Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:+	•	Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.+	•	Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.+	•	Neither the name of the McMaster nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ Setup.hs view

@@ -0,0 +1,4 @@+#!/usr/bin/env runhaskell++import Distribution.Simple+main = defaultMain

+ Test/GenCheck.lhs view

@@ -0,0 +1,42 @@+The GenCheck API for customizing test suite building, generators and+enumerations, re-exporting the definitions from other modules.++A significant number of Enumerated and Testable instances being+imported/exported from StructureGens, BaseGens, BaseEnum that can not be+explicitly shown.++\begin{code}+module Test.GenCheck +( Property, Rank, Count+, simpleCheck, simpleTest, simpleReport+, MapRankSuite, TestSuite, suiteMerge, GenInstruct+, genSuite, testSuite, stdSuite, deepSuite, baseSuite+, Generator, Testable(..), StandardGens(..), stdEnumGens+, Label(..), Enumerated(..), Enumeration+, listStdGens+, EnumGC(..)+, Structure(..)+, subst , substN, substAll -- , subPerm, subComb+, substStdGenN, substStdGenAll -- , subStdGenPerm, subStdGenComb+, Structure2(..)+, subst2, subst2N+, subst2StdGen --, subst2StdGenN, subst2StdGenAll, subst2StdGenPerm, subst2StdGenComb+, Structure3(..)++) where++import Test.GenCheck.Base.Base (Rank, Count, Property)+import Test.GenCheck.System.SimpleCheck(simpleTest, simpleReport, simpleCheck)+import Test.GenCheck.System.TestSuite (MapRankSuite, TestSuite, suiteMerge, +       GenInstruct, genSuite, testSuite, stdSuite, deepSuite, baseSuite)++import Test.GenCheck.Generator.Generator (Generator, Testable(..), +            StandardGens(..),stdEnumGens)+import Test.GenCheck.Generator.StructureGens(listStdGens) -- instances of Testable+import Test.GenCheck.Generator.BaseGens() -- and instances of Enumerated+import Test.GenCheck.Generator.Substitution++import Test.GenCheck.Generator.Enumeration(Label(..), Enumerated(..), Enumeration)+import Test.GenCheck.Generator.BaseEnum(EnumGC(..)) -- and instances++\end{code}

+ Test/GenCheck/Base/Base.lhs view

@@ -0,0 +1,25 @@+The fundamental definitions for GenCheck.++Throughout GenCheck, structured types are indexed with a (Rank,Count) pair.+These types are used everywhere so are in Base.++\begin{code}+module Test.GenCheck.Base.Base+  ( Rank+  , Count+  , Property+  ) where++type Rank = Int+type Count = Integer++\end{code}++The property type is a function from the test domain to a Boolean, i.e. a+univariate proposition.  If the specification property has multiple arguments,+it must first be uncurried to make the test domain the product of the+arguments.++\begin{code}+type Property a = a -> Bool+\end{code}

+ Test/GenCheck/Base/Datum.lhs view

@@ -0,0 +1,23 @@+The Datum class describes a record that has a significant value (the datum)+and possibly additional information (metadata) about that value.+The purpose of the class is to allow components of a system to +pass metadata through other components which are only aware of the datum type.++The Identity functor from the Transformers package is the Datum instance+where the test requires no additional information or meta-data.++\begin{code}+{-# LANGUAGE TypeFamilies #-}++module Test.GenCheck.Base.Datum (Datum(..)) where++import Data.Functor.Identity    ++class Datum t where+  type DataType t :: *+  datum :: t -> DataType t++instance Datum (Identity a) where+  type DataType (Identity a) = a+  datum = runIdentity+\end{code}

+ Test/GenCheck/Base/LabelledPartition.lhs view

@@ -0,0 +1,133 @@+A partition of a set is a collection of disjoint subsets where +every element of the set is in exactly one of these subsets.+The LabelledPartition class defines a labelled collection of sets, with an+internal container type for the element subsets (or parts), a label for+each part, and an external container that maps the labels to the parts.+LabelledPartitions with the same (label and container) type can be merged,+with a guarantee that no data is lost and that where labels are equal,+commonly labelled parts will be merged into a single part.++The standard set theoretic definition of partition requires that the parts be+non-empty.  For pragmatic convenience, this condition is relaxed in this module +because of the labelling: the partition may contain a labelled empty part, +which is semantically identical to the the label not being represented in the+partition.++The LabelledPartition class is a generalization of a Map over lists of+elements.  Since the LabelledPartition class overloads the names empty, insert,+map and fold, it is recommended that the module always be imported qualified, +much like Data.Map.++\begin{code}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-}++module Test.GenCheck.Base.LabelledPartition +( LabelledPartition(..)+, fromList+, relabel+, Test.GenCheck.Base.LabelledPartition.filter+) where++import Data.Map(Map)+import qualified Data.Map as Map+import Data.Monoid+import qualified Data.Foldable as Fold++import Test.GenCheck.Base.Verdict(Verdict())++\end{code}++The LabelledPartition class is parameterized over:+ c - the external container structure+ v - the internal part structure for the data values++It also uses the following:+ k - the labels for the internal containers+ a - the actual values in the container++In order to support merge, (v a) must form a monoid; +v should generally be a free monoid not dependent on the contents of the+container.  There are exceptions: for example, the container might only retain+pass/fail information, in which case the (v a) might just be a generalized+boolean value under conjugation.++The LabelledPartition methods must obey the following rules:+   merge empty x                   == x           +   merge x empty                   == x+   merge empty (insert xs k y)     == merge xs (insert empty k y)+   merge (new k xs) (new k ys)     == new k (xs `mappend` ys)+   insert (k x (new k xs))         == new k (x : xs)  +   insert (k x (new k' xs))        == merge (new k [x]) (new k' xs)  for k /= k'+   lookup (insert empty k y) k     == Just y+   lookup (insert empty k y) k'    == Nothing for k' /= k+   lookup empty k'                 == Nothing++\begin{code}++class Verdict v => Labelled v where+  type Label v+  label :: v -> Label v++class (Fold.Foldable c, Verdict v, Labelled v) => LabelledPartition c v where+  empty   :: c v+  new     :: [v] -> c v+  size    :: c v -> Int+  insert  :: (Ord k) => k -> v -> c v -> c v+  lookup  :: (Ord k) => k -> c v -> Maybe v  +  merge   :: (Monoid v) => c v -> c v -> c v+  -- map     :: (Ord k) => (k -> v -> r) -> c (v a) -> c (v r)+  -- map f   = fold (\k x lys -> insert k (f k x) lys) empty+  fold    :: (k -> v -> b -> b) -> b -> c v -> b+  toList  :: c v -> [(k, v)]++instance (Fold.Foldable c, Monoid v) => Monoid (c v) where+  mempty  = empty+  mappend = merge++fromList :: (Ord k, LabelledPartition c v, Monoid v) => +    [(k,[v])] -> c v+fromList = Fold.foldr (\(k,ys) -> merge (new k ys)) empty++\end{code}++The following functions can be used to relabel and filter values in a+partition.+\begin{description}+\item[relabel] reorganizes the container with different grouping labels,+\item[filter] extracts only the contents that satisfy a predicate into a new+container with the same labels.+\end{description}++\begin{code}+relabel :: (Ord k', LabelledPartition c v) => (k -> v -> k') -> c v-> c v+relabel f cxs = fold (\k x -> insert (f k x) x) empty cxs++filter :: (LabelledPartition c v, Ord k) =>+    (k -> v -> Bool) -> c v -> c v+filter p cxs = fold cp empty cxs where+  cp k x ys = if (p k x) then insert k x ys else ys++\end{code}++One possible LabelledPartition instance is a Haskell Map of lists.+It is necessary to override the default insertions and union methods+so that no values are overwritten during those operations.++Any Map of Monoids would also work, such as Maps of Maps,+with the merging of categories carried out with the |mappend|.++\begin{code}++instance Ord k => LabelledPartition (Map k) a where+  empty      = Map.empty+  new k xs   = Map.fromList xs+  size       = Map.fold (\xs s -> (length xs) + s) 0+  insert k x = Map.insertWith mappend k [x]+  lookup     = Map.lookup+  merge      = Map.unionWith mappend+  fold f     = Map.foldrWithKey (\k x y -> foldr (f k) y x)+  toList     = Map.toList+\end{code}

+ Test/GenCheck/Base/Verdict.lhs view

@@ -0,0 +1,29 @@+A verdict is a Boolean pass or fail 'verdict' on a test result; an instance of+the Verdict class evaluates to such a result, but may also contain additional+information about the test.++A collection of verdicts is also a verdict: if all of the results are ``pass'',+the verdict for the collection is pass.  Specifically, the collective verdict+is the Boolean conjunction of the individual verdicts.  Therefore any foldable+container of verdicts is also a verdict.++\begin{code}+{-# LANGUAGE FlexibleInstances #-}+module Test.GenCheck.Base.Verdict ( Verdict(..), SummaryVerdict(..) ) where++import Data.Foldable(Foldable())++class Verdict s where+  verdict :: s -> Bool++instance Verdict Bool where+  verdict = id+\end{code}++Structures can be evaluated to a boolean if they are foldable and their+elements are generic booleans.++\begin{code}+class Foldable s => SummaryVerdict s where+  summaryverdict :: Verdict v => s v -> Bool+\end{code}

+ Test/GenCheck/Generator/BaseEnum.lhs view

@@ -0,0 +1,115 @@+This module is a library of some enumerations for the Haskell base types.+These are used to construct enumerated generators for base types using+enumerative strategies described in EnumStrat.lhs.  Enumerations can be added+as required for other base types here.++The base types (Int, Char) are ``flat'', meaning there is no structure to their+definition and no need to provide a rank to their generation.  BaseEnum is an+unranked enumeration to represent these flat types.  Note that not all+``scalar'' types are base types, and may require ranked enumerations (e.g.+Integer, Double).+++\begin{code}+module Test.GenCheck.Generator.BaseEnum+ ( makeBaseEnum+ , BaseEnum(..)+ , EnumGC(..)+ , getBase+ , getBaseUnsafe+ , enumList+ , enumBaseRange+ , enumBaseInt+ , enumBaseNat+ , enumBasePosInt+ , enumDfltInt+ , enumBaseChar+ , enumBaseBool+ , enumDfltChar+ , enumLowChar+ , enumUpperChar+ , enumDigitChar+ ) where++import Data.Char+import Data.List (genericLength)++import Test.GenCheck.Base.Base(Count)+\end{code}++Base types are unranked.  Base type enumerations are not memoized+because they are more likely to be accessed randomly than linearly,+and because they are generally very efficient.++\begin{code}+type BaseSelector a = Count -> a+data BaseEnum a = Base {baseCount::Count, baseSelect :: BaseSelector a }++makeBaseEnum :: Count -> BaseSelector a -> BaseEnum a+makeBaseEnum cnt sel = Base cnt sel++getBase :: BaseEnum a -> Count -> Maybe a+getBase (Base c s) n | (n > 0)   = if c >= n then Just (s n) else Nothing+getBase _  _         | otherwise = Nothing++getBaseUnsafe :: BaseEnum a -> Count -> a+getBaseUnsafe  (Base _ s) n = s n+\end{code}++Any list is a base enumeration, with the index provided by list position.+Any instance of Haskell's Enum class provides a base enumeration,+with enumBaseRng providing the enumeration over an arbitrary range of values.++\begin{code}+  +enumList :: [a] -> BaseEnum a+enumList xs = makeBaseEnum (genericLength xs) (((!!) xs).fromInteger)++enumBaseRange :: (Enum a) => (a,a) -> BaseEnum a+enumBaseRange (l,u) = +  let shift = toInteger (fromEnum l)+      cnt = ((toInteger (fromEnum u)) - shift) + 1+  in makeBaseEnum cnt (\x -> toEnum (fromInteger (x + shift - 1)))+\end{code}++If the type is also Bounded, then the enumeration can be over the entire set of+values.++\begin{code}+enumBaseInt, enumBaseNat, enumBasePosInt, enumDfltInt :: BaseEnum Int+enumBaseInt    = enumBaseRange (minBound::Int, maxBound::Int)+enumBaseNat    = enumBaseRange (0::Int, maxBound::Int)+enumBasePosInt = enumBaseRange (1::Int, maxBound::Int)+enumDfltInt    = enumBaseRange (-100::Int, 100::Int)++enumBaseBool :: BaseEnum Bool+enumBaseBool = makeBaseEnum 2 (\k -> k==1)++enumBaseChar, enumDfltChar, enumLowChar, enumDigitChar, enumUpperChar :: BaseEnum Char+enumBaseChar   = enumBaseRange (minBound::Char, maxBound::Char)+enumDfltChar   = makeBaseEnum 95 (\k -> chr ((32 +) (fromInteger k))) -- ' ' to '~'+enumLowChar    = makeBaseEnum 26 (\k -> chr ((97 +) (fromInteger k)))+enumDigitChar  = makeBaseEnum 10 (\k -> chr ((48 +) (fromInteger k)))+enumUpperChar  = makeBaseEnum 26 (\k -> chr ((65 +) (fromInteger k)))++\end{code}++GenCheck supplies an alternative interface to the Haskell Enum class, that+provides a selector function for the type and a default range of values of that+type.  Any Enum instance has an automatic EnumGC instance, but this is not+provided because the type variable is ambiguous, so must be explicitly+provided.++\begin{code}+class EnumGC a where+  base     :: BaseEnum a++instance EnumGC Int where+  base = let c = (toInteger (maxBound::Int)) - (toInteger (minBound::Int)) + (1 :: Integer)+         in Base c fromInteger++instance EnumGC Char where+  base = let c = ((toInteger.fromEnum) (maxBound::Char)) +                 - ((toInteger.fromEnum) (minBound::Char)) + (1 :: Integer)+         in Base c (toEnum.fromInteger)+\end{code}

+ Test/GenCheck/Generator/BaseGens.lhs view

@@ -0,0 +1,260 @@+\section{Generator Library}++This module is a library of generators for standard base types.+Most of the generators here are created from strategies over enumerations,+called enumerative generators, but some are manually coded for efficiency.++\begin{code}+module Test.GenCheck.Generator.BaseGens where++import System.Random (StdGen,randomR, Random(),RandomGen(), randoms, randomRs)+import Math.Combinat (combine)+--import Data.Ratio (Ratio, (%))+import Numeric.IEEE ++import Test.GenCheck.Base.Base (Rank)+import Test.GenCheck.Generator.BaseEnum -- enum* base enumerations+import Test.GenCheck.Generator.EnumStrat+import Test.GenCheck.Generator.Generator (Generator, Testable(..), StandardGens(..))++\end{code}++Generic generator for Haskell enumerated base types.+Base type values are all rank 1; baseGen defines such a range.++Note that the exhaustive and random generators are implemented +without using the base type enumerations, while the extreme and uniform generators +apply the enumerative strategy to the underlying enumeration.  +Bypassing the enumeration avoids the overhead of the selection function, +improving the performance of the generator.++\begin{code}+baseGen :: [a] -> Generator a+baseGen xs r = if r == 1 then xs else []++baseEnumGen :: EnumStrat -> BaseEnum a -> Generator a+baseEnumGen strat e r | r ==1 = map (getBaseUnsafe e) (strat (baseCount e))+baseEnumGen   _   _ _ | otherwise = []++baseEnumGCStdGens :: (EnumGC a) => StandardGens a+baseEnumGCStdGens = baseEnumGCGens base++baseEnumGCGens :: BaseEnum a -> StandardGens a+baseEnumGCGens e = StdGens allGen xtrmGen uniGen randGen+  where+    allGen   = baseEnumGen exhaustG e+    xtrmGen  = baseEnumGen extreme e+    uniGen   = \m' -> baseEnumGen (uniform m') e+    randGen  = \s' -> baseEnumGen (randG  s')  e++genBaseRangeAll, genBaseRangeExt :: Enum a => (a,a) -> Generator a+genBaseRangeAll (l,u)   = baseGen [l..u]+genBaseRangeExt (l,u)   = baseEnumGen extreme (enumBaseRange (l,u))++genBaseRangeUni :: Enum a => (a,a) -> Int -> Generator a+genBaseRangeUni (l,u) k = baseEnumGen (uniform k) (enumBaseRange (l,u))++genBaseRangeRnd :: (RandomGen t, Random a) => (a,a) -> t -> Generator a+genBaseRangeRnd (l',u') t = baseGen $ rg (l',u') t +  where +    rg (l,u) s = let (x,s') = (randomR (l,u) s) in x : (rg (l,u) s')++genBaseStdGens :: (Enum a, Random a) => (a,a) -> StandardGens a+genBaseStdGens rng = StdGens (genBaseRangeAll rng) (genBaseRangeExt rng)+                             (genBaseRangeUni rng) (genBaseRangeRnd rng)++instance Testable Int where+  stdTestGens = genBaseStdGens (-100, 100)++\end{code}++For bounded enumerative types, the minBound and maxBounds can be used.+The type needs to be provided explicitly, otherwise it would be ambiguous.+Copy and paste the functions as required for other enumerative bounded types,+or just use the ranged generators with (minBound, maxBound) as the argument.+These are the bounded Int generators.++\begin{code}++genIntAll, genIntExt :: Generator Int+genIntAll = baseGen [(minBound::Int)..(maxBound::Int)]+genIntExt = baseEnumGen extreme $ enumBaseRange ((minBound::Int), (maxBound::Int))++genIntUni :: Int -> Generator Int+genIntUni k = baseEnumGen (uniform k) $ enumBaseRange ((minBound::Int), (maxBound::Int))++genIntRnd :: RandomGen t => t -> Generator Int+genIntRnd t = baseGen $ rg ((minBound::Int), (maxBound::Int)) t +  where rg (l,u) s = let (x,s') = (randomR (l,u) s) in x : (rg (l,u) s')++\end{code}++These are some Char and String generators. Note that the exhaustive generator+does not use the enumeration, but the other generators use the base type+enumeration and an enumerative strategy.++The Testable instance default generator for Char is the default character+range.++\begin{code}+instance Testable Char where+  stdTestGens = StdGens genDfltCharAll genDfltCharExt genDfltCharUni genDfltCharRnd++genLowCharAll, genDfltCharAll, genUpperCharAll, genDigitCharAll :: Generator Char+genDfltCharAll     = baseGen [' '..'~']+genLowCharAll      = baseGen ['a'..'z']+genUpperCharAll    = baseGen ['A'..'Z']+genDigitCharAll    = baseGen ['0'..'9']++genLowCharRnd, genDfltCharRnd, genUpperCharRnd, genDigitCharRnd :: StdGen -> Generator Char+genDfltCharRnd   s = baseEnumGen (randG s) enumDfltChar+genLowCharRnd    s = baseEnumGen (randG s) enumLowChar+genUpperCharRnd  s = baseEnumGen (randG s) enumUpperChar+genDigitCharRnd  s = baseEnumGen (randG s) enumDigitChar++genLowCharExt, genDfltCharExt, genUpperCharExt, genDigitCharExt :: Generator Char+genDfltCharExt     = baseEnumGen extreme enumDfltChar+genLowCharExt      = baseEnumGen extreme enumLowChar+genUpperCharExt    = baseEnumGen extreme enumUpperChar+genDigitCharExt    = baseEnumGen extreme enumDigitChar++genLowCharUni, genDfltCharUni, genUpperCharUni, genDigitCharUni :: Int -> Generator Char+genDfltCharUni   k = baseEnumGen (uniform k) enumDfltChar+genLowCharUni    k = baseEnumGen (uniform k) enumLowChar+genUpperCharUni  k = baseEnumGen (uniform k) enumUpperChar+genDigitCharUni  k = baseEnumGen (uniform k) enumDigitChar++\end{code}++String (lists of character) generators where string length is the rank.+These could have been generated as list structures composed with characters,+but strings are used frequently so a more efficient implementation is desirable.++\begin{code}+genStrRangeAll :: (Char,Char) -> Generator String+genStrRangeAll (a,z) r = combine r [a..z]+genStrDfltCharAll, genStrLowCharAll, genStrUpperCharAll, genStrDigitCharAll :: Generator String+genStrDfltCharAll    = genStrRangeAll (' ','~')+genStrLowCharAll     = genStrRangeAll ('a','z')+genStrUpperCharAll   = genStrRangeAll ('A','Z')+genStrDigitCharAll   = genStrRangeAll ('0','9')++genStrRangeRnd :: StdGen -> (Char,Char) -> Generator String+genStrRangeRnd s (a,z) r = +   let (str,s') = bldStr s (a,z) r in str : (genStrRangeRnd s' (a,z) r)+genStrLowRnd, genStrUpperRnd, genStrDigitRnd :: StdGen -> Generator String+genStrLowRnd    s = genStrRangeRnd s ('a','z')+genStrUpperRnd  s = genStrRangeRnd s ('A','Z')+genStrDigitRnd  s = genStrRangeRnd s ('0','9')++bldStr :: StdGen -> (Char,Char) -> Rank -> (String, StdGen)+bldStr s (_,_) 0 = ("",s)+bldStr s (a,z) r = +  let (c,s') = randomR (a,z) s +      (str,s'') = bldStr s' (a,z) (r-1)+  in (c : str, s'')+ +\end{code}++Generating other scalars is a bit trickier.++Ratios: we can build enumerated generators of ratios,+or use the diagonalized counting of fractions to get a non-enumerated generator.++--\begin{code}+genRatioAll,genRatioXtrm :: Generator (Ratio Int)+genRatioAll = baseEnumGen exhaustG enumBasePosRatio+genRatioXtrm = baseEnumGen extreme enumBasePosRatio+genRatioRnd :: StdGen -> Generator (Ratio Int)+genRatioRnd s = baseEnumGen (randG s) enumBasePosRatio+genRatioUni :: Int -> Generator (Ratio Int)+genRatioUni n = baseEnumGen (uniform n) enumBasePosRatio++-- non-enumerated generator of positive ratios, Cantor counting (i.e. 1/1, 1/2, 2/1, 1/3, 2/2, 3/1, etc.)+diagInt :: Integral a => a -> [Ratio a]+diagInt n | n == 1 = [(1 % 1)]+diagInt n | n > 1 = [(i % (n-i+1)) | i<-[1..n]]+diagInt _ | otherwise = undefined++genPosRatio' :: (Num a, Eq a, Integral a1) => a -> [Ratio a1]+genPosRatio' r | r == 1 = foldr (++) [] $ map diagInt [1..]+genPosRatio' _ | otherwise = []++genRatio' :: (Num a, Eq a, Integral a1) => a -> [Ratio a1]+genRatio' r | r == 1 = let g = genPosRatio' (1::Integer) in +                       interleave g $ map negate g+genRatio' _ | otherwise = undefined++--\end{code}++Doubles and Floats: hard code some sample generators, which include extreme+value generator, and a random generator.  Extreme values use the constants from+the IEEE754 Hackage.  There are no exhaustive generators for these values.++It would have been nice to make general RealFloat versions of all of these+generators, but Haskell couldn't handle the ambiguous typing.++\begin{code}++genDblRnd :: StdGen -> Generator Double+genDblRnd s r | r == 1 = (randoms s:: [Double])+genDblRnd _ _ | otherwise = ([] :: [Double])++genDblRangeRnd :: (Double,Double) -> StdGen -> Generator Double+genDblRangeRnd (l,u) s r | r == 1 = (randomRs (l,u) s :: [Double])+genDblRangeRnd   _   _ _ | otherwise = ([] :: [Double])++genDblXtrm :: Generator Double+genDblXtrm r | r == 1 = +    [minNormal::Double, maxFinite::Double, negate (minNormal::Double), negate (maxFinite::Double), (0::Double),+     epsilon::Double, negate (epsilon::Double), infinity::Double, negate (infinity::Double), +     nan::Double, (nanWithPayload (maxNaNPayload (1::Double)))::Double, (nanWithPayload 1)::Double]+genDblXtrm _ | otherwise = []++genDblUni :: Int -> Generator Double+genDblUni m r | (r==1) && (m > 2) = +  let l = (negate maxFinite::Double)+      u = maxFinite::Double+      delta = (u / ((fromInteger.toInteger) (m-1))) - (l / ((fromInteger.toInteger) (m-1)))+  in take m $ iterate ((+) delta) l+genDblUni m r | r==1 && (m <= 2) = [ (negate maxFinite::Double), maxFinite::Double ]+genDblUni _ _ | otherwise = []++genDblRangeUni :: (Double,Double) -> Int -> Generator Double+genDblRangeUni (l,u) m r | (r==1) && (m > 2) = +  let delta = (u / ((fromInteger.toInteger) (m-1))) - (l / ((fromInteger.toInteger) (m-1)))+  in take m $ iterate ((+) delta) l+genDblRangeUni (l,u) m r | r==1 && (m <= 2) = [l,u]+genDblRangeUni   _   _ _ | otherwise = []++genFltRnd :: StdGen -> Generator Float+genFltRnd s r | r == 1 = (randoms s:: [Float])+genFltRnd _ _ | otherwise = ([] :: [Float])++genFltRangeRnd :: (Float,Float) -> StdGen -> Generator Float+genFltRangeRnd (l,u) s r | r == 1 = (randomRs (l,u) s :: [Float])+genFltRangeRnd   _   _ _ | otherwise = ([] :: [Float])++genFltXtrm :: Generator Float+genFltXtrm r | r == 1 = +    [minNormal::Float, maxFinite::Float, negate (minNormal::Float), negate (maxFinite::Float), (0::Float),+     epsilon::Float, negate (epsilon::Float), infinity::Float, negate (infinity::Float), +     nan::Float, (nanWithPayload (maxNaNPayload (1::Float)))::Float, (nanWithPayload 1)::Float]+genFltXtrm _ | otherwise = []++genFltUni :: Int -> Generator Float+genFltUni m r | (r==1) && (m > 2) = +  let l = (negate maxFinite::Float)+      u = maxFinite::Float+      delta = (u / ((fromInteger.toInteger) (m-1))) - (l / ((fromInteger.toInteger) (m-1)))+  in take m $ iterate ((+) delta) l+genFltUni m r | r==1 && (m <= 2) = [ (negate maxFinite::Float), maxFinite::Float ]+genFltUni _ _ | otherwise = []++genFltRangeUni :: (Float,Float) -> Int -> Generator Float+genFltRangeUni (l,u) m r | (r==1) && (m > 2) = +  let delta = (u / ((fromInteger.toInteger) (m-1))) - (l / ((fromInteger.toInteger) (m-1)))+  in take m $ iterate ((+) delta) l+genFltRangeUni (l,u) m r | r==1 && (m <= 2) = [l,u]+genFltRangeUni   _   _ _ | otherwise = []+\end{code}

+ Test/GenCheck/Generator/EnumStrat.lhs view

@@ -0,0 +1,112 @@+An \emph{enumerative strategy} is a list of indices that will be used to+produce a list of values of an enumerated type. \emph{Enumerative} generators+are the image of the enumerative strategy mapped to an enumeration.+This ``strategy'' abstracts the approach of selecting and ordering the values +of an enumerated type.++Strategies are a heuristic means of selecting values. The usefulness+of the resulting generator will depend on the circumstances.  Any+list of Integers can be used as an enumerative strategy, so these can be+combined or customized as required for a given test.++\begin{code}+module Test.GenCheck.Generator.EnumStrat where++import System.Random (StdGen, randomR)+import Data.List (genericTake)++import Test.GenCheck.Base.Base(Count)++type EnumStrat = Count -> [Count]  +\end{code}++Exhaustive testing includes all of the elements of the type.  The exhaustive+strategy has been included primarily for completeness and convenience.  Using+an enumerative strategy to construct an exhaustive generator will be+inefficient in general, so a non-enumerative generator might be a better+choice.++\begin{code}+exhaustG :: EnumStrat+exhaustG u | u > 0 = [1..u]+exhaustG _ | otherwise = []+\end{code}++Random testing makes use of Haskell's Random module to provide infinite streams+of uniformly distributed indices.  It requires a seed on input.++Random testing may generate many duplicate or clustered test cases, providing+insufficient diversity in a test suite, and is more expensive to calculate than+the other strategies.  It is, however, a good tool for supplementing the other+strategies by providing some deviation from the uniform intervals in the index+selection.++\begin{code}+randG :: StdGen -> EnumStrat+randG s = \cnt -> if cnt>=0 then genericTake cnt $ gr s cnt else []+    where gr t cnt = let (x,s') = (randomR (1,cnt) t) in x : (gr s' cnt)+\end{code}++Create a uniform sampling of the types by partitioning the index interval into+equal increments.  The meaning of uniform is dependent on the structure and+it's enumeration, so this is more of a heuristic means of sampling the type+values, but it guarantees at least some coverage of the type.++If only 2 or fewer samples are requested, just the top and bottom of the+interval are chosen.++\begin{code}+uniform :: Int -> EnumStrat+uniform n u | n > 2 && u > 1 = +  let s = (toRational u) / (toRational n)+  in if u > (toInteger n) then take (n+1) $ 1 : (map round (iterate ((+) s) s))+              else exhaustG u+uniform _ u | u > 1 = [1,u]+uniform _ u | u == 1 = [1]+uniform _ _ | otherwise = []++\end{code}++Extreme covers the boundaries of the range, then recursively splits the range+and takes those boundaries. For example,+    +|extreme (1,20) = [1,20,10,2,11,9,19,5,15,3,12,6,16,4,14,8,18,7,13,17]|++The first two extreme binary trees will be the ``all left'' and ''all right''+branched trees, which is a good start for testing, but in general extreme+indices may or may not map to boundary conditions in a particular structure.++Extreme generators is best used for pulling a small number of cases in+conjunction with random testing. It is not an efficient strategy to produce a+large number of test cases, and may contain duplicate index entries.++\begin{code}+extreme :: EnumStrat+extreme up | up <= 0 = []+extreme up | up == 1 = [1]+extreme up = interleave low high+  where low = [(1::Integer) .. (up `div` 2)] +        high = [(up - x + 1) | x <- low]++interleave :: [a] -> [a] -> [a]+interleave xs [] = xs+interleave [] ys = ys+interleave (x:xs) (y:ys) =  x : (y : interleave xs ys)+\end{code}++\begin{code}+branch :: EnumStrat+branch up | up <= 0 = []+branch up | up == 1 = [1]+branch up           = xtrm (1,up) -- up > 1+  where+    xtrm (l, u) = +      let dif = u - l+          m = (dif `div` 2) + l+      in if dif < 1 then [l]+         else if dif < 2 then [l,u]+         else l : u : m :+           (if dif < 3 then [] +               else interleave (xtrm ((l+1), (m-1))) (xtrm ((m+1), (u-1))))++\end{code}

+ Test/GenCheck/Generator/Enumeration.lhs view

@@ -0,0 +1,370 @@+Enumerations of a structured type (aka type constructor) provides the number of+shapes as well as a strict total ordering over the shapes of that (structured)+type.  One approach to generating instances of an enumerated type is to+generate indices into that enumeration to ``pick'' values of the type (when it+does not lead to too much confusion, we will refer to a particular shape of a+structured type (i.e. a tree with holes where data will be filled-in) as a+``value'').  This separation allows the generation of indices - the testing+``strategy'' - to be independent of the construction of concrete instances of+the type.  Enumerative generators use a generic strategy to sample value from+an enumerated type.++In the GenCheck package, the indexing scheme for enumerations has been fixed to+a pair consisting of a Rank (Int) and a Count (Integer), both of which are+natural numbers (i.e. positive integers).  The most general definition of rank+is a positive natural number that indexes (finite but possibly empty)+partitions of the set of elements of the type.  This two level indexing schema+is recognized by all of the components of GenCheck and is generally the default+mechanism for generating and reporting values.++Two flavours of enumerations are provided in the GenCheck package:++\begin{enumeration}+\item Haskell base (or scalar) types +\item Haskell regular polynomial types (i.e. non-nested Haskell types)+\end{enumeration}++The rank of all base types such as |Int| and |Char| is 1, and the rank of+regular polynomial data types is the number of holes for data elements in the+structure The second index (Count) is an arbitrary Integer type to allow very+large enumerations.++The built in enumeration (Enum) is used for Haskell base types that are+instances of Haskell's Bounded and Enumerated classes (e.g. |[minBound ..+maxBound]|).  Enumerations are also provided for |Integer|, |Ratio|,+|Rational|, |Float| and |Double|.  These ``scalar'' types require some+additional structure.  Most of the base type enumeration functions are in+BaseTypeEnum.lhs.++All Haskell regular polynomial structure types can be enumerated by rank (size)+using a mechanical algorithm based solely on the type constructor.  These+enumerations are constructed using the combinators eConst, eNode, eSum, eProd,+etc.  to mirror the type's constructor.  Recursive structure enumerations+should also be memoized to improve their performance since the count /+selection of value at rank r is dependent on the count / selection of values at+ranks $1$ through $(r-1)$. The eMemoize function provides the default+memoization; additional memoization techniques are also provided in Memoize.lhs++Note: the Enumeration class differs from Haskell's Enum class in that+the index of the enumerated value is unrecoverable, so the methods+succ, pred, enumToInt, etc. are not required for the Enumeration instances.++\begin{code}++module Test.GenCheck.Generator.Enumeration+( Enumeration+, Enumerated(..)+, Counter+, Selector+, mkEnumeration+, mkEnum+, counter+, selector+, get+, getUnsafe+, enumRange+, eMemoize+, eConst+, eNode+, eSum+, eSum3+, eSum4+, eProd+, eProd3+, eProd4+, cConst+, cNode+, cSum+, cSum3+, cSum4+, cProd+, cProd3+, cProd4+, sConst+, sNode+, sSum+, sSum3+, sSum4+, sProd+, sProd3+, sProd4+, Label(..)+) where ++import Math.Combinat.Combinations (combinations1)+import Data.Function.Memoize++import Test.GenCheck.Base.Base(Rank,Count)+\end{code}++Note that the actual implementation of |Enumeration| is not exported.  +Instead, smart constructors |mkEnumeration| and |mkEnum| are provided.+|mkEnumeration| applies a default memoization strategy to both the counter and+selector functions.  |mkEnum| is just the raw constructor, and is used for+enumerations that will be embedded in other enumerations to avoid redundant+memoization.  |mkEnum| should only be needed by experts and the Template Haskell+code that assembles the enumeration combinators based on the type constructor.++An enumerated type may be defined to be an instance of the |Enumerated| class,+which will automatically provide the default generators for that type+as instances of StandardGens in the Generator module.+The structures will have a Label (A, B, etc.) in each ``hole''+that distinguishes the sort of the element.++|get| retrieves a value from an enumeration given a rank and an index, +or returns |Nothing| if the index is outside of the range of the enumeration.+|getUnsafe| assumes the rank and index values are valid and in range,+with unpredictable results if not.++\begin{code}+type Counter      = Rank -> Count+type Selector c a = Rank -> Count -> c a++data Enumeration c a = Enum Counter (Selector c a)+data Label = A | B | C | D | E | F | G deriving Show++instance Functor c => Functor (Enumeration c) where+    fmap f (Enum c s) = Enum c (\rank count -> fmap f (s rank count))++mkEnum, mkEnumeration :: Counter -> Selector c a -> Enumeration c a+mkEnum = Enum+mkEnumeration c s = eMemoize $ mkEnum c s++counter :: Enumeration c a -> Counter+counter (Enum c _) = c+selector :: Enumeration c a -> Selector c a+selector (Enum _ s) = s++class Functor c => Enumerated c where+  enumeration :: Enumeration c Label+  enumFromTo :: (Integer,Integer) -> Enumeration c Label+  enumFromTo (l,u ) = enumRange (l,u) enumeration++enumRange :: (Count, Count) -> Enumeration c a -> Enumeration c a+enumRange (l,u) e = mkEnum c' s' +  where c = counter e+        s = selector e+        c' r = min (c r) (u - l + 1)+        s' r k' = s r (k' + l - 1)++get :: Enumeration c a -> Rank -> Count -> Maybe (c a)+get (Enum c s) r n | (r > 0) && (n > 0) =  +    if (c r) >= n then Just (s r n) else Nothing+get _ _ _ | otherwise = Nothing++getUnsafe :: Enumeration c a -> Rank -> Count -> c a+getUnsafe  (Enum _ s) r n = s r n+\end{code}++Enumerations are much more efficient when memoized. The counting and selector+functions built by these combinators are not memoized to avoid redundant+memoization.  It is appropriate to memoize the resulting enumeration using+eMemoize, which selects the current default memoization technique.+Other memoize techniques can be located in the Base.Memoize module.++\begin{code}+eMemoize :: Enumeration c a -> Enumeration c a+eMemoize (Enum c s) =  mkEnum (memoize c) (memoize s)+\end{code}++Enumerations can be mechanically constructed for regular polynomial types.+eConst, eNode, eSum, eProd, etc. are combinators for constructing enumerations.+They rely on counting (cConst, etc.) and selector (sConst, etc.) combinators.+The pattern matching on the sums must be lazy (irrefutable) to allow the+manual counting of the possible structures of that size to terminate the+recursive construction of the patterns.++\begin{code}+eConst, eNode :: c a -> Enumeration c a+eConst x = mkEnum cConst (sConst x)+eNode  x = mkEnum cNode  (sNode  x)++eSum :: Enumeration c a -> Enumeration c a -> Enumeration c a+eSum  e1@(~(Enum c1 _)) e2@(~(Enum c2 _)) = mkEnum (cSum c1 c2) (sSum e1 e2)+eSum3 :: Enumeration c a -> Enumeration c a -> Enumeration c a -> Enumeration c a+eSum3 e1@(~(Enum c1 _)) e2@(~(Enum c2 _)) e3@(~(Enum c3 _)) +          = mkEnum (cSum3 c1 c2 c3) (sSum3 e1 e2 e3)+eSum4 :: Enumeration c a -> Enumeration c a -> Enumeration c a -> Enumeration c a -> Enumeration c a+eSum4 e1@(~(Enum c1 _)) e2@(~(Enum c2 _)) e3@(~(Enum c3 _)) e4@(~(Enum c4 _))+          = mkEnum (cSum4 c1 c2 c3 c4) (sSum4 e1 e2 e3 e4)++eProd :: (a x -> b x -> c x) -> Enumeration a x -> Enumeration b x -> Enumeration c x+eProd con e1@(Enum c1 _) e2@(Enum c2 _) = mkEnum (cProd c1 c2) (sProd con e1 e2)+eProd3 :: (a x -> b x -> c x -> d x) -> Enumeration a x -> Enumeration b x -> Enumeration c x -> Enumeration d x+eProd3 con e1@(Enum c1 _) e2@(Enum c2 _) e3@(Enum c3 _) = +         mkEnum (cProd3 c1 c2 c3) (sProd3 con e1 e2 e3)+eProd4 :: (a x -> b x -> c x -> d x -> e x) -> Enumeration a x -> +        Enumeration b x -> Enumeration c x -> Enumeration d x -> Enumeration e x+eProd4 con e1@(Enum c1 _) e2@(Enum c2 _) e3@(Enum c3 _) e4@(Enum c4 _) = +         mkEnum (cProd4 c1 c2 c3 c4) (sProd4 con e1 e2 e3 e4)+\end{code}++Counting algebraic data types. The enumProd(3) functions compute the number of+instances for all possible distributions of the total rank within a product+constructor; they are defined below.++\begin{code}+cConst, cNode :: Counter+cConst r = if r == 1 then (1::Count) else (0::Count)+cNode  r = if r == 1 then (1::Count) else (0::Count)+cSum, cProd :: Counter -> Counter -> Counter+cSum c1 c2 r = c1 r + c2 r+cProd c1 c2 r = sum $ map product (sizes r)+    where sizes r' = map (zipWith ($) [c1, c2]) (combinations1 2 r')+cSum3, cProd3 :: Counter -> Counter -> Counter -> Counter+cSum3 c1 c2 c3 r = c1 r + c2 r + c3 r+cProd3 c1 c2 c3 r = sum $ map product (sizes r)+    where sizes r' = map (zipWith ($) [c1, c2, c3]) (combinations1 3 r')+cSum4, cProd4 :: Counter -> Counter -> Counter -> Counter -> Counter+cSum4 c1 c2 c3 c4 r = c1 r + c2 r + c3 r + c4 r+cProd4 c1 c2 c3 c4 r = sum $ map product (sizes r)+    where sizes r' = map (zipWith ($) [c1, c2, c3, c4]) (combinations1 4 r')++\end{code}++Selector functions for algebraic data types, builds a map from+the rank and index count to a value of the type.++sConst,sNode,sSum, sProd, etc. mirror the type constructor algebra.+sSum3,sSum4,sProd3,sProd4 could have been excluded, +with larger products and sums being built pairwise,+but incorporating them in a single function allows+all of the dimensions to be treated equally and avoids +creating and destroying intermediate tuples.++The interval and deref functions ``find'' the appropriate value+in the enumeration through some rather ugly arithmetic,+and are defined below.++\begin{code}+sConst,sNode :: (Num a, Num b, Eq a, Eq b) => t x -> a -> b -> t x+sConst x r n = if (r==1) && (n==1) then x else selector_error+sNode  x r n = if (r==1) && (n==1) then x else selector_error+sSum :: Enumeration c a -> Enumeration c a -> Selector c a+sSum (Enum c1 s1) (Enum c2 s2) r n = +  let n1 = c1 r in if (n <= n1) then s1 r n +                   else if (n <= c2 r) then s2 r (n - n1)+                   else selector_error++sSum3 :: Enumeration c a -> Enumeration c a -> Enumeration c a -> Selector c a+sSum3 (Enum c1 s1) (Enum c2 s2) (Enum c3 s3) r n = +  let n1 = c1 r +      n2 = c2 r+      in if          (n <= n1)   then s1 r n +           else   if (n <= n2)   then s2 r (n - n1)+           else   if (n <= c3 r) then s3 r (n - (n1+n2))+           else   selector_error++sSum4 :: Enumeration c a -> Enumeration c a -> Enumeration c a -> Enumeration c a -> Selector c a+sSum4 (Enum c1 s1) (Enum c2 s2) (Enum c3 s3) (Enum c4 s4) r n = +  let n1 = c1 r +      n2 = c2 r+      n3 = c3 r+      in if          (n <= n1)   then s1 r n +           else   if (n <= n2)   then s2 r (n - n1)+           else   if (n <= n3)   then s3 r (n - (n1+n2))+           else   if (n <= c4 r) then s4 r (n - (n1+n2+n3))+           else   selector_error++sProd ::  (a x -> b x -> c x) -> Enumeration a x -> Enumeration b x ->Selector c x+sProd con (Enum c1 s1) (Enum c2 s2) r n =+   let ([r1,r2],n') = interval n $ enumProd c1 c2 r+       [n1,n2]      = deref [c1 r1, c2 r2] n'+   in con (s1 r1 n1) (s2 r2 n2)++sProd3 ::  (a x -> b x -> c x -> d x) -> Enumeration a x -> Enumeration b x -> Enumeration c x -> Selector d x+sProd3 con (Enum c1 s1) (Enum c2 s2)  (Enum c3 s3) r n =+   let ([r1,r2,r3],n') = interval n $ enumProd3 c1 c2 c3 r+       [n1,n2,n3]      = deref [c1 r1, c2 r2, c3 r3] n'+   in con (s1 r1 n1) (s2 r2 n2) (s3 r3 n3)++sProd4 ::  (a x -> b x -> c x -> d x -> e x) -> Enumeration a x -> +    Enumeration b x -> Enumeration c x -> Enumeration d x -> Selector e x+sProd4 con (Enum c1 s1) (Enum c2 s2)  (Enum c3 s3) (Enum c4 s4) r n =+   let ([r1,r2,r3,r4],n') = interval n $ enumProd4 c1 c2 c3 c4 r+       [n1,n2,n3,n4]      = deref [c1 r1, c2 r2, c3 r3, c4 r4] n'+   in con (s1 r1 n1) (s2 r2 n2) (s3 r3 n3) (s4 r4 n4)++selector_error :: t+selector_error = error "Selector error"+\end{code}++The enumeration of products requires somewhat more complicated indexing.+A product of rank r is a pair $(\alpha_{r1}, \beta_{r2})$,+where $r1 + r2 = r$ are a partition of the rank,+so the set of products is given by all products over+all possible combinations of $(r1,r2)$.+For an n-product, this is an n-tuple,+with the argument ranks summing to $r$.+When enumerating an n-product, it is necessary to enumerate+all possible partitions of the rank into n components,+and then enumerate each of the rank decompositions.++enumProd, enumProd3, enumProd4 count the rank decomposition instances of +a product of other structures given their counting functions.+The count is given for each rank decomposition separately in a list,+the sum being the total number of structures of the product.+The output is a function from rank to a list of the number of +decompositions of the rank, with a minimum rank of 1, of pairs consisting of+the count and what is actually a pair (or triple) of ranks.++Combinations1 comes from the Math.Combinat package,+and returns a list of length n lists of the partition;+e.g. |combinations1 2 5 = [[1,4],[2,3],[3,2],[4,1]]|.+Note that the rank of all structures must be at least 1.++\begin{code}+-- Rank -> [(Count, [r1,r2])] where r1 + r2 = Rank+enumProd :: (Rank -> Count) -> (Rank -> Count) -> (Rank -> [(Count,[Rank])])+enumProd c1 c2 r = zip (map product sizes) combs+    where combs = combinations1 2 r+          sizes = map (zipWith ($) [c1, c2]) combs++-- Rank -> [(Count, [r1,r2,r3])] where r1 + r2 + r3 = Rank+enumProd3 :: (Rank -> Count) -> (Rank -> Count) -> (Rank -> Count) +               -> (Rank -> [(Count,[Rank])])+enumProd3 c1 c2 c3 r = zip (map product sizes) combs+    where combs = combinations1 3 r+          sizes = map (zipWith ($) [c1, c2, c3]) combs++-- Rank -> [(Count, [r1,r2,r3,r4])] where r1 + r2 + r3 + r4 = Rank+enumProd4 :: (Rank -> Count) -> (Rank -> Count) -> (Rank -> Count) -> (Rank -> Count) +               -> (Rank -> [(Count,[Rank])])+enumProd4 c1 c2 c3 c4 r = zip (map product sizes) combs+    where combs = combinations1 4 r+          sizes = map (zipWith ($) [c1, c2, c3, c4]) combs++\end{code}++The Enumeration indexes n-products as a n-dimensional cubes.+\emph{interval} takes an index into a rank r n-product and determines the +ranks $(r1, ..., rn)$ of each of the n components of the n-product where +$\sum r_{i} = r$, and an index into just the n-products of that particular rank+distribution.++\emph{deref} converts the one dimensional index into the n-product,+along with the ranks of each of the components of the product,+into an n-tuple index into each component.++\begin{code}+interval :: (Integral k) => k -> [(k,a)] -> (a, k)+interval k' ps = intv k' 0 ps where+  intv _ _ [] = error "Trying to partition an empty interval"+  intv k _ _ | k < 1 = error "Trying to partition a one element interval"+  intv k acc ((p, x) : ps') = +     let acc' = acc + p +     in if (k <= acc') then (x, (k-acc)) else intv k acc' ps'++deref :: (Integral k) => [k] -> k -> [k]+deref ds k'  | k' >= 1 =  drf (dimd ds) k'+             | otherwise  = error "Dereferencing below 1"+  where+    drf (dmax:[1]) k | k <= dmax = [k]+    drf (dmax:(dm:dims)) k | k <= dmax =+      let (c,j) = ((k-1) `divMod` dm)+          ds' = drf (dm:dims) (j+1)+      in (c+1) : ds'+    drf _ _ = error "Some weird illegal dereference"+    dimd [] = [1]+    dimd (d:ds') = let (md:mds) = dimd ds' in (md*d : (md:mds))+\end{code}

+ Test/GenCheck/Generator/Generator.lhs view

@@ -0,0 +1,134 @@+Generators produce lists of concrete (ground) terms of a given type.  They have+four objectives in the testing process:++\begin{itemize}+\item determine which elements of the type to instantiate,+\item provide a usable instance of the element (i.e. a ground term),+\item partition the set of values into finite subsets,+with each subset uniquely labelled by a natural number called the \emph{rank},+\item define an order in which to provide the elements of a given rank.+\end{itemize}++The meaning of the rank is dependent on the nature of the generated structure,+and there may be more than one acceptable definition of rank for a given data+type.  For example, the rank of a tree may be the number of leaves, or the+height of the tree, or the number of interior nodes.  The definition of the+rank needs to be clearly documented for each generator.  ++For data structures, the rank is the number of data elements or nodes.  For+simple base types, the rank is 1; for more complicated base types such as+Double, a ranked generator may make sense. Any function from Rank (Int) to a+list of values of a type can be a generator in GenCheck compatible type systems+as long as it satisfies the ranking criteria.  ++Generators might be constructed to:++\begin{itemize}+\item {embodying domain specific knowledge+e.g.physical addresses or international names,}+\item {improve efficiency for complicated structures,}+\item {incorporate value based constraints,}+\item {use incremental construction from smaller structures.}+\end{itemize}++\begin{code}++module Test.GenCheck.Generator.Generator +( Generator+, generate+, genTake+, enumGenerator+, StandardGens(..)+, Testable(..)+, stdEnumGens+, enumGens+) where++import System.Random (StdGen)+import Data.List (genericTake)++import Test.GenCheck.Base.Base (Rank, Count)+import Test.GenCheck.Generator.Enumeration as +            Enum(Enumeration, Enumerated(..), counter, getUnsafe,Label)+import Test.GenCheck.Generator.EnumStrat+\end{code}++The Generator type is defined to be a function from rank to a list of values.+Generators are not obliged to provide all possible values of a type, nor are+they obliged to provide only one occurence of the type in the list.  Although+those are useful properties for a generator to have, in some cases the+flexibility is desirable, such as random value generators.  Note that even+though the rank partitions the type into finite discrete subsets, there is no+restriction against duplicating values in the list, so the list may infinite.+Any function that satisfies the Generator type can be used with GenCheck+compatible systems, as long as they are total over non-negative ranks.++The generate function generates values of multiple ranks in a flat list.++\begin{code}+type Generator a = Rank -> [a]++generate :: Generator a -> [(Rank, Count)] -> [a]+generate g = concatMap $ uncurry (genTake g)++genTake :: Generator a -> Rank -> Count -> [a]+genTake g r n = genericTake n (g r)+\end{code}++Enumerated generators use an enumeration (Generator.Enumeration)  and an+enumerative strategy (a type independent list of indices, Generator.EnumStrat)+to order the generated values by mapping the selection order over the+enumeration.  The strategy is assumed to provide indices in the domain of the+enumeration, given the size of the enumeration at that rank.++\begin{code}+enumGenerator :: EnumStrat -> Enumeration c a -> Generator (c a)+enumGenerator strat e rnk =  fmap (Enum.getUnsafe e rnk) (strat (Enum.counter e rnk))+\end{code}++Four enumerative strategies form the standard approach to generating test+values, and these generators are grouped into the StandardGens structure for+use in the test programs and test suite building functions.+The standard generators are:++\begin{definition}+\item[allGen] an exhaustive generator+\item[xtrmGen] extreme / boundary condition generator+\item[uniGen]  picks a fixed number of uniformly separated elements+\item[randGen] random generator (infinitely many elements)+\end{definition}++The generators can be restricted to an interval of the total set of values+by providing a range of indices (low index, high index) into the enumeration.++A set of standard generators can be defined from the enumeration, (the random+generator requires an integer seed and uses the System.Random module) or+overridden with more efficient implementations.  The StandardGens structure is+just a convenient way to pass them around.++stdGenList fills in the uniform spacing provides the standard ordering in a+list format.++\begin{code}+class Show a => Testable a where+    stdTestGens  :: StandardGens a++data StandardGens a = StdGens +  { genAll  :: Generator a+  , genXtrm :: Generator a+  , genUni  :: Int    -> Generator a+  , genRand :: StdGen -> Generator a+  }+  | UnrankedGen (Generator a)++enumGens :: Enumeration c Label -> StandardGens (c Label) +enumGens e = StdGens allGen xtrmGen uniGen randGen+  where+    allGen   = enumGenerator exhaustG e+    xtrmGen  = enumGenerator extreme e+    uniGen   = \m' -> enumGenerator (uniform m') e+    randGen  = \s' -> enumGenerator (randG  s')  e++stdEnumGens :: Enumerated c => StandardGens (c Label)+stdEnumGens = enumGens enumeration+\end{code}

+ Test/GenCheck/Generator/StructureGens.lhs view

@@ -0,0 +1,90 @@+This module is a library of useful generators for structural types.+Additional generator modules should be added to the Generator directory.++\begin{code}+{-# LANGUAGE FlexibleInstances #-}++module Test.GenCheck.Generator.StructureGens +  ( genListOf+  , genListAll+  , listStdGens+  , genTplAll+  ) where++import Test.GenCheck.Base.Base (Rank)+import Test.GenCheck.Generator.Enumeration (Label(..))+import Test.GenCheck.Generator.Generator (Generator, StandardGens(..), Testable(..))+import Test.GenCheck.Generator.BaseGens() -- Testable instances+import Test.GenCheck.Generator.Substitution (Structure(..), Structure2(..))++\end{code}++Lists are a special kind of structure to generate, since there is only one+possible list for each rank, and the substitution values are already in a list.++The genListOf combinator turns a generator of a type a into a generator of+lists of a's of the specified rank.  The rank of the resulting generator+defines the length of the lists of a's it generates.++The basic list generator, with unit as the sort, is given as genListAll.  The+Structure class is provided for completeness, but there is only one possible+list for any given rank.++\begin{code}+genListOf :: Generator a -> Rank -> Generator [a]+genListOf g r l = let xs = g r in subLs xs+  where subLs [] = []+        subLs xs@(_:_) = let (ys',yss) = splitAt l xs in ys' : (subLs yss)++instance Structure [] where+  substitute lxs ys = lsub lxs ys+    where +       lsub [] zs          = (Just [], zs)+       lsub (_:_) []       = (Nothing, [])+       lsub (_:xs) (z:zs)  = +            let (mlys', ys') = lsub xs zs+                mlys = maybe Nothing (\lys -> Just (z:lys)) mlys'+            in (mlys, ys')++-- remember that generating a list of rank 1 gives the empty list, not a list of one element   +genListAll :: Generator [Label]+genListAll r = [take (r-1) (repeat A)]++listStdGens :: StandardGens [Label]+listStdGens = StdGens g g (\_ -> g) (\_ -> g) +  where g = genListAll++instance Testable [Label] where+  stdTestGens = listStdGens++listStdSub :: (Testable a) => StandardGens [a]+listStdSub = +  let stdg = stdTestGens+  in StdGens (vector (genAll stdg 1)) (vector (genXtrm stdg 1)) +             (\k -> (vector (genUni stdg k 1))) (\s -> (vector (genRand stdg s 1)))+  where vector xs r = let (x, xs') = splitAt r xs in x : (vector xs' r)++instance Testable [Int] where+  stdTestGens = listStdSub :: StandardGens [Int]++\end{code}++A pair generator is two sorted, so is an instance of Structure2.+Pairs are always of rank 2.++\begin{code}+instance Structure2 (,) where+  substitute2 _ [] ys = (Nothing, [], ys)+  substitute2 _ xs [] = (Nothing, xs, [])+  substitute2 _ (x:xs) (y:ys) = (Just (x,y), xs, ys)+  +genTplAll :: Generator (Label, Label)+genTplAll r | r == 2    = [(A,B)]+genTplAll _ | otherwise = []++tplStdGens :: StandardGens (Label, Label)+tplStdGens = StdGens g g (\_ -> g) (\_ -> g) where g = genTplAll++instance Testable (Label,Label) where+  stdTestGens = tplStdGens+\end{code}

+ Test/GenCheck/Generator/Substitution.lhs view

@@ -0,0 +1,194 @@+The generation of algebraic data structures is split into two steps.  First,+structure generators create instances of the structure type where the element+nodes are filled with a constant value, or a constant label for multi-sorted+structures.  These can be considered ``templates'' with ``holes'' for data+elements.  New generators are built by substituting elements, extracted from a+generator, into these templates to create one or more copies of each structure.+These new generators use the substitution method from the Structure class to+integrate the elements into the structures; the structures must be an instance+of the Structure class, or Structure2, etc. for multi-sorted structures.++The substitution functions use a structure generator and an element generator,+with each node (or ``hole'') in the template filled with a single value.+Elements are assumed to be base type generators, meaning they have no rank.+The different substitution functions produce differing numbers of copies of+each structure ``template'' to provide some flexibility in building generators.++Note that structures can be composed with other structures using the+Composition module, which takes into account the rank of both structure types.+These compound structures can themselves be filled using the substitution+functions.++\begin{code}++module Test.GenCheck.Generator.Substitution+( Structure(..)+, subst+, substN+, substAll+-- , subPerm+-- , subComb+, substStdGenN+, substStdGenAll+-- , subStdGenPerm+-- , subStdGenComb+, Structure2(..)+, subst2+, subst2N+, subst2StdGen+-- , subst2StdGenN+-- , subst2StdGenAll+-- , subst2StdGenPerm+-- , subst2StdGenComb+, Structure3(..)+) where++import Data.Maybe (catMaybes)+import Test.GenCheck.Generator.Generator (Generator, StandardGens(..))+\end{code}++The Structure class defines the \emph{substitution} method for a structure, the+mechanical details of replacing ``holes'' in the data structure with elements.+This is an order based operation with nodes populated from a list of elements.+There are two methods provided, one that assumes that enough elements are+available and throws an error if that is not so, the other returns a Maybe+encapsulated value and any leftover elements from the input list.++Instances of Structure can be generated mechanically from the data constructor+definitions via Template Haskell.++\begin{code}+class Structure c where+  substitute    :: c a -> [b] -> (Maybe (c b), [b])++class Structure2 c where+  substitute2   :: c a b -> [a'] -> [b'] -> (Maybe (c a' b'), [a'], [b'])++class Structure3 c where+  substitute3 :: c a1 a2 a3 -> [a1'] -> [a2'] -> [a3'] +                       -> (Maybe (c a1' a2' a3'), [a1'], [a2'], [a3'])++\end{code}++\begin{description}+\item[subst] populate one copy of each generated structure+\item[substN] populate n copies without reusing the generated elements +                 (does not guarantee unique values of those elements)+\item[substAll] populates each instance of the structure of a given rank+        with the same list of elements, and then all shapes with the next list+        until exhausting the element generator (non-terminating for infinite generators)+\end{description}++These three combinators all assume that the elements are of rank 1, regardless+of the rank of the structure.  This is typical of a structure with base type+nodes.++\begin{code}+subst :: Structure c => Generator (c a) -> Generator b -> Generator (c b)+subst gfx gy r =  +  let fxs = (gfx r)+      ys  = gy 1+  in gsub fxs ys++gsub :: Structure c => [c a] -> [b] -> [c b]+gsub [] _       = []+gsub (fx:fxs) ys = +   let (mfy, ys') = substitute fx ys+   in case mfy of+        Nothing -> []+        Just fy -> fy : (gsub fxs ys')++substN :: Structure c => Int -> Generator (c a) -> Generator b -> Generator (c b)+substN n gfx gy r = gsubN n n (gfx r) (gy 1)++gsubN :: Structure c => Int -> Int -> [c a] -> [b] -> [c b]+gsubN _ 0 _  _       = []+gsubN _ _ [] _       = []+gsubN n k fxs@(fx:fxss) ys = +   let (mfy, ys') = substitute fx ys+   in if k > 1 then maybe [] (\fy -> fy : (gsubN n (k-1) fxs ys')) mfy+               else maybe [] (\fy -> fy : (gsubN n n fxss ys')) mfy ++substAll :: Structure c => Generator (c a) -> Generator b -> Generator (c b)+substAll gfx gy r = +  let ys = gy 1+      fxs = gfx r+  in gsubAll fxs ys++gsubAll :: Structure c => [c a] -> [b] -> [c b]+gsubAll [] _ = []+gsubAll l@(fx:fxs) ys = +   let (mfy, ys') = substitute fx ys  -- subst elements into first structure+       -- sub same ys into remaining list of structures, guaranteed finite+       fys = catMaybes $  map (fst.((flip substitute) ys)) fxs+   in maybe [] (\x -> x:(fys ++ (gsubAll l ys'))) mfy+\end{code}++The ``standard'' list of generators is exhaustive, extreme (boundary), uniform+and random.  Using the data type instead of the StandardGens class avoids all+sorts of type hassles, and locks the random seed and uniform sampling size into+the record.++\begin{code}+substStdGenN :: Structure c => Int -> StandardGens (c a) -> Generator b -> StandardGens (c b)+substStdGenN n (StdGens g1 g2 g3 g4) g = +  let ga = substN n g1 g+      gx = substN n g2 g+      gu k = substN n (g3 k) g+      gr s = substN n (g4 s) g+  in StdGens ga gx gu gr+substStdGenN _ (UnrankedGen _) _ = error "Can only substituted into ranked"++substStdGenAll :: Structure c => StandardGens (c a) -> Generator b -> StandardGens (c b)+substStdGenAll (StdGens g1 g2 g3 g4) g = +  let ga = substAll g1 g+      gx = substAll g2 g+      gu k = substAll (g3 k) g+      gr s = substAll (g4 s) g+  in StdGens ga gx gu gr+substStdGenAll (UnrankedGen _) _ = error "Can only substitute into ranked"+\end{code}++Multi-sort structure substitution. This could be accomplished with multiple+steps of single sort substitution, but simultaneous substitution allows more+options.++Again, the elements are assumed to be of rank 1.++\begin{code}+subst2 :: Structure2 c => Generator (c a b) -> Generator a' -> Generator b' +                             -> Generator (c a' b')+subst2 gfxy gx' gy' r =  +  let fxs = gfxy r+      xs  = gx' 1+      ys  = gy' 1+  in gsub2 fxs xs ys++gsub2 :: Structure2 c => [c a b] -> [a'] -> [b'] -> [c a' b']+gsub2 [] _ _       = []+gsub2 (fx:fxs) ys zs = +   let (mfy, ys', zs') = substitute2 fx ys zs+   in maybe [] (\fy -> fy : (gsub2 fxs ys' zs')) mfy++subst2N :: Structure2 c => Int -> Generator (c a b) -> Generator a' +    -> Generator b' -> Generator (c a' b')+subst2N n gfx gy gz r = gsub2N n 1 (gfx r) (gy 1) (gz 1)++gsub2N :: Structure2 c => Int -> Int -> [c a b] -> [a'] -> [b'] -> [c a' b']+gsub2N _ 0 _  _ _      = []+gsub2N _ _ [] _ _      = []+gsub2N n k fxs@(fx:fxss) ys zs = +   let (mfy, ys', zs') = substitute2 fx ys zs+   in if n > k then maybe [] (\fy -> fy : (gsub2N n (k+1) fxs ys' zs')) mfy+               else maybe [] (\fy -> fy : (gsub2N n 1 fxss ys' zs')) mfy ++subst2StdGen :: Structure2 c => StandardGens (c a b) -> Generator a' -> Generator b'+                                  -> StandardGens (c a' b')+subst2StdGen (StdGens g1 g2 g3 g4) ga' gb' = +  let ga = subst2 g1 ga' gb'+      gx = subst2 g2 ga' gb'+      gu k = subst2 (g3 k) ga' gb'+      gr s = subst2 (g4 s) ga' gb'+  in StdGens ga gx gu gr+subst2StdGen (UnrankedGen _) _ _ = error "Can only substitute into ranked"+\end{code}

+ Test/GenCheck/System/Result.lhs view

@@ -0,0 +1,116 @@+A test result is a collective term for the individual results+of each test case and the overall conclusion of pass or fail +based on those results.  A test result should also include+the value of at least one failing test case if there are any.+The interpretation of the results to form the overall verdict+and the number of test failures to compute before terminating the test+will vary with the nature of the test context.++GenCheck test systems work with a standard Result class, a partition (instance+of Partition) of the individual test results (instances of Verdict).  The+overall result is itself a verdict, the conjugate of the individual test+results.  Each part of the result is also a verdict and can be evaluated+separately.++The Partition instance provides a label/index for each part.+There is no constraint on  nature of this grouping or labelling; it may be a+trivial label for the entire result set.  This constraint allows report schemas+to assume at least one label is provided, even if it is just the title of the+whole test.++\begin{code}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module Test.GenCheck.System.Result +( dspVerdict+, dspSummary+, dspDetails+, DetailedResult(..)+, result+, resultPartial+) where++import Test.GenCheck.Base.Verdict(Verdict(..),SummaryVerdict(..))+import Test.GenCheck.Base.Datum as Datum( Datum(..))+import Test.GenCheck.Base.LabelledPartition as Partition(LabelledPartition(..))+import qualified Test.GenCheck.Base.LabelledPartition as Partition(filter)++dspVerdict :: (LabelledPartition c k v, Verdict r, DetailedResult (c k) v r) => String -> c k (v r) -> IO (Bool)+dspVerdict lbl res =+  let fs = failures res+      n  = Partition.size res+      nf = Partition.size fs+  in do putStrLn lbl+        if (nf == 0) then putStrLn ("PASSED " ++ show n ++ " cases.")+                     else putStrLn ("FAILED: " ++ show nf ++ " failed cases.")+        return $ result res++dspSummary :: (Datum r, Show k, Show (v (DataType r)), LabelledPartition c k v, +               DetailedResult (c k) v r) => String -> c k (v r) -> IO ()+dspSummary lbl res = +  let fs = failures res+      n  = Partition.size res+      nf = Partition.size fs+  in do putStrLn lbl+        if (nf == 0) then putStrLn ("PASSED over " ++ show n ++ " cases.")+             else do putStrLn ("FAILED " ++ show nf ++ " Cases (of " ++ show n ++ "): " )+                     dspTestCases $ (cases fs)++dspDetails :: (Datum r, Show k, Show (v r), LabelledPartition c k v, +               DetailedResult (c k) v r) => String -> c k (v r) -> IO ()+dspDetails lbl res = +  let fs = failures res+      n  = Partition.size res+      nf = Partition.size fs+  in do putStrLn lbl+        if (nf == 0) then putStrLn ("PASSED " ++ show n ++ " cases:")+             else do putStrLn ("FAILED: " ++ show nf ++ " cases (of " ++ show n ++ "): " )+        dspTestCases res        ++dspTestCases :: (Show k, Show (v r), LabelledPartition c k v) => c k (v r) -> IO ()+dspTestCases res = +  let res' = Partition.toList res+  in sequence_ $ Prelude.map dspPart res'+       where+          dspPart (r, xs) = do putStrLn $ "Rank / Size " ++ (show r) ++ ": " +                               putStrLn $ show xs+                               putStrLn ""+\end{code}++When the elements of a LabelledPartition are test results,+e.g. instances of Verdict, then the LabelledPartition is also a verdict,+and the following apply:++\begin{description}+\item [result] determine if all of the tests in the container passed+\item [resultPartial] determine if a subset of the tests all passed+\end{description}++LabelledPartitions are also naturally monoids, which allows partitions of+partitions.++\begin{code}+result :: (LabelledPartition c k v, Verdict r) => c k (v r) -> Bool+result cxs = Partition.fold (\_ x y -> (verdict x) && y) True cxs++resultPartial :: (LabelledPartition c k v, SummaryVerdict v, Ord k, +    Verdict r) => c k (v r) -> k -> Bool+resultPartial cxs k = maybe True summaryverdict $ Partition.lookup k cxs+\end{code}++There is no requirement on the result class to expose the test case values.+The DetailedResult class extends the Result class by exposing the test values, +and allowing just the failing cases to be extracted.++\begin{code}+class (Verdict r, Datum r) => DetailedResult c v r where+  cases    :: c (v r) -> c (v (DataType r))+  failures :: c (v r) -> c (v r)++instance (LabelledPartition c k v, Verdict r, Datum r, Ord k, Functor v, +    Functor (c k)) => DetailedResult (c k) v r where+  cases    = fmap (\xs -> fmap Datum.datum xs)+  failures = Partition.filter (\_ x -> not (verdict x) )+\end{code}

+ Test/GenCheck/System/SimpleCheck.lhs view

@@ -0,0 +1,207 @@+SimpleCheck is a very simple test program written against the GenCheck+framework.  The test suite is pulled from a single generator, uses the |map|+function to schedule the tests, and reports either pass or fail with the+failing test cases.  Test cases and results are categorized by rank, stored in+a simple Map.++The functionality is similar to that of QuickCheck and SmallCheck, but the test+cases can generated using different strategies, including but not limited to+random and exhaustive generation.++\begin{code}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}++module Test.GenCheck.System.SimpleCheck +( Property+, simpleTest+, simpleReport+, simpleCheck+, stdTest+, stdTestArgs+, stdReport+, stdReportArgs+, stdCheck+, stdCheckArgs+, deepTest+, deepTestArgs+, deepReport+, deepReportArgs+, deepCheck+, deepCheckArgs+, baseTest+, baseTestArgs+, baseReport+, baseReportArgs+, baseCheck+, baseCheckArgs+) where++import System.Random (newStdGen)++import Test.GenCheck.Base.Base(Rank, Count, Property)+import Test.GenCheck.Base.Datum+import Test.GenCheck.Base.Verdict+import Test.GenCheck.Generator.Generator as +            Generator (Testable(..),StandardGens(..))+import Test.GenCheck.System.TestSuite (deepSuite, stdSuite, baseSuite, MapRankSuite)+import Test.GenCheck.System.Result as Result(dspSummary, dspDetails)++-- passing through instances of Testable and Enumerated+import Test.GenCheck.Generator.StructureGens()+import Test.GenCheck.Generator.BaseGens()+import Test.GenCheck.Generator.BaseEnum()++\end{code}++The following test programs use a heuristic strategy over the standard+generators (exhaustive, boundary, uniform and random) to create the test suites+for a property.++If the property input type is an instance of Testable, there is a default+implementation of the test that sets an arbitrary maximum rank for the test+cases and uses the standard generators from Testable.++\begin{description}+\item [stdTest]  exhausts small test cases, combines uniform and random+sampling for ``middle'' size cases, and finally tests a small number of random+values up to rank 30+\item [deepTest] tests a few structures of each rank up to rank 60+\item [baseTest] tests base (non-structure) types where all values are of rank 1+\end{description}++stdTestArgs and deepTestArgs expose the maximum rank parameter and take the+standard generators as arguments so alternative generators can be provided (the+heuristic still assumes they are exhaustive, boundary, etc.).  They also+include a label for the test reporting.++The stdReport, deepReport, etc. test schedulers are the same, but they print+out all of the test cases, highlighting the failure cases.++\begin{code}+stdTest       ::  (Testable a, Integral k)  => Property a -> k -> IO ()+stdTest p n = stdTestArgs stdTestGens "" 30 p (toInteger n)++stdTestArgs   :: Show a => StandardGens a -> String -> Rank -> Property a -> Count -> IO ()+stdTestArgs  gs lbl r p n = +  do s <- System.Random.newStdGen+     simpleTest lbl p (stdSuite gs s r n)++stdReport       ::  (Testable a, Integral k)  => Property a -> k -> IO ()+stdReport p n = stdReportArgs stdTestGens "" 30 p (toInteger n)++stdReportArgs   :: Show a => StandardGens a -> String -> Rank -> Property a -> Count -> IO ()+stdReportArgs  gs lbl r p n = +  do s <- System.Random.newStdGen+     simpleReport lbl p (stdSuite gs s r n)++stdCheck       ::  (Testable a, Integral k)  => Property a -> k -> IO ()+stdCheck p n = stdCheckArgs stdTestGens "" 30 p (toInteger n)++stdCheckArgs   :: Show a => StandardGens a -> String -> Rank -> Property a -> Count -> IO ()+stdCheckArgs  gs lbl r p n = +  do s <- System.Random.newStdGen+     simpleCheck lbl p (stdSuite gs s r n)++deepTest      :: (Testable a, Integral k)  => Property a -> k -> IO ()+deepTest p n = deepTestArgs stdTestGens "" 60 p (toInteger n)++deepTestArgs  :: Show a => StandardGens a -> String-> Rank -> Property a -> Count -> IO ()+deepTestArgs  gs lbl r p n = +  do s <- newStdGen+     simpleTest lbl p (deepSuite gs s r n)++deepReport      :: (Testable a, Integral k)  => Property a -> k -> IO ()+deepReport p n = deepReportArgs stdTestGens "" 60 p (toInteger n)++deepReportArgs  :: Show a => StandardGens a -> String-> Rank -> Property a -> Count -> IO ()+deepReportArgs  gs lbl r p n = +  do s <- newStdGen+     simpleReport lbl p (deepSuite gs s r n)++deepCheck      :: (Testable a, Integral k)  => Property a -> k -> IO ()+deepCheck p n = deepCheckArgs stdTestGens "" 60 p (toInteger n)++deepCheckArgs  :: Show a => StandardGens a -> String-> Rank -> Property a -> Count -> IO ()+deepCheckArgs  gs lbl r p n = +  do s <- newStdGen+     simpleCheck lbl p (deepSuite gs s r n)++baseTest      :: (Testable a, Integral k) => Property a -> k -> IO ()+baseTest p n = baseTestArgs stdTestGens "" p (toInteger n)++baseTestArgs  :: Show a => StandardGens a -> String -> Property a -> Count -> IO ()+baseTestArgs gs lbl p n = simpleTest lbl p (baseSuite gs n)++baseReport      :: (Testable a, Integral k) => Property a -> k -> IO ()+baseReport p n = baseReportArgs stdTestGens "" p (toInteger n)++baseReportArgs  :: Show a => StandardGens a -> String -> Property a -> Count -> IO ()+baseReportArgs gs lbl p n = simpleReport lbl p (baseSuite gs n)++baseCheck      :: (Testable a, Integral k) => Property a -> k -> IO ()+baseCheck p n = baseCheckArgs stdTestGens "" p (toInteger n)++baseCheckArgs  :: Show a => StandardGens a -> String -> Property a -> Count -> IO ()+baseCheckArgs gs lbl p n = simpleCheck lbl p (baseSuite gs n)+\end{code}++simpleTest takes the test suite as input and evaluates the property at +all of the test values, with just the failures reported.+simpleResult is the same but all of the test cases are reported.++SimpleTestRun just maps the property evaluation across a ranked |Map| of input+values to produce a ranked map of |SimpleTestPt| results.++\begin{code}+simpleTest, simpleReport ::  Show a =>+           String -> Property a -> MapRankSuite a -> IO ()+simpleTest   lbl p ts = dspSummary lbl $ simpleTestRun p ts+simpleReport lbl p ts = dspDetails lbl $ simpleTestRun p ts++simpleTestRun :: Show a => Property a -> MapRankSuite a -> SimpleResults a+simpleTestRun p = fmap (Prelude.map (simpleTestCase p))++\end{code}++SimpleCheck runs a monadic test that terminates when finding the first failure.+SimpleCheckArgs allows the maximum rank and number of failure cases before termination to be set.++\gordon{not yet defined, needs to be a monadic execution with an error response}++\begin{code}+simpleCheck ::  Show a => String -> Property a -> MapRankSuite a -> IO ()+simpleCheck lbl p ts = simpleCheckArgs lbl p ts 1++simpleCheckArgs ::  Show a => String -> Property a -> MapRankSuite a -> Int -> IO ()+simpleCheckArgs lbl p ts k = +  do putStrLn "SimpleCheck not yet enabled, running all cases using simpleTest"+     dspSummary lbl $ simpleCheckRun p ts k++simpleCheckRun :: Show a => Property a -> MapRankSuite a -> Int -> SimpleResults a+simpleCheckRun p ste _ = simpleTestRun p ste+\end{code}++Simple test results are stored in a |SimpleTestPt| structure,+and include only the test case and boolean property value.+|SimpleTestPt| is an instance of both Verdict and Datum,+which allow access to the test result and input value respectively.++\begin{code}+type SimpleResults a = MapRankSuite (SimpleTestPt a)+ +simpleTestCase :: Property a -> a -> SimpleTestPt a+simpleTestCase p x = Pt (p x) x++data SimpleTestPt a = Pt Bool a+instance Show a => Show (SimpleTestPt a) where+  show (Pt True x) = show x+  show (Pt False x) = "FAILED: " ++ (show x)++instance  Datum (SimpleTestPt a) where+  type DataType (SimpleTestPt a) = a+  datum (Pt _ x) = x  +instance Verdict (SimpleTestPt a) where+  verdict (Pt b _) = b+\end{code}

+ Test/GenCheck/System/TestSuite.lhs view

@@ -0,0 +1,106 @@+A test suite is a collection of test cases and / or results,+organized in a container with labelled partitions (such as a Map).+This module contains functions to build test suites for the SimpleCheck module,+and relies on the standard generators made available through the Testable class.+The test suite type used is a standard Map indexed by rank, called MapRankSuite.++\begin{code}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}++module Test.GenCheck.System.TestSuite +  ( GenInstruct+  , TestSuite+  , MapRankSuite+  , genSuite+  , testSuite+  , baseSuite+  , stdSuite+  , deepSuite+  , suiteMerge+  ) where++import Prelude hiding (map)+import qualified Prelude(map)+import Data.Map (Map)+import Data.Monoid(Monoid)+import System.Random(StdGen)++import Test.GenCheck.Base.Base (Rank, Count)+import Test.GenCheck.Generator.Generator (Generator, genTake, StandardGens(..))+import Test.GenCheck.Base.LabelledPartition as Partition (LabelledPartition(..))++\end{code}++The containers for the test cases must be instances of the LabelledPartition class.  +This class provides labelled partitions for the test cases (e.g. Data.Map), +but also supports merging of the containers.  Multiple component test suites+can be merged into a single test suite using suiteMerge.++\begin{code}+type TestSuite c k v a = c k (v a) -- (LabelledPartition c k v, Monoid (v a), Ord k)++suiteMerge :: (LabelledPartition c k v, Monoid (v a), Ord k) => +                  [TestSuite c k v a] -> TestSuite c k v a+suiteMerge = foldl1 Partition.merge++\end{code}++testSuite, genSuite and genPart build test suites from+generator(s) given a list of ranks and the number of values desired at that rank.+(called GenInstruct).  This provides a simple API for building test suites.++\begin{code}+type MapRankSuite a = TestSuite Map Rank [] a   -- = Map Rank [a]++type GenInstruct = [(Rank, Count)]++testSuite :: [Generator a] -> [GenInstruct] -> MapRankSuite a+testSuite gs rcs = suiteMerge $ zipWith genSuite gs rcs++genSuite :: Generator a -> GenInstruct -> MapRankSuite a+genSuite g rcs = suiteMerge $ Prelude.map (genPart g) rcs++genPart :: Generator a -> (Rank, Count) -> MapRankSuite a+genPart g (r,n) = Partition.new r $ genTake g r n+\end{code}++baseSuite is used for base type generators; all values are of rank 1.++\begin{code}+baseSuite :: StandardGens a -> Count -> MapRankSuite a+baseSuite (UnrankedGen g) n = +  let gis =  [(1, n)]+  in  testSuite [g] (repeat gis)+baseSuite _ _ = error "baseSuite applied to a Ranked Generator"+\end{code}++stdSuite uses all of the standard generators to create a good heuristic+default approach for testing across multiple ranks.++\gordon{for now, this is the same as the deepSuite, just until I get to it???}++\begin{code}+stdSuite :: StandardGens a -> StdGen -> Rank -> Count -> MapRankSuite a+stdSuite (StdGens g1 g2 g3 g4) s rmax n = +  let nr = ((n `div` (toInteger rmax) + 1) `div` 4) + 1+      gis =  [(r, nr) | r <- [1..rmax]]+      uni = fromInteger $ max (nr `div` 4 + 1) 3+  in  testSuite [g1, g2, g3 uni, g4 s] (repeat gis)+stdSuite (UnrankedGen _) _ _ _ = error "stdSuite applied to an Unranked Generator"+\end{code}++deepSuite performs a small number of tests over each rank up to a maximum size,+by dividing the number of tests evenly over the total number of ranks,+using the same rank and count instructions for each generator.++\begin{code}+deepSuite :: StandardGens a -> StdGen -> Rank -> Count -> MapRankSuite a+deepSuite (StdGens g1 g2 g3 g4) s rmax n = +  let nr = ((n `div` (toInteger rmax) + 1) `div` 4) + 1+      gis =  [(r, nr) | r <- [1..rmax]]+      uni = fromInteger $ max (nr `div` 4 + 1) 3+  in  testSuite [g1, g2, g3 uni, g4 s] (repeat gis)+deepSuite (UnrankedGen _) _ _ _ = error "deepSuite applied to an Unranked Generator"+\end{code}+

+ gencheck.cabal view

@@ -0,0 +1,62 @@+name:           gencheck+version:        0.1+cabal-version:  >= 1.6+license:        BSD3+license-file:   License.txt+stability:      experimental+author:         Gordon J. Uszkay, Jacques Carette+maintainer:     carette@mcmaster.ca, uszkaygj@mcmaster.ca+homepage:       http://github.com/JacquesCarette/GenCheck+package-url:    http://gitbug.com/JacquesCarette/GenCheck+category:       Testing+synopsis:       A testing framework inspired by QuickCheck and SmallCheck+build-type:     Simple++description:+        This framework provides functionality for testing Haskell functions+	against properties, similar to QuickCheck, but allowing +        different test data generation strategies for different structures,+	and even within the same structure using composition strategies.+	Reporting, test case scheduling and data generation modules can be+	assembled to customize the test program based on the situation.+        .+	Test data generation is based on combinatorial theory +	and uses explicit enumeration of regular polynomial types, +	combined with selection strategies to build data generators.+	Generators can be composed or combined in parallel to create+	composite strategies for data sampling.++library+  build-depends:        combinat >= 0.2,+                        base >=3 && <5,+                        random > 1.0.0.0,+                        containers >= 0.4.0.0,+                        transformers >= 0.2,+                        memoize >= 0.3,+                        template-haskell >=2,+                        ieee754 >= 0.7++  ghc-options:          -Wall -fno-warn-orphans++  exposed-modules:+    Test.GenCheck+    Test.GenCheck.System.SimpleCheck+    Test.GenCheck.System.Result+    Test.GenCheck.Generator.Generator+    Test.GenCheck.Generator.Substitution+    Test.GenCheck.Generator.StructureGens+    Test.GenCheck.Generator.BaseGens+    Test.GenCheck.Generator.EnumStrat+    Test.GenCheck.Generator.BaseEnum+    Test.GenCheck.Generator.Enumeration+    Test.GenCheck.Base.Base+    Test.GenCheck.Base.Datum+    Test.GenCheck.Base.Verdict+    Test.GenCheck.Base.LabelledPartition+    Test.GenCheck.System.TestSuite++  other-modules:++source-repository head+  type:     git+  location: http://github.com/JacquesCarette/GenCheck.git