packages feed

leancheck 0.4.1 → 0.5.0

raw patch · 21 files changed

+629/−253 lines, 21 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

- Test.LeanCheck: ascendingListsOf :: [[a]] -> [[[a]]]
- Test.LeanCheck: consFromAscendingList :: Listable a => ([a] -> b) -> [[b]]
- Test.LeanCheck: consFromList :: Listable a => ([a] -> b) -> [[b]]
- Test.LeanCheck: consFromNoDupList :: Listable a => ([a] -> b) -> [[b]]
- Test.LeanCheck: consFromSet :: Listable a => ([a] -> b) -> [[b]]
- Test.LeanCheck: consFromStrictlyAscendingList :: Listable a => ([a] -> b) -> [[b]]
- Test.LeanCheck: strictlyAscendingListsOf :: [[a]] -> [[[a]]]
- Test.LeanCheck.Tiers: ascendingChoices :: [[a]] -> [[(a, [[a]])]]
- Test.LeanCheck.Tiers: ascendingListsOf :: [[a]] -> [[[a]]]
- Test.LeanCheck.Tiers: consFromAscendingList :: Listable a => ([a] -> b) -> [[b]]
- Test.LeanCheck.Tiers: consFromList :: Listable a => ([a] -> b) -> [[b]]
- Test.LeanCheck.Tiers: consFromNoDupList :: Listable a => ([a] -> b) -> [[b]]
- Test.LeanCheck.Tiers: consFromSet :: Listable a => ([a] -> b) -> [[b]]
- Test.LeanCheck.Tiers: consFromStrictlyAscendingList :: Listable a => ([a] -> b) -> [[b]]
- Test.LeanCheck.Tiers: strictlyAscendingChoices :: [[a]] -> [[(a, [[a]])]]
- Test.LeanCheck.Tiers: strictlyAscendingListsOf :: [[a]] -> [[[a]]]
- Test.LeanCheck.Utils.Operators: infix 2 ||||
- Test.LeanCheck.Utils.Operators: infix 3 &&&&
- Test.LeanCheck.Utils.Operators: notIdentity :: Eq a => (a -> a) -> a -> Bool
+ Test.LeanCheck: bagCons :: Listable a => ([a] -> b) -> [[b]]
+ Test.LeanCheck: bagsOf :: [[a]] -> [[[a]]]
+ Test.LeanCheck: noDupListCons :: Listable a => ([a] -> b) -> [[b]]
+ Test.LeanCheck: setCons :: Listable a => ([a] -> b) -> [[b]]
+ Test.LeanCheck.Tiers: bagChoices :: [[a]] -> [[(a, [[a]])]]
+ Test.LeanCheck.Tiers: bagCons :: Listable a => ([a] -> b) -> [[b]]
+ Test.LeanCheck.Tiers: bagsOf :: [[a]] -> [[[a]]]
+ Test.LeanCheck.Tiers: distinctPairs :: [[a]] -> [[(a, a)]]
+ Test.LeanCheck.Tiers: distinctPairsWith :: (a -> a -> b) -> [[a]] -> [[b]]
+ Test.LeanCheck.Tiers: listCons :: Listable a => ([a] -> b) -> [[b]]
+ Test.LeanCheck.Tiers: noDupListCons :: Listable a => ([a] -> b) -> [[b]]
+ Test.LeanCheck.Tiers: product3 :: [[a]] -> [[b]] -> [[c]] -> [[(a, b, c)]]
+ Test.LeanCheck.Tiers: setChoices :: [[a]] -> [[(a, [[a]])]]
+ Test.LeanCheck.Tiers: setCons :: Listable a => ([a] -> b) -> [[b]]
+ Test.LeanCheck.Tiers: unorderedDistinctPairs :: [[a]] -> [[(a, a)]]
+ Test.LeanCheck.Tiers: unorderedDistinctPairsWith :: (a -> a -> b) -> [[a]] -> [[b]]
+ Test.LeanCheck.Tiers: unorderedPairs :: [[a]] -> [[(a, a)]]
+ Test.LeanCheck.Tiers: unorderedPairsWith :: (a -> a -> b) -> [[a]] -> [[b]]
+ Test.LeanCheck.Utils.Operators: antisymmetric :: Eq a => (a -> a -> Bool) -> a -> a -> Bool
+ Test.LeanCheck.Utils.Operators: asymmetric :: (a -> a -> Bool) -> a -> a -> Bool
+ Test.LeanCheck.Utils.Operators: comparison :: (a -> a -> Ordering) -> a -> a -> a -> Bool
+ Test.LeanCheck.Utils.Operators: equivalence :: (a -> a -> Bool) -> a -> a -> a -> Bool
+ Test.LeanCheck.Utils.Operators: infixr 2 ||||
+ Test.LeanCheck.Utils.Operators: infixr 3 &&&&
+ Test.LeanCheck.Utils.Operators: irreflexive :: (a -> a -> Bool) -> a -> Bool
+ Test.LeanCheck.Utils.Operators: neverIdentity :: Eq a => (a -> a) -> a -> Bool
+ Test.LeanCheck.Utils.Operators: okEq :: Eq a => a -> a -> a -> Bool
+ Test.LeanCheck.Utils.Operators: okEqOrd :: (Eq a, Ord a) => a -> a -> a -> Bool
+ Test.LeanCheck.Utils.Operators: okOrd :: Ord a => a -> a -> a -> Bool
+ Test.LeanCheck.Utils.Operators: partialOrder :: Eq a => (a -> a -> Bool) -> a -> a -> a -> Bool
+ Test.LeanCheck.Utils.Operators: reflexive :: (a -> a -> Bool) -> a -> Bool
+ Test.LeanCheck.Utils.Operators: strictPartialOrder :: (a -> a -> Bool) -> a -> a -> a -> Bool
+ Test.LeanCheck.Utils.Operators: strictTotalOrder :: Eq a => (a -> a -> Bool) -> a -> a -> a -> Bool
+ Test.LeanCheck.Utils.Operators: symmetric :: (a -> a -> Bool) -> a -> a -> Bool
+ Test.LeanCheck.Utils.Operators: symmetric2 :: Eq b => (a -> a -> b) -> (a -> a -> b) -> a -> a -> Bool
+ Test.LeanCheck.Utils.Operators: totalOrder :: Eq a => (a -> a -> Bool) -> a -> a -> a -> Bool

