leancheck 0.9.1 → 0.9.2

raw patch · 64 files changed

+1924/−485 lines, 64 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• .gitignore +10/−6
• .travis.yml +7/−4
• LICENSE +1/−1
• Makefile +17/−12
• README.md +49/−0
• TODO.md +0/−9
• bench/dets.hs +211/−0
• bench/memory-usage.hs +58/−0
• bench/pick.hs +79/−0
• bench/tiers.hs +6/−6
• bench/time-and-memory +41/−0
• changelog.md +16/−0
• doc/data-invariant.md +5/−1
• doc/faq.md +17/−0
• doc/memory-usage.md +170/−0
• eg/higher-order.hs +13/−1
• eg/test-bool.hs +7/−7
• eg/test-float.hs +1/−1
• eg/test-list.hs +1/−1
• eg/test-sort.hs +1/−1
• etc/hugs-backports/Data/Function.hs +1/−1
• leancheck.cabal +16/−4
• mk/All.hs +1/−2
• mk/Toplibs.hs +1/−0
• mk/depend.mk +47/−7
• mk/ghcdeps +1/−1
• mk/haddock-i +20/−8
• mk/haskell.mk +23/−5
• src/Test/LeanCheck.hs +5/−2
• src/Test/LeanCheck/Basic.hs +10/−3
• src/Test/LeanCheck/Core.hs +6/−6
• src/Test/LeanCheck/Derive.hs +3/−3
• src/Test/LeanCheck/Error.hs +79/−7
• src/Test/LeanCheck/Function.hs +2/−1
• src/Test/LeanCheck/Function/Eq.hs +1/−1
• src/Test/LeanCheck/Function/Listable.hs +4/−4
• src/Test/LeanCheck/Function/Listable/ListsOfPairs.hs +1/−1
• src/Test/LeanCheck/Function/ListsOfPairs.hs +1/−2
• src/Test/LeanCheck/Function/Show.hs +6/−5
• src/Test/LeanCheck/Function/Show/EightLines.hs +4/−2
• src/Test/LeanCheck/Function/Show/FourCases.hs +2/−2
• src/Test/LeanCheck/Function/ShowFunction.hs +20/−51
• src/Test/LeanCheck/Generic.hs +1/−1
• src/Test/LeanCheck/IO.hs +11/−8
• src/Test/LeanCheck/Stats.hs +111/−3
• src/Test/LeanCheck/Tiers.hs +24/−3
• src/Test/LeanCheck/Utils.hs +1/−1
• src/Test/LeanCheck/Utils/Operators.hs +533/−149
• src/Test/LeanCheck/Utils/TypeBinding.hs +1/−1
• src/Test/LeanCheck/Utils/Types.hs +110/−6
• test/Test.hs +3/−1
• test/derive.hs +2/−2
• test/diff/eg/higher-order.out +4/−0
• test/error.hs +2/−2
• test/fun.hs +28/−15
• test/funshow.hs +8/−5
• test/generic.hs +2/−2
• test/io.hs +1/−2
• test/main.hs +4/−4
• test/operators.hs +76/−72
• test/sdist +13/−21
• test/stats.hs +9/−4
• test/tiers.hs +2/−2
• test/types.hs +14/−13

@@ -3,6 +3,7 @@ .stack-work idx/ dist/+dist-newstyle log/ *.swp *.swo@@ -26,6 +27,9 @@ test/tiers test/types test/stats+bench/dets+bench/pick+bench/memory-usage bench/tiers bench/tiers-colistable bench/tiers-colistable.hs@@ -45,11 +49,11 @@ eg/test-list eg/higher-order eg/overflow-doc/*.html-doc/*.css-doc/*.js-doc/*.png-doc/*.gif-doc/*.json+doc/**/*.html+doc/**/*.css+doc/**/*.js+doc/**/*.png+doc/**/*.gif+doc/**/*.json mk/toplibs README.html

@@ -46,9 +46,12 @@   - ghc: 'head'     env:                   GHCVER=head         CABALVER=head     addons: {apt: {packages: [ghc-head,   cabal-install-head], sources: hvr-ghc}}+  - ghc: '8.8'+    env:                   GHCVER=8.8.3        CABALVER=3.0+    addons: {apt: {packages: [ghc-8.8.3,  cabal-install-3.0],  sources: hvr-ghc}}   - ghc: '8.6'-    env:                   GHCVER=8.6.3        CABALVER=2.4-    addons: {apt: {packages: [ghc-8.6.3,  cabal-install-2.4],  sources: hvr-ghc}}+    env:                   GHCVER=8.6.5        CABALVER=2.4+    addons: {apt: {packages: [ghc-8.6.5,  cabal-install-2.4],  sources: hvr-ghc}}   - ghc: '8.4'     env:                   GHCVER=8.4.4        CABALVER=2.2     addons: {apt: {packages: [ghc-8.4.4,  cabal-install-2.2],  sources: hvr-ghc}}@@ -84,7 +87,7 @@     - cabal --version     - haddock --version     script:-    - make && make test+    - make GHCFLAGS= && make test GHCFLAGS=     - make haddock HADDOCKFLAGS=     - make test-sdist     - cabal test@@ -97,7 +100,7 @@     - cabal --version     - haddock --version     script:-    - make && make test+    - make GHCFLAGS= && make test GHCFLAGS=     - make haddock HADDOCKFLAGS=     - make test-sdist     - cabal test

@@ -1,4 +1,4 @@-Copyright (c) 2015-2019, Rudy Matela+Copyright (c) 2015-2020, Rudy Matela  All rights reserved. 

@@ -1,6 +1,6 @@ # Makefile for LeanCheck #-# Copyright:   (c) 2015-2018 Rudy Matela+# Copyright:   (c) 2015-2020 Rudy Matela # License:     3-Clause BSD  (see the file LICENSE) # Maintainer:  Rudy Matela <rudy@matela.com.br> TESTS = test/main      \@@ -22,16 +22,21 @@ 	eg/test-list \ 	eg/test-sort BENCHS = \+	bench/dets \+	bench/pick \+	bench/memory-usage \ 	bench/tiers-default \ 	bench/tiers-4cases \ 	bench/tiers GHCIMPORTDIRS = src:test-# -dynamic is needed only for src/Test/LeanCheck/Derive.hs and test/derive.hs-GHCFLAGS = -O2 $(shell grep -q "Arch Linux" /etc/lsb-release && echo -dynamic)+GHCFLAGS = -O2 $(shell grep -q "Arch Linux" /etc/lsb-release && echo -dynamic) \+  -W -fno-warn-unused-matches -Werror HADDOCKFLAGS = --no-print-missing-docs HUGSIMPORTDIRS = .:./src:./test:./etc/hugs-backports:/usr/lib/hugs/packages/* HUGSFLAGS = -98 -h32M +LIB_DEPS = base template-haskell+ all: mk/toplibs  all-all: mk/All.o@@ -75,13 +80,13 @@ hugs-test: \   test/main.runhugs \   test/fun.runhugs \+  test/funshow.runhugs \   test/io.runhugs \   test/operators.runhugs \   test/stats.runhugs \   test/tiers.runhugs \+  test/types.runhugs \   test/error.runhugs-# test/funshow.runhugs  # TODO: make this pass-# test/types.runhugs    # TODO: make this pass  install: 	@echo "use \`cabal install' instead"@@ -96,11 +101,11 @@ 	stack test  legacy-test: # needs ghc-8.2 .. ghc-7.8 installed as such-	make clean  &&  make test GHC=ghc-8.2  GHCFLAGS="-Werror -dynamic"-	make clean  &&  make test GHC=ghc-8.0  GHCFLAGS="-Werror -dynamic"-	make clean  &&  make test GHC=ghc-7.10 GHCFLAGS="-Werror -dynamic"-	make clean  &&  make test GHC=ghc-7.8  GHCFLAGS="-Werror -dynamic"-	make clean  &&  make test+	make clean  &&  make test GHC=ghc-8.2 -j+	make clean  &&  make test GHC=ghc-8.0 -j+	make clean  &&  make test GHC=ghc-7.10 -j+	make clean  &&  make test GHC=ghc-7.8 -j+	make clean  &&  make test -j  legacy-test-via-cabal: # needs similarly named cabal wrappers 	cabal clean  &&  cabal-ghc-8.2  configure  &&  cabal-ghc-8.2  test@@ -275,13 +280,13 @@ prepare-depend-and-depend: prepare-depend 	make depend -TLF = "import\ Test.LeanCheck.Function"+TLF = import Test.LeanCheck.Function  bench/tiers-default.hs: bench/tiers.hs 	cp $< $@  bench/tiers-4cases.hs: bench/tiers.hs-	sed -e "s/$(TLF)$$/$(TLF).Listable\n$(TLF).Show.FourCases/" $< > $@+	sed -e "s/$(TLF) .*$$/$(TLF).Listable ()\n$(TLF).Show.FourCases ()/" $< > $@  bench/tiers-default: bench/tiers-default.hs src/Test/LeanCheck/Function/Listable/ListsOfPairs.hs 

