leancheck (empty) → 0.3.0

raw patch · 29 files changed

+3195/−0 lines, 29 filesdep +basedep +template-haskellsetup-changed

Dependencies added: base, template-haskell

Files

• CREDITS.md +10/−0
• LICENSE +30/−0
• README.md +150/−0
• Setup.hs +2/−0
• Test/Check.hs +112/−0
• Test/Check/Basic.hs +123/−0
• Test/Check/Core.hs +384/−0
• Test/Check/Derive.hs +153/−0
• Test/Check/Error.hs +118/−0
• Test/Check/Function.hs +2/−0
• Test/Check/Function/CoListable.hs +65/−0
• Test/Check/Function/ListsOfPairs.hs +62/−0
• Test/Check/Function/Periodic.hs +47/−0
• Test/Check/Function/Show.hs +10/−0
• Test/Check/IO.hs +80/−0
• Test/Check/Invariants.hs +130/−0
• Test/Check/ShowFunction.hs +173/−0
• Test/Check/Utils.hs +232/−0
• Test/Most.hs +21/−0
• Test/Operators.hs +113/−0
• Test/TypeBinding.hs +229/−0
• Test/Types.hs +438/−0
• leancheck.cabal +121/−0
• tests/test-error.hs +60/−0
• tests/test-most.hs +34/−0
• tests/test-operators.hs +72/−0
• tests/test-types.hs +72/−0
• tests/test-utils.hs +68/−0
• tests/test.hs +84/−0

@@ -0,0 +1,10 @@+Credits+=======++Rudy Matela:+  original implementation of LeanCheck previously known as "llcheck".++Colin Runciman:+  pointing out "why not a list of lists?";+  improvements in library interface and code;+  the name "LeanCheck".

@@ -0,0 +1,30 @@+Copyright (c) 2015-2016, Rudy Matela++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 Rudy Matela nor the names of other+      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+OWNER 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.

@@ -0,0 +1,150 @@+LeanCheck+=========++**The API is likely to change in the near future**++LeanCheck is a simple enumerative property-based testing library.  It works by+producing *tiers* of test values, which are essentially (possibly infinite)+lists of finite lists of same-and-increasingly-sized values.  It is similar to+[Feat] in that regard.++In this README, lines ending with `-- >` indicate expected return values.+++Checking if properties are True+-------------------------------++To check if properties are True,+just use the function `holds :: Testable a => Int -> a -> Bool`.+It takes _two arguments_:+the _number of values_ to test+and a _property_ (function returning Bool),+then, it returns a boolean indicating whether the property holds.+See (ghci):++	import Test.Check+	import Data.List+	holds 100 $ \xs -> sort (sort xs) == sort (xs::[Int])  -- > True+	holds 100 $ \xs -> [] `union` xs == (xs::[Int])        -- > False+++Finding counter examples+------------------------++To find counter examples to properties,+you can use the function `counterExample :: Testable a => Int -> a -> Maybe [String]`.+It takes _two arguments_:+the _number of values_ to test+and a _property_ (function returning Bool).+Then, it returns Nothing if no results are found or Just a list of Strings+representing the offending arguments to the property.+See (ghci):++	import Test.Check+	import Data.List++	counterExample 100 $ \xs -> sort (sort xs) == sort (xs::[Int])+	-- > Nothing++	counterExample 100 $ \xs -> [] `union` xs == (xs::[Int])+	-- > Just ["[0,0]"]++	counterExample 100 $ \xs ys -> xs `union` ys == ys `union` (xs::[Int])+	-- > Just ["[]","[0,0]"]+++Checking properties like in SmallCheck/QuickCheck+-------------------------------------------------++To "check" properties like in [SmallCheck] and [QuickCheck]+automatically printing results on standard output,+you can use the function `check :: Testable a => a -> IO ()`.++	import Test.Check+	import Data.List++	check $ \xs -> sort (sort xs) == sort (xs::[Int])+	-- > OK, passed 200 tests.++	check $ \xs ys -> xs `union` ys == ys `union` (xs::[Int])+	-- > Failed! Falsifiable (after 4 tests):+	-- > [] [0,0]++The function `check` tests for a maximum of 200 tests.+To check for a maximum of `n` tests, use `checkFor n`.+To get a boolean result wrapped in `IO`, use `checkResult` or `checkResultFor`.+There is no "quiet" option, just use `holds` or `counterExample` in that case.+++Testing for custom types+------------------------++LeanCheck works on properties with `Listable` argument types.+Custom `Listable` instances are created similarly to SmallCheck:++	data MyType = MyConsA+	            | MyConsB Int+	            | MyConsC Int Char+	            | MyConsD String++	instance Listable MyType where+	  tiers = cons0 MyConsA+	       \/ cons1 MyConsB+	       \/ cons2 MyConsC+	       \/ cons1 MyConsD++The tiers function return a potentially infinite list of finite sub-lists (tiers).+Each tier has values of increasing size.++	tiers :: Listable a => [[a]]++For convenience, there is also the function `list`,+which returns an infinite list of values of the bound type:++	list :: Listable a => [a]++So, for example:++	take 5 (list :: [(Int,Int)]) -- > [(0,0),(0,1),(1,0),(0,-1),(1,1)]++The `list` function can be used to debug your custom instances.+++More information / extra functions+----------------------------------++`Listable` class instances are more customizable than what is described here:+check source comments or haddock documentation for details.+++Building / Installing+---------------------++To build:++	$ cabal build++To install:++	$ cabal install++To reference in a cabal sandbox:++	$ cabal sandbox add-source ../path/to/leancheck++To use the files directly in your project:++	$ cp -r Test ../path/to/your-project+++LeanCheck was tested on GHC 7.10, GHC 7.8, GHC 7.6 and GHC 7.4.+This library does not use any fancy extensions:+if it does not work on previous GHC versions,+probably only *minor* changes are needed.+It optionally depends on Template Haskell+(for automatic derivation of Listable instances).+++[Feat]: https://hackage.haskell.org/package/testing-feat+[SmallCheck]: https://hackage.haskell.org/package/smallcheck+[QuickCheck]: https://hackage.haskell.org/package/QuickCheck

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,112 @@+-- | A simple property-based testing library based on+--   enumeration of values via lists of lists.+--+-- In the context of this library,+-- a __property__ is a function returning a 'Bool'+-- that should return 'True' for all input values.+--+-- To check if a property holds by testing a thousand values, you simply do:+--+-- > holds 1000 property  -- yield True when Ok, False otherwise+--+-- For example:+--+-- > holds $ \xs -> length (sort xs) == length (xs::[Int])+--+-- Arguments of properties should be instances of the 'Listable' typeclass.+-- 'Listable' instances are provided for the most common Haskell types.+-- New instances are easily defined+-- (see the 'Listable's documentation for more info).+module Test.Check+  (+  -- * Checking and testing+    holds+  , fails+  , exists++  -- ** Boolean (property) operators+  , (==>)++  -- ** Counterexamples and witnesses+  , counterExample+  , counterExamples+  , witness+  , witnesses++  -- * Listing test values+  , Listable(..)++  -- ** Listing constructors+  , cons0+  , cons1+  , cons2+  , cons3+  , cons4+  , cons5+  , cons6+  , cons7+  , cons8+  , cons9+  , cons10+  , cons11+  , cons12++  , ofWeight+  , addWeight+  , suchThat++  -- ** Combining tiers+  , (\/)+  , (\\//)+  , (><)+  , productWith++  -- ** Manipulating tiers+  , mapT+  , filterT+  , concatT+  , concatMapT+  , deleteT+  , normalizeT+  , toTiers++  -- ** Automatically deriving Listable instances+  , deriveListable++  -- ** Extra constructors+  , consFromList+  , consFromAscendingList+  , consFromStrictlyAscendingList+  , consFromSet+  , consFromNoDupList++  -- ** Products of tiers+  , product3With+  , productMaybeWith++  -- * Listing lists+  , listsOf+  , setsOf+  , ascendingListsOf+  , strictlyAscendingListsOf+  , noDupListsOf+  , products+  , listsOfLength++  -- ** Listing values+  , tiersFractional+  , listIntegral+  , (+|)++  -- * Test results+  , Testable+  , results++  , module Test.Check.IO+  )+where++import Test.Check.Basic+import Test.Check.Utils+import Test.Check.Derive+import Test.Check.IO

@@ -0,0 +1,123 @@+-- | Simple property-based testing library based on+--   enumeration of values via lists of lists.+--+-- This module exports "Test.Check.Core" functionality along with instances and+-- functions for further tuple and constructor arities.+--+-- For the complete list of functions, see "Test.Check".+module Test.Check.Basic+  ( module Test.Check.Core++  , cons6+  , cons7+  , cons8+  , cons9+  , cons10+  , cons11+  , cons12+  )+where++import Test.Check.Core++instance (Listable a, Listable b, Listable c,+          Listable d, Listable e, Listable f) =>+         Listable (a,b,c,d,e,f) where+  tiers = productWith (\x (y,z,w,v,u) -> (x,y,z,w,v,u)) tiers tiers++instance (Listable a, Listable b, Listable c, Listable d,+          Listable e, Listable f, Listable g) =>+         Listable (a,b,c,d,e,f,g) where+  tiers = productWith (\x (y,z,w,v,u,r) -> (x,y,z,w,v,u,r)) tiers tiers++instance (Listable a, Listable b, Listable c, Listable d,+          Listable e, Listable f, Listable g, Listable h) =>+         Listable (a,b,c,d,e,f,g,h) where+  tiers = productWith (\x (y,z,w,v,u,r,s) -> (x,y,z,w,v,u,r,s))+                      tiers tiers++instance (Listable a, Listable b, Listable c, Listable d, Listable e,+          Listable f, Listable g, Listable h, Listable i) =>+         Listable (a,b,c,d,e,f,g,h,i) where+  tiers = productWith (\x (y,z,w,v,u,r,s,t) -> (x,y,z,w,v,u,r,s,t))+                      tiers tiers++instance (Listable a, Listable b, Listable c, Listable d, Listable e,+          Listable f, Listable g, Listable h, Listable i, Listable j) =>+         Listable (a,b,c,d,e,f,g,h,i,j) where+  tiers = productWith (\x (y,z,w,v,u,r,s,t,o) -> (x,y,z,w,v,u,r,s,t,o))+                      tiers tiers++instance (Listable a, Listable b, Listable c, Listable d,+          Listable e, Listable f, Listable g, Listable h,+          Listable i, Listable j, Listable k) =>+         Listable (a,b,c,d,e,f,g,h,i,j,k) where+  tiers = productWith (\x (y,z,w,v,u,r,s,t,o,p) -> (x,y,z,w,v,u,r,s,t,o,p))+                      tiers tiers++instance (Listable a, Listable b, Listable c, Listable d,+          Listable e, Listable f, Listable g, Listable h,+          Listable i, Listable j, Listable k, Listable l) =>+         Listable (a,b,c,d,e,f,g,h,i,j,k,l) where+  tiers = productWith (\x (y,z,w,v,u,r,s,t,o,p,q) ->+                        (x,y,z,w,v,u,r,s,t,o,p,q))+                      tiers tiers++cons6 :: (Listable a, Listable b, Listable c, Listable d, Listable e, Listable f)+      => (a -> b -> c -> d -> e -> f -> g) -> [[g]]+cons6 f = mapT (uncurry6 f) tiers `addWeight` 1++cons7 :: (Listable a, Listable b, Listable c, Listable d,+          Listable e, Listable f, Listable g)+      => (a -> b -> c -> d -> e -> f -> g -> h) -> [[h]]+cons7 f = mapT (uncurry7 f) tiers `addWeight` 1++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]]+cons8 f = mapT (uncurry8 f) tiers `addWeight` 1++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]]+cons9 f = mapT (uncurry9 f) tiers `addWeight` 1++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]]+cons10 f = mapT (uncurry10 f) tiers `addWeight` 1++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]]+cons11 f = mapT (uncurry11 f) tiers `addWeight` 1++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]]+cons12 f = mapT (uncurry12 f) tiers `addWeight` 1++uncurry6 :: (a->b->c->d->e->f->g) -> (a,b,c,d,e,f) -> g+uncurry6 f (x,y,z,w,v,u) = f x y z w v u++uncurry7 :: (a->b->c->d->e->f->g->h) -> (a,b,c,d,e,f,g) -> h+uncurry7 f (x,y,z,w,v,u,r) = f x y z w v u r++uncurry8 :: (a->b->c->d->e->f->g->h->i) -> (a,b,c,d,e,f,g,h) -> i+uncurry8 f (x,y,z,w,v,u,r,s) = f x y z w v u r s++uncurry9 :: (a->b->c->d->e->f->g->h->i->j) -> (a,b,c,d,e,f,g,h,i) -> j+uncurry9 f (x,y,z,w,v,u,r,s,t) = f x y z w v u r s t++uncurry10 :: (a->b->c->d->e->f->g->h->i->j->k) -> (a,b,c,d,e,f,g,h,i,j) -> k+uncurry10 f (x,y,z,w,v,u,r,s,t,o) = f x y z w v u r s t o++uncurry11 :: (a->b->c->d->e->f->g->h->i->j->k->l)+          -> (a,b,c,d,e,f,g,h,i,j,k) -> l+uncurry11 f (x,y,z,w,v,u,r,s,t,o,p) = f x y z w v u r s t o p++uncurry12 :: (a->b->c->d->e->f->g->h->i->j->k->l->m)+          -> (a,b,c,d,e,f,g,h,i,j,k,l) -> m+uncurry12 f (x,y,z,w,v,u,r,s,t,o,p,q) = f x y z w v u r s t o p q

