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 +24/−14
- TODO.md +10/−14
- doc/tutorial.md +1/−1
- leancheck.cabal +4/−4
- src/Test/LeanCheck.hs +5/−8
- src/Test/LeanCheck/Basic.hs +7/−3
- src/Test/LeanCheck/Core.hs +19/−9
- src/Test/LeanCheck/Derive.hs +19/−4
- src/Test/LeanCheck/Error.hs +3/−4
- src/Test/LeanCheck/Function.hs +23/−0
- src/Test/LeanCheck/Function/CoListable.hs +5/−2
- src/Test/LeanCheck/Function/ListsOfPairs.hs +7/−2
- src/Test/LeanCheck/Function/Periodic.hs +4/−2
- src/Test/LeanCheck/IO.hs +1/−1
- src/Test/LeanCheck/Invariants.hs +3/−2
- src/Test/LeanCheck/Tiers.hs +192/−98
- src/Test/LeanCheck/Utils.hs +8/−0
- src/Test/LeanCheck/Utils/Operators.hs +159/−16
- tests/test-operators.hs +54/−3
- tests/test-tiers.hs +81/−0
- tests/test-utils.hs +0/−66
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