@@ -23,7 +23,10 @@ entered into an interactive interpreter (`ghci`).  The result of evaluating the expression is then printed on the following line. +LeanCheck implementation is easy to understand.+[LeanCheck's core] is under 190 lines of code. + Installing ---------- @@ -51,7 +54,11 @@ 	> holds 100 $ \xs -> [] `union` xs == (xs::[Int]) 	False +As a rule-of-thumb, you should run holds for 500, 1 000, or 10 000 tests.+With more than that you may run out-of-memory depending on the types being+tested. + Finding counter examples ------------------------ @@ -167,6 +174,40 @@   -- `$ cabal install hspec-leancheck` .  +Memory usage+------------++Due to the way it is implemented (using lists of lists), LeanCheck can be quite+memory intensive if we set the maximum number of tests of a property to+millions of values (YMMV).++For the default maximum number of tests (200) you should be safe on most cases.+If you use 1 000 or 10 000 as the maximum number of tests for a property you're+also generally safe.  More than that, it is in a hit or miss basis.++For more details, see [LeanCheck memory usage].+++Beginner friendliness+---------------------++LeanCheck strives to be beginner/student friendly both in the interface and its+implementation.  For instance, to understand [LeanCheck's core], one does not+need to understand Monads as they aren't used at all there.++In the name of keeping the implementation easy to understand,+a compromise were made in terms of performance+(cf. [LeanCheck memory usage]).++LeanCheck is mostly [Haskell 98] compliant and almost [Haskell 2010] compliant.+With the exception of [`Listable`] derivation modules ([TH] and [Generics]),+the only extension used by LeanCheck is [CPP].  This is to maintain+compatibility with different compilers.  LeanCheck even compiles and runs on+[Hugs98] from September 2006.++LeanCheck has 100% Haddock coverage with most functions having examples.++ Further reading --------------- @@ -182,6 +223,7 @@  [LeanCheck's Haddock documentation]: https://hackage.haskell.org/package/leancheck/docs/Test-LeanCheck.html [tutorial on property-based testing with LeanCheck]: https://github.com/rudymatela/leancheck/blob/master/doc/tutorial.md+[LeanCheck memory usage]: https://github.com/rudymatela/leancheck/blob/master/doc/memory-usage.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@@ -193,6 +235,7 @@ [`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 [`deriveListable`]: https://hackage.haskell.org/package/leancheck/docs/Test-LeanCheck.html#v:deriveListable+[LeanCheck's core]: https://github.com/rudymatela/leancheck/blob/master/src/Test/LeanCheck/Core.hs  [property-based testing]: https://github.com/rudymatela/leancheck/blob/master/doc/tutorial.md [Feat]: https://hackage.haskell.org/package/testing-feat@@ -212,7 +255,13 @@ [leancheck-instances]:                   https://hackage.haskell.org/package/leancheck-instances [the intentional exception of a few types]: https://hackage.haskell.org/package/leancheck/docs/Test-LeanCheck-Basic.html [Haskell 2010 Language Report]:          https://www.haskell.org/onlinereport/haskell2010/+[Haskell 2010]:                          https://www.haskell.org/onlinereport/haskell2010/+[Haskell 98]:                            https://www.haskell.org/onlinereport/ [Haskell Platform]:                      https://www.haskell.org/platform/+[Hugs98]:                                https://www.haskell.org/hugs/+[TH]:  https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#template-haskell+[CPP]: https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/phases.html#extension-CPP+[Generics]: https://hackage.haskell.org/package/base/docs/GHC-Generics.html  [leancheck-logo]: https://github.com/rudymatela/leancheck/raw/master/doc/leancheck.svg?sanitize=true 

@@ -14,12 +14,3 @@ -------------  * on tutorial.md, write about how to create test programs;--* on data-invariant.md, write missing section;----other improvements---------------------* implement `conditionStatsT` (see `classStatsT`)

@@ -0,0 +1,211 @@+-- dets.hs -- bugs from the Erlang's dets library+--+-- Copyright (c) 2017-2020 Rudy Matela.+-- Distributed under the 3-Clause BSD licence (see the file LICENSE).+--+--+-- In 2016, John Hughes wrote a paper titled:+--+-- "Experiences with QuickCheck: Testing the Hard Stuff And Staying Sane"+--+-- http://publications.lib.chalmers.se/records/fulltext/232550/local_232550.pdf+--+-- In it, among other things, he describes how he used QuviQ QuickCheck to find+-- 5 bugs in Erlang's dets library which were "open problems" at the time.+--+--+-- Fastforward to my PhD exam in 2017 (Rudy), John Hughes, one of my examiners+-- challenged me to use LeanCheck to try to find one of the bugs of Erlang's+-- dets library which he thought would be unreachable by LeanCheck.+--+-- Unreachable above means appearing too late in the enumeration to be able+-- to practially reach it.+--+-- Turns out Hughes was right, LeanCheck runs out of memory before reaching the+-- bug.+--+--+-- This is a reconstruction of the program written during my PhD exam+-- (2017-11-24).+--+-- This program does not really test the dets library directly, but merely+-- pattern matches the bug.  So the dummy property under test returns False for+-- the specific bug we're looking for.+--+--+-- This version seaches for the 5 bugs found by QuickCheck described in Hughes'+-- paper.  It is able to find 2 of these 5.  We run out of memory before being+-- able to reach the other 3.+--+-- By cheating a bit, we can increase bugs found to 3,+-- but 2 are then still out of reach.+--+--+-- Dets library online manual: http://erlang.org/doc/man/dets.html+import Test.LeanCheck+++-- For simplicity, we only stick ourselves with 3 different possible database+-- names+data Name  =  A | B | C+  deriving (Eq, Ord, Show, Read)++type Key  =  Int++type Value  =  Int++type Object  =  (Key, Value)++-- The most important operations in Erlang's dets.+data Op  =  All                       -- all() -> [tab_name()]+         |  Close Name                -- close(Name)+         |  Delete Name Key           -- delete(Name, Key)+         |  DeleteAllObjects Name     -- delete_all_objects(Name)+--       |  First Name                -- first(Name) -> Key+         |  Insert Name [Object]      -- insert(Name, Objects)+         |  InsertNew Name [Object]   -- insert_new(Name, Objects) -> boolean()+         |  Lookup Name Key           -- lookup(Name, Key) -> Objects+         |  Member Name Key           -- member(Name, Key) -> boolean()+--       |  Next Name Key             -- next(Name, Key) -> boolean()+         |  Open Name                 -- open_file(...)+         |  GetContents Name          -- get_contents(Name) -> Objects+  deriving (Eq, Ord, Show, Read)++-- NOTE: I couldn't find get_contents on the dets documentation, but it is listed on Hughes paper+--       as one of the operations.  Perhaps he implemented it using first and next.++-- NOTE (2): I am admittedly cheating a bit+--           by ommiting First and Next in+--           place of GetContents.++-- A Program has a prefix and a parallel section that follows immediately+data Program  =  Program [Op] [[Op]]+  deriving (Eq, Ord, Show, Read)++instance Listable Name where list = [A, B, C]++-- This is an unoptimized generator as it will generate invalid programs like:+--+-- Program [Close A, Lookup B 0] []+instance Listable Op where+  tiers  =  cons0 All+         \/ cons1 Close+         \/ cons2 Delete+         \/ cons1 DeleteAllObjects+--       \/ cons1 First+         \/ cons2 Insert+         \/ cons2 InsertNew+         \/ cons2 Lookup+         \/ cons2 Member+--       \/ cons2 Next+         \/ cons1 Open+         \/ cons1 GetContents++instance Listable Program where+  tiers  =  cons2 Program++--            open(a)+-- -------------|-----------------+-- insert(a,[]) | insert_new(a,[])+bug1 :: Program+bug1 = Program+  [Open A]           -- initialization+  [ [Insert A []]    -- thread 1+  , [InsertNew A []] -- thread 2+  ]++--             open(a)+-- ----------------|---------------------+-- insert(a,{0,0}) | insert_new(a,{0,0})+bug2 :: Program+bug2 = Program+  [Open A]+  [ [Insert A [(0,0)]]+  , [InsertNew A [(0,0)]]+  ]++--       open(a)+-- --------|----------------+-- open(a) | insert(a,{0,0})+--         | get_contents(a)+bug3 :: Program+bug3 = Program+  [Open A]+  [ [Open A]+  , [ Insert A [(0,0)]+    , GetContents A+    ]+  ]++-- This was the one John Hughes originally+-- challenged me to find using LeanCheck+-- after my PhD examination.  (Rudy, 2017)+bug4 :: Program+bug4 = Program+  [ Open A+  , Close A+  , Open A+  ]+  [ [Lookup A 0]+  , [Insert A [(0,0)]]+  , [Insert A [(0,0)]]+  ]++bug5 :: Program+bug5 = Program+  [ Open A+  , Insert A [(1,0)]+  ]+  [ [ Lookup A 0+    , Delete A 1+    ]+  , [Open A]+  ]+++prop1, prop2, prop3, prop4, prop5 :: Program -> Bool+prop1 p = p /= bug1+prop2 p = p /= bug2+prop3 p = p /= bug3+prop4 p = p /= bug4+prop5 p = p /= bug5++main :: IO ()+main = do+  checkFor   200000  prop1  -- bug found after    88 410 tests+  checkFor  4000000  prop2  -- bug found after 2 044 950 tests+  checkFor  2000000  prop3  -- bug not found, more tests and we go out of memory...+  checkFor  2000000  prop4  -- bug not found, more tests and we go out of memory...+  checkFor  2000000  prop5  -- bug not found, more tests and we go out of memory...++-- If I recall correcly, John Hughes mentioned that each test took 3 seconds to+-- run.  That means LeanCheck would find the first bug after 3 days, and the+-- second bug after 2 months.  This could be improved if we cheat by removing+-- some of the uneeded operations in our Program datatype.+--+-- 1. Supposing we drop the "All" and "DeleteAllObjects" operation:+--+--    * bug 1 is found after    18 580 tests+--    * bug 3 is found after   300 104 tests+--    * bug 3 is found after 1 204 421 tests+--    * bugs 4 and 5 are not found+--+-- 2. Supposing we just allow a single database name "A"+--+--    * bug 1 is found after    10 651 tests+--    * bug 3 is found after   144 852 tests+--    * bug 3 is found after   534 550 tests+--    * bugs 4 and 5 are not found+--+-- Other improvements are possible:+--+-- * generating a set of parallel programs instead of a list as the order does+--   not matter (we would have to change the Program comparison function+--   accordingly)+--+-- * only generating valid programs (we only operate on A after open'ing it)+--+-- * generating a set of operations, then from that generate a set of programs+--   with these operations+--+-- But I conjecture bugs 4 and 5 will be simply out of reach anyway.

@@ -0,0 +1,58 @@+-- memory-usage.hs -- example program illustrating a limitation of LeanCheck+--+-- Copyright (c) 2020 Rudy Matela.+-- Distributed under the 3-Clause BSD licence (see the file LICENSE).+--+-- Many thanks to Jonas Duregard for providing this example.+--+-- If we set the test limit to millions of values, memory consumption may be+-- too high.  This is aggravated depending on how tests are ordered.+--+-- See below.+import Test.LeanCheck+import Data.Int+import Data.Word++-- dummy property that is always 'True' for a correct 'Num' instance.+evenOrOdd :: (Listable a, Show a, Integral a) => [a] -> Bool+evenOrOdd xs  =  all (\x -> odd x || even x) xs++main :: IO ()+main = do++  -- With just the following 10 lines+  -- this program consumes around 500 Mb of memory.+  -- At the end of each checkFor call+  -- the underlying tiers/list is garbage collected.+  checkFor 1000000 (evenOrOdd :: [Int]     -> Bool)+  checkFor 1000000 (evenOrOdd :: [Int8]    -> Bool)+  checkFor 1000000 (evenOrOdd :: [Int16]   -> Bool)+  checkFor 1000000 (evenOrOdd :: [Int32]   -> Bool)+  checkFor 1000000 (evenOrOdd :: [Int64]   -> Bool)+  checkFor 1000000 (evenOrOdd :: [Word]    -> Bool)+  checkFor 1000000 (evenOrOdd :: [Word8]   -> Bool)+  checkFor 1000000 (evenOrOdd :: [Word16]  -> Bool)+  checkFor 1000000 (evenOrOdd :: [Word32]  -> Bool)+  checkFor 1000000 (evenOrOdd :: [Word64]  -> Bool)++  -- However, if the following 10 lines are uncommented+  -- we increase memory consumption.+  -- Turns out the GC will not trigger as Haskell sees it will still use+  -- enumerated values, so it tries to keep values in memory.+  -- The maximum resident set size will increase to 3 000 Mb.+  {-+  checkFor 1000000 (evenOrOdd :: [Int]     -> Bool)+  checkFor 1000000 (evenOrOdd :: [Int8]    -> Bool)+  checkFor 1000000 (evenOrOdd :: [Int16]   -> Bool)+  checkFor 1000000 (evenOrOdd :: [Int32]   -> Bool)+  checkFor 1000000 (evenOrOdd :: [Int64]   -> Bool)+  checkFor 1000000 (evenOrOdd :: [Word]    -> Bool)+  checkFor 1000000 (evenOrOdd :: [Word8]   -> Bool)+  checkFor 1000000 (evenOrOdd :: [Word16]  -> Bool)+  checkFor 1000000 (evenOrOdd :: [Word32]  -> Bool)+  checkFor 1000000 (evenOrOdd :: [Word64]  -> Bool)+  -}++  -- This is a limitation of LeanCheck+  -- that comes from using simple lists of lists+  -- as the means for enumeration.

@@ -0,0 +1,79 @@+-- pick.hs -- picks the n-th value in a LeanCheck enumeration+--+-- Copyright (c) 2020 Rudy Matela.+-- Distributed under the 3-Clause BSD licence (see the file LICENSE).+import Test.LeanCheck+import Test.LeanCheck.Utils+import Test.LeanCheck.Function ()++import System.Environment++u :: a+u  =  undefined++usage :: IO ()+usage  =  putStrLn $ "usage:"+                  \\ "  pick <Type> <n>"+                  \\ ""+                  \\ "example:"+                  \\ "  pick Int 12"+  where+  s1 \\ s2  =  s1 ++ "\n" ++ s2++main :: IO ()+main  =  do+  as <- getArgs+  case as of+    [t,n] -> pick t (read n)+    _ -> usage++put :: (Listable a, Show a) => String -> Int -> a -> IO ()+put t n u  =  putStrLn+           $  "list :: [" ++ t ++ "] !! " ++ show n ++ " = "+           ++ show ((list `asTypeOf` [u]) !! n)++pick :: String -> Int -> IO ()+pick t n = case t of+  "()"               -> put t n (u :: ()                   )+  "Int"              -> put t n (u :: Int                  )+  "Nat"              -> put t n (u :: Nat                  )+  "Integer"          -> put t n (u :: Integer              )+  "Bool"             -> put t n (u :: Bool                 )+  "Char"             -> put t n (u :: Char                 )+  "Float"            -> put t n (u :: Float                )+  "Double"           -> put t n (u :: Double               )+  "Rational"         -> put t n (u :: Rational             )+  -- lists+  "[()]"             -> put t n (u :: [()]                 )+  "[Int]"            -> put t n (u :: [Int]                )+  "[Nat]"            -> put t n (u :: [Nat]                )+  "[Integer]"        -> put t n (u :: [Integer]            )+  "[Bool]"           -> put t n (u :: [Bool]               )+  "[Char]"           -> put t n (u :: [Char]               )+  "String"           -> put t n (u :: String               )+  -- pairs+  "((),())"          -> put t n (u :: ((),())              )+  "(Int,Int)"        -> put t n (u :: (Int,Int)            )+  "(Nat,Nat)"        -> put t n (u :: (Nat,Nat)            )+  "(Bool,Bool)"      -> put t n (u :: (Bool,Bool)          )+  "(Bool,Int)"       -> put t n (u :: (Bool,Int)           )+  "(Int,Bool)"       -> put t n (u :: (Int,Bool)           )+  "(Int,Int,Int)"    -> put t n (u :: (Int,Int,Int)        )+  "(Nat,Nat,Nat)"    -> put t n (u :: (Nat,Nat,Nat)        )+  -- lists & pairs+  "[((),())]"        -> put t n (u :: [((),())]            )+  "([()],[()])"      -> put t n (u :: ([()],[()])          )+  "([Bool],[Bool])"  -> put t n (u :: ([Bool],[Bool])      )+  "([Int],[Int])"    -> put t n (u :: ([Int],[Int])        )+  -- lists of lists+  "[[()]]"           -> put t n (u :: [[()]]               )+  "[[Int]]"          -> put t n (u :: [[Int]]              )+  "[[Nat]]"          -> put t n (u :: [[Nat]]              )+  "[[Integer]]"      -> put t n (u :: [[Integer]]          )+  "[[Bool]]"         -> put t n (u :: [[Bool]]             )+  "[[Char]]"         -> put t n (u :: [[Char]]             )+  "[String]"         -> put t n (u :: [String]             )+  -- lists of pairs+  "[(Int,Int)]"      -> put t n (u :: [(Int,Int)]          )+  -- unhandled+  _                  -> error $ "unknown/unhandled type `" ++ t ++ "'"

@@ -1,11 +1,11 @@ -- tiers.hs -- prints tiers of values up to a certain point ----- Copyright (c) 2015-2018 Rudy Matela.+-- Copyright (c) 2015-2020 Rudy Matela. -- Distributed under the 3-Clause BSD licence (see the file LICENSE). import Test.LeanCheck import Test.LeanCheck.Utils.Types-import Test.LeanCheck.Function-import Test.LeanCheck.Function.Eq+import Test.LeanCheck.Function ()+import Test.LeanCheck.Function.Eq () import Test.LeanCheck.Tiers (showTiers, finite) import System.Environment import Data.List (intercalate, nub)@@ -75,9 +75,9 @@ main = do   as <- getArgs   let (t,n) = case as of-                []    -> ("Int", 12)-                [t]   -> (t,     12)-                [t,n] -> (t, read n)+              []      -> ("Int", 12)+              [t]     -> (t,     12)+              (t:n:_) -> (t, read n)   case t of     -- simple types     "()"               -> put t n (u :: ()                   )

@@ -0,0 +1,41 @@+#!/bin/bash+++dir="`dirname $0`"+pick="$dir/pick"++timem() {+	nice /usr/bin/time -f "%e %M" "$@" > /dev/null+}++pick() {+	echo -n "$1 $2 ";+	timem $pick $1 $2+}++timem-for() {+	pick $1 1         ; [ "$2" = 1        ] && return+	pick $1 10        ; [ "$2" = 10       ] && return+	pick $1 100       ; [ "$2" = 100      ] && return+	pick $1 1000      ; [ "$2" = 1000     ] && return+	pick $1 10000     ; [ "$2" = 10000    ] && return+	pick $1 100000    ; [ "$2" = 100000   ] && return+	pick $1 1000000   ; [ "$2" = 1000000  ] && return+	pick $1 10000000  ; [ "$2" = 10000000 ] && return+}++timem-for "Bool"  1+timem-for "Int"+timem-for "Char"  10++timem-for "(Int,Int)"+timem-for "(Int,Int,Int)"++timem-for "[()]"      10000 # ~ 25s+timem-for "[Bool]"          # ~  4s+timem-for "[Int]"           # ~  6s++timem-for "[[Bool]]"        # ~  4s+timem-for "[[Int]]"         # ~  4s++timem-for "[(Int,Int)]"     # ~  4s

@@ -1,6 +1,22 @@ Changelog for LeanCheck ======================= +v0.9.2+------++* rename most functions on `Test.LeanCheck.Utils.Operators`;+  deprecated names are provided;+* improve documentation:+	- 100% haddock coverage;+	- LeanCheck memory usage thoroughly documented;+* implement stub function `conditionStatsT`;+* improve function display on `Test.LeanCheck.Function.*`;+* fix some compiler warnings (newer GHC);+* improve build scripts;+* improve tests;+* update tests scripts to support the new cabal (`test/sdist`).++ v0.9.1 ------ 

@@ -65,9 +65,13 @@  3. **Only generate valid values in the Listable instance** (elegant and efficient): -    TODO: write!+    We can use the [`setCons`] when declaring `tiers`: +	    instance (Ord a, Listable a) => Listable (Set a) where+		  tiers = setCons Set+ [`Listable`]: https://hackage.haskell.org/package/leancheck/docs/Test-LeanCheck.html#t:Listable [`list`]:     https://hackage.haskell.org/package/leancheck/docs/Test-LeanCheck.html#v:list [`suchThat`]: https://hackage.haskell.org/package/leancheck/docs/Test-LeanCheck.html#v:suchThat+[`setCons`]:  https://hackage.haskell.org/package/leancheck/docs/Test-LeanCheck-Tiers.html#v:setCons [`Rational`]: https://hackage.haskell.org/package/base/docs/Data-Ratio.html#t:Ratio

@@ -133,6 +133,23 @@ 	> take 10 $ map fst ( values :: [(Integer, [[(Int,Int,Int)]]  )] ) 	[0,1,8,88,968,10632,116752,1282048,14078080,154590400] +__Performance.__  Feat is better in terms of runtime and memory when+enumerating "late" values.  With Feat, you can enumerate the billionth (1 000+000 000 th) value in an enumeration instantly in under 255kb:++	$ cabal install testing-feat+	...+	$ ghci+	> import Test.Feat+	> :set +s+	> index 1000000000 :: [Bool]+	[True,True,False,True,True,True,False,False,True,True,False,True,False,True,True,False,False,True,False,True,False,False,False,False,False,False,False,False,True]+	(0.02 secs, 255,288 bytes)++You'll probably run out of memory when doing that with LeanCheck.  LeanCheck+works best when we stick to thousands of values.  With more than that+your-mileage-may-vary.+ __Interface.__  The API of these tools differ in several ways.  Two examples:  * LeanCheck supports ([`Testable`]) properties with multiple arguments

@@ -0,0 +1,170 @@+LeanCheck Memory Usage+======================++Due to the way it is implemented (by using simple lists of lists for+enumeration), LeanCheck can be quite memory intensive.++When running LeanCheck for 500, 1 000 or 10 000 values on each property one+should be fine with regard to memory usage.  However, if as we start going+towards 1 000 000 test values per property, memory consumption can be quite+high depending on the types being tested.++Here are tables with LeanCheck's memory consumption for a few standard Haskell+types.+++Bool+----++```+n   time  memory+1     0s     17M+```++Int+---++```+       n  time  memory+       1  0.0s  17M+      10  0.0s  17M+     100  0.0s  17M+    1000  0.0s  17M+   10000  0.0s  18M+  100000  0.0s  19M+ 1000000  0.0s  18M+10000000  0.2s  19M+```+++(Int,Int)+---------++```+       1  0.0s  17M+      10  0.0s  18M+     100  0.0s  18M+    1000  0.0s  18M+   10000  0.0s  19M+  100000  0.0s  19M+ 1000000  0.1s  19M+10000000  2.1s  21M+```++(Int,Int,Int)+-------------++```+       1  0.0s  17M+      10  0.0s  17M+     100  0.0s  17M+    1000  0.0s  17M+   10000  0.0s  18M+  100000  0.0s  19M+ 1000000  0.1s  22M+10000000  1.5s  34M+```+++[()]+----++```+    1   0.0s  17M+   10   0.0s  17M+  100   0.0s  18M+ 1000   0.1s  19M+10000  24.9s  29M+```+++[Bool]+------++```+       1  0.0s   17M+      10  0.0s   17M+     100  0.0s   17M+    1000  0.0s   17M+   10000  0.0s   19M+  100000  0.1s   30M+ 1000000  0.4s  119M+10000000  4.3s    1G+```+++[Int]+-----+++```+       1  0.0s   17M+      10  0.0s   17M+     100  0.0s   17M+    1000  0.0s   17M+   10000  0.0s   20M+  100000  0.1s   41M+ 1000000  0.5s  205M+10000000  6.6s    2G+```++++[[Bool]]+--------++```+       1  0.0s    17M+      10  0.0s    17M+     100  0.0s    17M+    1000  0.0s    18M+   10000  0.0s    18M+  100000  0.1s    34M+ 1000000  0.5s   204M+10000000  4.7s     2G+```+++[[Int]]+-------++```+       1  0.0s    17M+      10  0.0s    17M+     100  0.0s    17M+    1000  0.0s    18M+   10000  0.0s    20M+  100000  0.1s    35M+ 1000000  0.5s   193M+10000000  4.7s     2G+```+++[(Int,Int)]+-----------++```+       1  0.0s    17M+      10  0.0s    17M+     100  0.0s    17M+    1000  0.0s    18M+   10000  0.0s    19M+  100000  0.1s    34M+ 1000000  0.5s   166M+10000000  4.7s     1G+```+++Generating measurements from this report+----------------------------------------++Values in the report above are approximate.  If you need more precise values,+you will need to generate them yourself.++To generate data from this report yourself, just:++```+$ make bench/pick bench/memory-usage+$ ./bench/time-and-memory+...+```

@@ -1,5 +1,9 @@+-- higher-order.hs -- example: testing higher-order properties using LeanCheck+--+-- Copyright (c) 2017-2020 Rudy Matela.+-- Distributed under the 3-Clause BSD licence (see the file LICENSE). import Test.LeanCheck-import Test.LeanCheck.Function+import Test.LeanCheck.Function ()  type A = Int @@ -13,8 +17,16 @@ prop_mapFilter :: (A -> A) -> (A -> Bool) -> [A] -> Bool prop_mapFilter f p xs  =  filter p (map f xs) == map f (filter p xs) +prop_false :: (A -> A) -> (A -> A) -> Bool+prop_false _ _ = False++prop_false' :: (A -> A) -> (A,A) -> Bool+prop_false' _ _ = False+ main :: IO () main = do   check prop_foldlr   check prop_foldlr'   check prop_mapFilter+  check prop_false+  check prop_false'

@@ -1,19 +1,19 @@ -- test-bool.hs -- example program, testing Bool fns using LeanCheck ----- Copyright (c) 2017-2018 Rudy Matela.+-- Copyright (c) 2017-2020 Rudy Matela. -- Distributed under the 3-Clause BSD licence (see the file LICENSE). import Test.LeanCheck-import Test.LeanCheck.Function+import Test.LeanCheck.Function () import Test.LeanCheck.Utils  main :: IO () main = do-  putStrLn "not . not === id";  check $ identity (not . not)-  putStrLn "(&&) commutes";     check $ commutative (&&)-  putStrLn "(||) commutes";     check $ commutative (||)+  putStrLn "not . not === id";  check $ isIdentity (not . not)+  putStrLn "(&&) commutes";     check $ isCommutative (&&)+  putStrLn "(||) commutes";     check $ isCommutative (||)    putStrLn "\nAll boolean operators are commutative (wrong)."-  check $ \(&|) -> commutative ((&|) :: Bool -> Bool -> Bool)+  check $ \(&|) -> isCommutative ((&|) :: Bool -> Bool -> Bool)    putStrLn "\nAll boolean operators are associative (wrong)."-  check $ \(&|) -> associative ((&|) :: Bool -> Bool -> Bool)+  check $ \(&|) -> isAssociative ((&|) :: Bool -> Bool -> Bool)

@@ -1,6 +1,6 @@ -- test-list.hs -- example program, testing Float using LeanCheck ----- Copyright (c) 2017-2018 Rudy Matela.+-- Copyright (c) 2017-2020 Rudy Matela. -- Distributed under the 3-Clause BSD licence (see the file LICENSE). import Test.LeanCheck 

@@ -1,6 +1,6 @@ -- test-list.hs -- example program, testing Data.List using LeanCheck ----- Copyright (c) 2017-2018 Rudy Matela.+-- Copyright (c) 2017-2020 Rudy Matela. -- Distributed under the 3-Clause BSD licence (see the file LICENSE). import Test.LeanCheck import Data.List

@@ -1,6 +1,6 @@ -- test-sort.hs -- example program, testing sort using LeanCheck ----- Copyright (c) 2017-2018 Rudy Matela.+-- Copyright (c) 2017-2020 Rudy Matela. -- Distributed under the 3-Clause BSD licence (see the file LICENSE). import Test.LeanCheck 

@@ -1,4 +1,4 @@--- Copyright 2018 Rudy Matela+-- Copyright 2018-2020 Rudy Matela -- -- Backport of Data.Function for Hugs 2006-09. -- Only exports `on`

@@ -11,7 +11,7 @@ -- this cabal file too complicated.  -- Rudy  name:                leancheck-version:             0.9.1+version:             0.9.2 synopsis:            Enumerative property-based testing description:   LeanCheck is a simple enumerative property-based testing library.@@ -40,13 +40,18 @@                , TODO.md                , changelog.md                , doc/data-invariant.md+               , doc/memory-usage.md                , doc/faq.md                , doc/tutorial.md                , doc/leancheck.svg extra-source-files: .gitignore                   , .travis.yml                   , Makefile+                  , bench/dets.hs+                  , bench/memory-usage.hs+                  , bench/pick.hs                   , bench/tiers.hs+                  , bench/time-and-memory                   , eg/higher-order.hs                   , eg/overflow.hs                   , eg/test-bool.hs@@ -64,8 +69,15 @@                   , test/diff/*.out                   , test/diff/eg/*.out                   , test/sdist-tested-with: GHC==8.6, GHC==8.4, GHC==8.2, GHC==8.0-           , GHC==7.10, GHC==7.8, GHC==7.6, GHC==7.4+tested-with: GHC==8.8+           , GHC==8.6+           , GHC==8.4+           , GHC==8.2+           , GHC==8.0+           , GHC==7.10+           , GHC==7.8+           , GHC==7.6+           , GHC==7.4   source-repository head@@ -75,7 +87,7 @@ source-repository this   type:            git   location:        https://github.com/rudymatela/leancheck-  tag:             v0.9.1+  tag:             v0.9.2  library   exposed-modules: Test.LeanCheck

@@ -5,7 +5,6 @@   , module Test.LeanCheck.Utils   , module Test.LeanCheck.Tiers   , module Test.LeanCheck.Generic-  , module Test.LeanCheck.Function   ) where @@ -15,4 +14,4 @@ import Test.LeanCheck.Utils import Test.LeanCheck.Tiers import Test.LeanCheck.Generic-import Test.LeanCheck.Function+import Test.LeanCheck.Function ()

@@ -1,6 +1,7 @@ -- Using ghc --make in this module triggers compilation of every library. module Toplibs () where +import Test () import Test.LeanCheck () import Test.LeanCheck.Utils () import Test.LeanCheck.Error ()

@@ -1,3 +1,49 @@+bench/dets: \+  bench/dets.hs \+  mk/toplibs+bench/dets.o: \+  src/Test/LeanCheck/Tiers.hs \+  src/Test/LeanCheck.hs \+  src/Test/LeanCheck/IO.hs \+  src/Test/LeanCheck/Derive.hs \+  src/Test/LeanCheck/Core.hs \+  src/Test/LeanCheck/Basic.hs \+  bench/dets.hs+bench/memory-usage: \+  bench/memory-usage.hs \+  mk/toplibs+bench/memory-usage.o: \+  src/Test/LeanCheck/Tiers.hs \+  src/Test/LeanCheck.hs \+  src/Test/LeanCheck/IO.hs \+  src/Test/LeanCheck/Derive.hs \+  src/Test/LeanCheck/Core.hs \+  src/Test/LeanCheck/Basic.hs \+  bench/memory-usage.hs+bench/pick: \+  bench/pick.hs \+  mk/toplibs+bench/pick.o: \+  src/Test/LeanCheck/Utils/Types.hs \+  src/Test/LeanCheck/Utils/TypeBinding.hs \+  src/Test/LeanCheck/Utils.hs \+  src/Test/LeanCheck/Utils/Operators.hs \+  src/Test/LeanCheck/Tiers.hs \+  src/Test/LeanCheck/Stats.hs \+  src/Test/LeanCheck.hs \+  src/Test/LeanCheck/IO.hs \+  src/Test/LeanCheck/Function/Show.hs \+  src/Test/LeanCheck/Function/ShowFunction.hs \+  src/Test/LeanCheck/Function/Show/EightLines.hs \+  src/Test/LeanCheck/Function.hs \+  src/Test/LeanCheck/Function/ListsOfPairs.hs \+  src/Test/LeanCheck/Function/Listable.hs \+  src/Test/LeanCheck/Function/Listable/ListsOfPairs.hs \+  src/Test/LeanCheck/Error.hs \+  src/Test/LeanCheck/Derive.hs \+  src/Test/LeanCheck/Core.hs \+  src/Test/LeanCheck/Basic.hs \+  bench/pick.hs bench/tiers-4cases: \   bench/tiers-4cases.hs \   mk/toplibs@@ -181,6 +227,7 @@   src/Test/LeanCheck/Basic.hs \   mk/All.hs mk/Toplibs.o: \+  test/Test.hs \   src/Test/LeanCheck/Utils/Types.hs \   src/Test/LeanCheck/Utils/TypeBinding.hs \   src/Test/LeanCheck/Utils.hs \@@ -415,19 +462,13 @@   test/Test.hs \   test/fun.hs \   src/Test/LeanCheck/Utils/Types.hs \-  src/Test/LeanCheck/Utils/TypeBinding.hs \-  src/Test/LeanCheck/Utils.hs \-  src/Test/LeanCheck/Utils/Operators.hs \   src/Test/LeanCheck/Tiers.hs \-  src/Test/LeanCheck/Stats.hs \   src/Test/LeanCheck.hs \   src/Test/LeanCheck/IO.hs \-  src/Test/LeanCheck/Function/ListsOfPairs.hs \   src/Test/LeanCheck/Derive.hs \   src/Test/LeanCheck/Core.hs \   src/Test/LeanCheck/Basic.hs test/funshow.o: \-  test/Test.hs \   test/funshow.hs \   src/Test/LeanCheck/Utils/Types.hs \   src/Test/LeanCheck/Utils/TypeBinding.hs \@@ -443,7 +484,6 @@   src/Test/LeanCheck/Core.hs \   src/Test/LeanCheck/Basic.hs test/funshow: \-  test/Test.hs \   test/funshow.hs \   mk/toplibs test/fun: \

@@ -2,7 +2,7 @@ # # ghcdeps: generate Haskell make dependencies for compiling with GHC. #-# Copyright (c) 2015-2018 Rudy Matela.+# Copyright (c) 2015-2020 Rudy Matela. # Distributed under the 3-Clause BSD licence. # # From a list of files provided on standard input,

@@ -2,7 +2,7 @@ # # haddock-i: list haddock's -i parameters. #-# Copyright (c) 2015-2018 Rudy Matela.+# Copyright (c) 2015-2020 Rudy Matela. # Distributed under the 3-Clause BSD licence. # # $ haddock-i <package1> <package2> ... <packageN>@@ -11,14 +11,26 @@ # documentation installed on your system, so you can: # # $ haddock-i base template-haskell | xargs haddock <files>-errxit() {+err() { 	echo "$@" > /dev/stderr+}++errxit() {+	err "$@" 	exit 1 } -for pkg in "$@"; do-	ghc-pkg field $pkg haddock-html,haddock-interfaces ||-	errxit "error: haddock-i: cannot find package $pkg (ghc-pkg)"-done |-sed "s/.*: //" |-sed "N;s/\n/,/;s/^/-i/"+iface-for() {+	ghc-pkg field $1 haddock-interfaces | sort -rV | head -1 | sed "s/.*: //"+}++html-for() {+	ghc-pkg field $1 haddock-html       | sort -rV | head -1 | sed "s/.*: //"+}++for pkg in "$@"+do+	iface=$(iface-for $pkg)+	html=$(html-for $pkg)+	[ -d "$html" -a -f "$iface" ] && echo "-i$html,$iface" || err "haddock-i: warning: could not find interface file for $pkg"+done

@@ -1,6 +1,6 @@ # Implicit rules for compiling Haskell code. #-# Copyright (c) 2015-2018 Rudy Matela.+# Copyright (c) 2015-2020 Rudy Matela. # Distributed under the 3-Clause BSD licence. # # You can optionally configure the "Configuration variables" below in your main@@ -20,6 +20,7 @@ GHCFLAGS ?= GHC ?= ghc GHCCMD = $(GHC) -i$(GHCIMPORTDIRS) $(GHCFLAGS)+HADDOCK ?= haddock  # Hugs Parameters HUGSIMPORTDIRS ?= "/usr/lib/hugs/packages/*"@@ -43,13 +44,19 @@ LIB_HSS ?= $(shell $(LIST_LIB_HSS)) ALL_HSS ?= $(shell $(LIST_ALL_HSS)) +LIB_DEPS ?= base+ALL_DEPS ?= $(LIB_DEPS)+ PKGNAME = $(shell cat *.cabal | grep "^name:"    | sed -e "s/name: *//")-HADDOCK_VERSION = $(shell haddock --version | grep version | sed -e 's/.*version //;s/,.*//')+HADDOCK_VERSION = $(shell $(HADDOCK) --version | grep version | sed -e 's/.*version //;s/,.*//') HADDOCK_MAJOR = $(shell echo $(HADDOCK_VERSION) | sed -e 's/\..*//') HADDOCK_MINOR = $(shell echo $(HADDOCK_VERSION) | sed -e 's/[0-9]*\.\([0-9]*\).[0-9]*/\1/') HADDOCK_PKG_NAME = $(shell [ $(HADDOCK_MAJOR) -gt 2 ] \                         || [ $(HADDOCK_MAJOR) -eq 2 -a $(HADDOCK_MINOR) -ge 20 ] \                         && echo "--package-name=$(PKGNAME)")+HADDOCK_HLNK_SRC = $(shell [ $(HADDOCK_MAJOR) -gt 2 ] \+                        || [ $(HADDOCK_MAJOR) -eq 2 -a $(HADDOCK_MINOR) -ge 17 ] \+                        && echo "--hyperlinked-source")   # Implicit rules@@ -90,7 +97,7 @@ haddock: doc/index.html  clean-haddock:-	rm -f doc/*.{html,css,js,png,gif,json} README.html+	rm -f doc/*.{html,css,js,png,gif,json} doc/src/* README.html  upload-haddock: 	@echo "use \`cabal upload -d' instead"@@ -99,9 +106,14 @@ 	@echo "(on Arch Linux, use: cabal haddock --for-hackage --haddock-options=--optghc=-dynamic)"  doc/index.html: $(LIB_HSS)-	./mk/haddock-i base template-haskell | xargs \-	haddock --html -odoc $(LIB_HSS) $(HADDOCKFLAGS) --title=$(PKGNAME) $(HADDOCK_PKG_NAME)+	./mk/haddock-i $(LIB_DEPS) | xargs \+	$(HADDOCK) --html -odoc $(LIB_HSS) \+	  --title=$(PKGNAME) \+	  $(HADDOCK_PKG_NAME) \+	  $(HADDOCK_HLNK_SRC) \+	  $(HADDOCKFLAGS) + # lists all Haskell source files list-all-hss: 	@find $(ALL_HSS)@@ -109,6 +121,12 @@ # lists library Haskell source files list-lib-hss: 	@find $(LIB_HSS)++bootstrap-haskell-mk:+	@[ -d "$(DEST)" ] || (echo -e "error: no destination found\nusage: \`make bootstrap-haskell-mk DEST=path/to/prj'"; exit 1)+	mkdir -p mk+	cp mk/{haskell.mk,ghcdeps,haddock-i} $(DEST)/mk+	touch $(DEST)/mk/depend.mk  show-pkgname: 	@echo $(PKGNAME)

@@ -1,7 +1,6 @@-{-# OPTIONS_HADDOCK prune #-} -- | -- Module      : Test.LeanCheck--- Copyright   : (c) 2015-2019 Rudy Matela+-- Copyright   : (c) 2015-2020 Rudy Matela -- License     : 3-Clause BSD  (see the file LICENSE) -- Maintainer  : Rudy Matela <rudy@matela.com.br> --@@ -28,6 +27,10 @@ -- we evaluate: -- -- > counterExample 1000 property+--+-- The suggested values for the number of tests to use with LeanCheck are+-- 500, 1 000 or 10 000.  LeanCheck is memory intensive and you should take+-- care if you go beyond that. -- -- -- Arguments of properties should be instances of the 'Listable' typeclass.

@@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} -- | -- Module      : Test.LeanCheck.Basic--- Copyright   : (c) 2015-2019 Rudy Matela+-- Copyright   : (c) 2015-2020 Rudy Matela -- License     : 3-Clause BSD  (see the file LICENSE) -- Maintainer  : Rudy Matela <rudy@matela.com.br> --@@ -50,8 +50,8 @@ import Test.LeanCheck.Core import Data.Ratio import Data.Complex-import Data.Int (Int8, Int16, Int32, Int64)-import Data.Word (Word, Word8, Word16, Word32, Word64)+import Data.Int+import Data.Word import Data.Char (GeneralCategory) import System.IO (IOMode (..), BufferMode (..), SeekMode (..)) import Foreign.C@@ -100,36 +100,43 @@                         (x,y,z,w,v,u,r,s,t,o,p,q))                       tiers tiers +-- | Returns tiers of applications of a 6-argument constructor. cons6 :: (Listable a, Listable b, Listable c, Listable d, Listable e, Listable f)       => (a -> b -> c -> d -> e -> f -> g) -> [[g]] cons6 f = delay $ mapT (uncurry6 f) tiers +-- | Returns tiers of applications of a 7-argument constructor. cons7 :: (Listable a, Listable b, Listable c, Listable d,           Listable e, Listable f, Listable g)       => (a -> b -> c -> d -> e -> f -> g -> h) -> [[h]] cons7 f = delay $ mapT (uncurry7 f) tiers +-- | Returns tiers of applications of a 8-argument constructor. cons8 :: (Listable a, Listable b, Listable c, Listable d,           Listable e, Listable f, Listable g, Listable h)       => (a -> b -> c -> d -> e -> f -> g -> h -> i) -> [[i]] cons8 f = delay $ mapT (uncurry8 f) tiers +-- | Returns tiers of applications of a 9-argument constructor. cons9 :: (Listable a, Listable b, Listable c, Listable d, Listable e,           Listable f, Listable g, Listable h, Listable i)       => (a -> b -> c -> d -> e -> f -> g -> h -> i -> j) -> [[j]] cons9 f = delay $ mapT (uncurry9 f) tiers +-- | Returns tiers of applications of a 10-argument constructor. cons10 :: (Listable a, Listable b, Listable c, Listable d, Listable e,            Listable f, Listable g, Listable h, Listable i, Listable j)        => (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k) -> [[k]] cons10 f = delay $ mapT (uncurry10 f) tiers +-- | Returns tiers of applications of a 11-argument constructor. cons11 :: (Listable a, Listable b, Listable c, Listable d,            Listable e, Listable f, Listable g, Listable h,            Listable i, Listable j, Listable k)        => (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l) -> [[l]] cons11 f = delay $ mapT (uncurry11 f) tiers +-- | Returns tiers of applications of a 12-argument constructor. cons12 :: (Listable a, Listable b, Listable c, Listable d,            Listable e, Listable f, Listable g, Listable h,            Listable i, Listable j, Listable k, Listable l)

@@ -1,6 +1,6 @@ -- | -- Module      : Test.LeanCheck.Core--- Copyright   : (c) 2015-2018 Rudy Matela+-- Copyright   : (c) 2015-2020 Rudy Matela -- License     : 3-Clause BSD  (see the file LICENSE) -- Maintainer  : Rudy Matela <rudy@matela.com.br> --@@ -383,11 +383,6 @@ cons4 f = delay $ mapT (uncurry4 f) tiers  -- | Returns tiers of applications of a 5-argument constructor.------ "Test.LeanCheck.Basic" defines--- 'Test.LeanCheck.Basic.cons6' up to 'Test.LeanCheck.Basic.cons12'.--- Those are exported by default from "Test.LeanCheck",--- but are hidden from the Haddock documentation. cons5 :: (Listable a, Listable b, Listable c, Listable d, Listable e)       => (a -> b -> c -> d -> e -> f) -> [[f]] cons5 f = delay $ mapT (uncurry5 f) tiers@@ -603,6 +598,11 @@ -- | Does a property __hold__ up to a number of test values? -- -- > holds 1000 $ \xs -> length (sort xs) == length xs+--+-- The suggested number of test values are 500, 1 000 or 10 000.+-- With more than that you may or may not run out of memory+-- depending on the types being tested.+-- This also applies to 'fails', 'exists', etc. holds :: Testable a => Int -> a -> Bool holds n = and . take n . map snd . results 

@@ -1,7 +1,7 @@ {-# LANGUAGE TemplateHaskell, CPP #-} -- | -- Module      : Test.LeanCheck.Derive--- Copyright   : (c) 2015-2018 Rudy Matela+-- Copyright   : (c) 2015-2020 Rudy Matela -- License     : 3-Clause BSD  (see the file LICENSE) -- Maintainer  : Rudy Matela <rudy@matela.com.br> --@@ -29,7 +29,7 @@  import Language.Haskell.TH import Test.LeanCheck.Basic-import Control.Monad (unless, liftM, liftM2, filterM)+import Control.Monad (unless, liftM, filterM) import Data.List (delete)  #if __GLASGOW_HASKELL__ < 706@@ -115,7 +115,6 @@            then reallyDeriveListableCascading t            else reallyDeriveListable t --- TODO: Somehow check if the enumeration has repetitions, then warn the user. reallyDeriveListable :: Name -> DecsQ reallyDeriveListable t = do   (nt,vs) <- normalizeType t@@ -305,6 +304,7 @@   simplify (NormalC n ts)  = (n,map snd ts)   simplify (RecC    n ts)  = (n,map trd ts)   simplify (InfixC  t1 n t2) = (n,[snd t1,snd t2])+  simplify _ = error "Test.LeanCheck.Derive.typeConstructors: unhandled case (see source)"   trd (x,y,z) = z  isTypeSynonym :: Name -> Q Bool

@@ -1,6 +1,6 @@ -- | -- Module      : Test.LeanCheck.Error--- Copyright   : (c) 2015-2018 Rudy Matela+-- Copyright   : (c) 2015-2020 Rudy Matela -- License     : 3-Clause BSD  (see the file LICENSE) -- Maintainer  : Rudy Matela <rudy@matela.com.br> --@@ -81,6 +81,17 @@ --   * ArrayException --   * ErrorCall --   * PatternMatchFail+--+-- > > errorToNothing False+-- > Just False+--+-- > > errorToNothing (0 :: Int)+-- > Just 0+--+-- > > errorToNothing (undefined :: ())+-- > Nothing+--+-- This function uses 'unsafePerformIO'. errorToNothing :: a -> Maybe a errorToNothing x = unsafePerformIO $ #if __GLASGOW_HASKELL__@@ -106,28 +117,89 @@   (Just `liftM` evaluate x) `catch` (\_ -> return Nothing) #endif +-- | Transforms errors into 'False' values.+--+-- > > errorToFalse False+-- > False+--+-- > > errorToFalse True+-- > True+--+-- > > errorToFalse undefined+-- > False+--+-- This functions uses 'unsafePerformIO'. errorToFalse :: Bool -> Bool errorToFalse = fromError False +-- | Transforms errors into 'True' values.+--+-- > > errorToTrue False+-- > False+--+-- > > errorToTrue True+-- > True+--+-- > > errorToTrue undefined+-- > True+--+-- This functions uses 'unsafePerformIO'. errorToTrue :: Bool -> Bool errorToTrue = fromError True +-- | Transforms errors into a default value.+--+-- > > fromError 0 (15 :: Int)+-- > 15+--+-- > > fromError 0 (undefined :: Int)+-- > 0 fromError :: a -> a -> a fromError x = fromMaybe x . errorToNothing -holds,fails,exists :: Testable a => Int -> a -> Bool+-- | An error-catching version of 'Test.LeanCheck.holds'+--   that returns 'False' in case of errors.+--+-- > prop_cannot_be_seven :: Int -> Bool+-- > prop_cannot_be_seven 7  =  error "Argument cannot be seven"+-- > prop_cannot_be_seven _  =  True+--+-- > > import Test.LeanCheck+-- > > holds 100 prop_cannot_be_seven+-- > *** Exception: Argument cannot be seven+--+-- > > import Test.LeanCheck.Error+-- > > holds 100 prop_cannot_be_seven+-- > False+holds :: Testable a => Int -> a -> Bool holds n = errorToFalse . C.holds n-fails n = errorToTrue  . C.fails n++-- | An error-catching version of 'Test.LeanCheck.fails'+--   that returns 'True' in case of errors.+fails :: Testable a => Int -> a -> Bool+fails n = errorToTrue . C.fails n++-- | An error-catching version of 'Test.LeanCheck.exists'.+exists :: Testable a => Int -> a -> Bool exists n = or . take n . map snd . results -counterExample,witness :: Testable a => Int -> a -> Maybe [String]+-- | An error-catching version of 'Test.LeanCheck.counterExample'.+counterExample :: Testable a => Int -> a -> Maybe [String] counterExample n = listToMaybe . counterExamples n-witness        n = listToMaybe . witnesses n -counterExamples,witnesses :: Testable a => Int -> a -> [[String]]+-- | An error-catching version of 'Test.LeanCheck.witness'.+witness :: Testable a => Int -> a -> Maybe [String]+witness n = listToMaybe . witnesses n++-- | An error-catching version of 'Test.LeanCheck.counterExamples'.+counterExamples :: Testable a => Int -> a -> [[String]] counterExamples n = map fst . filter (not . snd) . take n . results-witnesses       n = map fst . filter snd         . take n . results +-- | An error-catching version of 'Test.LeanCheck.witnesses'.+witnesses :: Testable a => Int -> a -> [[String]]+witnesses n = map fst . filter snd . take n . results++-- | An error-catching version of 'Test.LeanCheck.results'. results :: Testable a => a -> [([String],Bool)] results = map (mapSnd errorToFalse) . C.results   where mapSnd f (x,y) = (x,f y)

@@ -1,6 +1,6 @@ -- | -- Module      : Test.LeanCheck.Function--- Copyright   : (c) 2015-2018 Rudy Matela+-- Copyright   : (c) 2015-2020 Rudy Matela -- License     : 3-Clause BSD  (see the file LICENSE) -- Maintainer  : Rudy Matela <rudy@matela.com.br> --@@ -48,6 +48,7 @@ -- -- The 'Show' instance will work for all functions whose return types are -- instances of ShowFunction from "Test.LeanCheck.Function.ShowFunction".+{-# OPTIONS_GHC -fno-warn-unused-imports #-} module Test.LeanCheck.Function () where import Test.LeanCheck.Core (Listable) -- for Haddock import Test.LeanCheck.Function.Listable ()

@@ -1,6 +1,6 @@ -- | -- Module      : Test.LeanCheck.Function.Eq--- Copyright   : (c) 2015-2018 Rudy Matela+-- Copyright   : (c) 2015-2020 Rudy Matela -- License     : 3-Clause BSD  (see the file LICENSE) -- Maintainer  : Rudy Matela <rudy@matela.com.br> --

@@ -1,15 +1,15 @@ -- | -- Module      : Test.LeanCheck.Function.Listable--- Copyright   : (c) 2015-2018 Rudy Matela+-- Copyright   : (c) 2015-2020 Rudy Matela -- License     : 3-Clause BSD  (see the file LICENSE) -- Maintainer  : Rudy Matela <rudy@matela.com.br> -- -- This module is part of LeanCheck, -- a simple enumerative property-based testing library. ----- This module exports a 'Listable' instance for functions.+-- This module exports a 'Test.LeanCheck.Listable' instance for functions. ----- LeanCheck provides one definition of 'Listable' functions:+-- LeanCheck provides one definition of 'Test.LeanCheck.Listable' functions: -- -- * "Test.LeanCheck.Function.Listable.ListsOfPairs": --   considers functions as a finite list of exceptional input-output cases to@@ -22,4 +22,4 @@ -- importing this on modules that are used as libraries. module Test.LeanCheck.Function.Listable () where -import Test.LeanCheck.Function.Listable.ListsOfPairs+import Test.LeanCheck.Function.Listable.ListsOfPairs ()

@@ -1,6 +1,6 @@ -- | -- Module      : Test.LeanCheck.Function.ListsOfPairs--- Copyright   : (c) 2015-2018 Rudy Matela+-- Copyright   : (c) 2015-2020 Rudy Matela -- License     : 3-Clause BSD  (see the file LICENSE) -- Maintainer  : Rudy Matela <rudy@matela.com.br> --

@@ -1,6 +1,6 @@ -- | -- Module      : Test.LeanCheck.Function.ListsOfPairs--- Copyright   : (c) 2015-2018 Rudy Matela+-- Copyright   : (c) 2015-2020 Rudy Matela -- License     : 3-Clause BSD  (see the file LICENSE) -- Maintainer  : Rudy Matela <rudy@matela.com.br> --@@ -19,7 +19,6 @@  import Test.LeanCheck import Test.LeanCheck.Tiers-import Data.Maybe (fromMaybe)  -- | Given tiers of argument and result values, --   return tiers of functional values.

@@ -1,6 +1,6 @@ -- | -- Module      : Test.LeanCheck.Function.Show--- Copyright   : (c) 2015-2018 Rudy Matela+-- Copyright   : (c) 2015-2020 Rudy Matela -- License     : 3-Clause BSD  (see the file LICENSE) -- Maintainer  : Rudy Matela <rudy@matela.com.br> --@@ -13,10 +13,11 @@ -- /Warning: this is only intended to be used in testing modules./ -- /Avoid importing this on modules that are used as libraries./ ----- This is intended to 'Show' functions generated by the 'Listable' instance--- for functions defined in "Test.LeanCheck.Function.Listable": functions that--- have finite exceptions to a constant function.  It does work on other types--- of functions, albeit using @"..."@.+-- This is intended to 'Show' functions+-- generated by the 'Test.LeanCheck.Listable' instance for functions+-- defined in "Test.LeanCheck.Function.Listable":+-- functions that have finite exceptions to a constant function.+-- It does work on other types of functions, albeit using @"..."@. -- -- > > print (&&) -- > \x y -> case (x,y) of

@@ -1,6 +1,6 @@ -- | -- Module      : Test.LeanCheck.Function.Show.EightLines--- Copyright   : (c) 2015-2018 Rudy Matela+-- Copyright   : (c) 2015-2020 Rudy Matela -- License     : 3-Clause BSD  (see the file LICENSE) -- Maintainer  : Rudy Matela <rudy@matela.com.br> --@@ -69,4 +69,6 @@ -- >         (1,-1) -> 0 -- >         ... instance (Show a, Listable a, ShowFunction b) => Show (a->b) where-  showsPrec _ = (++) . showFunction 8+  showsPrec d f = showParen (d > 0 && '\n' `notElem` s) (s ++)+    where+    s = showFunction 8 f

@@ -1,6 +1,6 @@ -- | -- Module      : Test.LeanCheck.Function.Show.FourCases--- Copyright   : (c) 2015-2018 Rudy Matela+-- Copyright   : (c) 2015-2020 Rudy Matela -- License     : 3-Clause BSD  (see the file LICENSE) -- Maintainer  : Rudy Matela <rudy@matela.com.br> --@@ -50,4 +50,4 @@ -- > > print (+) -- > \x y -> case (x,y) of (0,0) -> 0; (0,1) -> 1; (1,0) -> 1; (0,-1) -> -1; ... instance (Show a, Listable a, ShowFunction b) => Show (a->b) where-  showsPrec d = showParen (d>10) . (++) . showFunctionLine 4+  showsPrec d = showParen (d>0) . (++) . showFunctionLine 4

@@ -1,6 +1,7 @@+{-# LANGUAGE CPP #-} -- | -- Module      : Test.LeanCheck.Function.ShowFunction--- Copyright   : (c) 2015-2018 Rudy Matela+-- Copyright   : (c) 2015-2020 Rudy Matela -- License     : 3-Clause BSD  (see the file LICENSE) -- Maintainer  : Rudy Matela <rudy@matela.com.br> --@@ -59,7 +60,6 @@ import Test.LeanCheck.Error (errorToNothing) import Test.LeanCheck.Utils.Types import Test.LeanCheck.Stats (classifyOn)-import Data.List (intercalate, sortBy) import Data.Maybe import Data.Function (on) import Data.Word@@ -70,7 +70,23 @@ import System.Exit (ExitCode) import System.IO (IOMode, BufferMode, SeekMode) import Foreign.C+#ifndef __HUGS__+import Data.List (intercalate, sortBy)+#else+import Data.List (sortBy) +intercalate :: [a] -> [[a]] -> [a]+intercalate xs xss = concat (intersperse xs xss)+  where+  intersperse             :: a -> [a] -> [a]+  intersperse _   []      = []+  intersperse sep (x:xs)  = x : prependToAll sep xs+    where+    prependToAll            :: a -> [a] -> [a]+    prependToAll _   []     = []+    prependToAll sep (x:xs) = sep : x : prependToAll sep xs+#endif+ -- | A functional binding in a showable format. --   Argument values are represented as a list of strings. --   The result value is represented by 'Just' a 'String' when defined@@ -199,10 +215,6 @@ paren :: String -> String paren s = "(" ++ s ++ ")" -varnamesFor :: ShowFunction a => a -> [String]-varnamesFor = zipWith const varnames . fst . head . bindings-  where varnames = ["x","y","z","w"] ++ map (++"'") varnames- showTuple :: [String] -> String showTuple [x]  =  x showTuple xs | all (== "_") xs  =  "_"@@ -316,6 +328,7 @@       => ShowFunction (a,b,c,d) where bindtiers = bindtiersShow instance (Show a, Show b, Show c, Show d, Show e)       => ShowFunction (a,b,c,d,e) where bindtiers = bindtiersShow+#ifndef __HUGS__ instance (Show a, Show b, Show c, Show d, Show e, Show f)       => ShowFunction (a,b,c,d,e,f) where bindtiers = bindtiersShow instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g)@@ -338,6 +351,7 @@          , Show e, Show f, Show g, Show h          , Show i, Show j, Show k, Show l )       => ShowFunction (a,b,c,d,e,f,g,h,i,j,k,l) where bindtiers = bindtiersShow+#endif  -- Data.Ratio instance (Integral a, Show a) => ShowFunction (Ratio a) where bindtiers = bindtiersShow@@ -436,51 +450,6 @@ instance ShowFunction CUSeconds  where bindtiers = bindtiersShow instance ShowFunction CSUSeconds where bindtiers = bindtiersShow #endif---- | Hard coded function names and bindings---   Search this list for a short name for your function.-functionNames :: [(String, [Binding])]-functionNames =-  [ "id"    `for` (id          :: () -> ())-  , "const" `for` (const       :: () -> () -> ())--  -- booleans-  , "id"    `for` (id          :: Bool -> Bool)-  , "not"   `for` (not         :: Bool -> Bool)-  , "const" `for` (const :: Bool -> Bool -> Bool)--  , "(&&)"  `for` (&&)-  , "(||)"  `for` (||)--  -- numeric types-  , "id"      `for` (id      :: Int -> Int)-  , "const"   `for` (const   :: Int -> Int -> Int)--  -- Num typeclass-  , "(+)"     `for` ((+)     :: Int -> Int -> Int)-  , "(-)"     `for` ((-)     :: Int -> Int -> Int)-  , "(*)"     `for` ((*)     :: Int -> Int -> Int)-  , "negate"  `for` (negate  :: Int -> Int)-  , "abs"     `for` (abs     :: Int -> Int)-  , "signum"  `for` (signum  :: Int -> Int)--  -- integer properties-  , "odd"     `for` (odd     :: Int -> Bool)-  , "even"    `for` (even    :: Int -> Bool)-  ]-  where-  n `for` f = (n, bindings f)---- | Tries to name a function heuristically-name :: ShowFunction a => Int -> a -> Maybe String-name n f = listToMaybe [ nm | (nm, bs) <- functionNames-                            , take n bs == take n (bindings f)]--canName :: ShowFunction a => Int -> a -> Bool-canName n = isJust . name n--showName :: ShowFunction a => Int -> a -> String-showName n = fromMaybe "unknown" . name n  -- | Returns a set of variables and a set of bindings --   describing how a function works.

@@ -4,7 +4,7 @@ #endif -- | -- Module      : Test.LeanCheck.Generic--- Copyright   : (c) 2018 Rudy Matela+-- Copyright   : (c) 2018-2020 Rudy Matela -- License     : 3-Clause BSD  (see the file LICENSE) -- Maintainer  : Rudy Matela <rudy@matela.com.br> --

@@ -1,6 +1,6 @@ -- | -- Module      : Test.LeanCheck.IO--- Copyright   : (c) 2015-2018 Rudy Matela+-- Copyright   : (c) 2015-2020 Rudy Matela -- License     : 3-Clause BSD  (see the file LICENSE) -- Maintainer  : Rudy Matela <rudy@matela.com.br> --@@ -22,8 +22,6 @@ #endif  import Test.LeanCheck.Core-import Data.Maybe (listToMaybe)-import Data.List (find) #ifdef __GLASGOW_HASKELL__ import Control.Exception (SomeException, catch, evaluate) #else@@ -32,7 +30,7 @@ type SomeException = Exception #endif --- | Checks a property printing results on 'stdout'+-- | Checks a property printing results on 'System.IO.stdout' -- -- > > check $ \xs -> sort (sort xs) == sort (xs::[Int]) -- > +++ OK, passed 200 tests.@@ -43,7 +41,7 @@ check p = checkResult p >> return ()  -- | Check a property for a given number of tests---   printing results on 'stdout'+--   printing results on 'System.IO.stdout' -- -- > > checkFor 1000 $ \xs -> sort (sort xs) == sort (xs::[Int]) -- > +++ OK, passed 1000 tests.@@ -51,7 +49,7 @@ checkFor n p = checkResultFor n p >> return ()  -- | Check a property---   printing results on 'stdout' and+--   printing results on 'System.IO.stdout' and --   returning 'True' on success. -- -- > > p <- checkResult $ \xs -> sort (sort xs) == sort (xs::[Int])@@ -68,7 +66,7 @@ checkResult p = checkResultFor 200 p  -- | Check a property for a given number of tests---   printing results on 'stdout' and+--   printing results on 'System.IO.stdout' and --   returning 'True' on success. -- -- > > checkResultFor 1000 $ \xs -> sort (sort xs) == sort (xs::[Int])@@ -118,8 +116,13 @@  -- joins the counter-example arguments joinArgs :: [String] -> String-joinArgs ce | any ('\n' `elem`) ce = unlines $ map chopBreak ce+joinArgs ce | any ('\n' `elem`) ce = unlines $ map (chopBreak . deparenf) ce             | otherwise            = unwords ce++-- deparenthises a functional expression if it is parenthized+deparenf :: String -> String+deparenf ('(':'\\':cs) | last cs == ')' = '\\':init cs+deparenf cs                        = cs  -- chops a line break at the end if there is any chopBreak :: String -> String

@@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} -- | -- Module      : Test.LeanCheck.Stats--- Copyright   : (c) 2017-2018 Rudy Matela+-- Copyright   : (c) 2017-2020 Rudy Matela -- License     : 3-Clause BSD  (see the file LICENSE) -- Maintainer  : Rudy Matela <rudy@matela.com.br> --@@ -43,6 +43,26 @@     prependToAll sep (x:xs) = sep : x : prependToAll sep xs #endif +-- | Prints statistics about a given 'Listable' generator+--   up to a number of test values.+--+-- For example,+-- to know the distribution of the length of generated lists,+-- just run:+--+-- > > classStats 100 (length :: [Int] -> Int)+-- > 0:  1/100  1%+-- > 1:  6/100  6%+-- > 2: 16/100 16%+-- > 3: 25/100 25%+-- > 4: 26/100 26%+-- > 5: 18/100 18%+-- > 6:  7/100  7%+-- > 7:  1/100  1%+--+-- This provides similar functionality to QuickCheck's+-- label, collect, classify and tabulate+-- while keeping statistics separate from your properties. classStats :: (Listable a, Show b) => Int -> (a -> b) -> IO () classStats n f = putStrLn                . table " "@@ -56,6 +76,29 @@                     , show (100 * n `div` len) ++ "%"                     ] +-- | Same as 'classStats', but separated by 'tiers'.+--+-- The first argument is the number of tiers to evaluate.+--+-- > > classStatsT 6 (length :: [Int] -> Int)+-- >       tot   0  1  2  3  4   5+-- > +-- > tot:   32   1  1  2  4  8  16+-- >   0:    1   1  0  0  0  0   0+-- >   1:    5   0  1  1  1  1   1+-- >   2:   10   0  0  1  2  3   4+-- >   3:   10   0  0  0  1  3   6+-- >   4:    5   0  0  0  0  1   4+-- >   5:    1   0  0  0  0  0   1+--+-- Lines are values, columns are tiers:+--+-- > > classStatsT 6 and+-- >         tot   0  1  2  3   4   5+-- > +-- >   tot:   63   1  2  4  8  16  32+-- >  True:    6   1  1  1  1   1   1+-- > False:   57   0  1  3  7  15  31 classStatsT :: (Listable a, Show b) => Int -> (a -> b) -> IO () classStatsT n f = putStrLn                 . table "  "@@ -72,6 +115,18 @@   totalizeCounts = foldr (-+-) (undefined, 0, repeat 0)   prependTotal cs = totalizeCounts cs : cs +-- | How many values match each of a list of conditions?+-- +-- How many odd and even numbers are in the 'Listable' enumeration?+--+-- > > conditionStats 1000 [("odd", odd :: Int -> Bool), ("even", even)]+-- >  odd: 500/1000 50%+-- > even: 500/1000 50%+--+-- How many of the generated lists are ordered?+--+-- > > conditionStats 1000 [("ordered", ordered :: [Int] -> Bool)]+-- > ordered: 131/1000 13% conditionStats :: Listable a => Int -> [(String,a->Bool)] -> IO () conditionStats n = putStrLn . table " " . map show1   where@@ -83,13 +138,44 @@                    , show (100 * c `div` len) ++ "%" ]   count f = length . filter f --- TODO: implement conditionStatsT+-- | Same as 'conditionStats' but by tier.+--+-- The first argument is the number of tiers to evaluate.+--+-- How many odd and even numbers are in each tier?+--+-- > > conditionStatsT 10 [("odd", odd :: Int -> Bool), ("even", even)]+-- > total: 1 1 1 1 1 1 1 1 1 1+-- >   odd: 0 1 1 0 0 1 1 0 0 1+-- >  even: 1 0 0 1 1 0 0 1 1 0+--+-- How many ordered lists are in each tier?+--+-- > > conditionStatsT 10 [("ordered", ordered :: [Int] -> Bool)]+-- >   total: 1 1 2 4 8 16 32 64 128 256+-- > ordered: 1 1 2 3 5  7 11 15  22  30 conditionStatsT :: Listable a => Int -> [(String,a->Bool)] -> IO ()-conditionStatsT = error "conditionsStatsT: not implemented yet, use conditionStats for now"+conditionStatsT n = putStrLn . table " " . map show1 . (("total", const True):)+  where+  xss = take n tiers+  show1 (s,f) = (s ++ ":") : map (show . count f) xss+  count f = length . filter f +-- | Classify values using their 'Eq' instance.+--+-- > > classify [1,2,3,1,2,1]+-- > [[1,1,1],[2,2],[3]]+--+-- (cf. 'classifyBy', 'classifyOn') classify :: Eq a => [a] -> [[a]] classify = classifyBy (==) +-- | Classify values by a given comparison function.+--+-- > > classifyBy (\(x,_) (y,_) -> x == y) [(1,1),(1,2),(2,1),(2,2)]+-- > [[(1,1),(1,2)],[(2,1),(2,2)]]+--+-- (cf. 'classify', 'classifyOn') classifyBy :: (a -> a -> Bool) -> [a] -> [[a]] classifyBy (==) []     = [] classifyBy (==) (x:xs) = (x:filter (== x) xs)@@ -97,17 +183,39 @@   where   x /= y = not (x == y) +-- | Classify values based on the result of a given function.+--+-- > > classifyOn head ["sheep", "chip", "ship", "cheap"]+-- > [["sheep","ship"],["chip","cheap"]]+--+-- > > classifyOn odd [1,2,3,4,5,6]+-- > [[1,3,5],[2,4,6]]+--+-- (cf. 'classify', 'classifyBy') classifyOn :: Eq b => (a -> b) -> [a] -> [[a]] classifyOn f xs = map (map fst)                 . classifyBy ((==) `on` snd)                 $ map (\x -> (x,f x)) xs +-- | Returns the counts of each value in a list.+--+-- > > counts "Mississippi"+-- > [('M',1),('i',4),('s',4),('p',2)]+--+-- Values are returned in the order they appear. counts :: Eq a => [a] -> [(a,Int)] counts = map headLength . classify +-- | Returns the counts of each value in a list+--   using a given comparison function. countsBy :: (a -> a -> Bool) -> [a] -> [(a,Int)] countsBy (==) = map headLength . classifyBy (==) +-- | Returns the counts of each value in a list+--   based on a projection.+--+-- > > countsOn length ["sheep", "chip", "ship", "cheap", "Mississippi"]+-- > [(5,2),(4,2),(11,1)] countsOn :: Eq b => (a -> b) -> [a] -> [(b,Int)] countsOn f = map (\xs -> (f $ head xs, length xs)) . classifyOn f 

@@ -1,6 +1,6 @@ -- | -- Module      : Test.LeanCheck.Tiers--- Copyright   : (c) 2015-2018 Rudy Matela+-- Copyright   : (c) 2015-2020 Rudy Matela -- License     : 3-Clause BSD  (see the file LICENSE) -- Maintainer  : Rudy Matela <rudy@matela.com.br> --@@ -86,7 +86,7 @@ -- | 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.+-- For example, a @Bag@ represented as a list. -- -- > bagCons Bag bagCons :: Listable a => ([a] -> b) -> [[b]]@@ -128,13 +128,34 @@ noDupListCons :: Listable a => ([a] -> b) -> [[b]] noDupListCons = (`mapT` noDupListsOf tiers) +-- | Like 'cons0' but lifted over a 'Maybe' value.+--+-- Only a 'Just' value will be returned. maybeCons0 :: Maybe b -> [[b]] maybeCons0 Nothing  = [] maybeCons0 (Just x) = [[x]] +-- | Like 'cons1' but lifted over a 'Maybe' result.+--+-- This discard 'Nothing' values.+-- Only 'Just' values are returned. maybeCons1 :: Listable a => (a -> Maybe b) -> [[b]] maybeCons1 f = delay $ mapMaybeT f tiers +-- | Like 'cons2' but lifted over a 'Maybe' result.+--+-- This discard 'Nothing' values.+-- Only 'Just' values are returned.+--+-- Useful when declaring generators which have pre-conditions:+--+-- > data Fraction = Fraction Int Int+-- >+-- > mkFraction _ 0 = Nothing+-- > mkFraction n d = Fraction n d+-- >+-- > instance Listable Fraction where+-- >   tiers = maybeCons2 mkFraction maybeCons2 :: (Listable a, Listable b) => (a -> b -> Maybe c) -> [[c]] maybeCons2 f = delay $ mapMaybeT (uncurry f) tiers @@ -286,7 +307,7 @@ catMaybesT :: [[Maybe a]] -> [[a]] catMaybesT = map catMaybes --- | Like 'mapMaybe' but for tiers.+-- | Like 'Data.Maybe.mapMaybe' but for tiers. mapMaybeT :: (a -> Maybe b) -> [[a]] -> [[b]] mapMaybeT f = catMaybesT . mapT f 

@@ -1,6 +1,6 @@ -- | -- Module      : Test.LeanCheck.Utils--- Copyright   : (c) 2015-2018 Rudy Matela+-- Copyright   : (c) 2015-2020 Rudy Matela -- License     : 3-Clause BSD  (see the file LICENSE) -- Maintainer  : Rudy Matela <rudy@matela.com.br> --

@@ -1,6 +1,6 @@ -- | -- Module      : Test.LeanCheck.Utils.Operators--- Copyright   : (c) 2015-2018 Rudy Matela+-- Copyright   : (c) 2015-2020 Rudy Matela -- License     : 3-Clause BSD  (see the file LICENSE) -- Maintainer  : Rudy Matela <rudy@matela.com.br> --@@ -10,63 +10,80 @@ -- Some operators for property-based testing. module Test.LeanCheck.Utils.Operators   (---  (==>) -- already provided by Test.LeanCheck    -- * Combining properties-    (===), (====)-  , (&&&), (&&&&)+    (==>)+  , (===), (====)+  , (&&&), (&&&&), (&&&&&)   , (|||), (||||)    -- * Properties of unary functions+  , isIdempotent+  , isIdentity+  , isNeverIdentity++  -- * Properties of operators (binary functions)+  , isCommutative+  , isAssociative+  , isDistributiveOver+  , isLeftDistributiveOver+  , isRightDistributiveOver+  , isFlipped++  -- * Properties of relations (binary functions returning truth values)+  , isTransitive+  , isReflexive+  , isIrreflexive+  , isSymmetric+  , isAsymmetric+  , isAntisymmetric++  -- * Properties of order relations+  , isEquivalence+  , isPartialOrder+  , isStrictPartialOrder+  , isTotalOrder+  , isStrictTotalOrder+  , isComparison++  -- * Ternary comparison operators+  , (=$), ($=)+  , (=|), (|=)++  -- * Properties for typeclass instances+  , okEq+  , okOrd+  , okEqOrd+  , okNum+  , okNumNonNegative++  -- * Deprecated functions   , idempotent   , identity   , neverIdentity--  -- * Properties of operators (binary functions)   , commutative   , associative   , distributive   , symmetric2--  -- * Properties of relations (binary functions returning truth values)   , transitive   , reflexive   , irreflexive   , symmetric   , asymmetric   , antisymmetric--  -- ** Order relations   , equivalence   , partialOrder   , strictPartialOrder   , totalOrder   , strictTotalOrder   , comparison--  -- * Ternary comparison operators-  , (=$), ($=)-  , (=|), (|=)--  -- * Properties for typeclass instances-  , okEq-  , okOrd-  , okEqOrd-  , okNum-  , okNumNonNegative   ) where --- TODO: Add examples in the haddock documentation of most functions in this---       module.---- 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+combine (?) f g  =  \x -> f x ? g x  -- Uneeded, just food for thought: -- > combine2 :: (c -> d -> e) -> (a -> b -> c) -> (a -> b -> d) -> (a -> b -> e)@@ -74,198 +91,456 @@ -- > combine2 op f g = \x y -> f x y `op` g x y -- > combine2 = combine . combine +-- | Allows building equality properties between functions.+--+-- > prop_id_idempotent  =  id === id . id+--+-- > > check $ id === (+0)+-- > +++ OK, passed 200 tests.+--+-- > > check $ id === id . id+-- > +++ OK, passed 1 tests (exhausted).+--+-- > > check $ id === (+1)+-- > *** Failed! Falsifiable (after 1 tests):+-- > 0 (===) :: Eq b => (a -> b) -> (a -> b) -> a -> Bool-(===) = combine (==)+(===)  =  combine (==) infix 4 === +-- | Allows building equality properties between two-argument functions.+--+-- > > holds 100 $ const ==== asTypeOf+-- > True+--+-- > > holds 100 $ (+) ==== flip (+)+-- > True+--+-- > > holds 100 $ (+) ==== (*)+-- > False (====) :: Eq c => (a -> b -> c) -> (a -> b -> c) -> a -> b -> Bool-(====) = combine (===)+(====)  =  combine (===) infix 4 ==== +-- | And ('&&') operator over one-argument properties.+--+-- Allows building conjuntions between one-argument properties:+--+-- > > holds 100 $ id === (+0) &&& id === (id . id)+-- > True (&&&) :: (a -> Bool) -> (a -> Bool) -> a -> Bool-(&&&) = combine (&&)+(&&&)  =  combine (&&) infixr 3 &&& +-- | And ('&&') operator over two-argument properties.+--+-- Allows building conjuntions between two-argument properties:+--+-- > > holds 100 $ (+) ==== flip (+) &&&& (+) ==== (*)+-- > False (&&&&) :: (a -> b -> Bool) -> (a -> b -> Bool) -> a -> b -> Bool-(&&&&) = combine (&&&)+(&&&&)  =  combine (&&&) infixr 3 &&&& +-- | And operator over three-argument properties. (&&&&&) :: (a -> b -> c -> Bool) -> (a -> b -> c -> Bool) -> a -> b -> c -> Bool-(&&&&&) = combine (&&&&)+(&&&&&)  =  combine (&&&&) infixr 3 &&&&& +-- | Or ('||') operator over one-argument properties.+--+-- Allows building disjunctions between one-argument properties:+--+-- > > holds 100 $ id === (+0) ||| id === (id . id)+-- > True (|||) :: (a -> Bool) -> (a -> Bool) -> a -> Bool-(|||) = combine (||)+(|||)  =  combine (||) infixr 2 ||| +-- | Or ('||') operator over two-argument properties.+--+-- Allows building conjuntions between two-argument properties:+--+-- > > holds 100 $ (+) ==== flip (+) |||| (+) ==== (*)+-- > True (||||) :: (a -> b -> Bool) -> (a -> b -> Bool) -> a -> b -> Bool-(||||) = combine (|||)+(||||)  =  combine (|||) infixr 2 ||||  -- | Is a given operator commutative?  @x + y = y + x@ ----- > holds n $ commutative (+)+-- > > check $ isCommutative (+)+-- > +++ OK, passed 200 tests. ----- > 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+-- > > import Data.List+-- > > check $ isCommutative (union :: [Int]->[Int]->[Int])+-- > *** Failed! Falsifiable (after 4 tests):+-- > [] [0,0]+isCommutative :: Eq b => (a -> a -> b) -> a -> a -> Bool+isCommutative (?)  =  \x y -> x ? y == y ? 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+--+-- > > check $ isAssociative (+)+-- > +++ OK, passed 200 tests.+--+-- > > check $ isAssociative (-)+-- > *** Failed! Falsifiable (after 2 tests):+-- > 0 0 1+isAssociative :: Eq a => (a -> a -> a) -> a -> a -> a -> Bool+isAssociative (?)  =  \x y z -> x ? (y ? z) == (x ? y) ? z --- | 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)+-- | Does the first operator, left-distributes over the second?+--+-- This is an alias to 'isLeftDistributiveOver'.+isDistributiveOver :: Eq a => (a -> a -> a) -> (a -> a -> a) -> a -> a -> a -> Bool+isDistributiveOver  =  isLeftDistributiveOver --- | Are two operators flipped versions of each other?+-- | Does the first operator, left-distributes over the second?+--   @x * (y + z) = (x * y) + (x * z)@ ----- > holds n $ (<)  `symmetric2` (>)  -:> int--- > holds n $ (<=) `symmetric2` (>=) -:> int+-- > > check $ (*) `isLeftDistributiveOver` (+)+-- > +++ OK, passed 200 tests. ----- > 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+-- > > check $ (+) `isLeftDistributiveOver` (*)+-- > *** Failed! Falsifiable (after 8 tests):+-- > 1 0 1+isLeftDistributiveOver :: Eq a => (a -> a -> a) -> (a -> a -> a) -> a -> a -> a -> Bool+(?) `isLeftDistributiveOver` (#)  =  \x y z -> x ? (y # z) == (x ? y) # (x ? z) +-- | Does the first operator, right-distributes over the second?+--   @(y + z) * x = (y * x) + (z * x)@+--+-- > > check $ (*) `isRightDistributiveOver` (+)+-- > +++ OK, passed 200 tests.+--+-- > > check $ (+) `isRightDistributiveOver` (*)+-- > *** Failed! Falsifiable (after 8 tests):+-- > 1 0 1+isRightDistributiveOver :: Eq a => (a -> a -> a) -> (a -> a -> a) -> a -> a -> a -> Bool+(?) `isRightDistributiveOver` (#)  =  \x y z -> (y # z) ? x == (y ? x) # (z ? x)++-- | Are two operators 'flip'ped versions of each other?+--+-- > > check $ ((<) `isFlipped` (>) :: Int -> Int -> Bool)+-- > +++ OK, passed 200 tests.+--+-- > > check $ ((<=) `isFlipped` (>=) :: Int -> Int -> Bool)+-- > +++ OK, passed 200 tests.+--+-- > > check $ ((<) `isFlipped` (>=) :: Int -> Int -> Bool)+-- > *** Failed! Falsifiable (after 1 tests):+-- > 0 0+--+-- > > check $ ((<=) `isFlipped` (>) :: Int -> Int -> Bool)+-- > *** Failed! Falsifiable (after 1 tests):+-- > 0 0+isFlipped :: Eq c => (a -> b -> c) -> (b -> a -> c) -> a -> b -> Bool+(+-) `isFlipped` (-+)  =  \x y -> x +- y == y -+ x+ -- | 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+--+-- A relation is transitive when+-- if a is related to b then b is related to c.+--+-- > > check $ isTransitive ((==) :: Int->Int->Bool)+-- > +++ OK, passed 200 tests.+--+-- > > check $ isTransitive ((/=) :: Int->Int->Bool)+-- > *** Failed! Falsifiable (after 3 tests):+-- > 0 1 0+isTransitive :: (a -> a -> Bool) -> a -> a -> a -> Bool+isTransitive (?)  =  \x y z -> x ? y && y ? z ==> x ? z --- | An element is always related to itself.-reflexive :: (a -> a -> Bool) -> a -> Bool-reflexive o = \x -> x `o` x+-- | Is a given relation reflexive?+--+-- A relation is reflexive when+-- an element is always related to itself.+--+-- > > check $ isReflexive ((==) :: Int->Int->Bool)+-- > +++ OK, passed 200 tests.+--+-- > > check $ isReflexive ((/=) :: Int->Int->Bool)+-- > *** Failed! Falsifiable (after 1 tests):+-- > 0+isReflexive :: (a -> a -> Bool) -> a -> Bool+isReflexive (?)  =  \x -> x ? 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 irreflexive?+--+-- A given relation is irreflexive or anti-reflexive+-- when an element is _never_ related to itself.+--+-- This is /not/ the negation of 'isReflexive'.+--+-- > > check $ isIrreflexive ((==) :: Int->Int->Bool)+-- > *** Failed! Falsifiable (after 1 tests):+-- > 0+--+-- > > check $ isIrreflexive ((/=) :: Int->Int->Bool)+-- > +++ OK, passed 200 tests.+isIrreflexive :: (a -> a -> Bool) -> a -> Bool+isIrreflexive (?)  =  \x -> not $ x ? x  -- | Is a given relation symmetric?--- This is a type-restricted version of 'commutative'.-symmetric :: (a -> a -> Bool) -> a -> a -> Bool-symmetric = commutative+--+-- A relation is symmetric when+-- if a is related to b, then b is related to a.+--+-- > > check $ isSymmetric (&&)+-- > +++ OK, passed 4 tests (exhausted).+--+-- > > check $ isSymmetric (==>)+-- > *** Failed! Falsifiable (after 2 tests):+-- > False True+--+-- This is a type-restricted version of 'isCommutative'.+isSymmetric :: (a -> a -> Bool) -> a -> a -> Bool+isSymmetric  =  isCommutative  -- | 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+--+-- Not to be confused with 'isAsymmetric'.+-- Not to be confused with the negation of 'isSymmetric'.+--+-- > > check $ isAntisymmetric ((<=) :: Int->Int->Bool)+-- > +++ OK, passed 200 tests.+--+-- > > check $ isAntisymmetric ((/=) :: Int->Int->Bool)+-- > *** Failed! Falsifiable (after 2 tests):+-- > 0 1+isAntisymmetric :: Eq a => (a -> a -> Bool) -> a -> a -> Bool+isAntisymmetric (?)  =  \x y -> x ? y && y ? 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)+--+-- Not to be confused with not 'isSymmetric' and 'isAntisymmetric'.+--+-- > > check $ isAsymmetric ((<=) :: Int->Int->Bool)+-- > *** Failed! Falsifiable (after 1 tests):+-- > 0 0+--+-- > > check $ isAsymmetric ((<) :: Int->Int->Bool)+-- > +++ OK, passed 200 tests.+isAsymmetric :: (a -> a -> Bool) -> a -> a -> Bool+isAsymmetric (?)  =  \x y -> x ? y ==> not (y ? x)  -- | Is the given binary relation an equivalence?---   Is the given relation reflexive, symmetric and transitive? ----- > > check (equivalence (==) :: Int -> Int -> Int -> Bool)+-- In other words,+-- is the given relation reflexive, symmetric and transitive?+--+-- > > check (isEquivalence (==) :: Int -> Int -> Int -> Bool) -- > +++ OK, passed 200 tests.--- > > check (equivalence (<=) :: Int -> Int -> Int -> Bool)+--+-- > > check (isEquivalence (<=) :: Int -> Int -> Int -> Bool) -- > *** Failed! Falsifiable (after 3 tests): -- > 0 1 0 -- -- Or, using "Test.LeanCheck.Utils.TypeBinding": ----- > > check $ equivalence (<=) -:> int+-- > > check $ isEquivalence (<=) -:> int -- > *** Failed! Falsifiable (after 3 tests): -- > 0 1 0-equivalence :: (a -> a -> Bool) -> a -> a -> a -> Bool-equivalence (==) = \x y z -> reflexive  (==) x-                          && symmetric  (==) x y-                          && transitive (==) x y z+isEquivalence :: (a -> a -> Bool) -> a -> a -> a -> Bool+isEquivalence (==)  =  \x y z -> isReflexive  (==) x+                              && isSymmetric  (==) x y+                              && isTransitive (==) x y z  -- | Is the given binary relation a partial order?---   Is the given relation reflexive, antisymmetric and transitive?-partialOrder :: Eq a => (a -> a -> Bool) -> a -> a -> a -> Bool-partialOrder (<=) = \x y z -> reflexive     (<=) x-                           && antisymmetric (<=) x y-                           && transitive    (<=) x y z+--+-- In other words,+-- is the given relation reflexive, antisymmetric and transitive?+--+-- > > check $ isPartialOrder ((<) :: Int->Int->Bool)+-- > *** Failed! Falsifiable (after 1 tests):+-- > 0 0 0+--+-- > > check $ isPartialOrder ((<=) :: Int->Int->Bool)+-- > +++ OK, passed 200 tests.+--+-- > > check $ isPartialOrder isSubsetOf+-- > +++ OK, passed 200 tests.+isPartialOrder :: Eq a => (a -> a -> Bool) -> a -> a -> a -> Bool+isPartialOrder (<=)  =  \x y z -> isReflexive     (<=) x+                               && isAntisymmetric (<=) x y+                               && isTransitive    (<=) x y z  -- | Is the given binary relation a strict partial order?---   Is the given relation irreflexive, asymmetric and transitive?-strictPartialOrder :: (a -> a -> Bool) -> a -> a -> a -> Bool-strictPartialOrder (<) = \x y z -> irreflexive (<) x-                                && asymmetric  (<) x y -- implied?-                                && transitive  (<) x y z+--+-- In other words,+-- is the given relation irreflexive, asymmetric and transitive?+--+-- > > check $ isStrictPartialOrder ((<) :: Int->Int->Bool)+-- > +++ OK, passed 200 tests.+--+-- > > check $ isStrictPartialOrder ((<=) :: Int->Int->Bool)+-- > *** Failed! Falsifiable (after 1 tests):+-- > 0 0 0+isStrictPartialOrder :: (a -> a -> Bool) -> a -> a -> a -> Bool+isStrictPartialOrder (<)  =  \x y z -> isIrreflexive (<) x+                                    && isAsymmetric  (<) x y -- implied?+                                    && isTransitive  (<) x y z  -- | Is the given binary relation a total order?-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+--+-- > > check $ isTotalOrder ((<) :: Int->Int->Bool)+-- > *** Failed! Falsifiable (after 1 tests):+-- > 0 0 0+-- > > check $ isTotalOrder ((<=) :: Int->Int->Bool)+-- > +++ OK, passed 200 tests.+isTotalOrder :: Eq a => (a -> a -> Bool) -> a -> a -> a -> Bool+isTotalOrder (<=)  =  \x y z -> (x <= y || y <= x)+                             && isAntisymmetric (<=) x y+                             && isTransitive    (<=) x y z  -- | Is the given binary relation a strict total order?-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+--+-- > > check $ isStrictTotalOrder ((<=) :: Int->Int->Bool)+-- > *** Failed! Falsifiable (after 1 tests):+-- > 0 0 0+--+-- > > check $ isStrictTotalOrder ((<) :: Int->Int->Bool)+-- > +++ OK, passed 200 tests.+isStrictTotalOrder :: Eq a => (a -> a -> Bool) -> a -> a -> a -> Bool+isStrictTotalOrder (<)  =  \x y z -> (x /= y ==> x < y || y < x)+                                  && isIrreflexive (<) x+                                  && isAsymmetric  (<) x y -- implied?+                                  && isTransitive  (<) 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+-- | Does the given 'compare' function follow the required properties?+--+-- This is useful for testing custom 'Ord' instances.+--+-- > > check $ isComparison (compare :: Int->Int->Ordering)+-- > +++ OK, passed 200 tests.+isComparison :: (a -> a -> Ordering) -> a -> a -> a -> Bool+isComparison compare  =  \x y z -> isEquivalence (===) x y z+                                && isIrreflexive (<) x+                                && isTransitive  (<) x y z+                                && ((<) `isFlipped` (>)) 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-+  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+-- > > check $ isIdempotent abs+-- > +++ OK, passed 200 tests. ----- > fails n $ idempotent negate-idempotent :: Eq a => (a -> a) -> a -> Bool-idempotent f = f . f === f+-- > > check $ isIdempotent sort+-- > +++ OK, passed 200 tests.+--+-- > > check $ isIdempotent negate+-- > *** Failed! Falsifiable (after 2 tests):+-- > 1+isIdempotent :: Eq a => (a -> a) -> a -> Bool+isIdempotent 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+-- > > check $ isIdentity (+0)+-- > +++ OK, passed 200 tests.+--+-- > > check $ isIdentity (sort :: [()]->[()])+-- > +++ OK, passed 200 tests.+--+-- > > check $ isIdentity (not . not)+-- > +++ OK, passed 2 tests (exhausted).+isIdentity :: Eq a => (a -> a) -> a -> Bool+isIdentity f  =  f === id  -- | Is the given function never an identity? @f x /= x@ ----- > holds n $ neverIdentity not+-- > > check $ neverIdentity not+-- > +++ OK, passed 2 tests (exhausted). ----- > fails n $ neverIdentity negate   -- yes, fails: negate 0 == 0, hah!+-- > > check $ neverIdentity negate+-- > *** Failed! Falsifiable (after 1 tests):+-- > 0 ----- Note: this is not the same as not being an identity.-neverIdentity :: Eq a => (a -> a) -> a -> Bool-neverIdentity = (not .) . identity+-- Note: this is not the same as not being an 'identity'.+isNeverIdentity :: Eq a => (a -> a) -> a -> Bool+isNeverIdentity  =  (not .) . isIdentity +-- | Is this 'Eq' instance valid?+--+-- This is useful for testing your custom 'Eq' instances+-- against required properties.+--+-- In particular,+-- this function tests that '==' is an equivalence+-- and that '/=' is the negation of '=='.+--+-- > > check $ (okEq :: Int -> Int -> Int -> Bool)+-- > +++ OK, passed 200 tests.+--+-- > > check $ (okEq :: Bool -> Bool -> Bool -> Bool)+-- > +++ OK, passed 8 tests (exhausted). okEq :: Eq a => a -> a -> a -> Bool-okEq = equivalence (==)+okEq x y z  =  isEquivalence (==) x y z+            && (x /= y) == not (x == y) +-- | Is this 'Ord' instance valid?+--+-- This is useful for testing your custom 'Ord' instances+-- against required properties.+--+-- > > check $ (okOrd :: Int -> Int -> Int -> Bool)+-- > +++ OK, passed 200 tests.+--+-- > > check $ (okOrd :: Bool -> Bool -> Bool -> Bool)+-- > +++ OK, passed 8 tests (exhausted). 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])+okOrd x y z  =  isTotalOrder (<=) x y z+             && isComparison compare x y z+             && (x <= y) == ((x `compare` y) `elem` [LT,EQ]) +-- | Is this 'Eq' and 'Ord' instance valid and consistent?+--+-- This is useful for testing your custom 'Eq' and 'Ord' instances+-- against required properties.+--+-- > > check $ (okEqOrd :: Int -> Int -> Int -> Bool)+-- > +++ OK, passed 200 tests.+--+-- > > check $ (okEqOrd :: Bool -> Bool -> Bool -> Bool)+-- > +++ OK, passed 8 tests (exhausted). 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+okEqOrd x y z  =  okEq  x y z+               && okOrd x y z+               && (x == y) == (x `compare` y == EQ) -- consistent instances +-- | Like 'okNum' but restricted to zero and positives.+--+-- > > check (okNumNonNegative :: Natural -> Natural -> Natural -> Bool)+-- > +++ OK, passed 200 tests. okNumNonNegative :: (Eq a, Num a) => a -> a -> a -> Bool-okNumNonNegative x y z  =  commutative (+) x y-                        && commutative (*) x y-                        && associative (+) x y z-                        && associative (*) x y z-                        && distributive (*) (+) x y z-                        && idempotent (+0) x-                        && idempotent (*1) x-                        && idempotent abs x-                        && idempotent signum x+okNumNonNegative x y z  =  isCommutative (+) x y+                        && isCommutative (*) x y+                        && isAssociative (+) x y z+                        && isAssociative (*) x y z+                        && ((*) `isDistributiveOver` (+)) x y z+                        && isIdempotent (+0) x+                        && isIdempotent (*1) x+                        && isIdempotent abs x+                        && isIdempotent signum x                         && abs x * signum x == x +-- | Is this 'Num' instance valid?+--+-- This is useful for testing your custom 'Num' instances+-- against required properties.+--+-- > > check (okNum :: Int -> Int -> Int -> Bool)+-- > +++ OK, passed 200 tests.+--+-- Double is /mostly/ valid, but not /entirely/ valid:+--+-- > > check (okNum :: Double -> Double -> Double -> Bool)+-- > *** Failed! Falsifiable (after 6 tests):+-- 0.0 0.0 Infinity okNum :: (Eq a, Num a) => a -> a -> a -> Bool okNum x y z  =  okNumNonNegative x y z              && negate (negate x) == x@@ -273,22 +548,35 @@  -- | Equal under, a ternary operator with the same fixity as '=='. ----- > x =$ f $= y  =  f x = f y+-- > x =$ f $= y  =  f x == f y ----- > [1,2,3,4,5] =$  take 2    $= [1,2,4,8,16] -- > True--- > [1,2,3,4,5] =$  take 3    $= [1,2,4,8,16] -- > False--- >     [1,2,3] =$    sort    $= [3,2,1]      -- > True--- >          42 =$ (`mod` 10) $= 16842        -- > True--- >          42 =$ (`mod`  9) $= 16842        -- > False--- >         'a' =$  isLetter  $= 'b'          -- > True--- >         'a' =$  isLetter  $= '1'          -- > False+-- > > [1,2,3,4,5] =$ take 2 $= [1,2,4,8,16]+-- > True+--+-- > > [1,2,3,4,5] =$ take 3 $= [1,2,4,8,16]+-- > False+--+-- > > [1,2,3] =$ sort $= [3,2,1]+-- > True+--+-- > > 42 =$ (`mod` 10) $= 16842+-- > True+--+-- > > 42 =$ (`mod`  9) $= 16842+-- > False+--+-- > > 'a' =$ isLetter $= 'b'+-- > True+--+-- > > 'a' =$ isLetter $= '1'+-- > False (=$) :: Eq b => a -> (a -> b) -> a -> Bool-(x =$ f) y = f x == f y+(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.@@ -299,10 +587,106 @@ -- > [1,2,3,4,5] =| 2 |= [1,2,4,8,16] -- > True -- > [1,2,3,4,5] =| 3 |= [1,2,4,8,16] -- > False (=|) :: Eq a => [a] -> Int -> [a] -> Bool-xs =| n = xs =$ take n+xs =| n  =  xs =$ take n infixl 4 =|  -- | See '=|' (|=) :: (a -> Bool) -> a -> Bool-(|=) = ($)+(|=)  =  ($) infixl 4 |=+++-- | Deprecated: use 'isCommutative'.+{-# DEPRECATED commutative "Use isCommutative." #-}+commutative :: Eq b => (a -> a -> b) -> a -> a -> Bool+commutative  =  isCommutative++-- | Deprecated: use 'isAssociative'.+{-# DEPRECATED associative "Use isAssociative." #-}+associative :: Eq a => (a -> a -> a) -> a -> a -> a -> Bool+associative  =  isAssociative++-- | Deprecated: use 'isDistributiveOver'.+{-# DEPRECATED distributive "Use isDistributiveOver." #-}+distributive :: Eq a => (a -> a -> a) -> (a -> a -> a) -> a -> a -> a -> Bool+distributive  =  isDistributiveOver++-- | Deprecated: use 'isFlipped'.+{-# DEPRECATED symmetric2 "Use isFlipped." #-}+symmetric2 :: Eq c => (a -> b -> c) -> (b -> a -> c) -> a -> b -> Bool+symmetric2  =  isFlipped++-- | Deprecated: use 'isTransitive'.+{-# DEPRECATED transitive "Use isTransitive." #-}+transitive :: (a -> a -> Bool) -> a -> a -> a -> Bool+transitive  =  isTransitive++-- | Deprecated: use 'isReflexive'.+{-# DEPRECATED reflexive "Use isReflexive." #-}+reflexive :: (a -> a -> Bool) -> a -> Bool+reflexive  =  isReflexive++-- | Deprecated: use 'isIrreflexive'.+{-# DEPRECATED irreflexive "Use isIrreflexive." #-}+irreflexive :: (a -> a -> Bool) -> a -> Bool+irreflexive  =  isIrreflexive++-- | Deprecated: use 'isSymmetric'.+{-# DEPRECATED symmetric "Use isSymmetric." #-}+symmetric :: (a -> a -> Bool) -> a -> a -> Bool+symmetric  =  isSymmetric++-- | Deprecated: use 'isAntisymmetric'.+{-# DEPRECATED antisymmetric "Use isAntisymmetric." #-}+antisymmetric :: Eq a => (a -> a -> Bool) -> a -> a -> Bool+antisymmetric  =  isAntisymmetric++-- | Deprecated: use 'isAsymmetric'.+{-# DEPRECATED asymmetric "Use isAsymmetric." #-}+asymmetric :: (a -> a -> Bool) -> a -> a -> Bool+asymmetric  =  isAsymmetric++-- | Deprecated: use 'isEquivalence'.+{-# DEPRECATED equivalence "Use isEquivalence." #-}+equivalence :: (a -> a -> Bool) -> a -> a -> a -> Bool+equivalence  =  isEquivalence++-- | Deprecated: use 'isPartialOrder'.+{-# DEPRECATED partialOrder "Use isPartialOrder." #-}+partialOrder :: Eq a => (a -> a -> Bool) -> a -> a -> a -> Bool+partialOrder  =  isPartialOrder++-- | Deprecated: use 'isStrictPartialOrder'.+{-# DEPRECATED strictPartialOrder "Use isStrictPartialOrder." #-}+strictPartialOrder :: (a -> a -> Bool) -> a -> a -> a -> Bool+strictPartialOrder  =  isStrictPartialOrder++-- | Deprecated: use 'isTotalOrder'.+{-# DEPRECATED totalOrder "Use isTotalOrder." #-}+totalOrder :: Eq a => (a -> a -> Bool) -> a -> a -> a -> Bool+totalOrder  =  isTotalOrder++-- | Deprecated: use 'isStrictTotalOrder'.+{-# DEPRECATED strictTotalOrder "Use isStrictTotalOrder." #-}+strictTotalOrder :: Eq a => (a -> a -> Bool) -> a -> a -> a -> Bool+strictTotalOrder  =  isStrictTotalOrder++-- | Deprecated: use 'isComparison'.+{-# DEPRECATED comparison "Use isComparison." #-}+comparison :: (a -> a -> Ordering) -> a -> a -> a -> Bool+comparison  =  isComparison++-- | Deprecated: use 'isIdempotent'.+{-# DEPRECATED idempotent "Use isIdempotent." #-}+idempotent :: Eq a => (a -> a) -> a -> Bool+idempotent  =  isIdempotent++-- | Deprecated: use 'isIdentity'.+{-# DEPRECATED identity "Use isIdentity." #-}+identity :: Eq a => (a -> a) -> a -> Bool+identity  =  isIdentity++-- | Deprecated: use 'isNeverIdentity'.+{-# DEPRECATED neverIdentity "Use isNeverIdentity." #-}+neverIdentity :: Eq a => (a -> a) -> a -> Bool+neverIdentity  =  isNeverIdentity

@@ -1,6 +1,6 @@ -- | -- Module      : Test.LeanCheck.Utils.TypeBinding--- Copyright   : (c) 2015-2018 Rudy Matela+-- Copyright   : (c) 2015-2020 Rudy Matela -- License     : 3-Clause BSD  (see the file LICENSE) -- Maintainer  : Rudy Matela <rudy@matela.com.br> --

@@ -1,6 +1,6 @@ -- | -- Module      : Test.LeanCheck.Utils.Types--- Copyright   : (c) 2015-2018 Rudy Matela+-- Copyright   : (c) 2015-2020 Rudy Matela -- License     : 3-Clause BSD  (see the file LICENSE) -- Maintainer  : Rudy Matela <rudy@matela.com.br> --@@ -80,12 +80,12 @@   , Letters (..)   ) where--- TODO: Add Ix and Bits instances  import Test.LeanCheck (Listable(..), listIntegral) import Test.LeanCheck.Core ((+|),cons1) import Test.LeanCheck.Tiers (noDupListCons, setCons, bagCons, mapCons) import Data.Ratio ((%))+import Data.Ix  narrowU :: Int -> Int -> Int narrowU w i = i `mod` 2^w@@ -490,6 +490,34 @@   enumFrom     (Natural x)             = map Natural [x..]   enumFromThen (Natural x) (Natural s) = map Natural [x,s..] +range' :: Enum a => (a,a) -> [a]+range' (m,n)  =  [m..n]++index' :: Integral a => (a,a) -> a -> Int+index' b@(m,_) i  | inRange' b i  =  fromIntegral (i - m)+                  | otherwise     =  error "Index out of range."++inRange' :: Ord a => (a,a) -> a -> Bool+inRange' (m,n) i  =  m <= i && i <= m++instance Ix Int1 where range = range'; index = index'; inRange = inRange'+instance Ix Int2 where range = range'; index = index'; inRange = inRange'+instance Ix Int3 where range = range'; index = index'; inRange = inRange'+instance Ix Int4 where range = range'; index = index'; inRange = inRange'+instance Ix Word1 where range = range'; index = index'; inRange = inRange'+instance Ix Word2 where range = range'; index = index'; inRange = inRange'+instance Ix Word3 where range = range'; index = index'; inRange = inRange'+instance Ix Word4 where range = range'; index = index'; inRange = inRange'+instance Ix Nat where range = range'; index = index'; inRange = inRange'+instance Ix Nat1 where range = range'; index = index'; inRange = inRange'+instance Ix Nat2 where range = range'; index = index'; inRange = inRange'+instance Ix Nat3 where range = range'; index = index'; inRange = inRange'+instance Ix Nat4 where range = range'; index = index'; inRange = inRange'+instance Ix Nat5 where range = range'; index = index'; inRange = inRange'+instance Ix Nat6 where range = range'; index = index'; inRange = inRange'+instance Ix Nat7 where range = range'; index = index'; inRange = inRange'+instance Ix Natural where range = range'; index = index'; inRange = inRange'+ instance Listable Int1 where list = [0,minBound] instance Listable Int2 where list = listIntegral instance Listable Int3 where list = listIntegral@@ -541,7 +569,7 @@ -- > > take 6 (list :: [Bag Nat]) -- > [Bag [],Bag [0],Bag [0,0],Bag [1],Bag [0,0,0],Bag [0,1]] ----- See also: 'bagsOf' and 'bagCons'.+-- See also: 'Test.LeanCheck.Tiers.bagsOf' and 'bagCons'. newtype Bag a = Bag [a] deriving (Show, Read, Eq, Ord)  -- | Lists representing sets.@@ -590,9 +618,12 @@ listXIntegral :: (Bounded a, Integral a) => [a] listXIntegral = l undefined   where-  l :: (Ord a, Num a, Bounded a, Integral a) => a -> [a]-  l a | minBound `asTypeOf` a < 0 = listXIntegralN-      | otherwise                 = listXIntegralP+  l :: (Bounded a, Integral a) => a -> [a]+  l a | count a <= 4 = listIntegral+      | min < 0      = listXIntegralN+      | otherwise    = listXIntegralP+    where+    min = minBound `asTypeOf` a -- The type-hackery above is needed so that we don't need to activate -- ScopedTypeVariables @@ -606,6 +637,14 @@   where   midBound = maxBound `div` 3 * 2 +-- how many of this type exist?+-- assumes 0 `elem` [minBound..maxBound]+count :: (Bounded a, Integral a) => a -> Integer+count a  =  1 + max + abs min+  where+  min = fromIntegral $ minBound `asTypeOf` a+  max = fromIntegral $ maxBound `asTypeOf` a+ extremes :: (Integral a) => a -> a -> [a] extremes x y   | x > y      =  [x,x-1..m] +| [y..m-1]@@ -642,12 +681,64 @@   tiers = cons1 (Xs . map unX) -- ^ Lists with elements of the 'X' type. +-- | Space characters.+--+-- > list :: [Space]  =  " \t\n\r\f\v"+--+-- > > check $ \(Space c) -> isSpace c+-- > +++ OK, passed 6 tests (exhausted). data Space  =  Space {unSpace :: Char}++-- | Lowercase characters.+--+-- > list :: [Lower]  =  "abcdef..."+--+-- > > check $ \(Lower c) -> isLower c+-- > +++ OK, passed 26 tests (exhausted). data Lower  =  Lower {unLower :: Char}++-- | Uppercase characters.+--+-- > list :: [Upper]  =  "ABCDEF..."+--+-- > > check $ \(Upper c) -> isUpper c+-- > +++ OK, passed 26 tests (exhausted). data Upper  =  Upper {unUpper :: Char}++-- | Alphabetic characters.+--+-- > list :: [Alpha]  =  "aAbBcC..."+--+-- > > check $ \(Alpha c) -> isAlpha c+-- > +++ OK, passed 52 tests (exhausted).+--+-- Equivalent to 'Letter'. data Alpha  =  Alpha {unAlpha :: Char}++-- | Digits.+--+-- > list :: [Digit]  =  "0123456789"+--+-- > > check $ \(Digit c) -> isDigit c+-- > +++ OK, passed 10 tests (exhausted). data Digit  =  Digit {unDigit :: Char}++-- | Alphanumeric characters.+--+-- > list :: [AlphaNum]  =  "0a1A2b3B4c..."+--+-- > > check $ \(AlphaNum c) -> isAlphaNum c+-- > +++ OK, passed 62 tests (exhausted). data AlphaNum  =  AlphaNum {unAlphaNum :: Char}++-- | Alphabetic characters.+--+-- > list :: [Letter]  =  "aAbBcC..."+--+-- > > check $ \(Letter c) -> isLetter c+-- > +++ OK, passed 52 tests (exhausted).+--+-- Equivalent to 'Alpha'. data Letter    =  Letter   {unLetter   :: Char}  instance Show Space where show = show . unSpace@@ -666,12 +757,25 @@ instance Listable AlphaNum where list = map AlphaNum $ ['0'..'9'] +| ['a'..'z'] +| ['A'..'Z'] instance Listable Letter   where list = map Letter $ ['a'..'z'] +| ['A'..'Z'] +-- | Strings of spaces. data Spaces  =  Spaces {unSpaces :: String}++-- | Strings of lowercase characters. data Lowers  =  Lowers {unLowers :: String}++-- | Strings of uppercase characters data Uppers  =  Uppers {unUppers :: String}++-- | Strings of alphabetic characters data Alphas  =  Alphas {unAlphas :: String}++-- | Strings of digits. data Digits  =  Digits {unDigits :: String}++-- | Strings of alphanumeric characters data AlphaNums  =  AlphaNums {unAlphaNums :: String}++-- | Strings of letters data Letters    =  Letters   {unLetters   :: String}  instance Show Spaces where show = show . unSpaces

@@ -1,6 +1,6 @@ -- | -- Module      : Test--- Copyright   : (c) 2015-2018 Rudy Matela+-- Copyright   : (c) 2015-2020 Rudy Matela -- License     : 3-Clause BSD  (see the file LICENSE) -- Maintainer  : Rudy Matela <rudy@matela.com.br> --@@ -27,6 +27,8 @@   , strictlyOrdered   , strictlyOrderedBy   , strictlyOrderedOn+  , tOrderedBy+  , tStrictlyOrderedBy   ) where 

@@ -1,8 +1,8 @@--- Copyright (c) 2015-2018 Rudy Matela.+-- Copyright (c) 2015-2020 Rudy Matela. -- Distributed under the 3-Clause BSD licence (see the file LICENSE). {-# LANGUAGE TemplateHaskell, CPP #-} import Test-import Test.LeanCheck+-- import Test.LeanCheck -- already exported by Test import Test.LeanCheck.Derive import System.Exit (exitFailure) import Data.List (elemIndices,sort)

@@ -13,3 +13,7 @@       _ -> False [1] +*** Failed! Falsifiable (after 1 tests):+(\_ -> 0) (\_ -> 0)+*** Failed! Falsifiable (after 1 tests):+(\_ -> 0) (0,0)

@@ -1,5 +1,6 @@--- Copyright (c) 2015-2018 Rudy Matela.+-- Copyright (c) 2015-2020 Rudy Matela. -- Distributed under the 3-Clause BSD licence (see the file LICENSE).+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} import Test ()  import System.Exit (exitFailure)@@ -7,7 +8,6 @@  import Test.LeanCheck.Error import Test.LeanCheck.Utils.Types (Nat)-import Data.List (sort)  main :: IO () main =

@@ -1,29 +1,42 @@--- Copyright (c) 2015-2018 Rudy Matela.+-- Copyright (c) 2015-2020 Rudy Matela. -- Distributed under the 3-Clause BSD licence (see the file LICENSE). import Test  import System.Exit (exitFailure)-import Data.List (elemIndices, sort, nub, delete)--import Test.LeanCheck-import Test.LeanCheck.Function.ListsOfPairs-import Test.LeanCheck.Utils-+import Data.List (elemIndices)+import Test.LeanCheck.Function ()  main :: IO () main =-  case elemIndices False tests of+  case elemIndices False (tests 200) of     [] -> putStrLn "Tests passed!"     is -> do putStrLn ("Failed tests:" ++ show is)              exitFailure -tests =+tests :: Int -> [Bool]+tests n =   [ True-  -- TODO: add some tests here+  , fails n prop_foldlr+  , holds n prop_foldlr'+  , fails n prop_mapFilter+  , fails n prop_false+  , fails n prop_false'   ] -allUnique :: Ord a => [a] -> Bool-allUnique [] = True-allUnique (x:xs) = x `notElem` xs-                && allUnique (filter (< x) xs)-                && allUnique (filter (> x) xs)+type A = Int++prop_foldlr :: (A -> A -> A) -> A -> [A] -> Bool+prop_foldlr f z xs  =  foldr f z xs == foldl f z xs++-- correct version of the property above+prop_foldlr' :: (A -> A -> A) -> A -> [A] -> Bool+prop_foldlr' f z xs  =  foldl (flip f) z (reverse xs) == foldr f z xs++prop_mapFilter :: (A -> A) -> (A -> Bool) -> [A] -> Bool+prop_mapFilter f p xs  =  filter p (map f xs) == map f (filter p xs)++prop_false :: (A -> A) -> (A -> A) -> Bool+prop_false _ _ = False++prop_false' :: (A -> A) -> (A,A) -> Bool+prop_false' _ _ = False

@@ -1,11 +1,10 @@--- Copyright (c) 2015-2018 Rudy Matela.+-- Copyright (c) 2015-2020 Rudy Matela. -- Distributed under the 3-Clause BSD licence (see the file LICENSE).-import Test-+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} import System.Exit (exitFailure) import Data.List (elemIndices,sort) import Test.LeanCheck.Function.ShowFunction-import Test.LeanCheck.Function.Show+import Test.LeanCheck.Function.Show () import Test.LeanCheck.Utils.TypeBinding  main :: IO ()@@ -15,7 +14,7 @@     is -> do putStrLn ("Failed tests:" ++ show is)              exitFailure -+tests :: [Bool] tests =   [ True @@ -57,6 +56,10 @@     -- fully defined, finite --+  , show not+    == "\\x -> case x of\n"+    ++ "      False -> True\n"+    ++ "      True -> False\n"   , showFunction 1 not     == "\\x -> case x of\n"     ++ "      False -> True\n"

@@ -1,8 +1,8 @@--- Copyright (c) 2015-2018 Rudy Matela.+-- Copyright (c) 2015-2020 Rudy Matela. -- Distributed under the 3-Clause BSD licence (see the file LICENSE). {-# LANGUAGE DeriveGeneric, StandaloneDeriving, TemplateHaskell #-} import Test-import Test.LeanCheck+-- import Test.LeanCheck -- already exported by Test import Test.LeanCheck.Generic import Test.LeanCheck.Derive (deriveTiers) import System.Exit (exitFailure)

@@ -1,7 +1,6 @@--- Copyright (c) 2015-2018 Rudy Matela.+-- Copyright (c) 2015-2020 Rudy Matela. -- Distributed under the 3-Clause BSD licence (see the file LICENSE). import Test-import Test.LeanCheck.IO  main :: IO () main = do

@@ -1,17 +1,17 @@--- Copyright (c) 2015-2018 Rudy Matela.+-- Copyright (c) 2015-2020 Rudy Matela. -- Distributed under the 3-Clause BSD licence (see the file LICENSE). import Test  import System.Exit (exitFailure) import Data.List (elemIndices) -import Test.LeanCheck+-- import Test.LeanCheck -- already exported by Test import Test.LeanCheck.Utils  import Data.Ratio import Data.Complex-import Data.Int (Int, Int8, Int16, Int32, Int64)-import Data.Word (Word, Word8, Word16, Word32, Word64)+import Data.Int+import Data.Word  main :: IO () main =

@@ -1,10 +1,10 @@--- Copyright (c) 2015-2018 Rudy Matela.+-- Copyright (c) 2015-2020 Rudy Matela. -- Distributed under the 3-Clause BSD licence (see the file LICENSE). import Test  import System.Exit (exitFailure) import Data.List (elemIndices,sort)-import Test.LeanCheck+-- import Test.LeanCheck -- already exported by Test import Test.LeanCheck.Utils  import Data.List (isPrefixOf)@@ -31,73 +31,77 @@   , holds n $ const False ||| const True  -:> int   , fails n $ const False ||| const False -:> int -  , holds n $ commutative (+)  -:> int-  , holds n $ commutative (*)  -:> int-  , holds n $ commutative (++) -:> [()]-  , holds n $ commutative (&&)-  , holds n $ commutative (||)-  , fails n $ commutative (-)  -:> int-  , fails n $ commutative (++) -:> [bool]-  , fails n $ commutative (==>)+  , holds n $ isCommutative (+)  -:> int+  , holds n $ isCommutative (*)  -:> int+  , holds n $ isCommutative (++) -:> [()]+  , holds n $ isCommutative (&&)+  , holds n $ isCommutative (||)+  , fails n $ isCommutative (-)  -:> int+  , fails n $ isCommutative (++) -:> [bool]+  , fails n $ isCommutative (==>) -  , holds n $ associative (+)  -:> int-  , holds n $ associative (*)  -:> int-  , holds n $ associative (++) -:> [int]-  , holds n $ associative (&&)-  , holds n $ associative (||)-  , fails n $ associative (-)  -:> int-  , fails n $ associative (==>)+  , holds n $ isAssociative (+)  -:> int+  , holds n $ isAssociative (*)  -:> int+  , holds n $ isAssociative (++) -:> [int]+  , holds n $ isAssociative (&&)+  , holds n $ isAssociative (||)+  , fails n $ isAssociative (-)  -:> int+  , fails n $ isAssociative (==>) -  , holds n $ distributive (*) (+) -:> int-  , fails n $ distributive (+) (*) -:> int+  , holds n $ (*) `isDistributiveOver` (+) -:> int+  , fails n $ (+) `isDistributiveOver` (*) -:> int+  , holds n $ (*) `isLeftDistributiveOver` (+) -:> int+  , fails n $ (+) `isLeftDistributiveOver` (*) -:> int+  , holds n $ (*) `isRightDistributiveOver` (+) -:> int+  , fails n $ (+) `isRightDistributiveOver` (*) -:> int -  , holds n $ symmetric (==) -:> int-  , holds n $ symmetric (/=) -:> int-  , fails n $ symmetric (<=) -:> int+  , holds n $ isSymmetric (==) -:> int+  , holds n $ isSymmetric (/=) -:> int+  , fails n $ isSymmetric (<=) -:> int -  , holds n $   reflexive (==) -:> int-  , holds n $ irreflexive (/=) -:> int+  , holds n $ isReflexive   (==) -:> int+  , holds n $ isIrreflexive (/=) -:> int -  , holds n $ (<)  `symmetric2` (>)  -:> int-  , holds n $ (<=) `symmetric2` (>=) -:> int-  , fails n $ (<)  `symmetric2` (>=) -:> int-  , fails n $ (<=) `symmetric2` (>)  -:> int+  , holds n $ (<)  `isFlipped` (>)  -:> int+  , holds n $ (<=) `isFlipped` (>=) -:> int+  , fails n $ (<)  `isFlipped` (>=) -:> int+  , fails n $ (<=) `isFlipped` (>)  -:> int -  , holds n $ transitive (==) -:> bool-  , holds n $ transitive (<)  -:> bool-  , holds n $ transitive (<=) -:> bool-  , fails n $ transitive (/=) -:> bool-  , holds n $ transitive (==) -:> int-  , holds n $ transitive (<)  -:> int-  , holds n $ transitive (<=) -:> int-  , fails n $ transitive (/=) -:> int+  , holds n $ isTransitive (==) -:> bool+  , holds n $ isTransitive (<)  -:> bool+  , holds n $ isTransitive (<=) -:> bool+  , fails n $ isTransitive (/=) -:> bool+  , holds n $ isTransitive (==) -:> int+  , holds n $ isTransitive (<)  -:> int+  , holds n $ isTransitive (<=) -:> int+  , fails n $ isTransitive (/=) -:> 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 $ isAsymmetric    (<)  -:> int+  , holds n $ isAntisymmetric (<=) -:> int+  , fails n $ isAsymmetric    (<=) -:> int+  , holds n $ isAsymmetric    (>)  -:> int+  , holds n $ isAntisymmetric (>=) -:> int+  , fails n $ isAsymmetric    (>=) -:> int -  , holds n $ equivalence (==) -:> int-  , holds n $ equivalence ((==) `on` fst) -:> (int,int)-  , holds n $ equivalence ((==) `on` length) -:> [int]+  , holds n $ isEquivalence (==) -:> int+  , holds n $ isEquivalence ((==) `on` fst) -:> (int,int)+  , holds n $ isEquivalence ((==) `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 $       isTotalOrder (<=) -:> int+  , holds n $ isStrictTotalOrder (<)  -:> int+  , fails n $       isTotalOrder (<)  -:> int+  , fails n $ isStrictTotalOrder (<=) -:> int+  , holds n $       isTotalOrder (>=) -:> int+  , holds n $ isStrictTotalOrder (>)  -:> int+  , fails n $       isTotalOrder (>)  -:> int+  , fails n $ isStrictTotalOrder (>=) -:> int -  , holds n $ partialOrder isPrefixOf -:> [int]-  , fails n $   totalOrder isPrefixOf -:> [int]+  , holds n $ isPartialOrder isPrefixOf -:> [int]+  , fails n $   isTotalOrder isPrefixOf -:> [int] -  , holds n $ comparison compare -:> int-  , holds n $ comparison compare -:> bool-  , holds n $ comparison compare -:> ()+  , holds n $ isComparison compare -:> int+  , holds n $ isComparison compare -:> bool+  , holds n $ isComparison compare -:> ()    , holds n $ okEqOrd -:> ()   , holds n $ okEqOrd -:> int@@ -123,21 +127,21 @@   , holds n $ (\x y -> x < y ==> x - y == 0) -:> nat   , holds n $ (\x y -> x < y ==> x - y == 0) -:> natural -  , holds n $ idempotent id   -:> int-  , holds n $ idempotent abs  -:> int-  , holds n $ idempotent sort -:> [bool]-  , fails n $ idempotent not+  , holds n $ isIdempotent id   -:> int+  , holds n $ isIdempotent abs  -:> int+  , holds n $ isIdempotent sort -:> [bool]+  , fails n $ isIdempotent not -  , holds n $ identity id   -:> int-  , holds n $ identity (+0) -:> int-  , holds n $ identity sort -:> [()]-  , holds n $ identity (not . not)-  , fails n $ identity not+  , holds n $ isIdentity id   -:> int+  , holds n $ isIdentity (+0) -:> int+  , holds n $ isIdentity sort -:> [()]+  , holds n $ isIdentity (not . not)+  , fails n $ isIdentity not -  , holds n $ neverIdentity not-  , fails n $ neverIdentity abs    -:> int-  , fails n $ neverIdentity negate -:> int+  , holds n $ isNeverIdentity not+  , fails n $ isNeverIdentity abs    -:> int+  , fails n $ isNeverIdentity negate -:> int   ] -none :: (a -> Bool) -> [a] -> Bool-none p = not . or . map p+--none :: (a -> Bool) -> [a] -> Bool+--none p = not . or . map p