Files

README.md view
@@ -27,7 +27,7 @@ -------------------------------  To check if properties are True,-just use the function `holds :: Testable a => Int -> a -> Bool`.+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),@@ -44,7 +44,7 @@ ------------------------  To find counter examples to properties,-you can use the function `counterExample :: Testable a => Int -> a -> Maybe [String]`.+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).@@ -70,7 +70,7 @@  To "check" properties like in [SmallCheck] and [QuickCheck] automatically printing results on standard output,-you can use the function `check :: Testable a => a -> IO ()`.+you can use the function [`check`] `:: Testable a => a -> IO ()`.  	import Test.LeanCheck 	import Data.List@@ -82,10 +82,10 @@ 	-- > *** 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.+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 user-defined types@@ -105,12 +105,12 @@ 	       \/ cons2 MyConsC 	       \/ cons1 MyConsD -The `tiers` function return a potentially infinite list of finite sub-lists+The [`tiers`] function return a potentially infinite list of finite sub-lists (tiers).  Each successive tier has values of increasing size.  	tiers :: Listable a => [[a]] -For convenience, the function `list` returns a potentially infinite list+For convenience, the function [`list`] returns a potentially infinite list of values of the bound type:  	list :: Listable a => [a]@@ -132,14 +132,24 @@ [LeanCheck's Haddock documentation].  For an introduction to property-based testing-and a step-by-step guide to LeanCheck, see this-[tutorial on property-based testing with LeanCheck].+and a step-by-step guide to LeanCheck, see the+[tutorial on property-based testing with LeanCheck]+(`doc/tutorial.md` in the source repository).  [LeanCheck's Haddock documentation]: https://hackage.haskell.org/package/leancheck/docs/Test-LeanCheck.html-[tutorial on property-based testing with LeanCheck]: doc/tutorial.md-[`Listable`]: https://hackage.haskell.org/package/leancheck/docs/Test-LeanCheck.html#t:Listable+[tutorial on property-based testing with LeanCheck]: https://github.com/rudymatela/leancheck/blob/master/doc/tutorial.md -[property-based testing]: doc/tutorial.md+[`Listable`]:       https://hackage.haskell.org/package/leancheck/docs/Test-LeanCheck.html#t:Listable+[`holds`]:          https://hackage.haskell.org/package/leancheck/docs/Test-LeanCheck.html#v:holds+[`counterExample`]: https://hackage.haskell.org/package/leancheck/docs/Test-LeanCheck.html#v:counterExample+[`check`]:          https://hackage.haskell.org/package/leancheck/docs/Test-LeanCheck.html#v:check+[`checkFor`]:       https://hackage.haskell.org/package/leancheck/docs/Test-LeanCheck.html#v:checkFor+[`checkResult`]:    https://hackage.haskell.org/package/leancheck/docs/Test-LeanCheck.html#v:checkResult+[`checkResultFor`]: https://hackage.haskell.org/package/leancheck/docs/Test-LeanCheck.html#v:checkResultFor+[`tiers`]:          https://hackage.haskell.org/package/leancheck/docs/Test-LeanCheck.html#v:tiers+[`list`]:           https://hackage.haskell.org/package/leancheck/docs/Test-LeanCheck.html#v:list++[property-based testing]: https://github.com/rudymatela/leancheck/blob/master/doc/tutorial.md [Feat]: https://hackage.haskell.org/package/testing-feat [SmallCheck]: https://hackage.haskell.org/package/smallcheck [QuickCheck]: https://hackage.haskell.org/package/QuickCheck
TODO.md view
@@ -4,6 +4,15 @@ List of things to do for LeanCheck.  +misc+----++* improve `mk/haskell.mk`: pass ALLHS and LIBHS instead of HSS+  By making that distinction, haskell.mk will be able to handle Haddock.+  It will also be clearer what each parameter means.+  Note that ALLHS and LIBHS are not (but could be) the final names.++ documentation ------------- @@ -13,21 +22,8 @@  * on data-invariant.md, write missing section; -* update documentation of `T.LC.Function.*`, mark done/stub/experimental modules; -* review Haddock of all public modules--* find a way to fix links on hackage's README rendering-  (absolute links to github?)---v0.4.1---------* rework LeanCheck.Tiers module (simply bagsOf and setsOf);---v0.4.2+v0.6.0 ------  * implement stub `Test.LeanCheck.Function.*` modules;
doc/tutorial.md view
@@ -102,7 +102,7 @@ arguments to the [`check`] function, we get:      $ ghci-	> import Test.Check+	> import Test.LeanCheck      > check (prop_elem :: Int -> [Int] -> Bool)     +++ OK, passed 200 tests.
leancheck.cabal view
@@ -11,7 +11,7 @@ -- this cabal file too complicated.  -- Rudy  name:                leancheck-version:             0.4.1+version:             0.5.0 synopsis:            Cholesterol-free property-based testing description:   LeanCheck is a simple enumerative property-based testing library.@@ -50,7 +50,7 @@ source-repository this   type:            git   location:        https://github.com/rudymatela/leancheck-  tag:             v0.4.1+  tag:             v0.5.0  library   exposed-modules: Test.LeanCheck@@ -89,9 +89,9 @@   build-depends:       base >= 4 && < 5, template-haskell   default-language:    Haskell2010 -test-suite utils+test-suite tiers   type:                exitcode-stdio-1.0-  main-is:             test-utils.hs+  main-is:             test-tiers.hs   hs-source-dirs:      src, tests   build-depends:       base >= 4 && < 5, template-haskell   default-language:    Haskell2010
src/Test/LeanCheck.hs view
@@ -90,12 +90,10 @@   -- ** Automatically deriving Listable instances   , deriveListable -  -- ** Extra constructors-  , consFromList-  , consFromAscendingList-  , consFromStrictlyAscendingList-  , consFromSet-  , consFromNoDupList+  -- ** Specialized constructors of tiers+  , setCons+  , bagCons+  , noDupListCons    -- ** Products of tiers   , product3With@@ -104,8 +102,7 @@   -- * Listing lists   , listsOf   , setsOf-  , ascendingListsOf-  , strictlyAscendingListsOf+  , bagsOf   , noDupListsOf   , products   , listsOfLength
src/Test/LeanCheck/Basic.hs view
@@ -1,10 +1,14 @@--- | Simple property-based testing library based on---   enumeration of values via lists of lists.+-- | LeanCheck is a simple enumerative property-based testing library. ----- This module exports "Test.LeanCheck.Core" functionality along with instances and+-- This module exports "Test.LeanCheck.Core" along with instances and -- functions for further tuple and constructor arities. -- -- For the complete list of functions, see "Test.LeanCheck".+--+-- "Test.LeanCheck" already exports everything from this module.+-- You should only import this if you /only/ want basic functionality from+-- "Test.LeanCheck.Core" with support for tuples and constructors with arities+-- from 6 up to 12. module Test.LeanCheck.Basic   ( module Test.LeanCheck.Core 
src/Test/LeanCheck/Core.hs view
@@ -1,22 +1,28 @@--- | Simple property-based testing library based on---   enumeration of values via lists of lists.+-- | LeanCheck is a simple enumerative property-based testing library. -- -- 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.LeanCheck". ----- If you want to understand how the code works, this is the place to start.+-- If you want to understand how the code works, this is the place to start+-- reading. -- -- -- Other important modules: ----- "Test.LeanCheck.Basic" re-exports (almost) everything from this module---         along with constructors and instances for further arities.+-- * "Test.LeanCheck.Basic" exports:+--     "Test.LeanCheck.Core",+--     additional 'tiers' constructors+--       ('Test.LeanCheck.Basic.cons6' ...+--        'Test.LeanCheck.Basic.cons12') and+--     'Listable' tuple instances. ----- "Test.LeanCheck.Utils" re-exports "Test.LeanCheck.Basic"---         along with functions for advanced Listable instance definitions.+-- * "Test.LeanCheck.Tiers" exports:+--     functions for advanced Listable definitions. ----- "Test.LeanCheck" re-exports "Test.LeanCheck.Utils"---   along with a TH function to automatically derive Listable instances.+-- * "Test.LeanCheck" exports:+--      "Test.LeanCheck.Basic",+--      most of "Test.LeanCheck.Tiers" and+--      'Test.LeanCheck.Derive.deriveListable'. module Test.LeanCheck.Core   (   -- * Checking and testing@@ -149,6 +155,7 @@   tiers = cons1 Left  `ofWeight` 0      \\// cons1 Right `ofWeight` 0 +-- | > list :: [(Int,Int)] = [(0,0), (0,1), (1,0), (0,-1), (1,1), ...] instance (Listable a, Listable b) => Listable (a,b) where   tiers = tiers >< tiers @@ -159,6 +166,9 @@          Listable (a,b,c,d) where   tiers = productWith (\x (y,z,w) -> (x,y,z,w)) tiers tiers +-- | Instances for 'Listable' sixtuples up to 12-tuples are exported by default+--   form "Test.LeanCheck" but are hidden from Haddock documentation.  These+--   instances are defined in "Test.LeanCheck.Basic". 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
src/Test/LeanCheck/Derive.hs view
@@ -1,8 +1,13 @@ {-# LANGUAGE TemplateHaskell, CPP #-}--- Experimental module for deriving Listable instances+-- | LeanCheck is a simple enumerative property-based testing library. --+-- This is an experimental module for deriving 'Listable' instances.+-- -- Needs GHC and Template Haskell--- (tested on GHC 7.4, 7.6, 7.8, 7.10 and 8.0)+-- (tested on GHC 7.4, 7.6, 7.8, 7.10 and 8.0).+--+-- If LeanCheck does not compile under later GHCs, this module is probably the+-- culprit. module Test.LeanCheck.Derive   ( deriveListable   )@@ -18,12 +23,22 @@ reportWarning = report False #endif --- | Derives a Listable instance for a given type 'Name', e.g.:+-- | Derives a 'Listable' instance for a given type 'Name'. --+-- Consider the following @Stack@ datatype:+-- -- > data Stack a = Stack a (Stack a) | Empty+--+-- Writing+-- -- > deriveListable ''Stack ----- Needs @TemplateHaskell@ extension.+-- will automatically derive the following 'Listable' instance:+--+-- > instance Listable a => Listable (Stack a) where+-- >   tiers = cons2 Stack \/ cons0 Empty+--+-- Needs the @TemplateHaskell@ extension. deriveListable :: Name -> DecsQ deriveListable t = do   is <- t `isInstanceOf` ''Listable
src/Test/LeanCheck/Error.hs view
@@ -1,10 +1,9 @@--- | A simple property-based testing library based on---   enumeration of values via lists of lists.+-- | LeanCheck is a simple enumerative property-based testing library. ----- This module re-exports Test.LeanCheck but some test functions have been+-- This module re-exports "Test.LeanCheck" 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.+-- This module is unsafe as it uses `unsafePerformIO` to catch errors. {-# LANGUAGE CPP #-} module Test.LeanCheck.Error   ( holds
src/Test/LeanCheck/Function.hs view
@@ -1,3 +1,26 @@+-- | LeanCheck is a simple enumerative property-based testing library.+--+-- This module exports 'Listable' and 'Show' function typeclass instances.+-- These can be useful for testing higher-order properties --- properties that+-- take functions as arguments.+--+-- LeanCheck provides several alternative definitions of 'Listable' functions:+--+-- * "Test.LeanCheck.Function.ListsOfPairs":+--   considers functions as a finite list of exceptional input-output cases to+--   a default value (list of pairs of arguments and results).+--   This is the LeanCheck default, and is the one exported by this module.+--+-- * "Test.LeanCheck.Function.CoListable":+--   declares a 'CoListable' typeclass similar to SmallCheck's @CoSerial@.+--   Currently a stub.+--+-- * "Test.LeanCheck.Function.Periodic":+--   similar to ListsOfPairs, but instead of having a default value, functions+--   are periodic.+--+-- Take care: all the above 'Listable' instances are __experimental__.  Only+-- one of the above can be imported at a time. module Test.LeanCheck.Function () where import Test.LeanCheck.Function.ListsOfPairs () import Test.LeanCheck.Function.Show ()
src/Test/LeanCheck/Function/CoListable.hs view
@@ -1,5 +1,8 @@--- | Function enumeration via CoListable typeclass---   This currently just a sketch.+-- | This module is part of 'Test.LeanCheck'.+-- It exports a 'Listable' instance for function enumeration+-- by means of a 'CoListable' typeclass.+--+-- This module /does not currently work/, it it just a sketch and a stub. module Test.LeanCheck.Function.CoListable where 
src/Test/LeanCheck/Function/ListsOfPairs.hs view
@@ -1,4 +1,9 @@--- | Function enumeration via lists of pairs.+-- | This module is part of 'Test.LeanCheck'.+--   It exports a 'Listable' instance for function enumeration+--   via lists of pairs.+--+-- This module considers functions as a finite list of exceptional input-output+-- cases to a default value (list of pairs of arguments and results). module Test.LeanCheck.Function.ListsOfPairs   ( functionPairs   , associations@@ -35,7 +40,7 @@ -- Those represent functional relations. functionPairs :: [[a]] -> [[b]] -> [[[(a,b)]]] functionPairs xss yss = concatMapT (`associations` yss)-                                   (strictlyAscendingListsOf xss)+                                   (setsOf xss)  -- | Returns a function given by a list of input-output pairs. -- The result is wrapped in a maybe value.
src/Test/LeanCheck/Function/Periodic.hs view
@@ -1,5 +1,7 @@--- | Periodic function enumeration.---   This is just a sketch.+-- | This module is part of 'Test.LeanCheck'.+-- It exports a 'Listable' instance for enumeration of periodic functions.+--+-- This module /barely works/ and is just a sketch. module Test.LeanCheck.Function.Periodic where 
src/Test/LeanCheck/IO.hs view
@@ -1,4 +1,4 @@--- | QuickCheck-like interface to LeanCheck+-- | QuickCheck-like interface to 'Test.LeanCheck' {-# LANGUAGE CPP #-} module Test.LeanCheck.IO   ( check
src/Test/LeanCheck/Invariants.hs view
@@ -1,5 +1,6 @@--- | Some invariants over Test.LeanCheck functions---   You should be importing this ONLY to test 'Test/LeanCheck.hs' itself.+-- | Some invariants over Test.LeanCheck functions.+--+-- You should be importing this ONLY to test "Test.LeanCheck" itself. module Test.LeanCheck.Invariants   ( tNatPairOrd   , tNatTripleOrd
src/Test/LeanCheck/Tiers.hs view
@@ -1,33 +1,47 @@--- | Utilities functions for manipulating tiers (sized lists of lists)+-- | LeanCheck is a simple enumerative property-based testing library.+--+-- This module provides advanced functions for manipulating 'tiers'.+-- Most definitions given here are exported by "Test.LeanCheck", except:+--   'listCons',+--   'choices',+--   'setChoices' and+--   'bagChoices'. module Test.LeanCheck.Tiers   (   -- * Additional tiers constructors-    consFromList-  , consFromAscendingList-  , consFromStrictlyAscendingList-  , consFromSet-  , consFromNoDupList+    listCons+  , setCons+  , bagCons+  , noDupListCons    -- * Products of tiers+  , product3   , product3With   , productMaybeWith    -- * Tiers of lists   , listsOf-  , ascendingListsOf-  , strictlyAscendingListsOf+  , bagsOf   , setsOf   , noDupListsOf   , products   , listsOfLength +  -- * Tiers of pairs+  , distinctPairs+  , distinctPairsWith+  , unorderedPairs+  , unorderedPairsWith+  , unorderedDistinctPairs+  , unorderedDistinctPairsWith+   , deleteT   , normalizeT    -- * Tiers of choices   , choices-  , ascendingChoices-  , strictlyAscendingChoices+  , setChoices+  , bagChoices   ) where @@ -37,42 +51,47 @@ -- | Given a constructor that takes a list, --   return tiers of applications of this constructor. -----   This is equivalent to 'cons1'.-consFromList :: Listable a => ([a] -> b) -> [[b]]-consFromList = (`mapT` listsOf tiers)+-- This is basically a type-restricted version of 'cons1'.+-- You should use 'cons1' instead: this serves more as an illustration of how+-- 'setCons' and 'bagCons' work (see source).+listCons :: Listable a => ([a] -> b) -> [[b]]+listCons = (`mapT` listsOf tiers) --- | Given a constructor that takes a list with ascending elements,---   return tiers of applications of this constructor.+-- | Given a constructor that takes a bag of elements (as a list),+--   lists tiers of applications of this constructor. -- -- For example, a 'Bag' represented as a list. ----- > consFromAscendingList Bag-consFromAscendingList :: Listable a => ([a] -> b) -> [[b]]-consFromAscendingList = (`mapT` ascendingListsOf tiers)+-- > bagCons Bag+bagCons :: Listable a => ([a] -> b) -> [[b]]+bagCons = (`mapT` bagsOf tiers) --- | Given a constructor that takes a list with ascending elements,---   return tiers of applications of this constructor.+-- | Given a constructor that takes a set of elements (as a list),+--   lists tiers of applications of this constructor. ----- For example, a 'Set' represented as a list.+-- A naive 'Listable' instance for the 'Data.Set.Set' (of "Data.Set")+-- would read: ----- > consFromAscendingList Set-consFromStrictlyAscendingList :: Listable a => ([a] -> b) -> [[b]]-consFromStrictlyAscendingList = (`mapT` strictlyAscendingListsOf tiers)---- | Given a constructor that takes a set of elements (as a list),---   return tiers of applications of this constructor.+-- > instance Listable a => Listable (Set a) where+-- >   tiers = cons0 empty \/ cons2 insert ----- For example, a 'Set' represented as a list.+-- The above instance has a problem: it generates repeated sets.+-- A more efficient implementation that does not repeat sets is given by: ----- > consFromAscendingList Set-consFromSet :: Listable a => ([a] -> b) -> [[b]]-consFromSet = (`mapT` setsOf tiers)+-- >   tiers = setCons fromList+--+-- Alternatively, you can use 'setsOf' direclty.+setCons :: Listable a => ([a] -> b) -> [[b]]+setCons = (`mapT` setsOf tiers)  -- | Given a constructor that takes a list with no duplicate elements, --   return tiers of applications of this constructor.-consFromNoDupList :: Listable a => ([a] -> b) -> [[b]]-consFromNoDupList f = mapT f (noDupListsOf tiers)+noDupListCons :: Listable a => ([a] -> b) -> [[b]]+noDupListCons f = mapT f (noDupListsOf tiers) +-- | Like '><', but over 3 lists of tiers.+product3 :: [[a]] -> [[b]]-> [[c]] -> [[(a,b,c)]]+product3 = product3With (\x y z -> (x,y,z))  -- | Like 'productWith', but over 3 lists of tiers. product3With :: (a->b->c->d) -> [[a]] -> [[b]] -> [[c]] -> [[d]]@@ -88,9 +107,65 @@                                \/ productMaybeWith f xss yss `addWeight` 1   where xs ** ys = catMaybes [ f x y | x <- xs, y <- ys ] +-- | Takes as argument tiers of element values;+--   returns tiers of pairs with distinct element values.+--+-- When argument tiers have no repeated elements:+--+-- > distinctPairs xss  =  xss >< xss  `suchThat` uncurry (/=)+distinctPairs :: [[a]] -> [[(a,a)]]+distinctPairs = distinctPairsWith (,) --- | Given tiers of values, returns tiers of lists of those values+-- | 'distinctPairs' by a given function: --+-- > distinctPairsWith f = mapT (uncurry f) . distinctPairs+distinctPairsWith :: (a -> a -> b) -> [[a]] -> [[b]]+distinctPairsWith f = concatT . choicesWith (\e -> mapT (f e))++-- | Takes as argument tiers of element values;+--   returns tiers of unordered pairs where, in enumeration order,+--   the first element is less than or equal to the second.+--+-- The name of this function is perhaps a misnomer.  But in mathematics,+-- an unordered pair is a pair where you don't care about element order, e.g.:+-- @(1,2) = (2,1)@.  This function will enumerate canonical versions of such+-- pairs where the first element is less than the second.+--+-- The returned element pairs can be seen as bags with two elements.+--+-- When argument tiers are listed in 'Ord':+--+-- > distinctPairs xss  =  xss >< xss  `suchThat` uncurry (<=)+unorderedPairs :: [[a]] -> [[(a,a)]]+unorderedPairs = unorderedPairsWith (,)++-- | 'unorderedPairs' by a given function:+--+-- > unorderedPairsWith f = mapT (uncurry f) . unorderedPairs+unorderedPairsWith :: (a -> a -> b) -> [[a]] -> [[b]]+unorderedPairsWith f = concatT . bagChoicesWith (\e -> mapT (f e))++-- | Takes as argument tiers of element values;+--   returns tiers of unordered pairs where, in enumeration order,+--   the first element is strictly less than the second.+--+-- The returned element pairs can be seen as sets with two elements.+--+-- When argument tiers are listed in 'Ord':+--+-- > distinctPairs xss  =  xss >< xss  `suchThat` uncurry (<)+unorderedDistinctPairs :: [[a]] -> [[(a,a)]]+unorderedDistinctPairs = unorderedDistinctPairsWith (,)++-- | 'unorderedPairs' by a given function:+--+-- > unorderedDistinctPairsWith f = mapT (uncurry f) . unorderedDistinctPairs+unorderedDistinctPairsWith :: (a -> a -> b) -> [[a]] -> [[b]]+unorderedDistinctPairsWith f = concatT . setChoicesWith (\e -> mapT (f e))++-- | Takes as argument tiers of element values;+--   returns tiers of lists of elements.+-- -- > listsOf [[]] == [[[]]] -- -- > listsOf [[x]] == [ [[]]@@ -110,11 +185,15 @@ listsOf xss = cons0 []            \/ productWith (:) xss (listsOf xss) `addWeight` 1 --- | Generates several lists of the same size.+-- | Takes the product of N lists of tiers, producing lists of length N. ----- > products [ xss, yss, zss ] ==+-- Alternatively,+-- takes as argument a list of lists of tiers of elements;+-- returns lists combining elements of each list of tiers. ----- Tiers of all lists combining elements of tiers: xss, yss and zss+-- > products [xss] = mapT (:[]) xss+-- > products [xss,yss] = mapT (\(x,y) -> [x,y]) (xss >< yss)+-- > products [xss,yss,zss] = product3With (\x y z -> [x,y,z]) xss yss zss products :: [ [[a]] ] -> [[ [a] ]] products = foldr (productWith (:)) [[[]]] @@ -143,7 +222,8 @@ normalizeT [[]] = [] normalizeT (xs:xss) = xs:normalizeT xss --- | Given tiers of values, returns tiers of lists with no repeated elements.+-- | Takes as argument tiers of element values;+--   returns tiers of lists with no repeated elements. -- -- > noDupListsOf [[0],[1],[2],...] == -- >   [ [[]]@@ -157,7 +237,45 @@ noDupListsOf =   ([[]]:) . concatT . choicesWith (\x xss -> mapT (x:) (noDupListsOf xss)) --- | Lists tiers of all choices of values from tiers.+-- | Takes as argument tiers of element values;+--   returns tiers of size-ordered lists of elements possibly with repetition.+--+-- > bagsOf [[0],[1],[2],...] =+-- >   [ [[]]+-- >   , [[0]]+-- >   , [[0,0],[1]]+-- >   , [[0,0,0],[0,1],[2]]+-- >   , [[0,0,0,0],[0,0,1],[0,2],[1,1],[3]]+-- >   , [[0,0,0,0,0],[0,0,0,1],[0,0,2],[0,1,1],[0,3],[1,2],[4]]+-- >   , ...+-- >   ]+bagsOf :: [[a]] -> [[[a]]]+bagsOf = ([[]]:) . concatT . bagChoicesWith (\x xss -> mapT (x:) (bagsOf xss))+++-- | Takes as argument tiers of element values;+--   returns tiers of size-ordered lists of elements without repetition.+--+-- > setsOf [[0],[1],[2],...] =+-- >   [ [[]]+-- >   , [[0]]+-- >   , [[1]]+-- >   , [[0,1],[2]]+-- >   , [[0,2],[3]]+-- >   , [[0,3],[1,2],[4]]+-- >   , [[0,1,2],[0,4],[1,3],[5]]+-- >   , ...+-- >   ]+--+-- Can be used in the constructor of specialized 'Listable' instances.+-- For 'Data.Set.Set' (from "Data.Set"), we would have:+--+-- > instance Listable a => Listable (Set a) where+-- >   tiers = mapT fromList $ setsOf tiers+setsOf :: [[a]] -> [[[a]]]+setsOf = ([[]]:) . concatT . setChoicesWith (\x xss -> mapT (x:) (setsOf xss))++-- | Lists tiers of choices. -- Choices are pairs of values and tiers excluding that value. -- -- > choices [[False,True]] == [[(False,[[True]]),(True,[[False]])]]@@ -178,82 +296,58 @@ 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).+-- | Like 'choices' but lists tiers of non-decreasing (ascending) choices.+--   Used to construct 'bagsOf' values. ---ascendingListsOf :: [[a]] -> [[[a]]]-ascendingListsOf =-  ([[]]:) . concatT . ascendingChoicesWith (\x xss -> mapT (x:) (ascendingListsOf xss))---- > ascendingChoices [[False,True]] =+-- > bagChoices [[False,True]] = -- >   [ [(False,[[False,True]]), (True,[[True]])] -- >   ] ----- > ascendingChoices [[1],[2],[3],...] =+-- > bagChoices [[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))+bagChoices :: [[a]] -> [[(a,[[a]])]]+bagChoices = bagChoicesWith (,) --- | Returns tiers of sets represented as lists of values (no repeated sets).---   Shorthand for 'strictlyAscendingListsOf'.-setsOf :: [[a]] -> [[[a]]]-setsOf = strictlyAscendingListsOf+-- | Like 'bagChoices' but customized by a function.+bagChoicesWith :: (a -> [[a]] -> b) -> [[a]] -> [[b]]+bagChoicesWith f []           = []+bagChoicesWith f [[]]         = []+bagChoicesWith f ([]:xss)     = [] : bagChoicesWith (\y yss -> f y ([]:yss)) xss+bagChoicesWith f ((x:xs):xss) = [[f x ((x:xs):xss)]]+                             \/ bagChoicesWith f (xs:xss) --- | Like 'choices', but paired tiers are always strictly ascending (in terms---   of enumeration).+-- | Like 'choices' but lists tiers of strictly ascending choices.+--   Used to construct 'setsOf' values. ----- > strictlyAscendingChoices [[False,True]] == [[(False,[[True]]),(True,[[]])]]--- > strictlyAscendingChoices [[1],[2],[3]]+-- > setChoices [[False,True]] == [[(False,[[True]]),(True,[[]])]]+-- > setChoices [[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)+setChoices :: [[a]] -> [[(a,[[a]])]]+setChoices = setChoicesWith (,) +-- | Like 'setChoices' but customized by a function.+setChoicesWith :: (a -> [[a]] -> b) -> [[a]] -> [[b]]+setChoicesWith f []           = []+setChoicesWith f [[]]         = []+setChoicesWith f ([]:xss)     = [] : setChoicesWith (\y yss -> f y ([]:yss)) xss+setChoicesWith f ((x:xs):xss) = [[f x (xs:xss)]]+                             \/ setChoicesWith f (xs:xss) --- | Given tiers, returns tiers of lists of a given length.+-- | Takes as argument an integer length and tiers of element values;+--   returns tiers of lists of element values of the given length.+--+-- > listsOfLength 3 [[0],[1],[2],[3],[4]...] =+-- >   [ [[0,0,0]]+-- >   , [[0,0,1],[0,1,0],[1,0,0]]+-- >   , [[0,0,2],[0,1,1],[0,2,0],[1,0,1],[1,1,0],[2,0,0]]+-- >   , ...+-- >   ] listsOfLength :: Int -> [[a]] -> [[[a]]] listsOfLength n xss = products (replicate n xss)
src/Test/LeanCheck/Utils.hs view
@@ -1,3 +1,11 @@+-- | Some utilities for property-based testing with 'Test.LeanCheck'.+--+-- Those utilities are general-purpose enough to be used with other+-- property-based based testing libraries.  See each exported module for+-- details.+--+-- This is not exported by "Test.LeanCheck".  You need to import this+-- explicitly. module Test.LeanCheck.Utils   ( module Test.LeanCheck.Utils.Types   , module Test.LeanCheck.Utils.Operators
src/Test/LeanCheck/Utils/Operators.hs view
@@ -7,31 +7,57 @@   , (&&&), (&&&&)   , (|||), (||||) -  -- * Properties over functions+  -- * Properties of unary functions+  , idempotent+  , identity+  , neverIdentity++  -- * Properties of operators (binary functions)   , commutative   , associative   , distributive+  , symmetric2++  -- * Properties of relations (binary functions returning truth values)   , transitive-  , idempotent-  , identity-  , notIdentity+  , reflexive+  , irreflexive+  , symmetric+  , asymmetric+  , antisymmetric +  -- ** Order relations+  , equivalence+  , partialOrder+  , strictPartialOrder+  , totalOrder+  , strictTotalOrder+  , comparison+   -- * Ternary comparison operators   , (=$), ($=)   , (=|), (|=)++  -- * Properties for typeclass instances+  , okEq+  , okOrd+  , okEqOrd   ) where +-- TODO: review terminology in this module.  Some names aren't quite right!+ import Test.LeanCheck ((==>))+import Data.List (elem)  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)+-- 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+-- > 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 (==)@@ -43,43 +69,157 @@  (&&&) :: (a -> Bool) -> (a -> Bool) -> a -> Bool (&&&) = combine (&&)-infix 3 &&&+infixr 3 &&&  (&&&&) :: (a -> b -> Bool) -> (a -> b -> Bool) -> a -> b -> Bool (&&&&) = combine (&&&)-infix 3 &&&&+infixr 3 &&&& +(&&&&&) :: (a -> b -> c -> Bool) -> (a -> b -> c -> Bool) -> a -> b -> c -> Bool+(&&&&&) = combine (&&&&)+infixr 3 &&&&&+ (|||) :: (a -> Bool) -> (a -> Bool) -> a -> Bool (|||) = combine (||)-infix 2 |||+infixr 2 |||  (||||) :: (a -> b -> Bool) -> (a -> b -> Bool) -> a -> b -> Bool (||||) = combine (|||)-infix 2 ||||+infixr 2 |||| +-- | Is a given operator commutative?  @x + y = y + x@+--+-- > holds n $ commutative (+)+--+-- > fails n $ commutative union  -- union [] [0,0] = [0] commutative :: Eq b => (a -> a -> b) -> a -> a -> Bool commutative o = \x y -> x `o` y == y `o` x +-- | Is a given operator associative?  @x + (y + z) = (x + y) + z@ 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+-- | Does the first operator, distributes over the second? 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) +-- | Are two operators flipped versions of each other?+--+-- > holds n $ (<)  `symmetric2` (>)  -:> int+-- > holds n $ (<=) `symmetric2` (>=) -:> int+--+-- > fails n $ (<)  `symmetric2` (>=) -:> int+-- > fails n $ (<=) `symmetric2` (>)  -:> int+symmetric2 :: Eq b => (a -> a -> b) -> (a -> a -> b) -> a -> a -> Bool+symmetric2 (+-) (-+) = \x y -> x +- y == y -+ x+-- TODO: generalize type of symmetric2!  a -> b -> c, b -> a -> c++-- | Is a given relation transitive? transitive :: (a -> a -> Bool) -> a -> a -> a -> Bool transitive o = \x y z -> x `o` y && y `o` z ==> x `o` z +-- | An element is always related to itself.+reflexive :: (a -> a -> Bool) -> a -> Bool+reflexive o = \x -> x `o` x++-- | An element is __never__ related to itself.+irreflexive :: (a -> a -> Bool) -> a -> Bool+irreflexive o = \x -> not $ x `o` x++-- | Is a given relation symmetric?+-- This is a type-restricted version of 'commutative'.+symmetric :: (a -> a -> Bool) -> a -> a -> Bool+symmetric = commutative++-- | Is a given relation antisymmetric?+-- Not to be confused with "not symmetric" and "assymetric".+antisymmetric :: Eq a => (a -> a -> Bool) -> a -> a -> Bool+antisymmetric r = \x y -> x `r` y && y `r` x ==> x == y++-- | Is a given relation asymmetric?+-- Not to be confused with "not symmetric" and "antissymetric".+asymmetric :: (a -> a -> Bool) -> a -> a -> Bool+asymmetric r = \x y -> x `r` y ==> not (y `r` x)++equivalence :: (a -> a -> Bool) -> a -> a -> a -> Bool+equivalence (==) = \x y z -> reflexive  (==) x+                          && symmetric  (==) x y+                          && transitive (==) x y z++partialOrder :: Eq a => (a -> a -> Bool) -> a -> a -> a -> Bool+partialOrder (<=) = \x y z -> reflexive     (<=) x+                           && antisymmetric (<=) x y+                           && transitive    (<=) x y z++strictPartialOrder :: (a -> a -> Bool) -> a -> a -> a -> Bool+strictPartialOrder (<) = \x y z -> irreflexive (<) x+                                && asymmetric  (<) x y -- implied?+                                && transitive  (<) x y z++totalOrder :: Eq a => (a -> a -> Bool) -> a -> a -> a -> Bool+totalOrder (<=) = \x y z -> (x <= y || y <= x)+                         && antisymmetric (<=) x y+                         && transitive    (<=) x y z++strictTotalOrder :: Eq a => (a -> a -> Bool) -> a -> a -> a -> Bool+strictTotalOrder (<) = \x y z -> (x /= y ==> x < y || y < x)+                              && irreflexive (<) x+                              && asymmetric  (<) x y -- implied?+                              && transitive  (<) x y z++comparison :: (a -> a -> Ordering) -> a -> a -> a -> Bool+comparison compare = \x y z -> equivalence (===) x y z+                            && irreflexive (<) x+                            && transitive  (<) x y z+                            && symmetric2  (<) (>) x y+  where+  x === y = x `compare` y == EQ+  x =/= y = x `compare` y /= EQ+  x  <  y = x `compare` y == LT+  x  >  y = x `compare` y == GT+++-- | Is the given function idempotent? @f (f x) == x@+--+-- > holds n $ idempotent abs+-- > holds n $ idempotent sort+--+-- > fails n $ idempotent negate idempotent :: Eq a => (a -> a) -> a -> Bool idempotent f = f . f === f +-- | Is the given function an identity? @f x == x@+--+-- > holds n $ identity (+0)+-- > holds n $ identity (sort :: [()])+-- > holds n $ identity (not . not) identity :: Eq a => (a -> a) -> a -> Bool identity f = f === id -notIdentity :: Eq a => (a -> a) -> a -> Bool-notIdentity = (not .) . identity+-- | Is the given function never an identity? @f x /= x@+--+-- > holds n $ neverIdentity not+--+-- > fails n $ neverIdentity negate   -- yes, fails: negate 0 == 0, hah!+--+-- Note: this is not the same as not being an identity.+neverIdentity :: Eq a => (a -> a) -> a -> Bool+neverIdentity = (not .) . identity --- | Equal under.  A ternary operator.+okEq :: Eq a => a -> a -> a -> Bool+okEq = equivalence (==)++okOrd :: Ord a => a -> a -> a -> Bool+okOrd x y z = totalOrder (<=) x y z+           && comparison compare x y z+           && (x <= y) == ((x `compare` y) `elem` [LT,EQ])++okEqOrd :: (Eq a, Ord a) => a -> a -> a -> Bool+okEqOrd x y z = okEq  x y z+             && okOrd x y z+             && (x == y) == (x `compare` y == EQ) -- consistent instances++-- | Equal under, a ternary operator with the same fixity as '=='. -- -- > x =$ f $= y  =  f x = f y --@@ -94,11 +234,13 @@ (x =$ f) y = f x == f y infixl 4 =$ +-- | See '=$' ($=) :: (a -> Bool) -> a -> Bool ($=) = ($) infixl 4 $=  -- | Check if two lists are equal for @n@ values.+--   This operator has the same fixity of '=='. -- -- > xs =| n |= ys  =  take n xs == take n ys --@@ -108,6 +250,7 @@ xs =| n = xs =$ take n infixl 4 =| +-- | See '=|' (|=) :: (a -> Bool) -> a -> Bool (|=) = ($) infixl 4 |=
tests/test-operators.hs view
@@ -3,6 +3,8 @@ import Test.LeanCheck import Test.LeanCheck.Utils +import Data.List (isPrefixOf)+import Data.Function (on)  main :: IO () main =@@ -45,6 +47,18 @@   , holds n $ distributive (*) (+) -:> int   , fails n $ distributive (+) (*) -:> int +  , holds n $ symmetric (==) -:> int+  , holds n $ symmetric (/=) -:> int+  , fails n $ symmetric (<=) -:> int++  , holds n $   reflexive (==) -:> int+  , holds n $ irreflexive (/=) -:> int++  , holds n $ (<)  `symmetric2` (>)  -:> int+  , holds n $ (<=) `symmetric2` (>=) -:> int+  , fails n $ (<)  `symmetric2` (>=) -:> int+  , fails n $ (<=) `symmetric2` (>)  -:> int+   , holds n $ transitive (==) -:> bool   , holds n $ transitive (<)  -:> bool   , holds n $ transitive (<=) -:> bool@@ -54,6 +68,43 @@   , holds n $ transitive (<=) -:> int   , fails n $ transitive (/=) -:> int +  , holds n $ asymmetric    (<)  -:> int+  , holds n $ antisymmetric (<=) -:> int+  , fails n $ asymmetric    (<=) -:> int+  , holds n $ asymmetric    (>)  -:> int+  , holds n $ antisymmetric (>=) -:> int+  , fails n $ asymmetric    (>=) -:> int++  , holds n $ equivalence (==) -:> int+  , holds n $ equivalence ((==) `on` fst) -:> (int,int)+  , holds n $ equivalence ((==) `on` length) -:> [int]++  , holds n $       totalOrder (<=) -:> int+  , holds n $ strictTotalOrder (<)  -:> int+  , fails n $       totalOrder (<)  -:> int+  , fails n $ strictTotalOrder (<=) -:> int+  , holds n $       totalOrder (>=) -:> int+  , holds n $ strictTotalOrder (>)  -:> int+  , fails n $       totalOrder (>)  -:> int+  , fails n $ strictTotalOrder (>=) -:> int++  , holds n $ partialOrder isPrefixOf -:> [int]+  , fails n $   totalOrder isPrefixOf -:> [int]++  , holds n $ comparison compare -:> int+  , holds n $ comparison compare -:> bool+  , holds n $ comparison compare -:> ()++  , holds n $ okEqOrd -:> ()+  , holds n $ okEqOrd -:> int+  , holds n $ okEqOrd -:> char+  , holds n $ okEqOrd -:> bool+  , holds n $ okEqOrd -:> [()]+  , holds n $ okEqOrd -:> [int]+  , holds n $ okEqOrd -:> [bool]+  , holds n $ okEqOrd -:> float  -- fails if NaN is included in enumeration+  , holds n $ okEqOrd -:> double -- fails if NaN is included in enumeration+   , holds n $ idempotent id   -:> int   , holds n $ idempotent abs  -:> int   , holds n $ idempotent sort -:> [bool]@@ -65,7 +116,7 @@   , holds n $ identity (not . not)   , fails n $ identity not -  , holds n $ notIdentity not-  , fails n $ notIdentity abs    -:> int-  , fails n $ notIdentity negate -:> int+  , holds n $ neverIdentity not+  , fails n $ neverIdentity abs    -:> int+  , fails n $ neverIdentity negate -:> int   ]
+ tests/test-tiers.hs view
@@ -0,0 +1,81 @@+import System.Exit (exitFailure)+import Data.List (elemIndices, sort, nub, delete)++import Test.LeanCheck+import Test.LeanCheck.Invariants+import Test.LeanCheck.Utils++import Test.LeanCheck.Tiers++main :: IO ()+main =+  case elemIndices False tests of+    [] -> putStrLn "Tests passed!"+    is -> do putStrLn ("Failed tests:" ++ show is)+             exitFailure++tests =+  [ True++  , checkNoDup 12+  , checkBags 18+  , checkSets 20+  , checkDistinctPairs 20+  , checkUnorderedPairs 20+  , checkUnorderedDistinctPairs 20+  , checkLengthListingsOfLength 5 5+  , checkSizesListingsOfLength 5 5++  , all (uncurry (/=)) . concat . take 100 $ distinctPairs (tiers :: [[Nat]])++  , 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++checkBags :: Int -> Bool+checkBags n = bagsOf (tiers :: [[Nat]]) =| n |= tiers `suchThat` ordered++checkSets :: Int -> Bool+checkSets n = setsOf (tiers :: [[Nat]]) =| n |= tiers `suchThat` strictlyOrdered++checkDistinctPairs :: Int -> Bool+checkDistinctPairs n =+  distinctPairs (tiers :: [[Nat]]) =| n |= tiers `suchThat` uncurry (/=)++checkUnorderedDistinctPairs :: Int -> Bool+checkUnorderedDistinctPairs n =+  unorderedDistinctPairs (tiers :: [[Nat]]) =| n |= tiers `suchThat` uncurry (<)++checkUnorderedPairs :: Int -> Bool+checkUnorderedPairs n =+  unorderedPairs (tiers :: [[Nat]]) =| n |= tiers `suchThat` uncurry (<=)++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
− tests/test-utils.hs
@@ -1,66 +0,0 @@-import System.Exit (exitFailure)-import Data.List (elemIndices, sort, nub, delete)--import Test.LeanCheck-import Test.LeanCheck.Invariants-import Test.LeanCheck.Utils---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