@@ -0,0 +1,384 @@+-- | Simple property-based testing library based on+--   enumeration of values via lists of lists.+--+-- This is the core module of the library, with the most basic definitions.  If+-- you are looking just to use the library, import and see "Test.Check".+--+-- If you want to understand how the code works, this is the place to start.+--+--+-- Other important modules:+--+-- "Test.Check.Basic" re-exports (almost) everything from this module+--         along with constructors and instances for further arities.+--+-- "Test.Check.Utils" re-exports "Test.Check.Basic"+--         along with functions for advanced Listable instance definitions.+--+-- "Test.Check" re-exports "Test.Check.Utils"+--   along with a TH function to automatically derive Listable instances.+module Test.Check.Core+  (+  -- * Checking and testing+    holds+  , fails+  , exists+  , counterExample+  , counterExamples+  , witness+  , witnesses+  , Testable++  , results++  -- * Listing test values+  , Listable(..)++  -- ** Constructing lists of tiers+  , cons0+  , cons1+  , cons2+  , cons3+  , cons4+  , cons5++  , ofWeight+  , addWeight+  , suchThat++  -- ** Combining lists of tiers+  , (\/), (\\//)+  , (><)+  , productWith++  -- ** Manipulating lists of tiers+  , mapT+  , filterT+  , concatT+  , concatMapT+  , toTiers++  -- ** Boolean (property) operators+  , (==>)++  -- ** Misc utilities+  , (+|)+  , listIntegral+  , tiersFractional+  )+where++import Data.Maybe (listToMaybe)+++-- | A type is 'Listable' when there exists a function that+--   is able to list (ideally all of) its values.+--+-- Ideally, this type should be defined by a 'tiers' function that+-- returns a (possibly 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 = consN ConstructorA+-- >      \/ consN ConstructorB+-- >      \/ consN ConstructorC+-- >      \/ ...+--+-- When defined by 'list', each sub-list in 'tiers' is a singleton list+-- (each element of 'list' has +1 size).+--+-- The function 'Test.Check.Derive.deriveListable' from "Test.Check.Derive"+-- can automatically derive instances of this typeclass.+--+-- A 'Listable' instance for functions is also available but is not exported by+-- default.  Import "Test.Check.Function" for that.+-- ("Test.Check.Function.Show" for a Show instance for functions)+class Listable a where+  tiers :: [[a]]+  list :: [a]+  tiers = toTiers list+  list = concat tiers+  {-# MINIMAL list | tiers #-}++-- | Takes a list of values @xs@ and transform it into tiers on which each+--   tier is occupied by a single element from @xs@.+--+-- To convert back to a list, just 'concat'.+toTiers :: [a] -> [[a]]+toTiers = map (:[])++instance Listable () where+  list = [()]++listIntegral :: (Enum a, Num a) => [a]+listIntegral = [0,-1..] +| [1..]++instance Listable Int where+  list = listIntegral++instance Listable Integer where+  list = listIntegral++instance Listable Char where+  list = ['a'..'z']+      +| [' ','\n']+      +| ['A'..'Z']+      +| ['0'..'9']+      +| ['!'..'/']+      +| ['\t']+      +| [':'..'@']+      +| ['['..'`']+      +| ['{'..'~']++instance Listable Bool where+  tiers = cons0 False \/ cons0 True++instance Listable a => Listable (Maybe a) where+  tiers = cons0 Nothing \/ cons1 Just++instance (Listable a, Listable b) => Listable (Either a b) where+  tiers = cons1 Left  `ofWeight` 0+     \\// cons1 Right `ofWeight` 0++instance (Listable a, Listable b) => Listable (a,b) where+  tiers = tiers >< tiers++instance (Listable a, Listable b, Listable c) => Listable (a,b,c) where+  tiers = productWith (\x (y,z) -> (x,y,z)) tiers tiers++instance (Listable a, Listable b, Listable c, Listable d) =>+         Listable (a,b,c,d) where+  tiers = productWith (\x (y,z,w) -> (x,y,z,w)) tiers tiers++instance (Listable a, Listable b, Listable c, Listable d, Listable e) =>+         Listable (a,b,c,d,e) where+  tiers = productWith (\x (y,z,w,v) -> (x,y,z,w,v)) tiers tiers++instance (Listable a) => Listable [a] where+  tiers = cons0 []+       \/ cons2 (:)++-- | Tiers of 'Fractional' values.+--   This can be used as the implementation of 'tiers' for 'Fractional' types.+tiersFractional :: Fractional a => [[a]]+tiersFractional = productWith (+) tiersFractionalParts+                                  (mapT fromIntegral (tiers::[[Integer]]))+               \/ [ [], [], [1/0], [-1/0] {- , [-0], [0/0] -} ]+  where tiersFractionalParts :: Fractional a => [[a]]+        tiersFractionalParts = [0]+                             : [ [fromIntegral a / fromIntegral b]+                               | b <- iterate (*2) 2, a <- [1::Integer,3..b] ]+-- The position of Infinity in the above enumeration is arbitrary.++-- Note that this instance ignores NaN's.+instance Listable Float where+  tiers = tiersFractional++instance Listable Double where+  tiers = tiersFractional+++-- | 'map' over tiers+mapT :: (a -> b) -> [[a]] -> [[b]]+mapT = map . map++-- | 'filter' tiers+filterT :: (a -> Bool) -> [[a]] -> [[a]]+filterT f = map (filter f)++-- | 'concat' tiers of tiers+concatT :: [[ [[a]] ]] -> [[a]]+concatT = foldr (\+:/) [] . map (foldr (\/) [])+  where xss \+:/ yss = xss \/ ([]:yss)++-- | 'concatMap' over tiers+concatMapT :: (a -> [[b]]) -> [[a]] -> [[b]]+concatMapT f = concatT . mapT f+++-- | Takes a constructor with no arguments and return tiers (with a single value).+--   This value, by default, has size/weight 0.+cons0 :: a -> [[a]]+cons0 x = [[x]]++-- | Takes a constructor with one argument and return tiers of that value.+--   This value, by default, has size/weight 1.+cons1 :: Listable a => (a -> b) -> [[b]]+cons1 f = mapT f tiers `addWeight` 1++-- | Takes a constructor with two arguments and return tiers of that value.+--   This value, by default, has size/weight 1.+cons2 :: (Listable a, Listable b) => (a -> b -> c) -> [[c]]+cons2 f = mapT (uncurry f) tiers `addWeight` 1++cons3 :: (Listable a, Listable b, Listable c) => (a -> b -> c -> d) -> [[d]]+cons3 f = mapT (uncurry3 f) tiers `addWeight` 1++cons4 :: (Listable a, Listable b, Listable c, Listable d)+      => (a -> b -> c -> d -> e) -> [[e]]+cons4 f = mapT (uncurry4 f) tiers `addWeight` 1++cons5 :: (Listable a, Listable b, Listable c, Listable d, Listable e)+      => (a -> b -> c -> d -> e -> f) -> [[f]]+cons5 f = mapT (uncurry5 f) tiers `addWeight` 1++-- | Resets the weight of a constructor (or tiers)+-- Typically used as an infix constructor when defining Listable instances:+--+-- > cons<N> `ofWeight` W+--+-- Be careful: 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 :: [[a]] -> Int -> [[a]]+ofWeight xss w = dropWhile null xss `addWeight` w++-- | Adds to the weight of tiers of a constructor+addWeight :: [[a]] -> Int -> [[a]]+addWeight xss w = replicate w [] ++ xss++-- | Tiers of values that follow a property+--+-- > cons<N> `suchThat` condition+suchThat :: [[a]] -> (a->Bool) -> [[a]]+suchThat = flip filterT++-- | 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]+(+|) :: [a] -> [a] -> [a]+[]     +| ys = ys+(x:xs) +| ys = x:(ys +| xs)+infixr 5 +|++-- | Append tiers.+--+-- > [xs,ys,zs,...] \/ [as,bs,cs,...] = [xs++as,ys++bs,zs++cs,...]+(\/) :: [[a]] -> [[a]] -> [[a]]+xss \/ []  = xss+[]  \/ yss = yss+(xs:xss) \/ (ys:yss) = (xs ++ ys) : xss \/ yss+infixr 7 \/++-- | Interleave tiers.  When in doubt, use @\/@ instead.+--+-- > [xs,ys,zs,...] \/ [as,bs,cs,...] = [xs+|as,ys+|bs,zs+|cs,...]+(\\//) :: [[a]] -> [[a]] -> [[a]]+xss \\// []  = xss+[]  \\// yss = yss+(xs:xss) \\// (ys:yss) = (xs +| ys) : xss \\// yss+infixr 7 \\//++-- | 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]] -> [[b]] -> [[(a,b)]]+(><) = productWith (,)+infixr 8 ><++-- | Take the product of two lists of tiers.+--+-- > productWith f xss yss = map (uncurry f) $ xss >< yss+productWith :: (a->b->c) -> [[a]] -> [[b]] -> [[c]]+productWith _ _ [] = []+productWith _ [] _ = []+productWith f (xs:xss) yss = map (xs **) yss+                          \/ productWith f xss yss `addWeight` 1+  where xs ** ys = [x `f` y | x <- xs, y <- ys]++-- | 'Testable' values are functions+--   of 'Listable' arguments that return boolean values,+--   e.g.:+--+-- * @ Bool @+-- * @ Int -> Bool @+-- * @ Listable a => a -> a -> Bool @+class Testable a where+  resultiers :: a -> [[([String],Bool)]]++instance Testable Bool where+  resultiers p = [[([],p)]]++instance (Testable b, Show a, Listable a) => Testable (a->b) where+  resultiers p = concatMapT resultiersFor tiers+    where resultiersFor x = mapFst (showsPrec 11 x "":) `mapT` resultiers (p x)+          mapFst f (x,y) = (f x, y)++-- | List all results of a 'Testable' property.+-- Each results is composed by a list of strings and a boolean.+-- The list of strings represents the arguments applied to the function.+-- The boolean tells whether the property holds for that selection of argument.+-- This list is usually infinite.+results :: Testable a => a -> [([String],Bool)]+results = concat . resultiers++-- | Lists all counter-examples for a number of tests to a property,+counterExamples :: Testable a => Int -> a -> [[String]]+counterExamples n = map fst . filter (not . snd) . take n . results++-- | For a number of tests to a property,+--   returns Just the first counter-example or Nothing.+counterExample :: Testable a => Int -> a -> Maybe [String]+counterExample n = listToMaybe . counterExamples n++-- | Lists all witnesses for a number of tests to a property,+witnesses :: Testable a => Int -> a -> [[String]]+witnesses n = map fst . filter snd . take n . results++-- | For a number of tests to a property,+--   returns Just the first witness or Nothing.+witness :: Testable a => Int -> a -> Maybe [String]+witness n = listToMaybe . witnesses n++-- | Does a property __hold__ for a number of test values?+--+-- > holds 1000 $ \xs -> length (sort xs) == length xs+holds :: Testable a => Int -> a -> Bool+holds n = and . take n . map snd . results++-- | Does a property __fail__ for a number of test values?+--+-- > fails 1000 $ \xs -> xs ++ ys == ys ++ xs+fails :: Testable a => Int -> a -> Bool+fails n = not . holds n++-- | There __exists__ and assignment of values that satisfy a property?+exists :: Testable a => Int -> a -> Bool+exists n = or . take n . map snd . results++uncurry3 :: (a->b->c->d) -> (a,b,c) -> d+uncurry3 f (x,y,z) = f x y z++uncurry4 :: (a->b->c->d->e) -> (a,b,c,d) -> e+uncurry4 f (x,y,z,w) = f x y z w++uncurry5 :: (a->b->c->d->e->f) -> (a,b,c,d,e) -> f+uncurry5 f (x,y,z,w,v) = f x y z w v++-- | Boolean implication.  Use this for defining conditional properties:+--+-- > prop_something x y = condition x y ==> something x y+(==>) :: Bool -> Bool -> Bool+False ==> _ = True+True  ==> p = p+infixr 0 ==>

@@ -0,0 +1,153 @@+{-# LANGUAGE TemplateHaskell, CPP #-}+-- Experimental module for deriving Listable instances+--+-- Needs GHC and Template Haskell (tested on GHC 7.4, 7.6, 7.8 and 7.10)+module Test.Check.Derive+  ( deriveListable+  )+where++import Language.Haskell.TH+import Test.Check.Basic+import Control.Monad (unless, liftM, liftM2)++#if __GLASGOW_HASKELL__ < 706+-- reportWarning was only introduced in GHC 7.6 / TH 2.8+reportWarning :: String -> Q ()+reportWarning = report False+#endif++-- | Derives a Listable instance for a given type ('Name').+deriveListable :: Name -> DecsQ+deriveListable t = do+  is <- t `isInstanceOf` ''Listable+  if is+    then do reportWarning $ "Instance Listable "+                         ++ show t+                         ++ " already exists, skipping derivation"+            return []+    else do cd <- canDeriveListable t+            unless cd (fail $ "Unable to derive Listable "+                           ++ show t)+            reallyDeriveListable t++-- | Checks whether it is possible to derive a Listable instance.+--+-- For example, it is not possible if there are is no Listable instance for a+-- type in one of the constructors.+canDeriveListable :: Name -> Q Bool+canDeriveListable t = return True -- TODO: Check instances for type-cons args++-- TODO: Somehow check if the enumeration has repetitions, then warn the user.+reallyDeriveListable :: Name -> DecsQ+reallyDeriveListable t = do+  (nt,vs) <- normalizeType t+#if __GLASGOW_HASKELL__ >= 710+  cxt <- sequence [[t| Listable $(return v) |] | v <- vs]+#else+  cxt <- sequence [classP ''Listable [return v] | v <- vs]+#endif+#if __GLASGOW_HASKELL__ >= 708+  cxt |=>| [d| instance Listable $(return nt)+                 where tiers = $(conse =<< typeCons t) |]+#else+  tiersE <- conse =<< typeCons t+  return [ InstanceD+             cxt+             (AppT (ConT ''Listable) nt)+             [ValD (VarP 'tiers) (NormalB tiersE) []]+         ]+#endif+  where cone n arity = do+          (Just consN) <- lookupValueName $ "cons" ++ show arity+          [| $(varE consN) $(conE n) |]+        conse = foldr1 (\e1 e2 -> [| $e1 \/ $e2 |]) . map (uncurry cone)+++-- * Template haskell utilities++-- Normalizes a type by applying it to necessary type variables, making it+-- accept "zero" parameters.  The normalized type is tupled with a list of+-- necessary type variables.+--+-- Suppose:+--+-- > data DT a b c ... = ...+--+-- Then, in pseudo-TH:+--+-- > normalizeType [t|DT|] == Q (DT a b c ..., [a, b, c, ...])+normalizeType :: Name -> Q (Type, [Type])+normalizeType t = do+  ar <- typeArity t+  vs <- newVarTs ar+  return (foldl AppT (ConT t) vs, vs)+  where+    newNames :: [String] -> Q [Name]+    newNames = mapM newName+    newVarTs :: Int -> Q [Type]+    newVarTs n = liftM (map VarT)+               $ newNames (take n . map (:[]) $ cycle ['a'..'z'])++-- Normalizes a type by applying it to units (`()`) while possible.+--+-- > normalizeTypeUnits ''Int    === [t| Int |]+-- > normalizeTypeUnits ''Maybe  === [t| Maybe () |]+-- > normalizeTypeUnits ''Either === [t| Either () () |]+normalizeTypeUnits :: Name -> Q Type+normalizeTypeUnits t = do+  ar <- typeArity t+  return (foldl AppT (ConT t) (replicate ar (TupleT 0)))++-- Given a type name and a class name,+-- returns whether the type is an instance of that class.+isInstanceOf :: Name -> Name -> Q Bool+isInstanceOf tn cl = do+  ty <- normalizeTypeUnits tn+  isInstance cl [ty]++-- | Given a type name, return the number of arguments taken by that type.+-- Examples in partially broken TH:+--+-- > arity ''Int        === Q 0+-- > arity ''Int->Int   === Q 0+-- > arity ''Maybe      === Q 1+-- > arity ''Either     === Q 2+-- > arity ''Int->      === Q 1+--+-- This works for Data's and Newtype's and it is useful when generating+-- typeclass instances.+typeArity :: Name -> Q Int+typeArity t = do+  ti <- reify t+  return . length $ case ti of+    TyConI (DataD    _ _ ks _ _) -> ks+    TyConI (NewtypeD _ _ ks _ _) -> ks+    _                            -> error $ "error (arity): symbol "+                                         ++ show t+                                         ++ " is not a newtype or data"++-- Given a type name, returns a list of its type constructor names tupled with+-- the number of arguments they take.+typeCons :: Name -> Q [(Name,Int)]+typeCons t = do+  ti <- reify t+  return . map simplify $ case ti of+    TyConI (DataD    _ _ _ cs _) -> cs+    TyConI (NewtypeD _ _ _ c  _) -> [c]+    _ -> error $ "error (typeConstructors): symbol "+              ++ show t+              ++ " is neither newtype nor data"+  where simplify (NormalC n ts)  = (n,length ts)+        simplify (RecC    n ts)  = (n,length ts)+        simplify (InfixC  _ n _) = (n,2)++-- Append to instance contexts in a declaration.+--+-- > sequence [[|Eq b|],[|Eq c|]] |=>| [t|instance Eq a => Cl (Ty a) where f=g|]+-- > == [t| instance (Eq a, Eq b, Eq c) => Cl (Ty a) where f = g |]+(|=>|) :: Cxt -> DecsQ -> DecsQ+c |=>| qds = do ds <- qds+                return $ map (`ac` c) ds+  where ac (InstanceD c ts ds) c' = InstanceD (c++c') ts ds+        ac d                   _  = d

@@ -0,0 +1,118 @@+-- | A simple property-based testing library based on+--   enumeration of values via lists of lists.+--+-- This module re-exports Test.Check but some test functions have been+-- specialized to catch errors (see the explicit export list below).+--+-- This module is unsafe, it uses `unsafePerformIO` to catch errors.+{-# LANGUAGE CPP #-}+module Test.Check.Error+  ( holds+  , fails+  , exists+  , counterExample+  , counterExamples+  , witness+  , witnesses+  , results++  , errorToNothing+  , errorToFalse+  , errorToTrue+  , anyErrorToNothing++  , module Test.Check+  )+where++#if __GLASGOW_HASKELL__ <= 704+import Prelude hiding (catch)+#endif++import Test.Check hiding+  ( holds+  , fails+  , exists+  , counterExample+  , counterExamples+  , witness+  , witnesses+  , results+  )++import qualified Test.Check as C+  ( holds+  , fails+  , results+  )++import Control.Monad (liftM)+import System.IO.Unsafe (unsafePerformIO)+import Data.Maybe (listToMaybe)+import Control.Exception ( Exception+                         , SomeException+                         , ArithException+                         , ArrayException+                         , ErrorCall+                         , PatternMatchFail+                         , catch+                         , catches+                         , Handler (Handler)+                         , evaluate+                         )++-- | Takes a value and a function.  Ignores the value.  Binds the argument of+--   the function to the type of the value.+bindArgumentType :: a -> (a -> b) -> a -> b+bindArgumentType _ f = f++-- | Transforms a value into 'Just' that value or 'Nothing' on some errors:+--+--   * ArithException+--   * ArrayException+--   * ErrorCall+--   * PatternMatchFail+errorToNothing :: a -> Maybe a+errorToNothing x = unsafePerformIO $+  (Just `liftM` evaluate x) `catches` map ($ return Nothing)+                                      [ hf (undefined :: ArithException)+                                      , hf (undefined :: ArrayException)+                                      , hf (undefined :: ErrorCall)+                                      , hf (undefined :: PatternMatchFail)+                                      ]+  where hf :: Exception e => e -> IO a -> Handler a -- handlerFor+        hf e h = Handler $ bindArgumentType e (\_ -> h)++-- | Transforms a value into 'Just' that value or 'Nothing' on error.+anyErrorToNothing :: a -> Maybe a+anyErrorToNothing x = unsafePerformIO $+  (Just `liftM` evaluate x) `catch` \e -> do let _ = e :: SomeException+                                             return Nothing++errorToFalse :: Bool -> Bool+errorToFalse p = case errorToNothing p of+                   Just p' -> p+                   Nothing -> False++errorToTrue :: Bool -> Bool+errorToTrue p = case errorToNothing p of+                  Just p' -> p+                  Nothing -> True+++holds,fails,exists :: Testable a => Int -> a -> Bool+holds n = errorToFalse . C.holds n+fails n = errorToTrue  . C.fails n+exists n = or . take n . map snd . results++counterExample,witness :: Testable a => Int -> a -> Maybe [String]+counterExample n = listToMaybe . counterExamples n+witness        n = listToMaybe . witnesses n++counterExamples,witnesses :: Testable a => Int -> a -> [[String]]+counterExamples n = map fst . filter (not . snd) . take n . results+witnesses       n = map fst . filter snd         . take n . results++results :: Testable a => a -> [([String],Bool)]+results = map (mapSnd errorToFalse) . C.results+  where mapSnd f (x,y) = (x,f y)

@@ -0,0 +1,2 @@+module Test.Check.Function () where+import Test.Check.Function.ListsOfPairs ()

@@ -0,0 +1,65 @@+-- | Function enumeration via CoListable typeclass+--   This currently just a sketch.+module Test.Check.Function.CoListable+where+++import Test.Check.Core+import Test.Check.Utils+import Data.Maybe (fromMaybe)+++(\+:/) :: [[a]] -> [[a]] -> [[a]]+xss \+:/ yss = xss \/ ([]:yss)+infixr 9 \+:/+++class CoListable a where+  coListing :: [[b]] -> [[a -> b]]+++instance CoListable () where+  coListing rs = mapT (\r  () -> r) rs+++instance CoListable Bool where+  coListing rs = productWith (\r1 r2  b -> if b then r1 else r2) rs rs+++instance CoListable a => CoListable (Maybe a) where+  coListing rs = productWith (\z f  m -> case m of Nothing -> z+                                                   Just x  -> f x) rs (coListing rs)+++instance (CoListable a, CoListable b) => CoListable (Either a b) where+  coListing rs = productWith (\f g  e -> case e of Left x  -> f x+                                                   Right x -> g x) (coListing rs) (coListing rs)+++instance (CoListable a) => CoListable [a] where+  coListing rss = mapT const rss+             \+:/ productWith (\y f  xs -> case xs of []      -> y+                                                      (x:xs') -> f x xs') rss (coListing (coListing rss))+++instance CoListable Int where+  coListing rss = mapT const rss+             \+:/ product3With (\f g z  i -> if i > 0 then f (i-1)+                                        else if i < 0 then g (i+1)+                                             else z) (coListing rss) (coListing rss) rss+++alts0 :: [[a]] -> [[a]]+alts0 = id++alts1 :: CoListable a => [[b]] -> [[a->b]]+alts1 bs = coListing bs++alts2 :: (CoListable a, CoListable b) => [[c]] -> [[a->b->c]]+alts2 cs = coListing (coListing cs)++alts3 :: (CoListable a, CoListable b, CoListable c) => [[d]] -> [[a->b->c->d]]+alts3 ds = coListing (coListing (coListing ds))++fListing :: (CoListable a, Listable b) => [[a->b]]+fListing = coListing tiers

@@ -0,0 +1,62 @@+-- | Function enumeration via lists of pairs.+module Test.Check.Function.ListsOfPairs+  ( functionPairs+  , associations+  , pairsToFunction+  , defaultFunPairsToFunction+  )+where++import Test.Check.Core+import Test.Check.Utils+import Data.Maybe (fromMaybe)++instance (Eq a, Listable a, Listable b) => Listable (a -> b) where+  tiers = mapT (uncurry $ flip defaultPairsToFunction)+        $ functions list tiers+++functions :: [[a]] -> [[b]] -> [[([(a,b)],b)]]+functions xss yss =+  concatMapT+    (\(r,yss) -> mapT (\ps -> (ps,r)) $ functionPairs xss yss)+    (choices yss)+++-- | Given a list of domain values, and tiers of codomain values,+-- return tiers of lists of ordered pairs of domain and codomain values.+--+-- Technically: tiers of left-total functional relations.+associations :: [a] -> [[b]] -> [[ [(a,b)] ]]+associations xs sbs = zip xs `mapT` products (const sbs `map` xs)++-- | Given tiers of input values and tiers of output values,+-- return tiers with all possible lists of input-output pairs.+-- Those represent functional relations.+functionPairs :: [[a]] -> [[b]] -> [[[(a,b)]]]+functionPairs xss yss = concatMapT (`associations` yss)+                                   (strictlyAscendingListsOf xss)++-- | Returns a function given by a list of input-output pairs.+-- The result is wrapped in a maybe value.+-- The output for bound inputs is 'Just' a value.+-- The output for unbound inputs is 'Nothing'.+pairsToMaybeFunction :: Eq a => [(a,b)] -> a -> Maybe b+pairsToMaybeFunction []          _ = Nothing+pairsToMaybeFunction ((a',r):bs) a | a == a'   = Just r+                                   | otherwise = pairsToMaybeFunction bs a++-- | Returns a partial function given by a list of input-output pairs.+--+-- NOTE: This function *will* return undefined values for unbound inputs.+pairsToFunction :: Eq a => [(a,b)] -> a -> b+pairsToFunction bs a = fromMaybe undefined (pairsToMaybeFunction bs a)+++-- | Returns a function given by a list of input-output pairs and a default value.+defaultPairsToFunction :: Eq a => b -> [(a,b)] -> a -> b+defaultPairsToFunction r bs a = fromMaybe r (pairsToMaybeFunction bs a)+++defaultFunPairsToFunction :: Eq a => (a -> b) -> [(a,b)] -> a -> b+defaultFunPairsToFunction f bs a = fromMaybe (f a) (pairsToMaybeFunction bs a)

@@ -0,0 +1,47 @@+-- | Periodic function enumeration.+--   This is just a sketch.+module Test.Check.Function.Periodic+where+++import Test.Check.Basic+import Test.Check.Utils (listsOf)+import Data.List (inits)+++instance (Eq a, Eq b, Listable a, Listable b) => Listable (a -> b) where+  tiers = mapT pairsToFunction $ functions list tiers++functions :: Eq b => [a] -> [[b]] -> [[[(a,b)]]]+functions xs yss = mapT (zip xs . cycle) $ lsPeriodsOfLimit xs yss++functionsz :: Eq b => [[a]] -> [[b]] -> [[[(a,b)]]]+functionsz xss = functions (concat xss)+++lsPeriodsOf :: Eq a => [[a]] -> [[[a]]]+lsPeriodsOf xss = map (filter isPeriod) (listsOf xss)++lsPeriodsOfLimit :: Eq a => [b] -> [[a]] -> [[[a]]]+lsPeriodsOfLimit ys xss = map (filter isPeriod) (tiersOfLimit ys xss)+++isPeriod :: Eq a => [a] -> Bool+isPeriod [] = False+isPeriod [x] = True+isPeriod xs = not $ any (`isPeriodOf` xs) $ (tail . init . inits) xs++isPeriodOf :: Eq a => [a] -> [a] -> Bool+xs `isPeriodOf` ys = length ys `mod` length xs == 0+                  && and (zipWith (==) (cycle xs) ys)+++tiersOfLimit :: [b] -> [[a]] -> [[[a]]]+tiersOfLimit     [] xss = [[[]]]+tiersOfLimit (_:ys) xss = [[[]]] ++ productWith (:) xss (tiersOfLimit ys xss)+++pairsToFunction :: Eq a => [(a,b)] -> (a -> b)+pairsToFunction ((x,y):ps) x' =  if x' == x+                                   then y+                                   else pairsToFunction ps x'

@@ -0,0 +1,10 @@+-- | A 'Show' instance for functions.+module Test.Check.Function.Show () where++import Test.Check.ShowFunction++instance (Show a, Listable a, ShowFunction b) => Show (a->b) where+  showsPrec 0 = (++) . showFunction 8+  showsPrec _ = (++) . paren . showFunctionLine 4+    where paren s = "(" ++ s ++ ")"+

@@ -0,0 +1,80 @@+-- | QuickCheck-like interface to LeanCheck+{-# LANGUAGE CPP #-}+module Test.Check.IO+  ( check+  , checkFor+  , checkResult+  , checkResultFor+  )+where++#if __GLASGOW_HASKELL__ <= 704+import Prelude hiding (catch)+#endif++import Test.Check.Core+import Data.Maybe (listToMaybe)+import Data.List (find)+import Control.Exception (SomeException, catch, evaluate)++-- | Check a property+--   printing results on 'stdout'+check :: Testable a => a -> IO ()+check p = checkResult p >> return ()++-- | Check a property for @N@ tests+--   printing results on 'stdout'+checkFor :: Testable a => Int -> a -> IO ()+checkFor n p = checkResultFor n p >> return ()++-- | Check a property+--   printing results on 'stdout' and+--   returning 'True' on success.+--+-- There is no option to silence this function:+-- in that case, you should use 'Test.Check.holds'.+checkResult :: Testable a => a -> IO Bool+checkResult p = checkResultFor 200 p++-- | Check a property for @N@ tests+--   printing results on 'stdout' and+--   returning 'True' on success.+--+-- There is no option to silence this function:+-- in that case, you should use 'Test.Check.holds'.+checkResultFor :: Testable a => Int -> a -> IO Bool+checkResultFor n p = do+  r <- resultIO n p+  putStrLn . showResult $ r+  return (isOK r)+  where isOK (OK _) = True+        isOK _      = False++data Result = OK        Int+            | Falsified Int [String]+            | Exception Int [String] String+  deriving (Eq, Show)++resultsIO :: Testable a => Int -> a -> IO [Result]+resultsIO n = sequence . zipWith torio [1..] . take n . results+  where+    tor i (_,True) = OK i+    tor i (as,False) = Falsified i as+    torio i r@(as,_) = evaluate (tor i r)+       `catch` \e -> let _ = e :: SomeException+                     in return (Exception i as (show e))++resultIO :: Testable a => Int -> a -> IO Result+resultIO n p = do+  rs <- resultsIO n p+  return . maybe (last rs) id+         $ find isFailure rs+  where isFailure (OK _) = False+        isFailure _      = True++showResult :: Result -> String+showResult (OK n)             = "+++ OK, passed " ++ show n ++ " tests."+showResult (Falsified i ce)   = "*** Failed! Falsifiable (after "+                             ++ show i ++ " tests):\n" ++ unwords ce+showResult (Exception i ce e) = "*** Failed! Exception '" ++ e ++ "' (after "+                             ++ show i ++ " tests):\n" ++ unwords ce

@@ -0,0 +1,130 @@+-- | Some invariants over Test.Check functions+--   You should be importing this ONLY to test 'Check.hs' itself.+module Test.Check.Invariants+  ( tNatPairOrd+  , tNatTripleOrd+  , tNatQuadrupleOrd+  , tNatQuintupleOrd+  , tNatSixtupleOrd+  , tNatListOrd+  , tListsOfNatOrd+  , tPairEqParams+  , tTripleEqParams+  , tProductsIsFilterByLength++  , ordered+  , orderedBy+  , strictlyOrdered+  , strictlyOrderedBy+  )+where++import Test.Check+import Data.List+import Data.Ord+import Test.Types (Nat(..))++-- | check if a list is ordered+ordered :: Ord a => [a] -> Bool+ordered = orderedBy compare+-- ordered [] = True+-- ordered [_] = True+-- ordered (x:y:xs) = x <= y && ordered (y:xs)++strictlyOrdered :: Ord a => [a] -> Bool+strictlyOrdered = strictlyOrderedBy compare++-- | check if a list is ordered by a given ordering function+orderedBy :: (a -> a -> Ordering) -> [a] -> Bool+orderedBy _ [] = True+orderedBy _ [_] = True+orderedBy cmp (x:y:xs) = case x `cmp` y of+                           GT -> False+                           _  -> orderedBy cmp (y:xs)++-- | check if a list is strictly ordered by a given ordering function+strictlyOrderedBy :: (a -> a -> Ordering) -> [a] -> Bool+strictlyOrderedBy _ [] = True+strictlyOrderedBy _ [_] = True+strictlyOrderedBy cmp (x:y:xs) = case x `cmp` y of+                                   LT -> strictlyOrderedBy cmp (y:xs)+                                   _  -> False++ifNotEq :: Ordering -> Ordering -> Ordering+-- Could be implemented as:  ifNotEq = mappend+ifNotEq EQ p = p+ifNotEq  o _ = o++thn :: (a->a->Ordering) -> (a->a->Ordering) -> a -> a -> Ordering+thn cmp1 cmp2 x y = (x `cmp1` y) `ifNotEq` (x `cmp2` y)+infixr 9 `thn`+++-- | checks if the first 'n' elements on tiers are ordered by 'cmp'.+--+-- > (n `seriesOrderedBy`) comparing (id :: Type)+tOrderedBy :: Listable a => Int -> (a -> a -> Ordering) -> Bool+tOrderedBy n cmp = orderedBy cmp $ take n list+infixr 9 `tOrderedBy`++tStrictlyOrderedBy :: Listable a => Int -> (a -> a -> Ordering) -> Bool+tStrictlyOrderedBy n cmp = strictlyOrderedBy cmp $ take n list+infixr 9 `tStrictlyOrderedBy`++tNatPairOrd :: Int -> Bool+tNatPairOrd n = n `tStrictlyOrderedBy`  comparing sum' `thn` compare+  where sum' (x,y) = x+y :: Nat++tNatTripleOrd :: Int -> Bool+tNatTripleOrd n = n `tStrictlyOrderedBy`  comparing sum' `thn` compare+  where sum' (x,y,z) = x+y+z :: Nat++tNatQuadrupleOrd :: Int -> Bool+tNatQuadrupleOrd n = n `tStrictlyOrderedBy`  comparing sum' `thn` compare+  where sum' (x,y,z,w) = x+y+z+w :: Nat++tNatQuintupleOrd :: Int -> Bool+tNatQuintupleOrd n = n `tStrictlyOrderedBy`  comparing sum' `thn` compare+  where sum' (x,y,z,w,v) = x+y+z+w+v :: Nat++tNatSixtupleOrd :: Int -> Bool+tNatSixtupleOrd n = n `tStrictlyOrderedBy`  comparing sum' `thn` compare+  where sum' (x,y,z,w,v,u) = x+y+z+w+v+u :: Nat++tNatListOrd :: Int -> Bool+tNatListOrd n = n `tStrictlyOrderedBy`  comparing sum' `thn` compare+  where sum' = sum . map (+1) :: [Nat] -> Nat++tListsOfStrictlyOrderedBy :: Int+                           -> (a -> a -> Ordering)+                           -> [[a]]+                           -> Bool+tListsOfStrictlyOrderedBy n cmp = strictlyOrderedBy cmp . take n . concat+infixr 9 `tListsOfStrictlyOrderedBy`++tListsOfNatOrd :: Int -> Bool+tListsOfNatOrd n = tListsOfStrictlyOrderedBy n (comparing sum' `thn` compare) tiers+  where sum' = sum . map (+1) :: [Nat] -> Nat++tPairEqParams :: Int -> Bool+tPairEqParams n = ces == srs+  where+    ces = map (map read) $ counterExamples n fail+    srs = map pairToList $ take n list+    pairToList (x,y) = [x,y :: Nat]+    fail :: Nat -> Nat -> Bool+    fail x y = False++tTripleEqParams :: Int -> Bool+tTripleEqParams n = ces == srs+  where+    ces = map (map read) $ counterExamples n fail+    srs = map tripleToList $ take n list+    tripleToList (x,y,z) = [x,y,z :: Nat]+    fail :: Nat -> Nat -> Nat -> Bool+    fail x y z = False++tProductsIsFilterByLength :: Eq a => [[a]] -> Int -> Int -> Bool+tProductsIsFilterByLength values m n = concat (take m byProduct) `isPrefixOf` concat byFilter+  where byProduct = products $ replicate n values+        byFilter  = ((==n) . length) `filterT` listsOf values

@@ -0,0 +1,173 @@+-- | This module exports the 'ShowFunction' typeclass,+--   its instances and related functions.+--+-- Using this module, it is possible to implement+-- a Show instance for functions:+--+-- > import Test.Check.ShowFunction+-- > instance (Show a, Listable a, ShowFunction b) => Show (a->b) where+-- >   show = showFunction 8+--+-- This shows functions as a case pattern with up to 8 cases.+--+-- The module+-- @Test.Check.Function.Show@ ('Test.Check.Function.Show')+-- exports an instance like the one above.+module Test.Check.ShowFunction+  ( showFunction+  , showFunctionLine+  , Binding+  , bindings+  , ShowFunction (..)+  , tBindingsShow+  -- * Re-exports+  , Listable+  )+where++import Test.Check.Core+import Test.Check.Error (errorToNothing)+import Data.List+import Data.Maybe++-- | A functional binding in a showable format.+type Binding = ([String], Maybe String)++-- | 'ShowFunction' values are those for which+--   we can return a list of functional bindings.+--+-- As a user, you probably want 'showFunction' and 'showFunctionLine'.+--+-- Non functional instances should be defined by:+--+-- > instance ShowFunction Ty where tBindings = tBindingsShow+class ShowFunction a where+  tBindings :: a -> [[Binding]]++-- | Given a 'ShowFunction' value, return a list of bindings+--   for printing.  Examples:+--+-- > bindings True == [([],True)]+-- > bindings (id::Int) == [(["0"],"0"), (["1"],"1"), (["-1"],"-1"), ...+-- > bindings (&&) == [ (["False","False"], "False")+-- >                  , (["False","True"], "False")+-- >                  , (["True","False"], "False")+-- >                  , (["True","True"], "True")+-- >                  ]+bindings :: ShowFunction a => a -> [Binding]+bindings = concat . tBindings+++-- instances for (algebraic/numeric) data types --+-- | A default implementation of tBindings for already 'Show'-able types.+tBindingsShow :: Show a => a -> [[Binding]]+tBindingsShow x = [[([],errorToNothing $ show x)]]++instance ShowFunction ()   where tBindings = tBindingsShow+instance ShowFunction Bool where tBindings = tBindingsShow+instance ShowFunction Int  where tBindings = tBindingsShow+instance ShowFunction Char where tBindings = tBindingsShow+instance Show a => ShowFunction [a]       where tBindings = tBindingsShow+instance Show a => ShowFunction (Maybe a) where tBindings = tBindingsShow+instance (Show a, Show b) => ShowFunction (a,b) where tBindings = tBindingsShow+++-- instance for functional value type --+instance (Show a, Listable a, ShowFunction b) => ShowFunction (a->b) where+  tBindings f = concatMapT tBindingsFor tiers+    where tBindingsFor x = mapFst (show x:) `mapT` tBindings (f x)+          mapFst f (x,y) = (f x, y)++paren :: String -> String+paren s = "(" ++ s ++ ")"++varnamesFor :: ShowFunction a => a -> [String]+varnamesFor = zipWith const varnames . fst . head . bindings+  where varnames = ["x","y","z","w"] ++ map (++"'") varnames++showTuple :: [String] -> String+showTuple [x] = x+showTuple xs  = paren $ intercalate "," xs++showNBindingsOf :: ShowFunction a => Int -> Int -> a -> [String]+showNBindingsOf m n f = take n bs+                     ++ ["..." | length bs' >= m || length bs > n]+  where bs' = take m $ bindings f+        bs = [ showTuple as ++ " -> " ++ r+             | (as, Just r) <- bs' ]++isValue :: ShowFunction a => a -> Bool+isValue f = case bindings f of+              [([],_)] -> True+              _        -> False++showValueOf :: ShowFunction a => a -> String+showValueOf x = case snd . head . bindings $ x of+                  Nothing -> "undefined"+                  Just x' -> x'++-- | Given a number of patterns to show, shows a 'ShowFunction' value.+--+-- > showFunction undefined True == "True"+-- > showFunction 3 (id::Int) == "\\x -> case x of\n\+-- >                              \        0 -> 0\n\+-- >                              \        1 -> 1\n\+-- >                              \        -1 -> -1\n\+-- >                              \        ...\n"+-- > showFunction 4 (&&) == "\\x y -> case (x,y) of\n\+-- >                         \          (False,False) -> False\n\+-- >                         \          (False,True) -> False\n\+-- >                         \          (True,False) -> False\n\+-- >                         \          (True,True) -> True\n"+--+-- This can be used as an implementation of show for functions:+--+-- > instance (Show a, Listable a, ShowFunction b) => Show (a->b) where+-- >   show = showFunction 8+showFunction :: ShowFunction a => Int -> a -> String+showFunction n = showFunctionL False (n*n+1) n++-- | Same as showFunction, but has no line breaks.+--+-- > showFunction 2 (id::Int) == "\\x -> case x of 0 -> 0; 1 -> 1; ..."+showFunctionLine :: ShowFunction a => Int -> a -> String+showFunctionLine n = showFunctionL True (n*n+1) n++-- | isUndefined checks if a function is totally undefined.+-- When it is not possible to check all values, it returns false+isUndefined :: ShowFunction a => Int -> a -> Bool+isUndefined m f = length bs < m && all (isNothing . snd) bs+  where bs = take m $ bindings f++-- The first boolean parameter tells if we are showing+-- the function on a single line+showFunctionL :: ShowFunction a => Bool -> Int -> Int -> a -> String+showFunctionL singleLine m n f | isValue f = showValueOf f+showFunctionL singleLine m n f | otherwise = lambdaPat ++ caseExp+  where+    vs = varnamesFor f+    lambdaPat = "\\" ++ unwords vs ++ " -> "+    casePat = "case " ++ showTuple vs ++ " of"+    bs = showNBindingsOf m n f+    sep | singleLine = " "+        | otherwise = "\n"+    cases | singleLine = intercalate "; " bs+          | otherwise  = unlines+                       $ (replicate (length lambdaPat + 2) ' ' ++) `map` bs+    caseExp = if isUndefined m f+                then "undefined"+                else casePat ++ sep ++ cases++-- instances for further tuples --+instance (Show a, Show b, Show c)+      => ShowFunction (a,b,c) where tBindings = tBindingsShow+instance (Show a, Show b, Show c, Show d)+      => ShowFunction (a,b,c,d) where tBindings = tBindingsShow+instance (Show a, Show b, Show c, Show d, Show e)+      => ShowFunction (a,b,c,d,e) where tBindings = tBindingsShow+instance (Show a, Show b, Show c, Show d, Show e, Show f)+      => ShowFunction (a,b,c,d,e,f) where tBindings = tBindingsShow+instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g)+      => ShowFunction (a,b,c,d,e,f,g) where tBindings = tBindingsShow+instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h)+      => ShowFunction (a,b,c,d,e,f,g,h) where tBindings = tBindingsShow

@@ -0,0 +1,232 @@+-- | Utilities functions for manipulating tiers (sized lists of lists)+module Test.Check.Utils+  (+  -- * Additional tiers constructors+    consFromList+  , consFromAscendingList+  , consFromStrictlyAscendingList+  , consFromSet+  , consFromNoDupList++  -- * Products of tiers+  , product3With+  , productMaybeWith++  -- * Tiers of lists+  , listsOf+  , ascendingListsOf+  , strictlyAscendingListsOf+  , setsOf+  , noDupListsOf+  , products+  , listsOfLength++  , deleteT+  , normalizeT++  -- * Tiers of choices+  , choices+  , ascendingChoices+  , strictlyAscendingChoices+  )+where++import Test.Check.Basic+import Data.Maybe (catMaybes)++-- | Given a constructor for a type that takes a list,+--   return tiers for that type.+consFromList :: Listable a => ([a] -> b) -> [[b]]+consFromList = (`mapT` listsOf tiers)++consFromAscendingList :: Listable a => ([a] -> b) -> [[b]]+consFromAscendingList = (`mapT` ascendingListsOf tiers)++-- | Given a constructor for a type that takes a list with strictly ascending+--   elements, return tiers of that type (e.g.: a Set type).+consFromStrictlyAscendingList :: Listable a => ([a] -> b) -> [[b]]+consFromStrictlyAscendingList = (`mapT` strictlyAscendingListsOf tiers)++-- | Given a constructor for a type that takes a set of elements (as a list)+--   return tiers of that type (e.g.: a Set type).+consFromSet :: Listable a => ([a] -> b) -> [[b]]+consFromSet = (`mapT` setsOf tiers)++-- | Given a constructor for a type that takes a list with no duplicate+--   elements, return tiers of that type.+consFromNoDupList :: Listable a => ([a] -> b) -> [[b]]+consFromNoDupList f = mapT f (noDupListsOf tiers)+++-- | Like 'product', but over 3 lists of tiers.+product3With :: (a->b->c->d) -> [[a]] -> [[b]] -> [[c]] -> [[d]]+product3With f xss yss zss = productWith ($) (productWith f xss yss) zss++-- | Take the product of lists of tiers by a function returning a maybe value.+productMaybeWith :: (a->b->Maybe c) -> [[a]] -> [[b]] -> [[c]]+productMaybeWith _ _ [] = []+productMaybeWith _ [] _ = []+productMaybeWith f (xs:xss) yss = map (xs **) yss+                               \/ productMaybeWith f xss yss `addWeight` 1+  where xs ** ys = catMaybes [ f x y | x <- xs, y <- ys ]+++-- | Given tiers of values, returns tiers of lists of those values+--+-- > listsOf [[]] == [[[]]]+--+-- > listsOf [[x]] == [ [[]]+-- >                  , [[x]]+-- >                  , [[x,x]]+-- >                  , [[x,x,x]]+-- >                  , ...+-- >                  ]+--+-- > listsOf [[x],[y]] == [ [[]]+-- >                      , [[x]]+-- >                      , [[x,x],[y]]+-- >                      , [[x,x,x],[x,y],[y,x]]+-- >                      , ...+-- >                      ]+listsOf :: [[a]] -> [[[a]]]+listsOf xss = cons0 []+           \/ productWith (:) xss (listsOf xss) `addWeight` 1++-- | Generates several lists of the same size.+--+-- > products [ xss, yss, zss ] ==+--+-- Tiers of all lists combining elements of tiers: xss, yss and zss+products :: [ [[a]] ] -> [[ [a] ]]+products = foldr (productWith (:)) [[[]]]++-- | Delete the first occurence of an element in a tier,+--   for tiers without repetitions:+--+-- > deleteT x === normalizeT . (`suchThat` (/= x))+deleteT :: Eq a => a -> [[a]] -> [[a]]+deleteT _ [] = []+deleteT y ([]:xss) = [] : deleteT y xss+deleteT y [[x]]        | x == y    = []+deleteT y ((x:xs):xss) | x == y    = xs:xss+                       | otherwise = [[x]] \/ deleteT y (xs:xss)++normalizeT :: [[a]] -> [[a]]+normalizeT [] = []+normalizeT [[]] = []+normalizeT (xs:xss) = xs:normalizeT xss++-- | Given tiers of 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]]+-- >   , ...+-- >   ]+noDupListsOf :: [[a]] -> [[[a]]]+noDupListsOf =+  ([[]]:) . concatT . choicesWith (\x xss -> mapT (x:) (noDupListsOf xss))++-- | Lists tiers of all choices of values from tiers.+-- 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.+choices :: [[a]] -> [[(a,[[a]])]]+choices = choicesWith (,)++-- | Like 'choices', but allows a custom function.+choicesWith :: (a -> [[a]] -> b) -> [[a]] -> [[b]]+choicesWith f []           = []+choicesWith f [[]]         = []+choicesWith f ([]:xss)     = [] : choicesWith (\y yss -> f y ([]:yss)) xss+choicesWith f ((x:xs):xss) = [[f x (xs:xss)]]+                          \/ choicesWith (\y (ys:yss) -> f y ((x:ys):yss)) (xs:xss)++-- | Given tiers of values,+--   returns tiers of lists of elements in ascending order+--                               (from tiered enumeration).+--+ascendingListsOf :: [[a]] -> [[[a]]]+ascendingListsOf =+  ([[]]:) . concatT . ascendingChoicesWith (\x xss -> mapT (x:) (ascendingListsOf xss))++-- > ascendingChoices [[False,True]] =+-- >   [ [(False,[[False,True]]), (True,[[True]])]+-- >   ]+--+-- > ascendingChoices [[1],[2],[3],...] =+-- >   [ [(1,[[1],[2],[3],...])]+-- >   , [(2,[[ ],[2],[3],...])]+-- >   , [(3,[[ ],[ ],[3],...])]+-- >   , ...+-- >   ]+ascendingChoices :: [[a]] -> [[(a,[[a]])]]+ascendingChoices = ascendingChoicesWith (,)++ascendingChoicesWith :: (a -> [[a]] -> b) -> [[a]] -> [[b]]+ascendingChoicesWith f []           = []+ascendingChoicesWith f [[]]         = []+ascendingChoicesWith f ([]:xss)     = [] : ascendingChoicesWith (\y yss -> f y ([]:yss)) xss+ascendingChoicesWith f ((x:xs):xss) = [[f x ((x:xs):xss)]]+                                   \/ ascendingChoicesWith f (xs:xss)++-- | Given tiers of values,+--   returns tiers of lists of elements in strictly ascending order+--                              (from tiered enumeration).+--   If you only care about whether elements are in returned lists,+--   this returns the tiers of all sets of values.+--+-- > strictlyAscendingListsOf [[0],[1],[2],...] ==+-- >   [ [[]]+-- >   , [[0]]+-- >   , [[1]]+-- >   , [[0,1],[2]]+-- >   , [[0,2],[3]]+-- >   , [[0,3],[1,2],[4]]+-- >   , [[0,1,2],[0,4],[1,3],[5]]+-- >   , ...+-- >   ]+strictlyAscendingListsOf :: [[a]] -> [[[a]]]+strictlyAscendingListsOf =+  ([[]]:) . concatT .+  strictlyAscendingChoicesWith+    (\x xss -> mapT (x:) (strictlyAscendingListsOf xss))++-- | Returns tiers of sets represented as lists of values (no repeated sets).+--   Shorthand for 'strictlyAscendingListsOf'.+setsOf :: [[a]] -> [[[a]]]+setsOf = strictlyAscendingListsOf++-- | Like 'choices', but paired tiers are always strictly ascending (in terms+--   of enumeration).+--+-- > strictlyAscendingChoices [[False,True]] == [[(False,[[True]]),(True,[[]])]]+-- > strictlyAscendingChoices [[1],[2],[3]]+-- >   == [ [(1,[[],[2],[3]])]+-- >      , [(2,[[],[],[3]])]+-- >      , [(3,[[],[],[]])]+-- >      ]+strictlyAscendingChoices :: [[a]] -> [[(a,[[a]])]]+strictlyAscendingChoices = strictlyAscendingChoicesWith (,)++-- | Like 'strictlyAscendingChoices' but customized by a function.+strictlyAscendingChoicesWith :: (a -> [[a]] -> b) -> [[a]] -> [[b]]+strictlyAscendingChoicesWith f []           = []+strictlyAscendingChoicesWith f [[]]         = []+strictlyAscendingChoicesWith f ([]:xss)     = [] : strictlyAscendingChoicesWith (\y yss -> f y ([]:yss)) xss+strictlyAscendingChoicesWith f ((x:xs):xss) = [[f x (xs:xss)]]+                                           \/ strictlyAscendingChoicesWith f (xs:xss)+++-- | Given tiers, returns tiers of lists of a given length.+listsOfLength :: Int -> [[a]] -> [[[a]]]+listsOfLength n xss = products (replicate n xss)

@@ -0,0 +1,21 @@+-- | Simple property-based testing library+--   based on enumeration of values via lists of lists.+--+-- This module exports Most modules that accompain Test.Check+-- and is to be used as a shorthand:+--+-- > import Test.Most+--+-- To get most of the needed stuff+module Test.Most+  ( module Test.Check+  , module Test.Operators+  , module Test.TypeBinding+  , module Test.Types+  )+where++import Test.Check+import Test.Operators+import Test.TypeBinding+import Test.Types

@@ -0,0 +1,113 @@+module Test.Operators+  (+--  (==>) -- already provided by Test.Check++  -- * Combining properties+    (===), (====)+  , (&&&), (&&&&)+  , (|||), (||||)++  -- * Properties over functions+  , commutative+  , associative+  , distributive+  , transitive+  , idempotent+  , identity+  , notIdentity++  -- * Ternary comparison operators+  , (=$), ($=)+  , (=|), (|=)+  )+where++import Test.Check ((==>))++combine :: (b -> c -> d) -> (a -> b) -> (a -> c) -> (a -> d)+combine op f g = \x -> f x `op` g x++-- Uneeded, just food for thought+--combine2 :: (c -> d -> e) -> (a -> b -> c) -> (a -> b -> d) -> (a -> b -> e)+-- Two possible implementations:+--combine2 op f g = \x y -> f x y `op` g x y+--combine2 = combine . combine++(===) :: Eq b => (a -> b) -> (a -> b) -> a -> Bool+(===) = combine (==)+infix 4 ===++(====) :: Eq c => (a -> b -> c) -> (a -> b -> c) -> a -> b -> Bool+(====) = combine (===)+infix 4 ====++(&&&) :: (a -> Bool) -> (a -> Bool) -> a -> Bool+(&&&) = combine (&&)+infix 3 &&&++(&&&&) :: (a -> b -> Bool) -> (a -> b -> Bool) -> a -> b -> Bool+(&&&&) = combine (&&&)+infix 3 &&&&++(|||) :: (a -> Bool) -> (a -> Bool) -> a -> Bool+(|||) = combine (||)+infix 2 |||++(||||) :: (a -> b -> Bool) -> (a -> b -> Bool) -> a -> b -> Bool+(||||) = combine (|||)+infix 2 ||||++commutative :: Eq b => (a -> a -> b) -> a -> a -> Bool+commutative o = \x y -> x `o` y == y `o` x++associative :: Eq a => (a -> a -> a) -> a -> a -> a -> Bool+associative o = \x y z -> x `o` (y `o` z) == (x `o` y) `o` z++-- type could be more general: (b -> a -> a) for both operators+distributive :: Eq a => (a -> a -> a) -> (a -> a -> a) -> a -> a -> a -> Bool+distributive o o' = \x y z -> x `o` (y `o'` z) == (x `o` y) `o'` (x `o` z)++transitive :: (a -> a -> Bool) -> a -> a -> a -> Bool+transitive o = \x y z -> x `o` y && y `o` z ==> x `o` z++idempotent :: Eq a => (a -> a) -> a -> Bool+idempotent f = f . f === f++identity :: Eq a => (a -> a) -> a -> Bool+identity f = f === id++notIdentity :: Eq a => (a -> a) -> a -> Bool+notIdentity = (not .) . identity++-- | Equal under.  A ternary operator.+--+-- > x =$ f $= y  =  f x = f y+--+-- > [1,2,3,4,5] =$  take 2    $= [1,2,4,8,16] -- > True+-- > [1,2,3,4,5] =$  take 3    $= [1,2,4,8,16] -- > False+-- >     [1,2,3] =$    sort    $= [3,2,1]      -- > True+-- >          42 =$ (`mod` 10) $= 16842        -- > True+-- >          42 =$ (`mod`  9) $= 16842        -- > False+-- >         'a' =$  isLetter  $= 'b'          -- > True+-- >         'a' =$  isLetter  $= '1'          -- > False+(=$) :: Eq b => a -> (a -> b) -> a -> Bool+(x =$ f) y = f x == f y+infixl 4 =$++($=) :: (a -> Bool) -> a -> Bool+($=) = ($)+infixl 4 $=++-- | Check if two lists are equal for @n@ values.+--+-- > xs =| n |= ys  =  take n xs == take n ys+--+-- > [1,2,3,4,5] =| 2 |= [1,2,4,8,16] -- > True+-- > [1,2,3,4,5] =| 3 |= [1,2,4,8,16] -- > False+(=|) :: Eq a => [a] -> Int -> [a] -> Bool+xs =| n = xs =$ take n+infixl 4 =|++(|=) :: (a -> Bool) -> a -> Bool+(|=) = ($)+infixl 4 |=

@@ -0,0 +1,229 @@+-- | Infix operators for type binding using dummy first-class values.+--+-- Those are useful when property based testing to avoid repetition.+-- Suppose:+--+-- > prop_sortAppend :: Ord a => [a] -> Bool+-- > prop_sortAppend xs =  sort (xs++ys) == sort (ys++xs)+--+-- Then this:+--+-- > testResults n =+-- >   [ holds n (prop_sortAppend :: [Int] -> [Int] -> Bool)+-- >   , holds n (prop_sortAppend :: [UInt2] -> [UInt2] -> Bool)+-- >   , holds n (prop_sortAppend :: [Bool] -> [Bool] -> Bool)+-- >   , holds n (prop_sortAppend :: [Char] -> [Char] -> Bool)+-- >   , holds n (prop_sortAppend :: [String] -> [String] -> Bool)+-- >   , holds n (prop_sortAppend :: [()] -> [()] -> Bool)+-- >   ]+--+-- Becomes this:+--+-- > testResults n =+-- >   [ holds n $ prop_sortAppend -:> [int]+-- >   , holds n $ prop_sortAppend -:> [uint2]+-- >   , holds n $ prop_sortAppend -:> [bool]+-- >   , holds n $ prop_sortAppend -:> [char]+-- >   , holds n $ prop_sortAppend -:> [string]+-- >   , holds n $ prop_sortAppend -:> [()]+-- >   ]+--+-- Or even:+--+-- > testResults n = concat+-- >   [ for int, for uint2, for bool, for (), for char, for string ]+-- >   where for a = [ holds n $ prop_sortAppend -:> a ]+--+-- This last form is useful when testing multiple properties for multiple+-- types.+module Test.TypeBinding+  (+  -- * Type binding operators+  --+  -- | Summary:+  --+  -- *                 as type of: '-:'+  -- *        argument as type of: '-:>'+  -- *          result as type of: '->:'+  -- * second argument as type of: '->:>'+  -- * second  result  as type of: '->>:'+  -- * third  argument as type of: '->>:>'+  -- * third   result  as type of: '->>>:'+    (-:)+  , (-:>)+  , (->:)+  , (->:>)+  , (->>:)+  , (->>:>)+  , (->>>:)++  -- * Dummy (undefined) values+  -- ** Standard Haskell types+  , und+  , (>-)+  , bool+  , int, integer+  , float, double+  , char, string+  , mayb, eith+  -- ** Testing types+  , nat+  , int1, uint1+  , int2, uint2+  , int3, uint3+  , int4, uint4+  )+where++import Test.Types++undefinedOf :: String -> a+undefinedOf fn = error $ "Test.TypeBinding." ++ fn++-- | Type restricted version of const+-- that forces its first argument+-- to have the same type as the second.+-- A symnonym to 'asTypeOf':+--+-- >  value -: ty  =  value :: Ty+--+-- Examples:+--+-- >  10 -: int   =  10 :: Int+-- >  undefined -: 'a' >- 'b'  =  undefined :: Char -> Char+(-:) :: a -> a -> a+(-:) = asTypeOf -- const+infixl 1 -:++-- | Type restricted version of const+-- that forces the argument of its first argument+-- to have the same type as the second:+--+-- >  f -:> ty  =  f -: ty >- und  =  f :: Ty -> a+--+-- Example:+--+-- >  abs -:> int   =  abs -: int >- und  =  abs :: Int -> Int+(-:>) :: (a -> b) -> a -> (a -> b)+(-:>) = const+infixl 1 -:>++-- | Type restricted version of const+-- that forces the result of its first argument+-- to have the same type as the second.+--+-- >  f ->: ty  =  f -: und >- ty  =  f :: a -> Ty+(->:) :: (a -> b) -> b -> (a -> b)+(->:) = const+infixl 1 ->:++-- | Type restricted version of const+-- that forces the second argument of its first argument+-- to have the same type as the second.+--+-- > f ->:> ty   =  f -: und -> ty -> und  =  f :: a -> Ty -> b+(->:>) :: (a -> b -> c) -> b -> (a -> b -> c)+(->:>) = const+infixl 1 ->:>++-- | Type restricted version of const+-- that forces the result of the result of its first argument+-- to have the same type as the second.+--+-- > f ->>: ty   =  f -: und -> und -> ty  =  f :: a -> b -> Ty+(->>:) :: (a -> b -> c) -> c -> (a -> b -> c)+(->>:) = const+infixl 1 ->>:++-- | Type restricted version of const+-- that forces the third argument of its first argument+-- to have the same type as the second.+(->>:>) :: (a -> b -> c -> d) -> c -> (a -> b -> c -> d)+(->>:>) = const+infixl 1 ->>:>++-- | Type restricted version of const+-- that forces the result of the result of the result of its first argument+-- to have the same type as the second.+(->>>:) :: (a -> b -> c -> d) -> d -> (a -> b -> c -> d)+(->>>:) = const+infixl 1 ->>>:++-- | Returns an undefined functional value+-- that takes an argument of the type of its first argument+-- and return a value of the type of its second argument.+--+-- > ty >- ty  =  (undefined :: Ty -> Ty)+--+-- Examples:+--+-- > 'a' >- 'b'  =  char >- char  =  (undefined :: Char -> Char)+-- > int >- bool >- int  =  undefined :: Int -> Bool -> Int+(>-) :: a -> b -> (a -> b)+(>-) = undefinedOf "(>-): undefined function -- using dummy value?"+infixr 9 >-+++-- Dummy values of standard Haskell types++-- | Shorthand for undefined+und :: a+und = undefinedOf "und"++int :: Int+int = undefinedOf "int"++integer :: Integer+integer = undefinedOf "integer"++float :: Float+float = undefinedOf "float"++double :: Double+double = undefinedOf "double"++bool :: Bool+bool = undefinedOf "bool"++char :: Char+char = undefinedOf "char"++string :: String+string = undefinedOf "string"++-- | It might be better to just use 'Just'+mayb :: a -> Maybe a+mayb = undefinedOf "mayb"++eith :: a -> b -> Either a b+eith = undefinedOf "eith"+++-- Dummy values of Test.Types's types:++nat :: Nat+nat = undefinedOf "nat"++int1 :: Int1+int1 = undefinedOf "int1"++int2 :: Int2+int2 = undefinedOf "int2"++int3 :: Int3+int3 = undefinedOf "int3"++int4 :: Int4+int4 = undefinedOf "int4"++uint1 :: UInt1+uint1 = undefinedOf "uint1"++uint2 :: UInt2+uint2 = undefinedOf "uint2"++uint3 :: UInt3+uint3 = undefinedOf "uint3"++uint4 :: UInt4+uint4 = undefinedOf "uint4"

@@ -0,0 +1,438 @@+-- | Types to aid in property-based testing.+module Test.Types+  (+  -- * Integer types+  --+  -- | Small-width integer types to aid in property-based testing.+  -- Sometimes it is useful to limit the possibilities of enumerated values+  -- when testing polymorphic functions, these types allow that.+  --+  -- The signed integer types @IntN@ are of limited bit width @N@+  -- bounded by @-2^(N-1)@ to @2^(N-1)-1@.+  -- The unsigned integer types @WordN@ are of limited bit width @N@+  -- bounded by @0@ to @2^N-1@.+  --+  -- Operations are closed and modulo @2^N@.  e.g.:+  --+  -- > maxBound + 1      = minBound+  -- > read "2"          = -2 :: Int2+  -- > abs minBound      = minBound+  -- > negate n          = 2^N - n :: WordN+    Int1+  , Int2+  , Int3+  , Int4+  , Word1+  , Word2+  , Word3+  , Word4+  , Nat+  , Nat1+  , Nat2+  , Nat3+  , Nat4+  , Nat5+  , Nat6+  , Nat7++  -- * Aliases to word types (deprecated)+  , UInt1+  , UInt2+  , UInt3+  , UInt4+  )+where+-- TODO: Add Ix and Bits instances++import Test.Check (Listable(..), listIntegral)+import Data.Ratio ((%))++narrowU :: Int -> Int -> Int+narrowU w i = i `mod` 2^w++narrowS :: Int -> Int -> Int+narrowS w i = let l  = 2^w+                  i' = i `mod` l+              in if i' < 2^(w-1)+                   then i'+                   else i' - l++mapTuple :: (a -> b) -> (a,a) -> (b,b)+mapTuple f (x,y) = (f x, f y)++mapFst :: (a -> b) -> (a,c) -> (b,c)+mapFst f (x,y) = (f x,y)++oNewtype :: (a -> b) -> (b -> a) -> (a -> a -> a) -> (b -> b -> b)+oNewtype con des o = \x y -> con $ des x `o` des y++fNewtype :: (a -> b) -> (b -> a) -> (a -> a) -> (b -> b)+fNewtype con des f = con . f . des++otNewtype :: (a -> b) -> (b -> a) -> (a -> a -> (a,a)) -> (b -> b -> (b,b))+otNewtype con des o = \x y -> mapTuple con $ des x `o` des y++readsPrecNewtype :: Read a => (a -> b) -> Int -> String -> [(b,String)]+readsPrecNewtype con n = map (mapFst con) . readsPrec n++boundedEnumFrom :: (Ord a,Bounded a,Enum a) => a -> [a]+boundedEnumFrom x = [x..maxBound]++boundedEnumFromThen :: (Ord a,Bounded a,Enum a) => a -> a -> [a]+boundedEnumFromThen x y | x > y     = [x,y..minBound]+                        | otherwise = [x,y..maxBound]++-- | Single-bit signed integers: -1, 0+newtype Int1 = Int1 { unInt1 :: Int } deriving (Eq, Ord)++-- | Two-bit signed integers: -2, -1, 0, 1+newtype Int2 = Int2 { unInt2 :: Int } deriving (Eq, Ord)++-- | Three-bit signed integers: -4, -3, -2, -1, 0, 1, 2, 3+newtype Int3 = Int3 { unInt3 :: Int } deriving (Eq, Ord)++-- | Four-bit signed integers:+-- -8, -7, -6, -5, -4, -3, -2, -1, 0, 1, 2, 3, 4, 5, 6, 7+newtype Int4 = Int4 { unInt4 :: Int } deriving (Eq, Ord)++-- | Single-bit unsigned integer: 0, 1+newtype Word1 = Word1 { unWord1 :: Int } deriving (Eq, Ord)++-- | Two-bit unsigned integers: 0, 1, 2, 3+newtype Word2 = Word2 { unWord2 :: Int } deriving (Eq, Ord)++-- | Three-bit unsigned integers: 0, 1, 2, 3, 4, 5, 6, 7+newtype Word3 = Word3 { unWord3 :: Int } deriving (Eq, Ord)++-- | Four-bit unsigned integers:+-- 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15+newtype Word4 = Word4 { unWord4 :: Int } deriving (Eq, Ord)++-- | Natural numbers (including 0): 0, 1, 2, 3, 4, 5, 6, 7, ...+--+-- Internally, this type is represented as an 'Int'.+-- So, it is limited by the 'maxBound' of 'Int'.+newtype Nat = Nat { unNat :: Int } deriving (Eq, Ord)++-- | Natural numbers modulo 1: 0+newtype Nat1 = Nat1 { unNat1 :: Int } deriving (Eq, Ord)++-- | Natural numbers modulo 2: 0, 1+newtype Nat2 = Nat2 { unNat2 :: Int } deriving (Eq, Ord)++-- | Natural numbers modulo 3: 0, 1, 2+newtype Nat3 = Nat3 { unNat3 :: Int } deriving (Eq, Ord)++-- | Natural numbers modulo 4: 0, 1, 2, 3+newtype Nat4 = Nat4 { unNat4 :: Int } deriving (Eq, Ord)++-- | Natural numbers modulo 5: 0, 1, 2, 3, 4+newtype Nat5 = Nat5 { unNat5 :: Int } deriving (Eq, Ord)++-- | Natural numbers modulo 6: 0, 1, 2, 3, 4, 5+newtype Nat6 = Nat6 { unNat6 :: Int } deriving (Eq, Ord)++-- | Natural numbers modulo 7: 0, 1, 2, 3, 4, 5, 6+newtype Nat7 = Nat7 { unNat7 :: Int } deriving (Eq, Ord)++int1  :: Int -> Int1;   int1  = Int1  . narrowS 1+int2  :: Int -> Int2;   int2  = Int2  . narrowS 2+int3  :: Int -> Int3;   int3  = Int3  . narrowS 3+int4  :: Int -> Int4;   int4  = Int4  . narrowS 4+word1 :: Int -> Word1;  word1 = Word1 . narrowU 1+word2 :: Int -> Word2;  word2 = Word2 . narrowU 2+word3 :: Int -> Word3;  word3 = Word3 . narrowU 3+word4 :: Int -> Word4;  word4 = Word4 . narrowU 4+nat1 :: Int -> Nat1;  nat1 = Nat1 . (`mod` 1)+nat2 :: Int -> Nat2;  nat2 = Nat2 . (`mod` 2)+nat3 :: Int -> Nat3;  nat3 = Nat3 . (`mod` 3)+nat4 :: Int -> Nat4;  nat4 = Nat4 . (`mod` 4)+nat5 :: Int -> Nat5;  nat5 = Nat5 . (`mod` 5)+nat6 :: Int -> Nat6;  nat6 = Nat6 . (`mod` 6)+nat7 :: Int -> Nat7;  nat7 = Nat7 . (`mod` 7)++oInt1  ::(Int->Int->Int)->(Int1->Int1->Int1)   ; oInt1  = oNewtype int1  unInt1+oInt2  ::(Int->Int->Int)->(Int2->Int2->Int2)   ; oInt2  = oNewtype int2  unInt2+oInt3  ::(Int->Int->Int)->(Int3->Int3->Int3)   ; oInt3  = oNewtype int3  unInt3+oInt4  ::(Int->Int->Int)->(Int4->Int4->Int4)   ; oInt4  = oNewtype int4  unInt4+oWord1 ::(Int->Int->Int)->(Word1->Word1->Word1); oWord1 = oNewtype word1 unWord1+oWord2 ::(Int->Int->Int)->(Word2->Word2->Word2); oWord2 = oNewtype word2 unWord2+oWord3 ::(Int->Int->Int)->(Word3->Word3->Word3); oWord3 = oNewtype word3 unWord3+oWord4 ::(Int->Int->Int)->(Word4->Word4->Word4); oWord4 = oNewtype word4 unWord4+oNat   ::(Int->Int->Int)->(Nat->Nat->Nat)      ; oNat   = oNewtype Nat   unNat+oNat1  ::(Int->Int->Int)->(Nat1->Nat1->Nat1)   ; oNat1  = oNewtype nat1  unNat1+oNat2  ::(Int->Int->Int)->(Nat2->Nat2->Nat2)   ; oNat2  = oNewtype nat2  unNat2+oNat3  ::(Int->Int->Int)->(Nat3->Nat3->Nat3)   ; oNat3  = oNewtype nat3  unNat3+oNat4  ::(Int->Int->Int)->(Nat4->Nat4->Nat4)   ; oNat4  = oNewtype nat4  unNat4+oNat5  ::(Int->Int->Int)->(Nat5->Nat5->Nat5)   ; oNat5  = oNewtype nat5  unNat5+oNat6  ::(Int->Int->Int)->(Nat6->Nat6->Nat6)   ; oNat6  = oNewtype nat6  unNat6+oNat7  ::(Int->Int->Int)->(Nat7->Nat7->Nat7)   ; oNat7  = oNewtype nat7  unNat7++fInt1  :: (Int->Int) -> (Int1->Int1)   ; fInt1  = fNewtype int1  unInt1+fInt2  :: (Int->Int) -> (Int2->Int2)   ; fInt2  = fNewtype int2  unInt2+fInt3  :: (Int->Int) -> (Int3->Int3)   ; fInt3  = fNewtype int3  unInt3+fInt4  :: (Int->Int) -> (Int4->Int4)   ; fInt4  = fNewtype int4  unInt4+fWord1 :: (Int->Int) -> (Word1->Word1) ; fWord1 = fNewtype word1 unWord1+fWord2 :: (Int->Int) -> (Word2->Word2) ; fWord2 = fNewtype word2 unWord2+fWord3 :: (Int->Int) -> (Word3->Word3) ; fWord3 = fNewtype word3 unWord3+fWord4 :: (Int->Int) -> (Word4->Word4) ; fWord4 = fNewtype word4 unWord4+fNat   :: (Int->Int) -> (Nat->Nat)     ; fNat   = fNewtype Nat   unNat+fNat1  :: (Int->Int) -> (Nat1->Nat1)   ; fNat1  = fNewtype nat1  unNat1+fNat2  :: (Int->Int) -> (Nat2->Nat2)   ; fNat2  = fNewtype nat2  unNat2+fNat3  :: (Int->Int) -> (Nat3->Nat3)   ; fNat3  = fNewtype nat3  unNat3+fNat4  :: (Int->Int) -> (Nat4->Nat4)   ; fNat4  = fNewtype nat4  unNat4+fNat5  :: (Int->Int) -> (Nat5->Nat5)   ; fNat5  = fNewtype nat5  unNat5+fNat6  :: (Int->Int) -> (Nat6->Nat6)   ; fNat6  = fNewtype nat6  unNat6+fNat7  :: (Int->Int) -> (Nat7->Nat7)   ; fNat7  = fNewtype nat7  unNat7++instance Show Int1 where show = show . unInt1+instance Show Int2 where show = show . unInt2+instance Show Int3 where show = show . unInt3+instance Show Int4 where show = show . unInt4+instance Show Word1 where show = show . unWord1+instance Show Word2 where show = show . unWord2+instance Show Word3 where show = show . unWord3+instance Show Word4 where show = show . unWord4+instance Show Nat where show (Nat x) = show x+instance Show Nat1 where show = show . unNat1+instance Show Nat2 where show = show . unNat2+instance Show Nat3 where show = show . unNat3+instance Show Nat4 where show = show . unNat4+instance Show Nat5 where show = show . unNat5+instance Show Nat6 where show = show . unNat6+instance Show Nat7 where show = show . unNat7++instance Read Int1 where readsPrec = readsPrecNewtype int1+instance Read Int2 where readsPrec = readsPrecNewtype int2+instance Read Int3 where readsPrec = readsPrecNewtype int3+instance Read Int4 where readsPrec = readsPrecNewtype int4+instance Read Word1 where readsPrec = readsPrecNewtype word1+instance Read Word2 where readsPrec = readsPrecNewtype word2+instance Read Word3 where readsPrec = readsPrecNewtype word3+instance Read Word4 where readsPrec = readsPrecNewtype word4+instance Read Nat where readsPrec = readsPrecNewtype Nat+instance Read Nat1 where readsPrec = readsPrecNewtype nat1+instance Read Nat2 where readsPrec = readsPrecNewtype nat2+instance Read Nat3 where readsPrec = readsPrecNewtype nat3+instance Read Nat4 where readsPrec = readsPrecNewtype nat4+instance Read Nat5 where readsPrec = readsPrecNewtype nat5+instance Read Nat6 where readsPrec = readsPrecNewtype nat6+instance Read Nat7 where readsPrec = readsPrecNewtype nat7+++instance Num Int1 where (+) = oInt1 (+);  abs    = fInt1 abs+                        (-) = oInt1 (-);  signum = fInt1 signum+                        (*) = oInt1 (*);  fromInteger = int1 . fromInteger++instance Num Int2 where (+) = oInt2 (+);  abs    = fInt2 abs+                        (-) = oInt2 (-);  signum = fInt2 signum+                        (*) = oInt2 (*);  fromInteger = int2 . fromInteger++instance Num Int3 where (+) = oInt3 (+);  abs    = fInt3 abs+                        (-) = oInt3 (-);  signum = fInt3 signum+                        (*) = oInt3 (*);  fromInteger = int3 . fromInteger++instance Num Int4 where (+) = oInt4 (+);  abs    = fInt4 abs+                        (-) = oInt4 (-);  signum = fInt4 signum+                        (*) = oInt4 (*);  fromInteger = int4 . fromInteger++instance Num Word1 where (+) = oWord1 (+);  abs    = fWord1 abs+                         (-) = oWord1 (-);  signum = fWord1 signum+                         (*) = oWord1 (*);  fromInteger = word1 . fromInteger++instance Num Word2 where (+) = oWord2 (+);  abs    = fWord2 abs+                         (-) = oWord2 (-);  signum = fWord2 signum+                         (*) = oWord2 (*);  fromInteger = word2 . fromInteger++instance Num Word3 where (+) = oWord3 (+);  abs    = fWord3 abs+                         (-) = oWord3 (-);  signum = fWord3 signum+                         (*) = oWord3 (*);  fromInteger = word3 . fromInteger++instance Num Word4 where (+) = oWord4 (+);  abs    = fWord4 abs+                         (-) = oWord4 (-);  signum = fWord4 signum+                         (*) = oWord4 (*);  fromInteger = word4 . fromInteger++instance Num Nat where (+) = oNat (+);  abs    = fNat abs+                       (-) = oNat (-);  signum = fNat signum+                       (*) = oNat (*);  fromInteger = Nat . fromInteger++instance Num Nat1 where (+) = oNat1 (+);  abs    = fNat1 abs+                        (-) = oNat1 (-);  signum = fNat1 signum+                        (*) = oNat1 (*);  fromInteger = nat1 . fromInteger++instance Num Nat2 where (+) = oNat2 (+);  abs    = fNat2 abs+                        (-) = oNat2 (-);  signum = fNat2 signum+                        (*) = oNat2 (*);  fromInteger = nat2 . fromInteger++instance Num Nat3 where (+) = oNat3 (+);  abs    = fNat3 abs+                        (-) = oNat3 (-);  signum = fNat3 signum+                        (*) = oNat3 (*);  fromInteger = nat3 . fromInteger++instance Num Nat4 where (+) = oNat4 (+);  abs    = fNat4 abs+                        (-) = oNat4 (-);  signum = fNat4 signum+                        (*) = oNat4 (*);  fromInteger = nat4 . fromInteger++instance Num Nat5 where (+) = oNat5 (+);  abs    = fNat5 abs+                        (-) = oNat5 (-);  signum = fNat5 signum+                        (*) = oNat5 (*);  fromInteger = nat5 . fromInteger++instance Num Nat6 where (+) = oNat6 (+);  abs    = fNat6 abs+                        (-) = oNat6 (-);  signum = fNat6 signum+                        (*) = oNat6 (*);  fromInteger = nat6 . fromInteger++instance Num Nat7 where (+) = oNat7 (+);  abs    = fNat7 abs+                        (-) = oNat7 (-);  signum = fNat7 signum+                        (*) = oNat7 (*);  fromInteger = nat7 . fromInteger+++instance Real Int1 where toRational (Int1 x) = fromIntegral x % 1+instance Real Int2 where toRational (Int2 x) = fromIntegral x % 1+instance Real Int3 where toRational (Int3 x) = fromIntegral x % 1+instance Real Int4 where toRational (Int4 x) = fromIntegral x % 1+instance Real Word1 where toRational (Word1 x) = fromIntegral x % 1+instance Real Word2 where toRational (Word2 x) = fromIntegral x % 1+instance Real Word3 where toRational (Word3 x) = fromIntegral x % 1+instance Real Word4 where toRational (Word4 x) = fromIntegral x % 1+instance Real Nat where toRational (Nat x) = fromIntegral x % 1+instance Real Nat1 where toRational (Nat1 x) = fromIntegral x % 1+instance Real Nat2 where toRational (Nat2 x) = fromIntegral x % 1+instance Real Nat3 where toRational (Nat3 x) = fromIntegral x % 1+instance Real Nat4 where toRational (Nat4 x) = fromIntegral x % 1+instance Real Nat5 where toRational (Nat5 x) = fromIntegral x % 1+instance Real Nat6 where toRational (Nat6 x) = fromIntegral x % 1+instance Real Nat7 where toRational (Nat7 x) = fromIntegral x % 1++instance Integral Int1 where quotRem = otNewtype int1 unInt1 quotRem+                             toInteger = toInteger . unInt1++instance Integral Int2 where quotRem = otNewtype int2 unInt2 quotRem+                             toInteger = toInteger . unInt2++instance Integral Int3 where quotRem = otNewtype int3 unInt3 quotRem+                             toInteger = toInteger . unInt3++instance Integral Int4 where quotRem = otNewtype int4 unInt4 quotRem+                             toInteger = toInteger . unInt4++instance Integral Word1 where quotRem = otNewtype word1 unWord1 quotRem+                              toInteger = toInteger . unWord1++instance Integral Word2 where quotRem = otNewtype word2 unWord2 quotRem+                              toInteger = toInteger . unWord2++instance Integral Word3 where quotRem = otNewtype word3 unWord3 quotRem+                              toInteger = toInteger . unWord3++instance Integral Word4 where quotRem = otNewtype word4 unWord4 quotRem+                              toInteger = toInteger . unWord4++instance Integral Nat where quotRem = otNewtype Nat unNat quotRem+                            toInteger = toInteger . unNat++instance Integral Nat1 where quotRem = otNewtype nat1 unNat1 quotRem+                             toInteger = toInteger . unNat1++instance Integral Nat2 where quotRem = otNewtype nat2 unNat2 quotRem+                             toInteger = toInteger . unNat2++instance Integral Nat3 where quotRem = otNewtype nat3 unNat3 quotRem+                             toInteger = toInteger . unNat3++instance Integral Nat4 where quotRem = otNewtype nat4 unNat4 quotRem+                             toInteger = toInteger . unNat4++instance Integral Nat5 where quotRem = otNewtype nat5 unNat5 quotRem+                             toInteger = toInteger . unNat5++instance Integral Nat6 where quotRem = otNewtype nat6 unNat6 quotRem+                             toInteger = toInteger . unNat6++instance Integral Nat7 where quotRem = otNewtype nat7 unNat7 quotRem+                             toInteger = toInteger . unNat7++instance Bounded Int1 where maxBound = Int1 0; minBound = Int1 (-1)+instance Bounded Int2 where maxBound = Int2 1; minBound = Int2 (-2)+instance Bounded Int3 where maxBound = Int3 3; minBound = Int3 (-4)+instance Bounded Int4 where maxBound = Int4 7; minBound = Int4 (-8)+instance Bounded Word1 where maxBound = Word1 1; minBound = Word1 0+instance Bounded Word2 where maxBound = Word2 3; minBound = Word2 0+instance Bounded Word3 where maxBound = Word3 7; minBound = Word3 0+instance Bounded Word4 where maxBound = Word4 15; minBound = Word4 0+instance Bounded Nat1 where maxBound = Nat1 0; minBound = Nat1 0+instance Bounded Nat2 where maxBound = Nat2 1; minBound = Nat2 0+instance Bounded Nat3 where maxBound = Nat3 2; minBound = Nat3 0+instance Bounded Nat4 where maxBound = Nat4 3; minBound = Nat4 0+instance Bounded Nat5 where maxBound = Nat5 4; minBound = Nat5 0+instance Bounded Nat6 where maxBound = Nat6 5; minBound = Nat6 0+instance Bounded Nat7 where maxBound = Nat7 6; minBound = Nat7 0++instance Enum Int1 where toEnum   = int1;   enumFrom     = boundedEnumFrom+                         fromEnum = unInt1; enumFromThen = boundedEnumFromThen++instance Enum Int2 where toEnum   = int2;   enumFrom     = boundedEnumFrom+                         fromEnum = unInt2; enumFromThen = boundedEnumFromThen++instance Enum Int3 where toEnum   = int3;   enumFrom     = boundedEnumFrom+                         fromEnum = unInt3; enumFromThen = boundedEnumFromThen++instance Enum Int4 where toEnum   = int4;   enumFrom     = boundedEnumFrom+                         fromEnum = unInt4; enumFromThen = boundedEnumFromThen++instance Enum Word1 where toEnum   = word1;   enumFrom     = boundedEnumFrom+                          fromEnum = unWord1; enumFromThen = boundedEnumFromThen++instance Enum Word2 where toEnum   = word2;   enumFrom     = boundedEnumFrom+                          fromEnum = unWord2; enumFromThen = boundedEnumFromThen++instance Enum Word3 where toEnum   = word3;   enumFrom     = boundedEnumFrom+                          fromEnum = unWord3; enumFromThen = boundedEnumFromThen++instance Enum Word4 where toEnum   = word4;   enumFrom     = boundedEnumFrom+                          fromEnum = unWord4; enumFromThen = boundedEnumFromThen++instance Enum Nat where+  toEnum   = Nat;    enumFrom     (Nat x)         = map Nat [x..]+  fromEnum = unNat;  enumFromThen (Nat x) (Nat s) = map Nat [x,s..]++instance Enum Nat1 where toEnum   = nat1;   enumFrom     = boundedEnumFrom+                         fromEnum = unNat1; enumFromThen = boundedEnumFromThen++instance Enum Nat2 where toEnum   = nat2;   enumFrom     = boundedEnumFrom+                         fromEnum = unNat2; enumFromThen = boundedEnumFromThen++instance Enum Nat3 where toEnum   = nat3;   enumFrom     = boundedEnumFrom+                         fromEnum = unNat3; enumFromThen = boundedEnumFromThen++instance Enum Nat4 where toEnum   = nat4;   enumFrom     = boundedEnumFrom+                         fromEnum = unNat4; enumFromThen = boundedEnumFromThen++instance Enum Nat5 where toEnum   = nat5;   enumFrom     = boundedEnumFrom+                         fromEnum = unNat5; enumFromThen = boundedEnumFromThen++instance Enum Nat6 where toEnum   = nat6;   enumFrom     = boundedEnumFrom+                         fromEnum = unNat6; enumFromThen = boundedEnumFromThen++instance Enum Nat7 where toEnum   = nat7;   enumFrom     = boundedEnumFrom+                         fromEnum = unNat7; enumFromThen = boundedEnumFromThen++instance Listable Int1 where list = [0,minBound]+instance Listable Int2 where list = listIntegral+instance Listable Int3 where list = listIntegral+instance Listable Int4 where list = listIntegral+instance Listable Word1 where list = [0..]+instance Listable Word2 where list = [0..]+instance Listable Word3 where list = [0..]+instance Listable Word4 where list = [0..]+instance Listable Nat where list = [0..]+instance Listable Nat1 where list = [0..]+instance Listable Nat2 where list = [0..]+instance Listable Nat3 where list = [0..]+instance Listable Nat4 where list = [0..]+instance Listable Nat5 where list = [0..]+instance Listable Nat6 where list = [0..]+instance Listable Nat7 where list = [0..]++type UInt1 = Word1+type UInt2 = Word2+type UInt3 = Word3+type UInt4 = Word4

@@ -0,0 +1,121 @@+-- LeanCheck+--+-- Template Haskell dependency is optional.  To deactivate it:+-- 1. In this file, comment out:+--   Test.Check.Derive+--   template-haskell+--   and the test-suite derive+-- 2. On Test.Most, comment out the Test.Check.Derive module+-- 3. On Test.Check, comment out Test.Check.Derive and deriveListable+--+-- I could ultimately add a flag to deactivate that, but I do not want to make+-- this cabal file too complicated.  -- Rudy++name:                leancheck+version:             0.3.0+synopsis:            Cholesterol-free property-based testing+description:+  LeanCheck is a simple enumerative property-based testing library.+  .+  It works by producing *tiers* of test values,+  which are essentially (possibly infinite) lists+  of finite lists of same-and-increasingly-sized values.+  .+  LeanCheck has "lean" core with only 180 lines of Haskell code+  but provides a selection of utilitites for property testing:+  test types (@Nat@, @Nat\<1-7\>@, @Word\<1-4\>@, @Int\<1-4\>@);+  test operators (@==>@, @===@, @&&&@, @|||@);+  type binding operators.+  .+  LeanCheck API is likely to change in the near future.++homepage:            https://github.com/rudymatela/leancheck#readme+license:             BSD3+license-file:        LICENSE+author:              Rudy Matela <rudy@matela.com.br>+maintainer:          Rudy Matela <rudy@matela.com.br>+category:            Testing+build-type:          Simple+cabal-version:       >=1.10++extra-source-files:  README.md, CREDITS.md++source-repository head+  type:            git+  location:        https://github.com/rudymatela/leancheck++source-repository this+  type:            git+  location:        https://github.com/rudymatela/leancheck+  tag:             v0.3.0++library+  exposed-modules: Test.Check+                 , Test.Check.Utils+                 , Test.Check.Basic+                 , Test.Check.Core+                 , Test.Check.Derive+                 , Test.Check.Error+                 , Test.Check.IO+                 , Test.Types+                 , Test.Operators+                 , Test.TypeBinding+                 , Test.Most+                 , Test.Check.Function+                 , Test.Check.Function.ListsOfPairs+                 , Test.Check.Function.CoListable+                 , Test.Check.Function.Periodic+                 , Test.Check.Function.Show+                 , Test.Check.ShowFunction+  other-modules:       Test.Check.Invariants+  build-depends:       base >= 4 && < 5, template-haskell+  default-language:    Haskell2010++test-suite test+  type:                exitcode-stdio-1.0+  main-is:             test.hs+  hs-source-dirs:      ., tests+  build-depends:       base >= 4 && < 5, template-haskell+  default-language:    Haskell2010++test-suite types+  type:                exitcode-stdio-1.0+  main-is:             test-types.hs+  hs-source-dirs:      ., tests+  build-depends:       base >= 4 && < 5, template-haskell+  default-language:    Haskell2010++test-suite utils+  type:                exitcode-stdio-1.0+  main-is:             test-utils.hs+  hs-source-dirs:      ., tests+  build-depends:       base >= 4 && < 5, template-haskell+  default-language:    Haskell2010++test-suite operators+  type:                exitcode-stdio-1.0+  main-is:             test-operators.hs+  hs-source-dirs:      ., tests+  build-depends:       base >= 4 && < 5, template-haskell+  default-language:    Haskell2010++test-suite most+  type:                exitcode-stdio-1.0+  main-is:             test-most.hs+  hs-source-dirs:      ., tests+  build-depends:       base >= 4 && < 5, template-haskell+  default-language:    Haskell2010++test-suite derive+  type:                exitcode-stdio-1.0+  main-is:             test-most.hs+  hs-source-dirs:      ., tests+  build-depends:       base >= 4 && < 5, template-haskell+  default-language:    Haskell2010++test-suite error+  type:                exitcode-stdio-1.0+  main-is:             test-error.hs+  hs-source-dirs:      ., tests+  build-depends:       base >= 4 && < 5, template-haskell+  default-language:    Haskell2010

@@ -0,0 +1,60 @@+import System.Exit (exitFailure)+import Data.List (elemIndices,sort)++import Test.Check.Error+import Test.Types (Nat)+import Data.List (sort)++main :: IO ()+main =+  case elemIndices False (tests 100) of+    [] -> putStrLn "Tests passed!"+    is -> do putStrLn ("Failed tests:" ++ show is)+             exitFailure++tests n =+  [ True++  , not $ holds     n prop_sortMinE+  , fails           n prop_sortMinE+  , counterExample  n prop_sortMinE == Just ["[]"]+  , counterExamples n prop_sortMinE == [["[]"]]++  , holds           n prop_sortMin+  , not $ fails     n prop_sortMin+  , counterExample  n prop_sortMin == Nothing+  , counterExamples n prop_sortMin == []++  , exists          n someNumbers+  , witness         n someNumbers == Just ["2"]+  , witnesses       n someNumbers == map ((:[]).show) [2,3,5,7,11,13,17]++  , exists          n someOthers+  , witness         n someOthers == Just ["2","2"]+  , witnesses (100*n) someOthers == (map.map) show [[2,2],[2,4],[3,3]+                                                   ,[2,8],[3,9],[3,27]]+  ]++prop_sortMinE :: [Nat] -> Bool+prop_sortMinE xs = head (sort xs) == minimum (xs::[Nat])++prop_sortMin :: [Nat] -> Bool+prop_sortMin xs = not (null xs)+              ==> head (sort xs) == minimum (xs::[Nat])++someNumbers :: Int -> Bool+someNumbers  2 = True+someNumbers  3 = True+someNumbers  5 = True+someNumbers  7 = True+someNumbers 11 = True+someNumbers 13 = True+someNumbers 17 = True++someOthers :: Int -> Int -> Bool+someOthers = \x -> case x of 2 -> \y -> case y of 2 -> True+                                                  4 -> True+                                                  8 -> True+                             3 -> \y -> case y of 3 -> True+                                                  9 -> True+                                                  27 -> True

@@ -0,0 +1,34 @@+-- Simple file just to test if everything is imported fine+import System.Exit (exitFailure)+import Data.List (elemIndices)++import Test.Most+import Test.Check.Invariants (strictlyOrdered)++main :: IO ()+main =+  case elemIndices False tests of+    [] -> putStrLn "Tests passed!"+    is -> do putStrLn ("Failed tests:" ++ show is)+             exitFailure++tests =+  [ True++  -- Test.Check+  , holds 1 True++  -- Test.Check.Utils+  , checkCrescent 1++  -- Test.Types+  , [minBound..maxBound :: UInt1] == [0,1]++  -- Test.Operators+  , holds 1 $ (not . not) === id+  ]++checkCrescent :: Int -> Bool+checkCrescent n = strictlyAscendingListsOf (tiers :: [[Nat]])+          =| n |= (map . filter) strictlyOrdered (tiers :: [[[Nat]]])+

@@ -0,0 +1,72 @@+import System.Exit (exitFailure)+import Data.List (elemIndices,sort)+import Test.Check+import Test.Operators+import Test.TypeBinding+++main :: IO ()+main =+  case elemIndices False (tests 100) of+    [] -> putStrLn "Tests passed!"+    is -> do putStrLn ("Failed tests:" ++ show is)+             exitFailure++tests :: Int -> [Bool]+tests n =+  [ True++  , holds n $ (not . not) === id+  , fails n $ abs === (* (-1))             -:> int+  , holds n $ (+) ==== (\x y -> sum [x,y]) -:> int+  , fails n $ (+) ==== (*)                 -:> int++  , holds n $ const True  &&& const True  -:> bool+  , fails n $ const False &&& const True  -:> int+  , holds n $ const False ||| const True  -:> int+  , fails n $ const False ||| const False -:> int++  , holds n $ commutative (+)  -:> int+  , holds n $ commutative (*)  -:> int+  , holds n $ commutative (++) -:> [()]+  , holds n $ commutative (&&)+  , holds n $ commutative (||)+  , fails n $ commutative (-)  -:> int+  , fails n $ commutative (++) -:> [bool]+  , fails n $ commutative (==>)++  , holds n $ associative (+)  -:> int+  , holds n $ associative (*)  -:> int+  , holds n $ associative (++) -:> [int]+  , holds n $ associative (&&)+  , holds n $ associative (||)+  , fails n $ associative (-)  -:> int+  , fails n $ associative (==>)++  , holds n $ distributive (*) (+) -:> int+  , fails n $ distributive (+) (*) -:> int++  , holds n $ transitive (==) -:> bool+  , holds n $ transitive (<)  -:> bool+  , holds n $ transitive (<=) -:> bool+  , fails n $ transitive (/=) -:> bool+  , holds n $ transitive (==) -:> int+  , holds n $ transitive (<)  -:> int+  , holds n $ transitive (<=) -:> int+  , fails n $ transitive (/=) -:> int++  , holds n $ idempotent id   -:> int+  , holds n $ idempotent abs  -:> int+  , holds n $ idempotent sort -:> [bool]+  , fails n $ idempotent not++  , holds n $ identity id   -:> int+  , holds n $ identity (+0) -:> int+  , holds n $ identity sort -:> [()]+  , holds n $ identity (not . not)+  , fails n $ identity not++  , holds n $ notIdentity not+  , fails n $ notIdentity abs    -:> int+  , fails n $ notIdentity negate -:> int+  ]

@@ -0,0 +1,72 @@+import System.Exit (exitFailure)+import Data.List (elemIndices,delete)+import Test.Types+import Test.Check (list,fails)++main :: IO ()+main =+  case elemIndices False tests of+    [] -> putStrLn "Tests passed!"+    is -> do putStrLn ("Failed tests:" ++ show is)+             exitFailure+++-- | Given the number of bits, generates a range for signed/unsigned integers+--   of that width.+signedRange,unsignedRange :: (Num n) => Int -> [n]+signedRange n   = map fromIntegral [-(2^(n-1))..(2^(n-1))-1]+unsignedRange n = map fromIntegral [0..(2^n)-1]+++tests =+  [ True+++  , list `permutation` [minBound..maxBound :: Int1]+  , list `permutation` [minBound..maxBound :: Int2]+  , list `permutation` [minBound..maxBound :: Int3]+  , list `permutation` [minBound..maxBound :: Int4]++  , list `permutation` [minBound..maxBound :: UInt1]+  , list `permutation` [minBound..maxBound :: UInt2]+  , list `permutation` [minBound..maxBound :: UInt3]+  , list `permutation` [minBound..maxBound :: UInt4]++  , list `permutation` [minBound..maxBound :: Nat1]+  , list `permutation` [minBound..maxBound :: Nat2]+  , list `permutation` [minBound..maxBound :: Nat3]+  , list `permutation` [minBound..maxBound :: Nat4]+  , list `permutation` [minBound..maxBound :: Nat5]+  , list `permutation` [minBound..maxBound :: Nat6]+  , list `permutation` [minBound..maxBound :: Nat7]++  , [minBound..maxBound :: Int1] == signedRange 1+  , [minBound..maxBound :: Int2] == signedRange 2+  , [minBound..maxBound :: Int3] == signedRange 3+  , [minBound..maxBound :: Int4] == signedRange 4++  , [minBound..maxBound :: UInt1] == unsignedRange 1+  , [minBound..maxBound :: UInt2] == unsignedRange 2+  , [minBound..maxBound :: UInt3] == unsignedRange 3+  , [minBound..maxBound :: UInt4] == unsignedRange 4+++  -- abs minBound == minBound+  , fails 100 (\i -> abs i > (0::Int1))+  , fails 100 (\i -> abs i > (0::Int2))+  , fails 100 (\i -> abs i > (0::Int3))+  , fails 100 (\i -> abs i > (0::Int4))++  -- maxBound + 1 == minBound+  , fails 100 (\i -> i + 1 < (i::Int1))+  , fails 100 (\i -> i + 1 < (i::Int2))+  , fails 100 (\i -> i + 1 < (i::Int3))+  , fails 100 (\i -> i + 1 < (i::Int4))+  ]+++permutation :: Eq a => [a] -> [a] -> Bool+[]     `permutation` []    = True+(_:_)  `permutation` []    = False+[]     `permutation` (_:_) = False+(x:xs) `permutation` ys    = x `elem` ys  &&  xs `permutation` delete x ys

@@ -0,0 +1,68 @@+import System.Exit (exitFailure)+import Data.List (elemIndices, sort, nub, delete)++import Test.Check+import Test.Check.Invariants+import Test.Operators+import Test.TypeBinding+import Test.Types (Nat)+++main :: IO ()+main =+  case elemIndices False tests of+    [] -> putStrLn "Tests passed!"+    is -> do putStrLn ("Failed tests:" ++ show is)+             exitFailure++tests =+  [ True++  , checkNoDup 12+  , checkAscending 18+  , checkStrictlyAscending 20+  , checkLengthListingsOfLength 5 5+  , checkSizesListingsOfLength 5 5++  , productMaybeWith ($) [[const Nothing, Just]] [[1],[2],[3],[4]] == [[1],[2],[3],[4]]+  , productMaybeWith (flip ($))+                     [[1],[2],[3],[4]]+                     [[const Nothing],[Just]] == [[],[1],[2],[3],[4]]++  , holds 100 $ deleteT_is_map_delete 10 -:> nat+  , holds 100 $ deleteT_is_map_delete 10 -:> int+  , holds 100 $ deleteT_is_map_delete 10 -:> bool+  , holds 100 $ deleteT_is_map_delete 10 -:> int2+  ]++deleteT_is_map_delete :: (Eq a, Listable a) => Int -> a -> Bool+deleteT_is_map_delete n x = deleteT x tiers+                    =| n |= normalizeT (map (delete x) tiers)++checkNoDup :: Int -> Bool+checkNoDup n = noDupListsOf (tiers :: [[Int]])+       =| n |= tiers `suchThat` noDup+  where noDup xs = nub (sort xs) == sort xs++checkAscending :: Int -> Bool+checkAscending n = ascendingListsOf (tiers :: [[Nat]])+           =| n |= tiers `suchThat` ordered++checkStrictlyAscending :: Int -> Bool+checkStrictlyAscending n = setsOf (tiers :: [[Nat]])+                   =| n |= tiers `suchThat` strictlyOrdered++checkLengthListingsOfLength :: Int -> Int -> Bool+checkLengthListingsOfLength n m = all check [1..m]+  where check m = all (\xs -> length xs == m)+                $ concat . take n+                $ listsOfLength m natTiers++checkSizesListingsOfLength :: Int -> Int -> Bool+checkSizesListingsOfLength n m = all check [1..m]+  where check m = orderedBy compare+                $ map sum . concat . take n+                $ listsOfLength m natTiers++natTiers :: [[Nat]]+natTiers = tiers

@@ -0,0 +1,84 @@+import System.Exit (exitFailure)+import Data.List (elemIndices)++import Test.Check+import Test.Check.Invariants+import Test.Types (Nat)+import Test.Operators+import Test.TypeBinding++main :: IO ()+main =+  case elemIndices False tests of+    [] -> putStrLn "Tests passed!"+    is -> do putStrLn ("Failed tests:" ++ show is)+             exitFailure++tests =+  [ True++  -- interleave+  , [1,2,3] +| [0,0,0] == [1,0,2,0,3,0]+  , take 3 ([1,2] +| (0:undefined)) == [1,0,2]+  , [0,2..] +| [1,3..] =| 100 |= [0,1..]++  -- etc+  , tNatPairOrd 100+  , tNatTripleOrd 200+  , tNatQuadrupleOrd 300+  , tNatQuintupleOrd 400+  , tNatSixtupleOrd 500+  , tNatListOrd 500+  , tListsOfNatOrd 500+  , listsOf (tiers::[[Nat]]) =| 10 |= tiers++  -- tests!+  , counterExample 10 (\x y -> x + y /= (x::Int)) == Just ["0", "0"]+  , counterExample 10 (\x y -> x + y == (x::Int)) == Just ["0", "1"]+  , counterExample 10 (maybe True (==(0::Int))) == Just ["(Just 1)"]+  , holds 100 (\x -> x == (x::Int))++  -- For when NaN is in the enumeration (by default, it is not):+  --, fails 100 (\x -> x == (x::Float))  -- NaN != NaN  :-)+  --, counterExample 100 (\x -> x == (x::Float)) == Just ["NaN"]+  , counterExample 10 (\x y -> x + y == (x::Float))  == Just ["0.0","1.0"]+  , counterExample 10 (\x y -> x + y == (x::Double)) == Just ["0.0","1.0"]+  , holds          50 (\x -> x + 1 /= (x::Int))+  , counterExample 50 (\x -> x + 1 /= (x::Float))  == Just ["Infinity"]+  , counterExample 50 (\x -> x + 1 /= (x::Double)) == Just ["Infinity"]+  , allUnique (take 100 list :: [Float])+  , allUnique (take 500 list :: [Double])++  , tPairEqParams 100+  , tTripleEqParams 100++  , tProductsIsFilterByLength (tiers :: [[ Nat ]])   10 `all` [1..10]+  , tProductsIsFilterByLength (tiers :: [[ Bool ]])   6 `all` [1..10]+  , tProductsIsFilterByLength (tiers :: [[ [Nat] ]])  6 `all` [1..10]++  , holds 100 $  (\/)  ==== zipWith' (++) [] [] -:> [[uint2]]+  , holds 100 $  (\/)  ==== zipWith' (++) [] [] -:> [[bool]]+  , holds 100 $ (\\//) ==== zipWith' (+|) [] [] -:> [[uint2]]+  , holds 100 $ (\\//) ==== zipWith' (+|) [] [] -:> [[bool]]+  ]++allUnique :: Ord a => [a] -> Bool+allUnique [] = True+allUnique (x:xs) = x `notElem` xs+                && allUnique (filter (< x) xs)+                && allUnique (filter (> x) xs)+++-- | 'zipwith\'' works similarly to 'zipWith', but takes neutral elements to+--   operate when one of the lists is exhausted, so, you don't loose elements.+--+-- > zipWith' f z e [x,y] [a,b,c,d] == [f x a, f y b, f z c, f z d]+--+-- > zipWith' f z e [x,y,z] [a] == [f x a, f y e, f z e]+--+-- > zipWith' (+) 0 0 [1,2,3] [1,2,3,4,5,6] == [2,4,6,4,5,6]+zipWith' :: (a->b->c) -> a -> b  -> [a] -> [b] -> [c]+zipWith' _ _  _  []     [] = []+zipWith' f _  zy xs     [] = map (`f` zy) xs+zipWith' f zx _  []     ys = map (f zx) ys+zipWith' f zx zy (x:xs) (y:ys) = f x y : zipWith' f zx zy xs ys