@@ -2,32 +2,24 @@ # # test/sdist: tests the package generated by "cabal sdist". #-# Copyright (c) 2015-2018 Rudy Matela.+# Copyright (c) 2015-2020 Rudy Matela. # Distributed under the 3-Clause BSD licence. export LC_ALL=C  # consistent sort pkgver=` cat *.cabal | grep "^version:" | sed -e "s/version: *//"` pkgname=`cat *.cabal | grep "^name:"    | sed -e "s/name: *//"`-pkg=$pkgname-$pkgver-set -x+pkgbase=$pkgname-$pkgver+set -xe cabal sdist &&-cd dist &&-tar -tf $pkg.tar.gz | sort --ignore-case          > ls-cabal-i  &&-tar -tf $pkg.tar.gz | sort --ignore-case --unique > ls-cabal-iu &&-diff -rud ls-cabal-i ls-cabal-iu &&-rm -f ls-cabal ls-cabal-ignore-case &&-if [ -d ../.git ]+pkg=`find dist* -name $pkgbase.tar.gz`+tmp=`mktemp -d /tmp/test-sdist-XXXXXXXXXX`+tar -tf $pkg | sort --ignore-case          > $tmp/ls-cabal-i  &&+tar -tf $pkg | sort --ignore-case --unique > $tmp/ls-cabal-iu &&+diff -rud $tmp/ls-cabal-i $tmp/ls-cabal-iu &&+if [ -d .git ] then 	# on git repo, test if files are the same-	git -C .. ls-files                                      | sort > ls-git   &&-	tar -tf $pkg.tar.gz | grep -v "/$" | sed -e "s,$pkg/,," | sort > ls-cabal &&-	diff -rud ls-git ls-cabal &&-	rm -f ls-git ls-cabal-else-	# outside of git repo, test build-	rm -rf $pkg/ &&-	tar -xzf $pkg.tar.gz &&-	cd $pkg/ &&-	cabal configure --enable-tests --enable-benchmarks &&-	cabal build &&-	cabal test+	git ls-files                                         | sort > $tmp/ls-git   &&+	tar -tf $pkg | grep -v "/$" | sed -e "s,$pkgbase/,," | sort > $tmp/ls-cabal &&+	diff -rud $tmp/ls-git $tmp/ls-cabal fi+rm -r $tmp

@@ -1,13 +1,12 @@--- Copyright (c) 2017-2018 Rudy Matela.+-- Copyright (c) 2017-2020 Rudy Matela. -- Distributed under the 3-Clause BSD licence (see the file LICENSE). import Test  import System.Exit (exitFailure)-import Data.List (elemIndices,sort)-import Test.LeanCheck+-- import Test.LeanCheck -- already exported by Test import Test.LeanCheck.Stats -import Data.List (isPrefixOf)+import Data.List (elemIndices) import Data.Function (on)  main :: IO ()@@ -26,6 +25,12 @@    conditionStats 1000 [ ("ordered",ordered :: [Int] -> Bool)                       , ("ordered . reverse", ordered . reverse) ]++  conditionStatsT 6 [ ("odd", odd :: Int -> Bool)+                    , ("even", even) ]++  conditionStatsT 6 [ ("ordered",ordered :: [Int] -> Bool)+                    , ("ordered . reverse", ordered . reverse) ]    putStrLn "sum :: [Int] -> Bool"   classStatsT 6 (sum     :: [Int] -> Int)

@@ -1,11 +1,11 @@--- Copyright (c) 2015-2018 Rudy Matela.+-- Copyright (c) 2015-2020 Rudy Matela. -- Distributed under the 3-Clause BSD licence (see the file LICENSE). import Test  import System.Exit (exitFailure) import Data.List (elemIndices, sort, nub, delete) -import Test.LeanCheck+-- import Test.LeanCheck -- already exported by Test import Test.LeanCheck.Utils  import Test.LeanCheck.Tiers

@@ -1,10 +1,10 @@--- Copyright (c) 2015-2018 Rudy Matela.+{-# LANGUAGE CPP #-}+-- Copyright (c) 2015-2020 Rudy Matela. -- Distributed under the 3-Clause BSD licence (see the file LICENSE). import Test import System.Exit (exitFailure) import Data.List (elemIndices,delete,isPrefixOf) import Test.LeanCheck.Utils.Types-import Test.LeanCheck (list,fails) import Data.Word import Data.Int import Data.Char hiding (Space)@@ -48,9 +48,8 @@   , map unX list `permutation` [minBound..maxBound :: Int8]   , map unX list `permutation` [minBound..maxBound :: Int4]   , map unX list `permutation` [minBound..maxBound :: Int3]--- TODO: make the following commented tests pass:---, map unX list `permutation` [minBound..maxBound :: Int2]---, map unX list `permutation` [minBound..maxBound :: Int1]+  , map unX list `permutation` [minBound..maxBound :: Int2]+  , map unX list `permutation` [minBound..maxBound :: Int1]   , map unX list `permutation` [minBound..maxBound :: Word8]   , map unX list `permutation` [minBound..maxBound :: Word4]   , map unX list `permutation` [minBound..maxBound :: Word3]@@ -60,35 +59,37 @@   , map unX list `permutation` [minBound..maxBound :: Nat6]   , map unX list `permutation` [minBound..maxBound :: Nat5]   , map unX list `permutation` [minBound..maxBound :: Nat4]--- TODO: make the following commented tests pass:---, map unX list `permutation` [minBound..maxBound :: Nat3]---, map unX list `permutation` [minBound..maxBound :: Nat2]---, map unX list `permutation` [minBound..maxBound :: Nat1]+  , map unX list `permutation` [minBound..maxBound :: Nat3]+  , map unX list `permutation` [minBound..maxBound :: Nat2]+  , map unX list `permutation` [minBound..maxBound :: Nat1]    , (prefiX :: [Int8])  `isPrefixOf` map unX list   , (prefiX :: [Int16]) `isPrefixOf` map unX list   , (prefiX :: [Int32]) `isPrefixOf` map unX list-  , (prefiX :: [Int64]) `isPrefixOf` map unX list   , (prefiX :: [Int])   `isPrefixOf` map unX list    , (prefiXN :: [Word8])  `isPrefixOf` map unX list   , (prefiXN :: [Word16]) `isPrefixOf` map unX list   , (prefiXN :: [Word32]) `isPrefixOf` map unX list-  , (prefiXN :: [Word64]) `isPrefixOf` map unX list   , (prefiXN :: [Word])   `isPrefixOf` map unX list    , (prefiXs :: [[Int8]])  `isPrefixOf` map unXs list   , (prefiXs :: [[Int16]]) `isPrefixOf` map unXs list   , (prefiXs :: [[Int32]]) `isPrefixOf` map unXs list-  , (prefiXs :: [[Int64]]) `isPrefixOf` map unXs list   , (prefiXs :: [[Int]])   `isPrefixOf` map unXs list    , (prefiXNs :: [[Word8]])  `isPrefixOf` map unXs list   , (prefiXNs :: [[Word16]]) `isPrefixOf` map unXs list   , (prefiXNs :: [[Word32]]) `isPrefixOf` map unXs list-  , (prefiXNs :: [[Word64]]) `isPrefixOf` map unXs list   , (prefiXNs :: [[Word]])   `isPrefixOf` map unXs list +#ifndef __HUGS__+  -- Hugs returns an arithmetic overflow error for these tests+  , (prefiX   :: [Int64])    `isPrefixOf` map unX  list+  , (prefiXN  :: [Word64])   `isPrefixOf` map unX  list+  , (prefiXs  :: [[Int64]])  `isPrefixOf` map unXs list+  , (prefiXNs :: [[Word64]]) `isPrefixOf` map unXs list+#endif    , [minBound..maxBound :: Int1] == signedRange 1   , [minBound..maxBound :: Int2] == signedRange 2