quickcheck-classes 0.5.0.0 → 0.6.0.0
raw patch · 34 files changed
+1256/−522 lines, 34 filesdep +base-orphansdep +faildep +ghc-primdep ~QuickCheckdep ~aesondep ~basenew-uploader
Dependencies added: base-orphans, fail, ghc-prim, tasty, tasty-quickcheck
Dependency ranges changed: QuickCheck, aeson, base, containers, primitive, semigroups, semirings, transformers
Files
- README.md +2/−2
- changelog.md +27/−1
- quickcheck-classes.cabal +91/−9
- src/Test/QuickCheck/Classes.hs +46/−42
- src/Test/QuickCheck/Classes/Alt.hs +6/−27
- src/Test/QuickCheck/Classes/Alternative.hs +9/−18
- src/Test/QuickCheck/Classes/Applicative.hs +11/−20
- src/Test/QuickCheck/Classes/Apply.hs +6/−27
- src/Test/QuickCheck/Classes/Bifoldable.hs +124/−0
- src/Test/QuickCheck/Classes/Bifunctor.hs +10/−16
- src/Test/QuickCheck/Classes/Category.hs +11/−18
- src/Test/QuickCheck/Classes/Common.hs +63/−36
- src/Test/QuickCheck/Classes/Compat.hs +30/−8
- src/Test/QuickCheck/Classes/Enum.hs +2/−2
- src/Test/QuickCheck/Classes/Foldable.hs +11/−18
- src/Test/QuickCheck/Classes/Functor.hs +9/−17
- src/Test/QuickCheck/Classes/Generic.hs +112/−0
- src/Test/QuickCheck/Classes/Json.hs +23/−7
- src/Test/QuickCheck/Classes/Monad.hs +11/−20
- src/Test/QuickCheck/Classes/MonadFail.hs +6/−19
- src/Test/QuickCheck/Classes/MonadPlus.hs +12/−19
- src/Test/QuickCheck/Classes/MonadZip.hs +7/−16
- src/Test/QuickCheck/Classes/Monoid.hs +6/−14
- src/Test/QuickCheck/Classes/Plus.hs +8/−28
- src/Test/QuickCheck/Classes/Semigroup.hs +72/−13
- src/Test/QuickCheck/Classes/Semigroupoid.hs +7/−25
- src/Test/QuickCheck/Classes/Semiring.hs +4/−4
- src/Test/QuickCheck/Classes/Show.hs +48/−0
- src/Test/QuickCheck/Classes/ShowRead.hs +66/−23
- src/Test/QuickCheck/Classes/Storable.hs +18/−8
- src/Test/QuickCheck/Classes/Traversable.hs +8/−17
- test/Advanced.hs +193/−0
- test/Spec.hs +76/−48
- test/Spec/ShowRead.hs +121/−0
README.md view
@@ -79,7 +79,7 @@ ``` -### `specialisedLawsCheckMany`+### `lawsCheckOne` A convenience function that allows one to check many typeclass instances of the same type.@@ -87,7 +87,7 @@ For example, in GHCi: ```bash->>> specialisedLawsCheckMany (Proxy :: Proxy Word) [jsonLaws, showReadLaws]+>>> lawsCheckOne (Proxy :: Proxy Word) [jsonLaws, showReadLaws] ToJSON/FromJSON: Encoding Equals Value +++ OK, passed 100 tests. ToJSON/FromJSON: Partial Isomorphism +++ OK, passed 100 tests. Show/Read: Partial Isomorphism +++ OK, passed 100 tests.
changelog.md view
@@ -4,10 +4,36 @@ The format is based on [Keep a Changelog](http://keepachangelog.com/en/1.0.0/) and this project adheres to the [Haskell Package Versioning Policy](https://pvp.haskell.org/). +## [0.6.0.0] - TBA+### Change+- Support QuickCheck 2.7 and 2.8. This adds `Arbitrary` orphan instances+ to the test suite.+- Fix CPP that caused build failures on GHC 7.10 and some old + package versions.+- Fix compiling the test suite without semigroupoids and compiling with old+ versions of transformers.+- Add lower bound for semigroups to make sure the `stimes` method is available.+- The laws `commutativeSemigroupLaws` and `commutativeMonoidLaws` no longer+ check any property other than commutativity. They must now be used in conjunction+ with, rather than in place of, `semigroupLaws` and `monoidLaws`. This is a breaking+ change.+- Fix the right distribution law for semirings.+- The function `lawsCheckMany` now terminates with exit code 1 if a+ test fails.+- Extend `showReadLaws` with new properties for `showsPrec`, `readsPrec`,+ `showList` and `readList`.+- Prettify JSON partial isomorphism test failure.+### Added+- Add `genericLaws` and `generic1Laws`+- Add property tests for special classes of semigroups. This includes:+ commutative, idempotent, rectangular band, and exponential. +- `bifoldableLaws`, `bifoldableFunctorLaws`+- Add `showLaws`.+ ## [0.5.0.0] - 2018-09-25 ### Change - When compiling with GHC 8.6 and newer, use `QuantifiedConstraints` instead- of `Eq1`, `Show1`, and `Arbitrary1`.+ of `Eq1`, `Show1`, `Arbitrary1`, `Eq2`, `Show`, and `Arbitrary2`. ## [0.4.14.3] - 2018-09-21 ### Change
quickcheck-classes.cabal view
@@ -1,5 +1,5 @@ name: quickcheck-classes-version: 0.5.0.0+version: 0.6.0.0 synopsis: QuickCheck common typeclasses description: This library provides QuickCheck properties to ensure@@ -8,6 +8,11 @@ similar things, such as `genvalidity-hspec` and `checkers`. This library differs from other solutions by not introducing any new typeclasses that the user needs to learn.+ .+ /Note:/ on GHC < 8.5, this library uses the higher-kinded typeclasses+ ('Data.Functor.Classes.Show1', 'Data.Functor.Classes.Eq1', 'Data.Functor.Classes.Ord1', etc.),+ but on GHC >= 8.5, it uses `-XQuantifiedConstraints` to express these+ constraints more cleanly. homepage: https://github.com/andrewthad/quickcheck-classes#readme license: BSD3 license-file: LICENSE@@ -44,7 +49,22 @@ default: True manual: True +flag unary-laws+ description:+ Include infrastructure for testing class laws of unary type constructors.+ default: True+ manual: False++flag binary-laws+ description:+ Include infrastructure for testing class laws of binary type constructors.+ Disabling `unary-laws` while keeping `binary-laws` enabled is an unsupported+ configuration.+ default: True+ manual: False+ library+ default-language: Haskell2010 hs-source-dirs: src exposed-modules: Test.QuickCheck.Classes@@ -55,6 +75,7 @@ Test.QuickCheck.Classes.Applicative Test.QuickCheck.Classes.Apply -- Test.QuickCheck.Classes.Arrow+ Test.QuickCheck.Classes.Bifoldable Test.QuickCheck.Classes.Bifunctor Test.QuickCheck.Classes.Bits Test.QuickCheck.Classes.Category@@ -64,6 +85,7 @@ Test.QuickCheck.Classes.Eq Test.QuickCheck.Classes.Foldable Test.QuickCheck.Classes.Functor+ Test.QuickCheck.Classes.Generic Test.QuickCheck.Classes.Integral Test.QuickCheck.Classes.Json Test.QuickCheck.Classes.Monad@@ -76,43 +98,103 @@ Test.QuickCheck.Classes.Prim Test.QuickCheck.Classes.Semigroup Test.QuickCheck.Classes.Semigroupoid- Test.QuickCheck.Classes.Semiring + Test.QuickCheck.Classes.Semiring+ Test.QuickCheck.Classes.Show Test.QuickCheck.Classes.ShowRead Test.QuickCheck.Classes.Storable Test.QuickCheck.Classes.Traversable build-depends: base >= 4.5 && < 5+ , base-orphans >= 0.1 , bifunctors - , QuickCheck >= 2.9+ , QuickCheck >= 2.7 , transformers >= 0.3 && < 0.6 , primitive >= 0.6.1 && < 0.7 , containers >= 0.4.2.1- , semigroups+ , semigroups >= 0.17 , tagged+ , fail+ if impl(ghc > 7.4) && impl(ghc < 7.6)+ build-depends: ghc-prim+ if impl(ghc > 8.5)+ cpp-options: -DHAVE_QUANTIFIED_CONSTRAINTS+ if flag(unary-laws)+ build-depends:+ transformers >= 0.4.0+ , QuickCheck >= 2.10.0+ cpp-options: -DHAVE_UNARY_LAWS+ if flag(binary-laws)+ build-depends:+ transformers >= 0.5.0+ , QuickCheck >= 2.10.0+ cpp-options: -DHAVE_BINARY_LAWS if flag(aeson)- build-depends: aeson >= 1.1+ build-depends: aeson >= 0.9+ cpp-options: -DHAVE_AESON if flag(semigroupoids) build-depends: semigroupoids + cpp-options: -DHAVE_SEMIGROUPOIDS if flag(semirings)- build-depends: semirings >= 0.2.0.0- default-language: Haskell2010+ build-depends: semirings >= 0.2.1.1+ cpp-options: -DHAVE_SEMIRINGS -test-suite test+-- The basic test suite is compatible with all the versions of GHC that+-- this library supports. It is useful for confirming whether the laws tests+-- behave correct. Additionally, it helps catch CPP mistakes.+test-suite basic type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Spec.hs+ other-modules:+ Spec.ShowRead build-depends: base+ , base-orphans >= 0.5 , quickcheck-classes , QuickCheck , containers , primitive , vector- , semigroupoids , transformers , tagged+ if impl(ghc > 8.5)+ cpp-options: -DHAVE_QUANTIFIED_CONSTRAINTS+ if flag(unary-laws)+ cpp-options: -DHAVE_UNARY_LAWS+ if flag(binary-laws)+ cpp-options: -DHAVE_BINARY_LAWS if flag(aeson) build-depends: aeson+ cpp-options: -DHAVE_AESON+ if flag(semigroupoids)+ build-depends: semigroupoids+ cpp-options: -DHAVE_SEMIGROUPOIDS+ default-language: Haskell2010++-- The advanced test suite only builds with the newest version+-- of GHC. It is intended to be a sort of regression test for GHC and for+-- base. It check instances for a number of types in base. It also checks+-- a bunch of derived instances for data types of varying sizes. And it+-- does some tests on UnboxedSums.+test-suite advanced + type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Advanced.hs+ ghc-options: -O2+ build-depends:+ QuickCheck+ , base >= 4.12+ , base-orphans >= 0.5+ , containers + , primitive+ , quickcheck-classes+ , tagged+ , tasty+ , tasty-quickcheck+ , transformers+ , vector+ if impl(ghc < 8.6)+ buildable: False default-language: Haskell2010 source-repository head
src/Test/QuickCheck/Classes.hs view
@@ -5,13 +5,17 @@ {-| This library provides sets of properties that should hold for common typeclasses.++ /Note:/ on GHC < 8.5, this library uses the higher-kinded typeclasses+ ('Data.Functor.Classes.Show1', 'Data.Functor.Classes.Eq1', 'Data.Functor.Classes.Ord1', etc.),+ but on GHC >= 8.5, it uses `-XQuantifiedConstraints` to express these+ constraints more cleanly. -} module Test.QuickCheck.Classes ( -- * Running lawsCheck , lawsCheckMany , lawsCheckOne- , specialisedLawsCheckMany -- * Properties -- ** Ground types #if MIN_VERSION_base(4,7,0)@@ -22,7 +26,7 @@ #if MIN_VERSION_base(4,7,0) , isListLaws #endif-#if defined(VERSION_aeson)+#if HAVE_AESON , jsonLaws #endif , monoidLaws@@ -33,38 +37,43 @@ , primLaws , semigroupLaws , commutativeSemigroupLaws-#if defined(VERSION_semirings)+ , exponentialSemigroupLaws+ , idempotentSemigroupLaws+ , rectangularBandSemigroupLaws+#if HAVE_SEMIRINGS , semiringLaws #endif+ , showLaws , showReadLaws , storableLaws-#if MIN_VERSION_QuickCheck(2,10,0) && (MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0))- -- ** Higher-Kinded Types+#if HAVE_UNARY_LAWS+ -- ** Unary type constructors , alternativeLaws-#if defined(VERSION_semigroupoids)+#if HAVE_SEMIGROUPOIDS , altLaws , applyLaws #endif , applicativeLaws-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,5,0)- , bifunctorLaws- , categoryLaws- , commutativeCategoryLaws-#endif , foldableLaws , functorLaws , monadLaws , monadPlusLaws , monadZipLaws-#if defined(VERSION_semigroupoids)+#if HAVE_SEMIGROUPOIDS , plusLaws , extendedPlusLaws #endif-#if defined(VERSION_semigroupoids) && (MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,5,0))+ , traversableLaws+#endif+#if HAVE_BINARY_LAWS+ -- ** Binary type constructors+ , bifunctorLaws+ , categoryLaws+ , commutativeCategoryLaws+#if HAVE_SEMIGROUPOIDS , semigroupoidLaws , commutativeSemigroupoidLaws #endif- , traversableLaws #endif -- * Types , Laws(..)@@ -84,47 +93,47 @@ #if MIN_VERSION_base(4,7,0) import Test.QuickCheck.Classes.IsList #endif-#if defined(VERSION_aeson)+#if HAVE_AESON import Test.QuickCheck.Classes.Json #endif import Test.QuickCheck.Classes.Monoid import Test.QuickCheck.Classes.Ord import Test.QuickCheck.Classes.Prim import Test.QuickCheck.Classes.Semigroup-#if defined(VERSION_semirings)+#if HAVE_SEMIRINGS import Test.QuickCheck.Classes.Semiring #endif+import Test.QuickCheck.Classes.Show import Test.QuickCheck.Classes.ShowRead import Test.QuickCheck.Classes.Storable --- Higher-Kinded Types--#if MIN_VERSION_QuickCheck(2,10,0)-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)+-- Unary type constructors+#if HAVE_UNARY_LAWS import Test.QuickCheck.Classes.Alternative-#if defined(VERSION_semigroupoids)+#if HAVE_SEMIGROUPOIDS import Test.QuickCheck.Classes.Alt import Test.QuickCheck.Classes.Apply #endif import Test.QuickCheck.Classes.Applicative-#if MIN_VERSION_transformers(0,5,0)-import Test.QuickCheck.Classes.Bifunctor-#endif-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)-import Test.QuickCheck.Classes.Category-#endif import Test.QuickCheck.Classes.Foldable import Test.QuickCheck.Classes.Functor import Test.QuickCheck.Classes.Monad import Test.QuickCheck.Classes.MonadPlus import Test.QuickCheck.Classes.MonadZip-#if defined(VERSION_semigroupoids) && MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)+#if HAVE_SEMIGROUPOIDS import Test.QuickCheck.Classes.Plus-import Test.QuickCheck.Classes.Semigroupoid #endif import Test.QuickCheck.Classes.Traversable #endif++-- Binary type constructors+#if HAVE_BINARY_LAWS+import Test.QuickCheck.Classes.Bifunctor+import Test.QuickCheck.Classes.Category+#if HAVE_SEMIGROUPOIDS+import Test.QuickCheck.Classes.Semigroupoid #endif+#endif -- -- used below@@ -136,6 +145,7 @@ import Data.Monoid (Monoid(..)) import Data.Proxy (Proxy(..)) import Data.Semigroup (Semigroup)+import System.Exit (exitFailure) import qualified Data.List as List import qualified Data.Semigroup as SG @@ -163,17 +173,6 @@ -- ToJSON/FromJSON: Encoding Equals Value +++ OK, passed 100 tests. -- ToJSON/FromJSON: Partial Isomorphism +++ OK, passed 100 tests. -- Show/Read: Partial Isomorphism +++ OK, passed 100 tests.-{-# DEPRECATED specialisedLawsCheckMany "Use the better-named 'Test.QuickCheck.Classes.lawsCheckOne' instead" #-}-specialisedLawsCheckMany :: Proxy a -> [Proxy a -> Laws] -> IO ()-specialisedLawsCheckMany p ls = foldlMapM (lawsCheck . ($ p)) ls---- | A convenience function that allows one to check many typeclass--- instances of the same type.------ >>> specialisedLawsCheckMany (Proxy :: Proxy Word) [jsonLaws, showReadLaws]--- ToJSON/FromJSON: Encoding Equals Value +++ OK, passed 100 tests.--- ToJSON/FromJSON: Partial Isomorphism +++ OK, passed 100 tests.--- Show/Read: Partial Isomorphism +++ OK, passed 100 tests. lawsCheckOne :: Proxy a -> [Proxy a -> Laws] -> IO () lawsCheckOne p ls = foldlMapM (lawsCheck . ($ p)) ls @@ -233,6 +232,9 @@ -- Monoid: Right Identity +++ OK, passed 100 tests. -- Monoid: Concatenation +++ OK, passed 100 tests. -- @+--+-- In the case of a failing test, the program terminates with+-- exit code 1. lawsCheckMany :: [(String,[Laws])] -- ^ Element is type name paired with typeclass laws -> IO ()@@ -251,8 +253,10 @@ _ -> Bad putStrLn "" case r of- Good -> putStrLn "All tests succeeded"- Bad -> putStrLn "One or more tests failed"+ Good -> putStrLn "All tests succeeded" + Bad -> do+ putStrLn "One or more tests failed" + exitFailure data Status = Bad | Good
src/Test/QuickCheck/Classes/Alt.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} -#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS {-# LANGUAGE QuantifiedConstraints #-} #endif @@ -9,49 +9,31 @@ module Test.QuickCheck.Classes.Alt (-#if MIN_VERSION_QuickCheck(2,10,0)-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)-#if defined(VERSION_semigroupoids)+#if defined(HAVE_SEMIGROUPOIDS) && defined(HAVE_UNARY_LAWS) altLaws #endif-#endif-#endif ) where +#if defined(HAVE_SEMIGROUPOIDS) && defined(HAVE_UNARY_LAWS) import Data.Functor--#if defined(VERSION_semigroupoids) import Data.Functor.Alt (Alt) import qualified Data.Functor.Alt as Alt-#endif- import Test.QuickCheck hiding ((.&.))-#if MIN_VERSION_QuickCheck(2,10,0) import Test.QuickCheck.Arbitrary (Arbitrary1(..))-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0) import Data.Functor.Classes (Eq1,Show1)-#endif-#endif import Test.QuickCheck.Property (Property) import Test.QuickCheck.Classes.Common-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0) import Test.QuickCheck.Classes.Compat (eq1)-#endif -#if MIN_VERSION_QuickCheck(2,10,0)--#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)- -- | Tests the following alt properties: -- -- [/Associativity/] -- @(a 'Alt.<!>' b) 'Alt.<!>' c ≡ a 'Alt.<!>' (b 'Alt.<!>' c)@ -- [/Left Distributivity/] -- @f '<$>' (a 'Alt.<!>' b) ≡ (f '<$>' a) 'Alt.<!>' (f '<$>' b)@-#if defined(VERSION_semigroupoids) altLaws :: forall proxy f.-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (Alt f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a)) #else (Alt f, Eq1 f, Show1 f, Arbitrary1 f)@@ -63,7 +45,7 @@ ] altAssociative :: forall proxy f.-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (Alt f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a)) #else (Alt f, Eq1 f, Show1 f, Arbitrary1 f)@@ -72,7 +54,7 @@ altAssociative _ = property $ \(Apply (a :: f Integer)) (Apply (b :: f Integer)) (Apply (c :: f Integer)) -> eq1 ((a Alt.<!> b) Alt.<!> c) (a Alt.<!> (b Alt.<!> c)) altLeftDistributive :: forall proxy f.-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (Alt f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a)) #else (Alt f, Eq1 f, Show1 f, Arbitrary1 f)@@ -80,6 +62,3 @@ => proxy f -> Property altLeftDistributive _ = property $ \(Apply (a :: f Integer)) (Apply (b :: f Integer)) -> eq1 (id <$> (a Alt.<!> b)) ((id <$> a) Alt.<!> (id <$> b)) #endif-#endif-#endif-
src/Test/QuickCheck/Classes/Alternative.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} -#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS {-# LANGUAGE QuantifiedConstraints #-} #endif @@ -9,31 +9,25 @@ module Test.QuickCheck.Classes.Alternative (-#if MIN_VERSION_QuickCheck(2,10,0)-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)+#if HAVE_UNARY_LAWS alternativeLaws #endif-#endif ) where import Control.Applicative (Alternative(..)) import Test.QuickCheck hiding ((.&.))-#if MIN_VERSION_QuickCheck(2,10,0)+#if HAVE_UNARY_LAWS import Test.QuickCheck.Arbitrary (Arbitrary1(..))-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0) import Data.Functor.Classes (Eq1,Show1) #endif-#endif import Test.QuickCheck.Property (Property) import Test.QuickCheck.Classes.Common-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)+#if HAVE_UNARY_LAWS import Test.QuickCheck.Classes.Compat (eq1) #endif -#if MIN_VERSION_QuickCheck(2,10,0)--#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)+#if HAVE_UNARY_LAWS -- | Tests the following alternative properties: --@@ -44,7 +38,7 @@ -- [/Associativity/] -- @a '<|>' (b '<|>' c) ≡ (a '<|>' b) '<|>' c)@ alternativeLaws ::-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (Alternative f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a)) #else (Alternative f, Eq1 f, Show1 f, Arbitrary1 f)@@ -57,7 +51,7 @@ ] alternativeLeftIdentity :: forall proxy f.-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (Alternative f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a)) #else (Alternative f, Eq1 f, Show1 f, Arbitrary1 f)@@ -66,7 +60,7 @@ alternativeLeftIdentity _ = property $ \(Apply (a :: f Integer)) -> (eq1 (empty <|> a) a) alternativeRightIdentity :: forall proxy f.-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (Alternative f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a)) #else (Alternative f, Eq1 f, Show1 f, Arbitrary1 f)@@ -75,7 +69,7 @@ alternativeRightIdentity _ = property $ \(Apply (a :: f Integer)) -> (eq1 a (empty <|> a)) alternativeAssociativity :: forall proxy f.-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (Alternative f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a)) #else (Alternative f, Eq1 f, Show1 f, Arbitrary1 f)@@ -84,6 +78,3 @@ alternativeAssociativity _ = property $ \(Apply (a :: f Integer)) (Apply (b :: f Integer)) (Apply (c :: f Integer)) -> eq1 (a <|> (b <|> c)) ((a <|> b) <|> c) #endif--#endif-
src/Test/QuickCheck/Classes/Applicative.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} -#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS {-# LANGUAGE QuantifiedConstraints #-} #endif @@ -9,31 +9,25 @@ module Test.QuickCheck.Classes.Applicative (-#if MIN_VERSION_QuickCheck(2,10,0)-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)+#if HAVE_UNARY_LAWS applicativeLaws #endif-#endif ) where import Control.Applicative import Test.QuickCheck hiding ((.&.))-#if MIN_VERSION_QuickCheck(2,10,0)+#if HAVE_UNARY_LAWS import Test.QuickCheck.Arbitrary (Arbitrary1(..))-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0) import Data.Functor.Classes (Eq1,Show1) #endif-#endif import Test.QuickCheck.Property (Property) import Test.QuickCheck.Classes.Common-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)+#if HAVE_UNARY_LAWS import Test.QuickCheck.Classes.Compat (eq1) #endif -#if MIN_VERSION_QuickCheck(2,10,0)--#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)+#if HAVE_UNARY_LAWS -- | Tests the following applicative properties: --@@ -48,7 +42,7 @@ -- [/LiftA2 (1)/] -- @('<*>') ≡ 'liftA2' 'id'@ applicativeLaws ::-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (Applicative f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a)) #else (Applicative f, Eq1 f, Show1 f, Arbitrary1 f)@@ -64,7 +58,7 @@ ] applicativeIdentity :: forall proxy f.-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (Applicative f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a)) #else (Applicative f, Eq1 f, Show1 f, Arbitrary1 f)@@ -73,7 +67,7 @@ applicativeIdentity _ = property $ \(Apply (a :: f Integer)) -> eq1 (pure id <*> a) a applicativeComposition :: forall proxy f.-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (Applicative f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a)) #else (Applicative f, Eq1 f, Show1 f, Arbitrary1 f)@@ -85,7 +79,7 @@ in eq1 (pure (.) <*> u <*> v <*> w) (u <*> (v <*> w)) applicativeHomomorphism :: forall proxy f.-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (Applicative f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a)) #else (Applicative f, Eq1 f, Show1 f)@@ -96,7 +90,7 @@ in eq1 (pure f <*> pure a) (pure (f a) :: f Integer) applicativeInterchange :: forall proxy f.-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (Applicative f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a)) #else (Applicative f, Eq1 f, Show1 f, Arbitrary1 f)@@ -107,7 +101,7 @@ in eq1 (u <*> pure y) (pure ($ y) <*> u) applicativeLiftA2_1 :: forall proxy f.-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (Applicative f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a)) #else (Applicative f, Eq1 f, Show1 f, Arbitrary1 f)@@ -118,6 +112,3 @@ in eq1 (liftA2 id f x) (f <*> x) #endif--#endif-
src/Test/QuickCheck/Classes/Apply.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} -#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS {-# LANGUAGE QuantifiedConstraints #-} #endif @@ -9,46 +9,28 @@ module Test.QuickCheck.Classes.Apply (-#if MIN_VERSION_QuickCheck(2,10,0)-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)-#if defined(VERSION_semigroupoids)+#if defined(HAVE_SEMIGROUPOIDS) && defined(HAVE_UNARY_LAWS) applyLaws #endif-#endif-#endif ) where +#if defined(HAVE_SEMIGROUPOIDS) && defined(HAVE_UNARY_LAWS) import Data.Functor--#if defined(VERSION_semigroupoids) import qualified Data.Functor.Apply as FunctorApply-#endif- import Test.QuickCheck hiding ((.&.))-#if MIN_VERSION_QuickCheck(2,10,0) import Test.QuickCheck.Arbitrary (Arbitrary1(..))-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0) import Data.Functor.Classes (Eq1,Show1)-#endif-#endif import Test.QuickCheck.Property (Property) import Test.QuickCheck.Classes.Common-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0) import Test.QuickCheck.Classes.Compat (eq1)-#endif -#if MIN_VERSION_QuickCheck(2,10,0)--#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)- -- | Tests the following alt properties: -- -- [/LiftF2 (1)/]--- @('FunctorApply.<.>') ≡ 'liftF2' 'id'@-#if defined(VERSION_semigroupoids)+-- @('FunctorApply.<.>') ≡ 'FunctorApply.liftF2' 'id'@ applyLaws ::-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (FunctorApply.Apply f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a)) #else (FunctorApply.Apply f, Eq1 f, Show1 f, Arbitrary1 f)@@ -59,7 +41,7 @@ ] applyLiftF2_1 :: forall proxy f. -#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (FunctorApply.Apply f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a)) #else (FunctorApply.Apply f, Eq1 f, Show1 f, Arbitrary1 f)@@ -69,6 +51,3 @@ let f = fmap runQuadraticEquation f' in eq1 (FunctorApply.liftF2 id f x) (f FunctorApply.<.> x) #endif-#endif-#endif-
+ src/Test/QuickCheck/Classes/Bifoldable.hs view
@@ -0,0 +1,124 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ScopedTypeVariables #-}++#if HAVE_QUANTIFIED_CONSTRAINTS+{-# LANGUAGE QuantifiedConstraints #-}+#endif++{-# OPTIONS_GHC -Wall #-}++module Test.QuickCheck.Classes.Bifoldable+ (+#if HAVE_BINARY_LAWS+ bifoldableLaws+ , bifoldableFunctorLaws+#endif+ ) where++#if HAVE_BINARY_LAWS+import Data.Bifoldable(Bifoldable(..))+import Data.Bifunctor (Bifunctor(..))+import Test.QuickCheck hiding ((.&.))+import Data.Functor.Classes (Eq2,Show2)+import Test.QuickCheck.Property (Property)+import Data.Monoid+import Data.Orphans ()+import Test.QuickCheck.Classes.Common+#endif++#if HAVE_BINARY_LAWS++-- | Tests the following 'Bifunctor' properties:+--+-- [/Bifold Identity/]+-- @'bifold' ≡ 'bifoldMap' 'id' 'id'@ +-- [/BifoldMap Identity/]+-- @'bifoldMap' f g ≡ 'bifoldr' ('mappend' '.' f) ('mappend' '.' g) 'mempty'@+-- [/Bifoldr Identity/] +-- @'bifoldr' f g z t ≡ 'appEndo' ('bifoldMap' ('Endo' '.' f) ('Endo' '.' g) t) z@+--+-- /Note/: This property test is only available when this package is built with+-- @base-4.10+@ or @transformers-0.5+@.+bifoldableLaws :: forall proxy f.+#if HAVE_QUANTIFIED_CONSTRAINTS+ (Bifoldable f, forall a b. (Eq a, Eq b) => Eq (f a b), forall a b. (Show a, Show b) => Show (f a b), forall a b. (Arbitrary a, Arbitrary b) => Arbitrary (f a b))+#else+ (Bifoldable f, Eq2 f, Show2 f, Arbitrary2 f)+#endif+ => proxy f -> Laws+bifoldableLaws p = Laws "Bifoldable"+ [ ("Bifold Identity", bifoldIdentity p)+ , ("BifoldMap Identity", bifoldMapIdentity p)+ , ("Bifoldr Identity", bifoldrIdentity p)+ ]++-- | Tests the following 'Bifunctor'/'Bifoldable' properties:+--+-- [/Bifold Identity/]+-- @'bifoldMap' f g ≡ 'bifold' '.' 'bimap' f g@+-- [/BifoldMap Identity/]+-- @'bifoldMap' f g '.' 'bimap' h i ≡ 'bifoldMap' (f '.' h) (g '.' i)@+--+-- /Note/: This property test is only available when this package is built with+-- @base-4.10+@ or @transformers-0.5+@.+bifoldableFunctorLaws :: forall proxy f.+#if HAVE_QUANTIFIED_CONSTRAINTS+ (Bifoldable f, Bifunctor f, forall a b. (Eq a, Eq b) => Eq (f a b), forall a b. (Show a, Show b) => Show (f a b), forall a b. (Arbitrary a, Arbitrary b) => Arbitrary (f a b))+#else+ (Bifoldable f, Bifunctor f, Eq2 f, Show2 f, Arbitrary2 f)+#endif+ => proxy f -> Laws+bifoldableFunctorLaws p = Laws "Bifoldable/Bifunctor"+ [ ("Bifoldable Bifunctor Law", bifoldableFunctorLaw p)+ , ("Bifoldable Bifunctor Law Implication", bifoldableFunctorImplication p)+ ]++bifoldableFunctorLaw :: forall proxy f.+#if HAVE_QUANTIFIED_CONSTRAINTS+ (Bifoldable f, Bifunctor f, forall a b. (Eq a, Eq b) => Eq (f a b), forall a b. (Show a, Show b) => Show (f a b), forall a b. (Arbitrary a, Arbitrary b) => Arbitrary (f a b))+#else+ (Bifoldable f, Bifunctor f, Eq2 f, Show2 f, Arbitrary2 f)+#endif+ => proxy f -> Property+bifoldableFunctorLaw _ = property $ \(Apply2 (x :: f Integer Integer)) -> bifoldMap Sum Sum x == (bifold (bimap Sum Sum x))++bifoldableFunctorImplication :: forall proxy f.+#if HAVE_QUANTIFIED_CONSTRAINTS+ (Bifoldable f, Bifunctor f, forall a b. (Eq a, Eq b) => Eq (f a b), forall a b. (Show a, Show b) => Show (f a b), forall a b. (Arbitrary a, Arbitrary b) => Arbitrary (f a b))+#else+ (Bifoldable f, Bifunctor f, Eq2 f, Show2 f, Arbitrary2 f)+#endif+ => proxy f -> Property+bifoldableFunctorImplication _ = property $ \(Apply2 (x :: f Integer Integer)) -> bifoldMap Sum Sum (bimap Product Product x) == bifoldMap (Sum . Product) (Sum . Product) x++bifoldIdentity :: forall proxy f.+#if HAVE_QUANTIFIED_CONSTRAINTS+ (Bifoldable f, forall a b. (Eq a, Eq b) => Eq (f a b), forall a b. (Show a, Show b) => Show (f a b), forall a b. (Arbitrary a, Arbitrary b) => Arbitrary (f a b))+#else+ (Bifoldable f, Eq2 f, Show2 f, Arbitrary2 f)+#endif+ => proxy f -> Property+bifoldIdentity _ = property $ \(Apply2 (x :: f (Sum Integer) (Sum Integer))) -> (bifold x) == (bifoldMap id id x)++bifoldMapIdentity :: forall proxy f.+#if HAVE_QUANTIFIED_CONSTRAINTS+ (Bifoldable f, forall a b. (Eq a, Eq b) => Eq (f a b), forall a b. (Show a, Show b) => Show (f a b), forall a b. (Arbitrary a, Arbitrary b) => Arbitrary (f a b))+#else+ (Bifoldable f, Eq2 f, Show2 f, Arbitrary2 f)+#endif+ => proxy f -> Property+bifoldMapIdentity _ = property $ \(Apply2 (x :: f Integer Integer)) -> bifoldMap Sum Sum x == bifoldr (mappend . Sum) (mappend . Sum) mempty x++bifoldrIdentity :: forall proxy f.+#if HAVE_QUANTIFIED_CONSTRAINTS+ (Bifoldable f, forall a b. (Eq a, Eq b) => Eq (f a b), forall a b. (Show a, Show b) => Show (f a b), forall a b. (Arbitrary a, Arbitrary b) => Arbitrary (f a b))+#else+ (Bifoldable f, Eq2 f, Show2 f, Arbitrary2 f)+#endif+ => proxy f -> Property+bifoldrIdentity _ = property $ \(Apply2 (x :: f Integer Integer)) ->+ let f _ _ = mempty+ g _ _ = mempty+ in bifoldr f g (mempty :: Sum Integer) x == appEndo (bifoldMap (Endo . f) (Endo . g) x) mempty++#endif
src/Test/QuickCheck/Classes/Bifunctor.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} -#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS {-# LANGUAGE QuantifiedConstraints #-} #endif @@ -9,28 +9,24 @@ module Test.QuickCheck.Classes.Bifunctor (-#if MIN_VERSION_QuickCheck(2,10,0)-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,5,0)+#if HAVE_BINARY_LAWS bifunctorLaws #endif-#endif ) where import Data.Bifunctor(Bifunctor(..)) import Test.QuickCheck hiding ((.&.))-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,5,0)+#if HAVE_BINARY_LAWS import Data.Functor.Classes (Eq2,Show2) #endif import Test.QuickCheck.Property (Property) import Test.QuickCheck.Classes.Common-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,5,0)+#if HAVE_BINARY_LAWS import Test.QuickCheck.Classes.Compat (eq2) #endif -#if MIN_VERSION_QuickCheck(2,10,0)--#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,5,0)+#if HAVE_BINARY_LAWS -- | Tests the following 'Bifunctor' properties: --@@ -46,7 +42,7 @@ -- /Note/: This property test is only available when this package is built with -- @base-4.9+@ or @transformers-0.5+@. bifunctorLaws :: forall proxy f.-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (Bifunctor f, forall a b. (Eq a, Eq b) => Eq (f a b), forall a b. (Show a, Show b) => Show (f a b), forall a b. (Arbitrary a, Arbitrary b) => Arbitrary (f a b)) #else (Bifunctor f, Eq2 f, Show2 f, Arbitrary2 f)@@ -60,7 +56,7 @@ ] bifunctorIdentity :: forall proxy f.-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (Bifunctor f, forall a b. (Eq a, Eq b) => Eq (f a b), forall a b. (Show a, Show b) => Show (f a b), forall a b. (Arbitrary a, Arbitrary b) => Arbitrary (f a b)) #else (Bifunctor f, Eq2 f, Show2 f, Arbitrary2 f)@@ -69,7 +65,7 @@ bifunctorIdentity _ = property $ \(Apply2 (x :: f Integer Integer)) -> eq2 (bimap id id x) x bifunctorFirstIdentity :: forall proxy f.-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (Bifunctor f, forall a b. (Eq a, Eq b) => Eq (f a b), forall a b. (Show a, Show b) => Show (f a b), forall a b. (Arbitrary a, Arbitrary b) => Arbitrary (f a b)) #else (Bifunctor f, Eq2 f, Show2 f, Arbitrary2 f)@@ -78,7 +74,7 @@ bifunctorFirstIdentity _ = property $ \(Apply2 (x :: f Integer Integer)) -> eq2 (first id x) x bifunctorSecondIdentity :: forall proxy f.-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (Bifunctor f, forall a b. (Eq a, Eq b) => Eq (f a b), forall a b. (Show a, Show b) => Show (f a b), forall a b. (Arbitrary a, Arbitrary b) => Arbitrary (f a b)) #else (Bifunctor f, Eq2 f, Show2 f, Arbitrary2 f)@@ -87,14 +83,12 @@ bifunctorSecondIdentity _ = property $ \(Apply2 (x :: f Integer Integer)) -> eq2 (second id x) x bifunctorComposition :: forall proxy f. -#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (Bifunctor f, forall a b. (Eq a, Eq b) => Eq (f a b), forall a b. (Show a, Show b) => Show (f a b), forall a b. (Arbitrary a, Arbitrary b) => Arbitrary (f a b)) #else (Bifunctor f, Eq2 f, Show2 f, Arbitrary2 f) #endif => proxy f -> Property bifunctorComposition _ = property $ \(Apply2 (z :: f Integer Integer)) -> eq2 (bimap id id z) ((first id . second id) z)-#endif #endif-
src/Test/QuickCheck/Classes/Category.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} -#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS {-# LANGUAGE QuantifiedConstraints #-} #endif @@ -9,30 +9,26 @@ module Test.QuickCheck.Classes.Category (-#if MIN_VERSION_QuickCheck(2,10,0)-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,5,0)+#if HAVE_BINARY_LAWS categoryLaws , commutativeCategoryLaws #endif-#endif ) where import Prelude hiding (id, (.)) import Control.Category (Category(..)) import Test.QuickCheck hiding ((.&.))-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,5,0)+#if HAVE_BINARY_LAWS import Data.Functor.Classes (Eq2,Show2) #endif import Test.QuickCheck.Property (Property) import Test.QuickCheck.Classes.Common-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,5,0)+#if HAVE_BINARY_LAWS import Test.QuickCheck.Classes.Compat (eq2) #endif -#if MIN_VERSION_QuickCheck(2,10,0)--#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,5,0)+#if HAVE_BINARY_LAWS -- | Tests the following 'Category' properties: --@@ -46,7 +42,7 @@ -- /Note/: This property test is only available when this package is built with -- @base-4.9+@ or @transformers-0.5+@. categoryLaws :: forall proxy c.-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (Category c, forall a b. (Eq a, Eq b) => Eq (c a b), forall a b. (Show a, Show b) => Show (c a b), forall a b. (Arbitrary a, Arbitrary b) => Arbitrary (c a b)) #else (Category c, Eq2 c, Show2 c, Arbitrary2 c)@@ -66,7 +62,7 @@ -- /Note/: This property test is only available when this package is built with -- @base-4.9+@ or @transformers-0.5+@. commutativeCategoryLaws :: forall proxy c.-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (Category c, forall a b. (Eq a, Eq b) => Eq (c a b), forall a b. (Show a, Show b) => Show (c a b), forall a b. (Arbitrary a, Arbitrary b) => Arbitrary (c a b)) #else (Category c, Eq2 c, Show2 c, Arbitrary2 c)@@ -77,7 +73,7 @@ ] categoryRightIdentity :: forall proxy c.-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (Category c, forall a b. (Eq a, Eq b) => Eq (c a b), forall a b. (Show a, Show b) => Show (c a b), forall a b. (Arbitrary a, Arbitrary b) => Arbitrary (c a b)) #else (Category c, Eq2 c, Show2 c, Arbitrary2 c)@@ -86,7 +82,7 @@ categoryRightIdentity _ = property $ \(Apply2 (x :: c Integer Integer)) -> eq2 (x . id) x categoryLeftIdentity :: forall proxy c.-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (Category c, forall a b. (Eq a, Eq b) => Eq (c a b), forall a b. (Show a, Show b) => Show (c a b), forall a b. (Arbitrary a, Arbitrary b) => Arbitrary (c a b)) #else (Category c, Eq2 c, Show2 c, Arbitrary2 c)@@ -95,7 +91,7 @@ categoryLeftIdentity _ = property $ \(Apply2 (x :: c Integer Integer)) -> eq2 (id . x) x categoryAssociativity :: forall proxy c.-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (Category c, forall a b. (Eq a, Eq b) => Eq (c a b), forall a b. (Show a, Show b) => Show (c a b), forall a b. (Arbitrary a, Arbitrary b) => Arbitrary (c a b)) #else (Category c, Eq2 c, Show2 c, Arbitrary2 c)@@ -104,7 +100,7 @@ categoryAssociativity _ = property $ \(Apply2 (f :: c Integer Integer)) (Apply2 (g :: c Integer Integer)) (Apply2 (h :: c Integer Integer)) -> eq2 (f . (g . h)) ((f . g) . h) categoryCommutativity :: forall proxy c.-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (Category c, forall a b. (Eq a, Eq b) => Eq (c a b), forall a b. (Show a, Show b) => Show (c a b), forall a b. (Arbitrary a, Arbitrary b) => Arbitrary (c a b)) #else (Category c, Eq2 c, Show2 c, Arbitrary2 c)@@ -113,6 +109,3 @@ categoryCommutativity _ = property $ \(Apply2 (f :: c Integer Integer)) (Apply2 (g :: c Integer Integer)) -> eq2 (f . g) (g . f) #endif--#endif-
src/Test/QuickCheck/Classes/Common.hs view
@@ -3,7 +3,7 @@ {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE UndecidableInstances #-} -#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS {-# LANGUAGE QuantifiedConstraints #-} #endif @@ -12,11 +12,14 @@ module Test.QuickCheck.Classes.Common ( Laws(..) , foldMapA - , myForAllShrink - + , myForAllShrink+ -- Modifiers+ , SmallList(..)+ , ShowReadPrecedence(..)+ -- only used for higher-kinded types , Apply(..)-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,5,0)+#if HAVE_BINARY_LAWS , Apply2(..) #endif , Triple(..)@@ -25,31 +28,31 @@ , LastNothing(..) , Bottom(..) , LinearEquation(..)-#if MIN_VERSION_base(4,8,0) || MIN_VERSION_transformers(0,4,0)+#if HAVE_UNARY_LAWS , LinearEquationM(..) #endif , QuadraticEquation(..) , LinearEquationTwo(..)-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)+#if HAVE_UNARY_LAWS , nestedEq1 , propNestedEq1 , toSpecialApplicative #endif , flipPair-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)+#if HAVE_UNARY_LAWS , apTrans #endif , func1 , func2 , func3-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)+#if HAVE_UNARY_LAWS , func4 #endif , func5 , func6 , reverseTriple , runLinearEquation-#if MIN_VERSION_base(4,8,0) || MIN_VERSION_transformers(0,4,0)+#if HAVE_UNARY_LAWS , runLinearEquationM #endif , runQuadraticEquation@@ -61,10 +64,13 @@ import Data.Foldable import Data.Traversable import Data.Monoid-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)-import Data.Functor.Classes+#if defined(HAVE_UNARY_LAWS)+import Data.Functor.Classes (Eq1(..),Show1(..),eq1,showsPrec1) import Data.Functor.Compose #endif+#if defined(HAVE_BINARY_LAWS)+import Data.Functor.Classes (Eq2(..),Show2(..),eq2,showsPrec2)+#endif import Data.Semigroup (Semigroup) import Test.QuickCheck hiding ((.&.)) import Test.QuickCheck.Property (Property(..))@@ -87,14 +93,16 @@ => Bool -- Should we show the RHS. It's better not to show it -- if the RHS is equal to the input. -> (a -> Bool) -- is the value a valid input- -> (a -> [String])- -> String- -> (a -> b)- -> String- -> (a -> b)+ -> (a -> [String]) -- show the 'a' values+ -> String -- show the LHS+ -> (a -> b) -- the function that makes the LHS+ -> String -- show the RHS+ -> (a -> b) -- the function that makes the RHS -> Property myForAllShrink displayRhs isValid showInputs name1 calc1 name2 calc2 =+#if MIN_VERSION_QuickCheck(2,9,0) again $+#endif MkProperty $ arbitrary >>= \x -> unProperty $@@ -107,9 +115,9 @@ err = description ++ "\n" ++ unlines (map (" " ++) (showInputs x')) ++ " " ++ name1 ++ " = " ++ sb1 ++ (if displayRhs then "\n " ++ name2 ++ " = " ++ sb2 else "") in isValid x' ==> counterexample err (b1 == b2) -#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)+#if HAVE_UNARY_LAWS -- the Functor constraint is needed for transformers-0.4-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS nestedEq1 :: (forall x. Eq x => Eq (f x), forall x. Eq x => Eq (g x), Eq a) => f (g a) -> f (g a) -> Bool nestedEq1 = (==) #else@@ -117,7 +125,7 @@ nestedEq1 x y = eq1 (Compose x) (Compose y) #endif -#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS propNestedEq1 :: (forall x. Eq x => Eq (f x), forall x. Eq x => Eq (g x), Eq a, forall x. Show x => Show (f x), forall x. Show x => Show (g x), Show a) => f (g a) -> f (g a) -> Property propNestedEq1 = (===)@@ -137,7 +145,7 @@ flipPair :: (a,b) -> (b,a) flipPair (x,y) = (y,x) -#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)+#if HAVE_UNARY_LAWS -- Reverse the list and accumulate the writers. We cannot -- use Sum or Product or else it wont actually be a valid -- applicative transformation.@@ -156,7 +164,7 @@ func3 :: Integer -> SG.Sum Integer func3 i = SG.Sum (3 * i * i - 7 * i + 4) -#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)+#if HAVE_UNARY_LAWS func4 :: Integer -> Compose Triple (WL.Writer (S.Set Integer)) Integer func4 i = Compose $ Triple (WL.writer (i * i, S.singleton (i * 7 + 5)))@@ -177,7 +185,7 @@ tripleLiftEq p (Triple a1 b1 c1) (Triple a2 b2 c2) = p a1 a2 && p b1 b2 && p c1 c2 -#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)+#if HAVE_UNARY_LAWS instance Eq1 Triple where #if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,5,0) liftEq = tripleLiftEq@@ -195,7 +203,7 @@ . showString " " . elemShowsPrec 11 c -#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)+#if HAVE_UNARY_LAWS instance Show1 Triple where #if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,5,0) liftShowsPrec = tripleLiftShowsPrec@@ -204,7 +212,7 @@ #endif #endif -#if MIN_VERSION_QuickCheck(2,10,0)+#if HAVE_UNARY_LAWS instance Arbitrary1 Triple where liftArbitrary x = Triple <$> x <*> x <*> x @@ -287,12 +295,12 @@ mempty = Apply $ pure mempty mappend = (SG.<>) -#if MIN_VERSION_base(4,12,0)+#if HAVE_UNARY_LAWS+#if HAVE_QUANTIFIED_CONSTRAINTS deriving instance (forall x. Eq x => Eq (f x), Eq a) => Eq (Apply f a) deriving instance (forall x. Arbitrary x => Arbitrary (f x), Arbitrary a) => Arbitrary (Apply f a) deriving instance (forall x. Show x => Show (f x), Show a) => Show (Apply f a) #else-#if MIN_VERSION_base(4,8,0) || MIN_VERSION_transformers(0,5,0) instance (Eq1 f, Eq a) => Eq (Apply f a) where Apply a == Apply b = eq1 a b @@ -302,22 +310,20 @@ instance (Show1 f, Show a) => Show (Apply f a) where showsPrec p = showsPrec1 p . getApply -#if MIN_VERSION_QuickCheck(2,10,0) instance (Arbitrary1 f, Arbitrary a) => Arbitrary (Apply f a) where arbitrary = fmap Apply arbitrary1 shrink = map Apply . shrink1 . getApply #endif #endif-#endif foldMapA :: (Foldable t, Monoid m, Semigroup m, Applicative f) => (a -> f m) -> t a -> f m foldMapA f = getApply . foldMap (Apply . f) -#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,5,0)+#if HAVE_BINARY_LAWS newtype Apply2 f a b = Apply2 { getApply2 :: f a b } -#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS deriving instance (forall x y. (Eq x, Eq y) => Eq (f x y), Eq a, Eq b) => Eq (Apply2 f a b) deriving instance (forall x y. (Arbitrary x, Arbitrary y) => Arbitrary (f x y), Arbitrary a, Arbitrary b) => Arbitrary (Apply2 f a b) deriving instance (forall x y. (Show x, Show y) => Show (f x y), Show a, Show b) => Show (Apply2 f a b)@@ -328,13 +334,11 @@ instance (Show2 f, Show a, Show b) => Show (Apply2 f a b) where showsPrec p = showsPrec2 p . getApply2 -#if MIN_VERSION_QuickCheck(2,10,0) instance (Arbitrary2 f, Arbitrary a, Arbitrary b) => Arbitrary (Apply2 f a b) where arbitrary = fmap Apply2 arbitrary2 shrink = fmap Apply2 . shrink2 . getApply2 #endif #endif-#endif data LinearEquation = LinearEquation { _linearEquationLinear :: Integer@@ -357,7 +361,7 @@ ++ L.intersperse (SG.Endo (showChar ',')) (map (SG.Endo . showLinear 0) xs) ++ [SG.Endo (showChar ']')] -#if MIN_VERSION_base(4,8,0) || MIN_VERSION_transformers(0,4,0)+#if HAVE_UNARY_LAWS data LinearEquationM m = LinearEquationM (m LinearEquation) (m LinearEquation) runLinearEquationM :: Monad m => LinearEquationM m -> Integer -> m Integer@@ -365,7 +369,7 @@ then liftM (flip runLinearEquation i) e1 else liftM (flip runLinearEquation i) e2 -#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS deriving instance (forall x. Eq x => Eq (m x)) => Eq (LinearEquationM m) instance (forall a. Show a => Show (m a)) => Show (LinearEquationM m) where show (LinearEquationM a b) = (\f -> f "")@@ -390,7 +394,6 @@ . showString " else " . showsPrec1 0 b -#if MIN_VERSION_QuickCheck(2,10,0) instance Arbitrary1 m => Arbitrary (LinearEquationM m) where arbitrary = liftA2 LinearEquationM arbitrary1 arbitrary1 shrink (LinearEquationM a b) = L.concat@@ -399,7 +402,6 @@ ] #endif #endif-#endif instance Arbitrary LinearEquation where arbitrary = do@@ -456,3 +458,28 @@ runLinearEquationTwo :: LinearEquationTwo -> Integer -> Integer -> Integer runLinearEquationTwo (LinearEquationTwo a b) x y = a * x + b * y++newtype SmallList a = SmallList { getSmallList :: [a] }+ deriving (Eq,Show)++instance Arbitrary a => Arbitrary (SmallList a) where+ arbitrary = do+ n <- choose (0,6)+ xs <- vector n+ return (SmallList xs)+ shrink = map SmallList . shrink . getSmallList++-- Haskell uses the operator precedences 0..9, the special function application+-- precedence 10 and the precedence 11 for function arguments. Both show and+-- read instances have to accept this range. According to the Haskell Language+-- Report, the output of derived show instances in precedence context 11 has to+-- be an atomic expression.+showReadPrecedences :: [Int]+showReadPrecedences = [0..11]++newtype ShowReadPrecedence = ShowReadPrecedence Int+ deriving (Eq,Ord,Show)+instance Arbitrary ShowReadPrecedence where+ arbitrary = ShowReadPrecedence <$> elements showReadPrecedences+ shrink (ShowReadPrecedence p) =+ [ ShowReadPrecedence p' | p' <- showReadPrecedences, p' < p ]
src/Test/QuickCheck/Classes/Compat.hs view
@@ -1,35 +1,57 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} -#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS {-# LANGUAGE QuantifiedConstraints #-} #endif module Test.QuickCheck.Classes.Compat ( isTrue#-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)+#if HAVE_UNARY_LAWS , eq1 #endif-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,5,0)+#if HAVE_BINARY_LAWS , eq2 #endif+ , readMaybe ) where +#if MIN_VERSION_base(4,6,0)+import Text.Read (readMaybe)+#else+import Text.ParserCombinators.ReadP (skipSpaces)+import Text.ParserCombinators.ReadPrec (lift, minPrec, readPrec_to_S)+import Text.Read (readPrec)+#endif+ #if MIN_VERSION_base(4,7,0) import GHC.Exts (isTrue#) #endif -#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)+#if defined(HAVE_UNARY_LAWS) || defined(HAVE_BINARY_LAWS) import qualified Data.Functor.Classes as C #endif +#if !MIN_VERSION_base(4,6,0)+readMaybe :: Read a => String -> Maybe a+readMaybe s =+ case [ x | (x,"") <- readPrec_to_S read' minPrec s ] of+ [x] -> Just x+ _ -> Nothing+ where+ read' =+ do x <- readPrec+ lift skipSpaces+ return x+#endif+ #if !MIN_VERSION_base(4,7,0) isTrue# :: Bool -> Bool isTrue# b = b #endif -#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)-#if MIN_VERSION_base(4,12,0)+#if HAVE_UNARY_LAWS+#if HAVE_QUANTIFIED_CONSTRAINTS eq1 :: (forall a. Eq a => Eq (f a), Eq a) => f a -> f a -> Bool eq1 = (==) #else@@ -38,8 +60,8 @@ #endif #endif -#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,5,0)-#if MIN_VERSION_base(4,12,0)+#if HAVE_BINARY_LAWS+#if HAVE_QUANTIFIED_CONSTRAINTS eq2 :: (forall a. (Eq a, Eq b) => Eq (f a b), Eq a, Eq b) => f a b -> f a b -> Bool eq2 = (==) #else
src/Test/QuickCheck/Classes/Enum.hs view
@@ -16,9 +16,9 @@ -- | Tests the following properties: -- -- [/Succ Pred Identity/]--- @succ (pred x) ≡ x@+-- @'succ' ('pred' x) ≡ x@ -- [/Pred Succ Identity/]--- @pred (succ x) ≡ x@+-- @'pred' ('succ' x) ≡ x@ -- -- This only works for @Enum@ types that are not bounded, meaning -- that 'succ' and 'pred' must be total. This means that these property
src/Test/QuickCheck/Classes/Foldable.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} -#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS {-# LANGUAGE QuantifiedConstraints #-} #endif @@ -9,38 +9,34 @@ module Test.QuickCheck.Classes.Foldable (-#if MIN_VERSION_QuickCheck(2,10,0)-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)+#if HAVE_UNARY_LAWS foldableLaws #endif-#endif ) where import Data.Monoid import Data.Foldable import Test.QuickCheck hiding ((.&.))-#if MIN_VERSION_QuickCheck(2,10,0) import Control.Exception (ErrorCall,try,evaluate) import Control.Monad.Trans.Class (lift)+#if HAVE_UNARY_LAWS import Test.QuickCheck.Arbitrary (Arbitrary1(..))+#endif import Test.QuickCheck.Monadic (monadicIO)-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)+#if HAVE_UNARY_LAWS import Data.Functor.Classes (Eq1,Show1) #endif-#endif import Test.QuickCheck.Property (Property) import qualified Data.Foldable as F import qualified Data.Semigroup as SG import Test.QuickCheck.Classes.Common-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)+#if HAVE_UNARY_LAWS import Test.QuickCheck.Classes.Compat (eq1) #endif -#if MIN_VERSION_QuickCheck(2,10,0)--#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)+#if HAVE_UNARY_LAWS -- | Tests the following 'Foldable' properties: --@@ -70,7 +66,7 @@ -- Note that this checks to ensure that @foldl\'@ and @foldr\'@ -- are suitably strict. foldableLaws :: forall proxy f.-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (Foldable f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a)) #else (Foldable f, Eq1 f, Show1 f, Arbitrary1 f)@@ -79,7 +75,7 @@ foldableLaws = foldableLawsInternal foldableLawsInternal :: forall proxy f.-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (Foldable f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a)) #else (Foldable f, Eq1 f, Show1 f, Arbitrary1 f)@@ -130,7 +126,7 @@ compatToList = foldMap (\x -> [x]) foldableFoldl' :: forall proxy f.-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (Foldable f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a)) #else (Foldable f, Eq1 f, Show1 f, Arbitrary1 f)@@ -159,7 +155,7 @@ return (r1 == r2) foldableFoldr' :: forall proxy f.-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (Foldable f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a)) #else (Foldable f, Eq1 f, Show1 f, Arbitrary1 f)@@ -188,6 +184,3 @@ return (r1 == r2) #endif--#endif-
src/Test/QuickCheck/Classes/Functor.hs view
@@ -3,7 +3,7 @@ {-# LANGUAGE KindSignatures #-} {-# LANGUAGE ScopedTypeVariables #-} -#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS {-# LANGUAGE QuantifiedConstraints #-} #endif @@ -11,31 +11,25 @@ module Test.QuickCheck.Classes.Functor (-#if MIN_VERSION_QuickCheck(2,10,0)-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)+#if HAVE_UNARY_LAWS functorLaws #endif-#endif ) where import Data.Functor import Test.QuickCheck hiding ((.&.))-#if MIN_VERSION_QuickCheck(2,10,0)+#if HAVE_UNARY_LAWS import Test.QuickCheck.Arbitrary (Arbitrary1(..))-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0) import Data.Functor.Classes (Eq1,Show1) #endif-#endif import Test.QuickCheck.Property (Property) import Test.QuickCheck.Classes.Common-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)+#if HAVE_UNARY_LAWS import Test.QuickCheck.Classes.Compat (eq1) #endif -#if MIN_VERSION_QuickCheck(2,10,0)--#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)+#if HAVE_UNARY_LAWS -- | Tests the following functor properties: --@@ -46,7 +40,7 @@ -- [/Const/] -- @('<$') ≡ 'fmap' 'const'@ functorLaws ::-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (Functor f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a)) #else (Functor f, Eq1 f, Show1 f, Arbitrary1 f)@@ -60,7 +54,7 @@ ] functorIdentity :: forall proxy f.-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (Functor f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a)) #else (Functor f, Eq1 f, Show1 f, Arbitrary1 f)@@ -69,7 +63,7 @@ functorIdentity _ = property $ \(Apply (a :: f Integer)) -> eq1 (fmap id a) a functorComposition :: forall proxy f.-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (Functor f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a)) #else (Functor f, Eq1 f, Show1 f, Arbitrary1 f)@@ -79,7 +73,7 @@ eq1 (fmap func2 (fmap func1 a)) (fmap (func2 . func1) a) functorConst :: forall proxy f.-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (Functor f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a)) #else (Functor f, Eq1 f, Show1 f, Arbitrary1 f)@@ -87,8 +81,6 @@ => proxy f -> Property functorConst _ = property $ \(Apply (a :: f Integer)) -> eq1 (fmap (const 'X') a) ('X' <$ a)--#endif #endif
+ src/Test/QuickCheck/Classes/Generic.hs view
@@ -0,0 +1,112 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+#if HAVE_QUANTIFIED_CONSTRAINTS+{-# LANGUAGE QuantifiedConstraints #-}+#endif+{-# OPTIONS_GHC -Wall #-}++module Test.QuickCheck.Classes.Generic+ (+#if MIN_VERSION_base(4,5,0)+ genericLaws+#if HAVE_UNARY_LAWS+ , generic1Laws+#endif+#endif+ ) where++#if MIN_VERSION_base(4,5,0)+import Control.Applicative+import Data.Semigroup as SG+import Data.Monoid as MD+import GHC.Generics+#if HAVE_UNARY_LAWS+import Data.Functor.Classes+#endif+import Data.Proxy (Proxy(Proxy))+import Test.QuickCheck+import Test.QuickCheck.Property (Property)++import Test.QuickCheck.Classes.Common (Laws(..), Apply(..))++-- | Tests the following properties:+--+-- [/From-To Inverse/]+-- @'from' '.' 'to' ≡ 'id'@+-- [/To-From Inverse/]+-- @'to' '.' 'from' ≡ 'id'@+--+-- /Note:/ This property test is only available when+-- using @base-4.5@ or newer.+--+-- /Note:/ 'from' and 'to' don't actually care about+-- the type variable @x@ in @'Rep' a x@, so here we instantiate+-- it to @'()'@ by default. If you would like to instantiate @x@+-- as something else, please file a bug report.+genericLaws :: (Generic a, Eq a, Arbitrary a, Show a, Show (Rep a ()), Arbitrary (Rep a ()), Eq (Rep a ())) => Proxy a -> Laws+genericLaws pa = Laws "Generic"+ [ ("From-To inverse", fromToInverse pa (Proxy :: Proxy ()))+ , ("To-From inverse", toFromInverse pa)+ ]++toFromInverse :: forall proxy a. (Generic a, Eq a, Arbitrary a, Show a) => proxy a -> Property+toFromInverse _ = property $ \(v :: a) -> (to . from $ v) == v++fromToInverse ::+ forall proxy a x.+ (Generic a, Show (Rep a x), Arbitrary (Rep a x), Eq (Rep a x))+ => proxy a+ -> proxy x+ -> Property+fromToInverse _ _ = property $ \(r :: Rep a x) -> r == (from (to r :: a)) ++#if HAVE_UNARY_LAWS+-- | Tests the following properties:+--+-- [/From-To Inverse/]+-- @'from1' '.' 'to1' ≡ 'id'@+-- [/To-From Inverse/]+-- @'to1' '.' 'from1' ≡ 'id'@+--+-- /Note:/ This property test is only available when+-- using @base-4.9@ or newer.+generic1Laws :: (Generic1 f, Eq1 f, Arbitrary1 f, Show1 f, Eq1 (Rep1 f), Show1 (Rep1 f), Arbitrary1 (Rep1 f))+ => proxy f -> Laws+generic1Laws p = Laws "Generic1"+ [ ("From1-To1 inverse", fromToInverse1 p)+ , ("To1-From1 inverse", toFromInverse1 p)+ ]++-- hack for quantified constraints: under base >= 4.12,+-- our usual 'Apply' wrapper has Eq, Show, and Arbitrary+-- instances that are incompatible.+newtype GApply f a = GApply { getGApply :: f a }++instance (Applicative f, Semigroup a) => Semigroup (GApply f a) where+ GApply x <> GApply y = GApply $ liftA2 (SG.<>) x y++instance (Applicative f, Monoid a) => Monoid (GApply f a) where+ mempty = GApply $ pure mempty+ mappend (GApply x) (GApply y) = GApply $ liftA2 (MD.<>) x y++instance (Eq1 f, Eq a) => Eq (GApply f a) where+ GApply a == GApply b = eq1 a b++instance (Show1 f, Show a) => Show (GApply f a) where+ showsPrec p = showsPrec1 p . getGApply++instance (Arbitrary1 f, Arbitrary a) => Arbitrary (GApply f a) where+ arbitrary = fmap GApply arbitrary1+ shrink = map GApply . shrink1 . getGApply++toFromInverse1 :: forall proxy f. (Generic1 f, Eq1 f, Arbitrary1 f, Show1 f) => proxy f -> Property+toFromInverse1 _ = property $ \(GApply (v :: f Integer)) -> eq1 v (to1 . from1 $ v)++fromToInverse1 :: forall proxy f. (Generic1 f, Eq1 (Rep1 f), Arbitrary1 (Rep1 f), Show1 (Rep1 f)) => proxy f -> Property+fromToInverse1 _ = property $ \(GApply (r :: Rep1 f Integer)) -> eq1 r (from1 ((to1 $ r) :: f Integer))++#endif++#endif
src/Test/QuickCheck/Classes/Json.hs view
@@ -5,16 +5,16 @@ module Test.QuickCheck.Classes.Json (-#if defined(VERSION_aeson)+#if HAVE_AESON jsonLaws #endif ) where import Data.Proxy (Proxy) import Test.QuickCheck hiding ((.&.))-import Test.QuickCheck.Property (Property)+import Test.QuickCheck.Property (Property(..)) -#if defined(VERSION_aeson)+#if HAVE_AESON import Data.Aeson (FromJSON(..), ToJSON(..)) import qualified Data.Aeson as AE #endif@@ -30,7 +30,7 @@ -- -- Note that in the second property, the type of decode is @ByteString -> Value@, -- not @ByteString -> a@-#if defined(VERSION_aeson)+#if HAVE_AESON jsonLaws :: (ToJSON a, FromJSON a, Show a, Arbitrary a, Eq a) => Proxy a -> Laws jsonLaws p = Laws "ToJSON/FromJSON" [ ("Partial Isomorphism", jsonEncodingPartialIsomorphism p)@@ -46,7 +46,23 @@ Just (v :: AE.Value) -> v == toJSON a jsonEncodingPartialIsomorphism :: forall a. (ToJSON a, FromJSON a, Show a, Eq a, Arbitrary a) => Proxy a -> Property-jsonEncodingPartialIsomorphism _ = property $ \(a :: a) ->- AE.decode (AE.encode a) == Just a-+jsonEncodingPartialIsomorphism _ =+#if MIN_VERSION_QuickCheck(2,9,0)+ again $+#endif+ MkProperty $+ arbitrary >>= \(x :: a) ->+ unProperty $+ shrinking shrink x $ \x' ->+ let desc1 = "Just"+ desc2 = "Data.Aeson.decode . Data.Aeson.encode"+ name1 = "Data.Aeson.encode a"+ name2 = "Data.Aeson.decode (Data.Aeson.encode a)"+ b1 = AE.encode x'+ b2 = AE.decode (AE.encode x')+ sb1 = show b1+ sb2 = show b2+ description = " Description: " ++ desc1 ++ " == " ++ desc2+ err = description ++ "\n" ++ unlines (map (" " ++) (["a = " ++ show x'])) ++ " " ++ name1 ++ " = " ++ sb1 ++ "\n " ++ name2 ++ " = " ++ sb2+ in counterexample err (Just x' == b2) #endif
src/Test/QuickCheck/Classes/Monad.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} -#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS {-# LANGUAGE QuantifiedConstraints #-} #endif @@ -9,32 +9,26 @@ module Test.QuickCheck.Classes.Monad (-#if MIN_VERSION_QuickCheck(2,10,0)-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)+#if HAVE_UNARY_LAWS monadLaws #endif-#endif ) where import Control.Applicative import Test.QuickCheck hiding ((.&.))-#if MIN_VERSION_QuickCheck(2,10,0) import Control.Monad (ap)+#if HAVE_UNARY_LAWS import Test.QuickCheck.Arbitrary (Arbitrary1(..))-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0) import Data.Functor.Classes (Eq1,Show1) #endif-#endif import Test.QuickCheck.Property (Property) import Test.QuickCheck.Classes.Common-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)+#if HAVE_UNARY_LAWS import Test.QuickCheck.Classes.Compat (eq1) #endif -#if MIN_VERSION_QuickCheck(2,10,0)--#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)+#if HAVE_UNARY_LAWS -- | Tests the following monadic properties: --@@ -49,7 +43,7 @@ -- [/Ap/] -- @('<*>') ≡ 'ap'@ monadLaws ::-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (Monad f, Applicative f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a)) #else (Monad f, Applicative f, Eq1 f, Show1 f, Arbitrary1 f)@@ -64,7 +58,7 @@ ] monadLeftIdentity :: forall proxy f.-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (Monad f, Functor f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a)) #else (Monad f, Functor f, Eq1 f, Show1 f, Arbitrary1 f)@@ -75,7 +69,7 @@ in eq1 (return a >>= k) (k a) monadRightIdentity :: forall proxy f.-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (Monad f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a)) #else (Monad f, Eq1 f, Show1 f, Arbitrary1 f)@@ -85,7 +79,7 @@ eq1 (m >>= return) m monadAssociativity :: forall proxy f.-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (Monad f, Functor f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a)) #else (Monad f, Functor f, Eq1 f, Show1 f, Arbitrary1 f)@@ -97,7 +91,7 @@ in eq1 (m >>= (\x -> k x >>= h)) ((m >>= k) >>= h) monadReturn :: forall proxy f.-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (Monad f, Applicative f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a)) #else (Monad f, Applicative f, Eq1 f, Show1 f, Arbitrary1 f)@@ -107,7 +101,7 @@ eq1 (return x) (pure x :: f Integer) monadAp :: forall proxy f.-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (Monad f, Applicative f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a)) #else (Monad f, Applicative f, Eq1 f, Show1 f, Arbitrary1 f)@@ -118,6 +112,3 @@ in eq1 (ap f x) (f <*> x) #endif--#endif-
src/Test/QuickCheck/Classes/MonadFail.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} -#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS {-# LANGUAGE QuantifiedConstraints #-} #endif @@ -9,41 +9,31 @@ module Test.QuickCheck.Classes.MonadFail (-#if MIN_VERSION_QuickCheck(2,10,0)-#if MIN_VERSION_base(4,9,0) && MIN_VERSION_transformers(0,4,0)+#if HAVE_UNARY_LAWS monadFailLaws #endif-#endif ) where +#if HAVE_UNARY_LAWS+ import Control.Applicative import Test.QuickCheck hiding ((.&.))-#if MIN_VERSION_QuickCheck(2,10,0) import Control.Monad (ap) import Test.QuickCheck.Arbitrary (Arbitrary1(..))-#if MIN_VERSION_base(4,9,0) && MIN_VERSION_transformers(0,4,0) import Data.Functor.Classes (Eq1,Show1) import Prelude hiding (fail) import Control.Monad.Fail (MonadFail(..))-#endif-#endif import Test.QuickCheck.Property (Property) import Test.QuickCheck.Classes.Common-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0) import Test.QuickCheck.Classes.Compat (eq1)-#endif -#if MIN_VERSION_QuickCheck(2,10,0)--#if MIN_VERSION_base(4,9,0) && MIN_VERSION_transformers(0,4,0)- -- | Tests the following 'MonadFail' properties: -- -- [/Left Zero/] -- @'fail' s '>>=' f ≡ 'fail' s@ monadFailLaws :: forall proxy f.-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (MonadFail f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a)) #else (MonadFail f, Applicative f, Eq1 f, Show1 f, Arbitrary1 f)@@ -54,7 +44,7 @@ ] monadFailLeftZero :: forall proxy f.-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (MonadFail f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a)) #else (MonadFail f, Functor f, Eq1 f, Show1 f, Arbitrary1 f)@@ -65,6 +55,3 @@ in eq1 (fail s >>= k) (fail s) #endif--#endif-
src/Test/QuickCheck/Classes/MonadPlus.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} -#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS {-# LANGUAGE QuantifiedConstraints #-} #endif @@ -9,31 +9,26 @@ module Test.QuickCheck.Classes.MonadPlus (-#if MIN_VERSION_QuickCheck(2,10,0)-#if MIN_VERSION_base(4,8,0) || MIN_VERSION_transformers(0,4,0)+#if HAVE_UNARY_LAWS monadPlusLaws #endif-#endif ) where import Test.QuickCheck hiding ((.&.)) import Test.QuickCheck.Property (Property) import Test.QuickCheck.Classes.Common-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)+#if HAVE_UNARY_LAWS import Test.QuickCheck.Classes.Compat (eq1) #endif--#if MIN_VERSION_QuickCheck(2,10,0) import Control.Applicative(Alternative(empty)) import Control.Monad (MonadPlus(mzero,mplus))++#if HAVE_UNARY_LAWS import Test.QuickCheck.Arbitrary (Arbitrary1(..))-#if MIN_VERSION_base(4,8,0) || MIN_VERSION_transformers(0,4,0) import Data.Functor.Classes (Eq1,Show1) #endif-#endif -#if MIN_VERSION_QuickCheck(2,10,0)-#if MIN_VERSION_base(4,8,0) || MIN_VERSION_transformers(0,4,0)+#if HAVE_UNARY_LAWS -- | Tests the following monad plus properties: --@@ -48,7 +43,7 @@ -- [/Right Zero/] -- @m '>>' 'mzero' ≡ 'mzero'@ monadPlusLaws ::-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (MonadPlus f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a)) #else (MonadPlus f, Eq1 f, Show1 f, Arbitrary1 f)@@ -63,7 +58,7 @@ ] monadPlusLeftIdentity :: forall proxy f.-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (MonadPlus f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a)) #else (MonadPlus f, Eq1 f, Show1 f, Arbitrary1 f)@@ -72,7 +67,7 @@ monadPlusLeftIdentity _ = property $ \(Apply (a :: f Integer)) -> eq1 (mplus mzero a) a monadPlusRightIdentity :: forall proxy f.-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (MonadPlus f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a)) #else (MonadPlus f, Eq1 f, Show1 f, Arbitrary1 f)@@ -81,7 +76,7 @@ monadPlusRightIdentity _ = property $ \(Apply (a :: f Integer)) -> eq1 (mplus a mzero) a monadPlusAssociativity :: forall proxy f.-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (MonadPlus f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a)) #else (MonadPlus f, Eq1 f, Show1 f, Arbitrary1 f)@@ -90,7 +85,7 @@ monadPlusAssociativity _ = property $ \(Apply (a :: f Integer)) (Apply (b :: f Integer)) (Apply (c :: f Integer)) -> eq1 (mplus a (mplus b c)) (mplus (mplus a b) c) monadPlusLeftZero :: forall proxy f.-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (MonadPlus f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a)) #else (MonadPlus f, Eq1 f, Show1 f, Arbitrary1 f)@@ -99,7 +94,7 @@ monadPlusLeftZero _ = property $ \(k' :: LinearEquationM f) -> eq1 (mzero >>= runLinearEquationM k') mzero monadPlusRightZero :: forall proxy f.-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (MonadPlus f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a)) #else (MonadPlus f, Eq1 f, Show1 f, Arbitrary1 f)@@ -108,5 +103,3 @@ monadPlusRightZero _ = property $ \(Apply (a :: f Integer)) -> eq1 (a >> (mzero :: f Integer)) mzero #endif-#endif-
src/Test/QuickCheck/Classes/MonadZip.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} -#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS {-# LANGUAGE QuantifiedConstraints #-} #endif @@ -9,34 +9,28 @@ module Test.QuickCheck.Classes.MonadZip (-#if MIN_VERSION_QuickCheck(2,10,0)-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)+#if HAVE_UNARY_LAWS monadZipLaws #endif-#endif ) where import Control.Applicative import Control.Arrow (Arrow(..)) import Control.Monad.Zip (MonadZip(mzip)) import Test.QuickCheck hiding ((.&.))-#if MIN_VERSION_QuickCheck(2,10,0) import Control.Monad (liftM)+#if HAVE_UNARY_LAWS import Test.QuickCheck.Arbitrary (Arbitrary1(..))-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0) import Data.Functor.Classes (Eq1,Show1) #endif-#endif import Test.QuickCheck.Property (Property) import Test.QuickCheck.Classes.Common-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)+#if HAVE_UNARY_LAWS import Test.QuickCheck.Classes.Compat (eq1) #endif -#if MIN_VERSION_QuickCheck(2,10,0)--#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)+#if HAVE_UNARY_LAWS -- | Tests the following monadic zipping properties: --@@ -46,7 +40,7 @@ -- In the laws above, the infix function @'***'@ refers to a typeclass -- method of 'Arrow'. monadZipLaws ::-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (MonadZip f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a)) #else (MonadZip f, Applicative f, Eq1 f, Show1 f, Arbitrary1 f)@@ -57,7 +51,7 @@ ] monadZipNaturality :: forall proxy f.-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (MonadZip f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a)) #else (MonadZip f, Functor f, Eq1 f, Show1 f, Arbitrary1 f)@@ -69,6 +63,3 @@ in eq1 (liftM (f *** g) (mzip ma mb)) (mzip (liftM f ma) (liftM g mb)) #endif--#endif-
src/Test/QuickCheck/Classes/Monoid.hs view
@@ -12,7 +12,7 @@ import Test.QuickCheck hiding ((.&.)) import Test.QuickCheck.Property (Property) -import Test.QuickCheck.Classes.Common (Laws(..), myForAllShrink)+import Test.QuickCheck.Classes.Common (Laws(..), SmallList(..), myForAllShrink) -- | Tests the following properties: --@@ -32,12 +32,15 @@ , ("Concatenation", monoidConcatenation p) ] --- | Tests everything from 'monoidLaws' plus the following:+-- | Tests the following properties: -- -- [/Commutative/] -- @mappend a b ≡ mappend b a@+--+-- Note that this does not test associativity or identity. Make sure to use+-- 'monoidLaws' in addition to this set of laws. commutativeMonoidLaws :: (Monoid a, Eq a, Arbitrary a, Show a) => Proxy a -> Laws-commutativeMonoidLaws p = Laws "Commutative Monoid" $ lawsProperties (monoidLaws p) +++commutativeMonoidLaws p = Laws "Commutative Monoid" [ ("Commutative", monoidCommutative p) ] @@ -80,14 +83,3 @@ (\(a,b) -> mappend a b) "mappend b a" (\(a,b) -> mappend b a)--newtype SmallList a = SmallList { getSmallList :: [a] }- deriving (Eq,Show)--instance Arbitrary a => Arbitrary (SmallList a) where- arbitrary = do- n <- choose (0,6)- xs <- vector n- return (SmallList xs)- shrink = map SmallList . shrink . getSmallList-
src/Test/QuickCheck/Classes/Plus.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} -#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS {-# LANGUAGE QuantifiedConstraints #-} #endif @@ -9,53 +9,36 @@ module Test.QuickCheck.Classes.Plus (-#if MIN_VERSION_QuickCheck(2,10,0)-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)-#if defined(VERSION_semigroupoids)+#if defined(HAVE_SEMIGROUPOIDS) && defined(HAVE_UNARY_LAWS) plusLaws , extendedPlusLaws #endif-#endif-#endif ) where +#if defined(HAVE_SEMIGROUPOIDS) && defined(HAVE_UNARY_LAWS) import Data.Functor--#if defined(VERSION_semigroupoids) import Data.Functor.Alt (Alt) import Data.Functor.Plus (Plus) import qualified Data.Functor.Alt as Alt import qualified Data.Functor.Plus as Plus-#endif import Test.QuickCheck hiding ((.&.))-#if MIN_VERSION_QuickCheck(2,10,0) import Test.QuickCheck.Arbitrary (Arbitrary1(..))-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0) import Data.Functor.Classes (Eq1,Show1) import qualified Control.Applicative as Alternative-#endif-#endif import Test.QuickCheck.Property (Property) import Test.QuickCheck.Classes.Common-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0) import Test.QuickCheck.Classes.Compat (eq1)-#endif -#if MIN_VERSION_QuickCheck(2,10,0)--#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)- -- | Tests the following alt properties: -- -- [/Left Identity/] -- @'Plus.zero' 'Alt.<!>' m ≡ m@ -- [/Right Identity/] -- @m 'Alt.<!>' 'Plus.zero' ≡ m@-#if defined(VERSION_semigroupoids) plusLaws :: forall proxy f.-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (Plus f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a)) #else (Plus f, Eq1 f, Show1 f, Arbitrary1 f)@@ -71,7 +54,7 @@ -- [/Congruency/] -- @'Plus.zero' ≡ 'Alternative.empty'@ extendedPlusLaws :: forall proxy f.-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (Plus f, Alternative.Alternative f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a)) #else (Plus f, Alternative.Alternative f, Eq1 f, Show1 f, Arbitrary1 f)@@ -82,7 +65,7 @@ ] extendedPlusLaw :: forall proxy f.-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (Plus f, Alternative.Alternative f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a)) #else (Plus f, Alternative.Alternative f, Eq1 f, Show1 f, Arbitrary1 f)@@ -91,7 +74,7 @@ extendedPlusLaw _ = property $ eq1 (Plus.zero :: f Integer) (Alternative.empty :: f Integer) plusLeftIdentity :: forall proxy f.-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (Plus f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a)) #else (Plus f, Eq1 f, Show1 f, Arbitrary1 f)@@ -100,7 +83,7 @@ plusLeftIdentity _ = property $ \(Apply (m :: f Integer)) -> eq1 (Plus.zero Alt.<!> m) m plusRightIdentity :: forall proxy f.-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (Plus f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a)) #else (Plus f, Eq1 f, Show1 f, Arbitrary1 f)@@ -109,6 +92,3 @@ plusRightIdentity _ = property $ \(Apply (m :: f Integer)) -> eq1 (m Alt.<!> Plus.zero) m #endif-#endif-#endif-
src/Test/QuickCheck/Classes/Semigroup.hs view
@@ -3,8 +3,12 @@ {-# OPTIONS_GHC -Wall #-} module Test.QuickCheck.Classes.Semigroup- ( semigroupLaws+ ( -- * Laws+ semigroupLaws , commutativeSemigroupLaws+ , exponentialSemigroupLaws+ , idempotentSemigroupLaws+ , rectangularBandSemigroupLaws ) where import Prelude hiding (foldr1)@@ -13,11 +17,13 @@ import Test.QuickCheck hiding ((.&.)) import Test.QuickCheck.Property (Property) -import Test.QuickCheck.Classes.Common (Laws(..), myForAllShrink)+import Test.QuickCheck.Classes.Common (Laws(..), SmallList(..), myForAllShrink) import Data.Foldable (foldr1,toList) import Data.List.NonEmpty (NonEmpty((:|))) +import qualified Data.List as L+ -- | Tests the following properties: -- -- [/Associative/]@@ -25,7 +31,7 @@ -- [/Concatenation/] -- @'sconcat' as ≡ 'foldr1' ('<>') as@ -- [/Times/]--- @'stimes' n a ≡ 'foldr1' ('<>') (replicate n a)@+-- @'stimes' n a ≡ 'foldr1' ('<>') ('replicate' n a)@ semigroupLaws :: (Semigroup a, Eq a, Arbitrary a, Show a) => Proxy a -> Laws semigroupLaws p = Laws "Semigroup" [ ("Associative", semigroupAssociative p)@@ -33,15 +39,55 @@ , ("Times", semigroupTimes p) ] --- | Tests everything from 'semigroupLaws', plus the following:+-- | Tests the following properties: -- -- [/Commutative/] -- @a '<>' b ≡ b '<>' a@+--+-- Note that this does not test associativity. Make sure to use+-- 'semigroupLaws' in addition to this set of laws. commutativeSemigroupLaws :: (Semigroup a, Eq a, Arbitrary a, Show a) => Proxy a -> Laws-commutativeSemigroupLaws p = Laws "Commutative Semigroup" $ lawsProperties (semigroupLaws p) +++commutativeSemigroupLaws p = Laws "Commutative Semigroup" [ ("Commutative", semigroupCommutative p) ] +-- | Tests the following properties:+--+-- [/Idempotent/]+-- @a '<>' a ≡ a@+--+-- Note that this does not test associativity. Make sure to use+-- 'semigroupLaws' in addition to this set of laws. In literature,+-- this class of semigroup is known as a band.+idempotentSemigroupLaws :: (Semigroup a, Eq a, Arbitrary a, Show a) => Proxy a -> Laws+idempotentSemigroupLaws p = Laws "Idempotent Semigroup"+ [ ("Idempotent", semigroupIdempotent p)+ ]++-- | Tests the following properties:+--+-- [/Rectangular Band/]+-- @a '<>' b '<>' a ≡ a@+--+-- Note that this does not test associativity. Make sure to use+-- 'semigroupLaws' in addition to this set of laws.+rectangularBandSemigroupLaws :: (Semigroup a, Eq a, Arbitrary a, Show a) => Proxy a -> Laws+rectangularBandSemigroupLaws p = Laws "Rectangular Band Semigroup"+ [ ("Rectangular Band", semigroupRectangularBand p)+ ]++-- | Tests the following properties:+--+-- [/Exponential/]+-- @'stimes' n (a '<>' b) ≡ 'stimes' n a '<>' 'stimes' n b@+--+-- Note that this does not test associativity. Make sure to use+-- 'semigroupLaws' in addition to this set of laws.+exponentialSemigroupLaws :: (Semigroup a, Eq a, Arbitrary a, Show a) => Proxy a -> Laws+exponentialSemigroupLaws p = Laws "Exponential Semigroup"+ [ ("Rectangular Band", semigroupExponential p)+ ]+ semigroupAssociative :: forall a. (Semigroup a, Eq a, Arbitrary a, Show a) => Proxy a -> Property semigroupAssociative _ = myForAllShrink True (const True) (\(a :: a,b,c) -> ["a = " ++ show a, "b = " ++ show b, "c = " ++ show c])@@ -74,13 +120,26 @@ "foldr1 (<>) (replicate n a)" (\(a,n) -> foldr1 (<>) (replicate n a)) -newtype SmallList a = SmallList { getSmallList :: [a] }- deriving (Eq,Show)+semigroupExponential :: forall a. (Semigroup a, Eq a, Arbitrary a, Show a) => Proxy a -> Property+semigroupExponential _ = myForAllShrink True (\(_,_,n) -> n > 0)+ (\(a :: a, b, n :: Int) -> ["a = " ++ show a, "b = " ++ show b, "n = " ++ show n])+ "stimes n (a <> b)"+ (\(a,b,n) -> stimes n (a <> b))+ "stimes n a <> stimes n b"+ (\(a,b,n) -> stimes n a <> stimes n b) -instance Arbitrary a => Arbitrary (SmallList a) where- arbitrary = do- n <- choose (0,6)- xs <- vector n- return (SmallList xs)- shrink = map SmallList . shrink . getSmallList+semigroupIdempotent :: forall a. (Semigroup a, Eq a, Arbitrary a, Show a) => Proxy a -> Property+semigroupIdempotent _ = myForAllShrink False (const True)+ (\(a :: a) -> ["a = " ++ show a])+ "a <> a"+ (\a -> a <> a)+ "a"+ (\a -> a) +semigroupRectangularBand :: forall a. (Semigroup a, Eq a, Arbitrary a, Show a) => Proxy a -> Property+semigroupRectangularBand _ = myForAllShrink False (const True)+ (\(a :: a, b) -> ["a = " ++ show a, "b = " ++ show b])+ "a <> b <> a"+ (\(a,b) -> a <> b <> a)+ "a"+ (\(a,_) -> a)
src/Test/QuickCheck/Classes/Semigroupoid.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} -#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS {-# LANGUAGE QuantifiedConstraints #-} #endif @@ -9,36 +9,22 @@ module Test.QuickCheck.Classes.Semigroupoid (-#if MIN_VERSION_QuickCheck(2,10,0)-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,5,0)-#if defined(VERSION_semigroupoids)+#if defined(HAVE_SEMIGROUPOIDS) && defined(HAVE_BINARY_LAWS) semigroupoidLaws , commutativeSemigroupoidLaws #endif-#endif-#endif ) where +#if defined(HAVE_SEMIGROUPOIDS) && defined(HAVE_BINARY_LAWS) import Prelude hiding (id, (.))-#if defined(VERSION_semigroupoids) import Data.Semigroupoid (Semigroupoid(..))-#endif import Test.QuickCheck hiding ((.&.))-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,5,0) import Data.Functor.Classes (Eq2,Show2)-#endif import Test.QuickCheck.Property (Property) import Test.QuickCheck.Classes.Common-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,5,0) import Test.QuickCheck.Classes.Compat (eq2)-#endif -#if MIN_VERSION_QuickCheck(2,10,0)--#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,5,0)--#if defined (VERSION_semigroupoids) -- | Tests the following 'Semigroupoid' properties: -- -- [/Associativity/]@@ -47,7 +33,7 @@ -- /Note/: This property test is only available when this package is built with -- @base-4.9+@ or @transformers-0.5+@. semigroupoidLaws :: forall proxy s.-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (Semigroupoid s, forall a b. (Eq a, Eq b) => Eq (s a b), forall a b. (Show a, Show b) => Show (s a b), forall a b. (Arbitrary a, Arbitrary b) => Arbitrary (s a b)) #else (Semigroupoid s, Eq2 s, Show2 s, Arbitrary2 s)@@ -65,7 +51,7 @@ -- /Note/: This property test is only available when this package is built with -- @base-4.9+@ or @transformers-0.5+@. commutativeSemigroupoidLaws :: forall proxy s.-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (Semigroupoid s, forall a b. (Eq a, Eq b) => Eq (s a b), forall a b. (Show a, Show b) => Show (s a b), forall a b. (Arbitrary a, Arbitrary b) => Arbitrary (s a b)) #else (Semigroupoid s, Eq2 s, Show2 s, Arbitrary2 s)@@ -76,7 +62,7 @@ ] semigroupoidAssociativity :: forall proxy s.-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (Semigroupoid s, forall a b. (Eq a, Eq b) => Eq (s a b), forall a b. (Show a, Show b) => Show (s a b), forall a b. (Arbitrary a, Arbitrary b) => Arbitrary (s a b)) #else (Semigroupoid s, Eq2 s, Show2 s, Arbitrary2 s)@@ -85,16 +71,12 @@ semigroupoidAssociativity _ = property $ \(Apply2 (f :: s Integer Integer)) (Apply2 (g :: s Integer Integer)) (Apply2 (h :: s Integer Integer)) -> eq2 (f `o` (g `o` h)) ((f `o` g) `o` h) semigroupoidCommutativity :: forall proxy s.-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (Semigroupoid s, forall a b. (Eq a, Eq b) => Eq (s a b), forall a b. (Show a, Show b) => Show (s a b), forall a b. (Arbitrary a, Arbitrary b) => Arbitrary (s a b)) #else (Semigroupoid s, Eq2 s, Show2 s, Arbitrary2 s) #endif => proxy s -> Property semigroupoidCommutativity _ = property $ \(Apply2 (f :: s Integer Integer)) (Apply2 (g :: s Integer Integer)) -> eq2 (f `o` g) (g `o` f)--#endif--#endif #endif
src/Test/QuickCheck/Classes/Semiring.hs view
@@ -5,12 +5,12 @@ module Test.QuickCheck.Classes.Semiring ( -#if defined(VERSION_semirings)+#if HAVE_SEMIRINGS semiringLaws #endif ) where -#if defined(VERSION_semirings)+#if HAVE_SEMIRINGS import Data.Semiring import Prelude hiding (Num(..)) #endif@@ -21,7 +21,7 @@ import Test.QuickCheck.Classes.Common (Laws(..), myForAllShrink) -#if defined(VERSION_semirings)+#if HAVE_SEMIRINGS -- | Tests the following properties: -- -- [/Additive Commutativity/]@@ -70,7 +70,7 @@ semiringRightMultiplicationDistributes _ = myForAllShrink True (const True) (\(a :: a,b,c) -> ["a = " ++ show a, "b = " ++ show b, "c = " ++ show c]) "(a + b) * c"- (\(a,b,c) -> c * (a + b))+ (\(a,b,c) -> (a + b) * c) "(a * c) + (b * c)" (\(a,b,c) -> (a * c) + (b * c))
+ src/Test/QuickCheck/Classes/Show.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -Wall #-}++{-| Module : Test.QuickCheck.Classes.Show+ Description : Properties for testing the properties of the Show type class.+-}+module Test.QuickCheck.Classes.Show+ ( showLaws+ ) where++import Data.Proxy (Proxy)+import Test.QuickCheck (Arbitrary, Property, property)++import Test.QuickCheck.Classes.Common (Laws(..), ShowReadPrecedence(..))++-- | Tests the following properties:+--+-- [/Show/]+-- @'show' a ≡ 'showsPrec' 0 a ""@+-- [/Equivariance: 'showsPrec'/]+-- @'showsPrec' p a r '++' s ≡ 'showsPrec' p a (r '++' s)@+-- [/Equivariance: 'showList'/]+-- @'showList' as r '++' s ≡ 'showList' as (r '++' s)@+--+showLaws :: (Show a, Arbitrary a) => Proxy a -> Laws+showLaws p = Laws "Show"+ [ ("Show", showShowsPrecZero p)+ , ("Equivariance: showsPrec", equivarianceShowsPrec p)+ , ("Equivariance: showList", equivarianceShowList p)+ ]++showShowsPrecZero :: forall a. (Show a, Arbitrary a) => Proxy a -> Property+showShowsPrecZero _ =+ property $ \(a :: a) ->+ show a == showsPrec 0 a ""++equivarianceShowsPrec :: forall a.+ (Show a, Arbitrary a) => Proxy a -> Property+equivarianceShowsPrec _ =+ property $ \(ShowReadPrecedence p) (a :: a) (r :: String) (s :: String) ->+ showsPrec p a r ++ s == showsPrec p a (r ++ s)++equivarianceShowList :: forall a.+ (Show a, Arbitrary a) => Proxy a -> Property+equivarianceShowList _ =+ property $ \(as :: [a]) (r :: String) (s :: String) ->+ showList as r ++ s == showList as (r ++ s)
src/Test/QuickCheck/Classes/ShowRead.hs view
@@ -1,43 +1,86 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -Wall #-} +{-| Module : Test.QuickCheck.Classes.ShowRead+ Description : Properties for testing the interaction between the Show and Read+ type classes.+-} module Test.QuickCheck.Classes.ShowRead ( showReadLaws ) where import Data.Proxy (Proxy)-import Test.QuickCheck hiding ((.&.))-import Test.QuickCheck.Property (Property)--#if MIN_VERSION_base(4,6,0)-import Text.Read (readMaybe)-#endif+import Test.QuickCheck+import Text.Read (readListDefault)+import Text.Show (showListWith) -import Test.QuickCheck.Classes.Common (Laws(..))+import Test.QuickCheck.Classes.Common (Laws(..), ShowReadPrecedence(..),+ SmallList(..), myForAllShrink)+import Test.QuickCheck.Classes.Compat (readMaybe) -- | Tests the following properties: ----- [/Partial Isomorphism/]--- @'readMaybe' ('show' a) == 'Just' a@--- --- /Note:/ When using @base-4.5@ or older, this--- instead test the following:+-- [/Partial Isomorphism: 'show' \/ 'read'/]+-- @'readMaybe' ('show' a) ≡ 'Just' a@+-- [/Partial Isomorphism: 'show' \/ 'read' with initial space/]+-- @'readMaybe' (" " ++ 'show' a) ≡ 'Just' a@+-- [/Partial Isomorphism: 'showsPrec' \/ 'readsPrec'/]+-- @(a,"") \`elem\` 'readsPrec' p ('showsPrec' p a "")@+-- [/Partial Isomorphism: 'showList' \/ 'readList'/]+-- @(as,"") \`elem\` 'readList' ('showList' as "")@+-- [/Partial Isomorphism: 'showListWith' 'shows' \/ 'readListDefault'/]+-- @(as,"") \`elem\` 'readListDefault' ('showListWith' 'shows' as "")@ ----- [/Partial Isomorphism/]--- @'read' ('show' a) == a@ +-- /Note:/ When using @base-4.5@ or older, a shim implementation+-- of 'readMaybe' is used. -- showReadLaws :: (Show a, Read a, Eq a, Arbitrary a) => Proxy a -> Laws showReadLaws p = Laws "Show/Read"- [ ("Partial Isomorphism", showReadPartialIsomorphism p)+ [ ("Partial Isomorphism: show/read", showReadPartialIsomorphism p)+ , ("Partial Isomorphism: show/read with initial space", showReadSpacePartialIsomorphism p)+ , ("Partial Isomorphism: showsPrec/readsPrec", showsPrecReadsPrecPartialIsomorphism p)+ , ("Partial Isomorphism: showList/readList", showListReadListPartialIsomorphism p)+ , ("Partial Isomorphism: showListWith shows / readListDefault",+ showListWithShowsReadListDefaultPartialIsomorphism p) ] -showReadPartialIsomorphism :: forall a. (Show a, Read a, Arbitrary a, Eq a) => Proxy a -> Property-showReadPartialIsomorphism _ = property $ \(a :: a) ->-#if MIN_VERSION_base(4,6,0)- readMaybe (show a) == Just a-#else- read (show a) == a-#endif++showReadPartialIsomorphism :: forall a.+ (Show a, Read a, Arbitrary a, Eq a) => Proxy a -> Property+showReadPartialIsomorphism _ =+ myForAllShrink False (const True)+ (\(a :: a) -> ["a = " ++ show a])+ ("readMaybe (show a)")+ (\a -> readMaybe (show a))+ ("Just a")+ (\a -> Just a)++showReadSpacePartialIsomorphism :: forall a.+ (Show a, Read a, Arbitrary a, Eq a) => Proxy a -> Property+showReadSpacePartialIsomorphism _ =+ myForAllShrink False (const True)+ (\(a :: a) -> ["a = " ++ show a])+ ("readMaybe (\" \" ++ show a)")+ (\a -> readMaybe (" " ++ show a))+ ("Just a")+ (\a -> Just a)++showsPrecReadsPrecPartialIsomorphism :: forall a.+ (Show a, Read a, Arbitrary a, Eq a) => Proxy a -> Property+showsPrecReadsPrecPartialIsomorphism _ =+ property $ \(a :: a) (ShowReadPrecedence p) ->+ (a,"") `elem` readsPrec p (showsPrec p a "")++showListReadListPartialIsomorphism :: forall a.+ (Show a, Read a, Arbitrary a, Eq a) => Proxy a -> Property+showListReadListPartialIsomorphism _ =+ property $ \(SmallList (as :: [a])) ->+ (as,"") `elem` readList (showList as "")++showListWithShowsReadListDefaultPartialIsomorphism :: forall a.+ (Show a, Read a, Arbitrary a, Eq a) => Proxy a -> Property+showListWithShowsReadListDefaultPartialIsomorphism _ =+ property $ \(SmallList (as :: [a])) ->+ (as,"") `elem` readListDefault (showListWith shows as "")
src/Test/QuickCheck/Classes/Storable.hs view
@@ -29,9 +29,9 @@ -- | Tests the following alternative properties: -- -- [/Set-Get/]--- @'runST' ('pokeElemOff' ptr ix a >> 'peekElemOff' ptr ix') ≡ a@+-- @('pokeElemOff' ptr ix a >> 'peekElemOff' ptr ix') ≡ 'pure' a@ -- [/Get-Set/]--- @'runST' ('peekElemOff' ptr ix >> 'pokeElemOff' ptr ix a) ≡ a@+-- @('peekElemOff' ptr ix >> 'pokeElemOff' ptr ix a) ≡ 'pure' a@ storableLaws :: (Storable a, Eq a, Arbitrary a, Show a) => Proxy a -> Laws storableLaws p = Laws "Storable" [ ("Set-Get (you get back what you put in)", storableSetGet p)@@ -43,12 +43,22 @@ , ("peekByteOff a i x ≡ poke (plusPtr a i) x ≡ id ", storablePokeByte p) ] +arrayArbitrary :: forall a. (Arbitrary a, Storable a) => Int -> IO (Ptr a)+arrayArbitrary len = do+ let go ix xs = if ix == len+ then pure xs+ else do+ x <- generate (arbitrary :: Gen a)+ go (ix + 1) (x : xs)+ as <- go 0 []+ newArray as+ storablePeekElem :: forall a. (Storable a, Eq a, Arbitrary a, Show a) => Proxy a -> Property storablePeekElem _ = property $ \(as :: [a]) -> (not (L.null as)) ==> do let len = L.length as ix <- choose (0, len - 1) return $ unsafePerformIO $ do- addr :: Ptr a <- mallocArray len+ addr :: Ptr a <- arrayArbitrary len x <- peekElemOff addr ix y <- peek (addr `plusPtr` (ix * sizeOf (undefined :: a))) free addr@@ -59,7 +69,7 @@ let len = L.length as ix <- choose (0, len - 1) return $ unsafePerformIO $ do- addr :: Ptr a <- mallocArray len+ addr :: Ptr a <- arrayArbitrary len pokeElemOff addr ix x u <- peekElemOff addr ix poke (addr `plusPtr` (ix * sizeOf x)) x@@ -72,7 +82,7 @@ let len = L.length as off <- choose (0, len - 1) return $ unsafePerformIO $ do- addr :: Ptr a <- mallocArray len+ addr :: Ptr a <- arrayArbitrary len x :: a <- peekByteOff addr off y :: a <- peek (addr `plusPtr` off) free addr@@ -83,7 +93,7 @@ let len = L.length as off <- choose (0, len - 1) return $ unsafePerformIO $ do- addr :: Ptr a <- mallocArray len+ addr :: Ptr a <- arrayArbitrary len pokeByteOff addr off x u :: a <- peekByteOff addr off poke (addr `plusPtr` off) x@@ -95,7 +105,7 @@ storableSetGet _ = property $ \(a :: a) len -> (len > 0) ==> do ix <- choose (0,len - 1) return $ unsafePerformIO $ do- ptr :: Ptr a <- mallocArray len+ ptr :: Ptr a <- arrayArbitrary len pokeElemOff ptr ix a a' <- peekElemOff ptr ix free ptr@@ -107,7 +117,7 @@ ix <- choose (0,len - 1) return $ unsafePerformIO $ do ptrA <- newArray as- ptrB <- mallocArray len+ ptrB <- arrayArbitrary len copyArray ptrB ptrA len a <- peekElemOff ptrA ix pokeElemOff ptrA ix a
src/Test/QuickCheck/Classes/Traversable.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} -#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS {-# LANGUAGE QuantifiedConstraints #-} #endif @@ -9,35 +9,29 @@ module Test.QuickCheck.Classes.Traversable (-#if MIN_VERSION_QuickCheck(2,10,0)-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)+#if HAVE_UNARY_LAWS traversableLaws #endif-#endif ) where import Data.Foldable (foldMap) import Data.Traversable (Traversable,fmapDefault,foldMapDefault,sequenceA,traverse) import Test.QuickCheck hiding ((.&.))-#if MIN_VERSION_QuickCheck(2,10,0)+#if HAVE_UNARY_LAWS import Test.QuickCheck.Arbitrary (Arbitrary1(..))-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0) import Data.Functor.Classes (Eq1,Show1)+#endif import Data.Functor.Compose import Data.Functor.Identity-#endif-#endif import qualified Data.Set as S import Test.QuickCheck.Classes.Common-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)+#if HAVE_UNARY_LAWS import Test.QuickCheck.Classes.Compat (eq1) #endif -#if MIN_VERSION_QuickCheck(2,10,0)--#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)+#if HAVE_UNARY_LAWS -- | Tests the following 'Traversable' properties: --@@ -69,7 +63,7 @@ -- * Identity: @t ('pure' x) ≡ 'pure' x@ -- * Distributivity: @t (x '<*>' y) ≡ t x '<*>' t y@ traversableLaws ::-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (Traversable f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a)) #else (Traversable f, Eq1 f, Show1 f, Arbitrary1 f)@@ -78,7 +72,7 @@ traversableLaws = traversableLawsInternal traversableLawsInternal :: forall proxy f.-#if MIN_VERSION_base(4,12,0)+#if HAVE_QUANTIFIED_CONSTRAINTS (Traversable f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a)) #else (Traversable f, Eq1 f, Show1 f, Arbitrary1 f)@@ -106,6 +100,3 @@ #endif--#endif-
+ test/Advanced.hs view
@@ -0,0 +1,193 @@+{-# language DerivingStrategies #-}+{-# language DerivingVia #-}+{-# language GeneralizedNewtypeDeriving #-}+{-# language LambdaCase #-}+{-# language ScopedTypeVariables #-}+{-# language TypeApplications #-}++import Test.Tasty (TestTree,defaultMain,testGroup,adjustOption)+import Test.QuickCheck (Arbitrary)+import Data.Proxy (Proxy(..))+import Data.Set (Set)+import Data.Primitive (Array)+import Control.Monad (forM_,replicateM)+import Data.Monoid (All(..))+import Test.QuickCheck.Classes (eqLaws,ordLaws)+import Data.Typeable (Typeable,typeRep)+import Data.Coerce (coerce)+import Data.Set (Set)++import qualified Data.Set as S+import qualified Data.List as L+import qualified GHC.Exts as E+import qualified Test.QuickCheck as QC+import qualified Test.Tasty.QuickCheck as TQC+import qualified Test.QuickCheck.Classes as QCC++main :: IO ()+main = defaultMain tests++tests :: TestTree+tests = testGroup "universe"+ [ testGroup "deriving"+ [ testGroup "strict"+ [ laws @A [eqLaws,ordLaws]+ , laws @B [eqLaws,ordLaws]+ , laws @C [eqLaws,ordLaws]+ , laws @D [eqLaws,ordLaws]+ , laws @E [eqLaws,ordLaws]+ , laws @F [eqLaws,ordLaws]+ , laws @G [eqLaws,ordLaws]+ , laws @H [eqLaws,ordLaws]+ , laws @I [eqLaws,ordLaws]+ , laws @K [eqLaws,ordLaws]+ ]+ , testGroup "thunk"+ [ laws @(Thunk A) [eqLaws,ordLaws]+ , laws @(Thunk B) [eqLaws,ordLaws]+ , laws @(Thunk C) [eqLaws,ordLaws]+ , laws @(Thunk D) [eqLaws,ordLaws]+ , laws @(Thunk E) [eqLaws,ordLaws]+ , laws @(Thunk F) [eqLaws,ordLaws]+ , laws @(Thunk G) [eqLaws,ordLaws]+ , laws @(Thunk H) [eqLaws,ordLaws]+ , laws @(Thunk I) [eqLaws,ordLaws]+ , laws @(Thunk K) [eqLaws,ordLaws]+ ]+ , testGroup "lazy"+ [ laws @(Lazy A) [eqLaws,ordLaws]+ , laws @(Lazy B) [eqLaws,ordLaws]+ , laws @(Lazy C) [eqLaws,ordLaws]+ , laws @(Lazy D) [eqLaws,ordLaws]+ , laws @(Lazy E) [eqLaws,ordLaws]+ , laws @(Lazy F) [eqLaws,ordLaws]+ , laws @(Lazy G) [eqLaws,ordLaws]+ , laws @(Lazy H) [eqLaws,ordLaws]+ , laws @(Lazy I) [eqLaws,ordLaws]+ , laws @(Lazy K) [eqLaws,ordLaws]+ ]+ ]+ , testGroup "containers"+ [ testGroup "strict"+ [ laws @(Set A) [eqLaws,ordLaws]+ , laws @(Set B) [eqLaws,ordLaws]+ , laws @(Set C) [eqLaws,ordLaws]+ , laws @(Set D) [eqLaws,ordLaws]+ , laws @(Set E) [eqLaws,ordLaws]+ , laws @(Set F) [eqLaws,ordLaws]+ , laws @(Set G) [eqLaws,ordLaws]+ , laws @(Set H) [eqLaws,ordLaws]+ , laws @(Set I) [eqLaws,ordLaws]+ , laws @(Set K) [eqLaws,ordLaws]+ ]+ , testGroup "lazy"+ [ laws @(SmallLazySet A) [eqLaws,ordLaws]+ , laws @(SmallLazySet B) [eqLaws,ordLaws]+ , laws @(SmallLazySet C) [eqLaws,ordLaws]+ , laws @(SmallLazySet D) [eqLaws,ordLaws]+ , laws @(SmallLazySet E) [eqLaws,ordLaws]+ , laws @(SmallLazySet F) [eqLaws,ordLaws]+ , laws @(SmallLazySet G) [eqLaws,ordLaws]+ , laws @(SmallLazySet H) [eqLaws,ordLaws]+ , laws @(SmallLazySet I) [eqLaws,ordLaws]+ , laws @(SmallLazySet K) [eqLaws,ordLaws]+ ]+ ]+ ]++data A = A0+ deriving stock (Eq,Ord,Show,Read,Bounded,Enum)+ deriving Arbitrary via (Enumeration A)++data B = B0 | B1+ deriving stock (Eq,Ord,Show,Read,Bounded,Enum)+ deriving Arbitrary via (Enumeration B)++data C = C0 | C1 | C2+ deriving stock (Eq,Ord,Show,Read,Bounded,Enum)+ deriving Arbitrary via (Enumeration C)++data D = D0 | D1 | D2 | D3+ deriving stock (Eq,Ord,Show,Read,Bounded,Enum)+ deriving Arbitrary via (Enumeration D)++data E = E0 | E1 | E2 | E3 | E4+ deriving stock (Eq,Ord,Show,Read,Bounded,Enum)+ deriving Arbitrary via (Enumeration E)++data F = F0 | F1 | F2 | F3 | F4 | F5+ deriving stock (Eq,Ord,Show,Read,Bounded,Enum)+ deriving Arbitrary via (Enumeration F)++data G = G0 | G1 | G2 | G3 | G4 | G5 | G6+ deriving stock (Eq,Ord,Show,Read,Bounded,Enum)+ deriving Arbitrary via (Enumeration G)++data H = H0 | H1 | H2 | H3 | H4 | H5 | H6 | H7+ deriving stock (Eq,Ord,Show,Read,Bounded,Enum)+ deriving Arbitrary via (Enumeration H)++data I = I0 | I1 | I2 | I3 | I4 | I5 | I6 | I7 | I8+ deriving stock (Eq,Ord,Show,Read,Bounded,Enum)+ deriving Arbitrary via (Enumeration I)++data J = J0 | J1 | J2 | J3 | J4 | J5 | J6 | J7 | J8 | J9+ deriving stock (Eq,Ord,Show,Read,Bounded,Enum)+ deriving Arbitrary via (Enumeration J)++data K = K0 | K1 | K2 | K3 | K4 | K5 | K6 | K7 | K8 | K9 | K10+ deriving stock (Eq,Ord,Show,Read,Bounded,Enum)+ deriving Arbitrary via (Enumeration K)++laws :: forall a. Typeable a => [Proxy a -> QCC.Laws] -> TestTree+laws = testGroup (show (typeRep (Proxy :: Proxy a))) . map+ ( \f -> let QCC.Laws name pairs = f (Proxy :: Proxy a) in+ testGroup name (map (uncurry TQC.testProperty) pairs)+ )++newtype Enumeration a = Enumeration a++instance (Bounded a, Enum a, Eq a) => Arbitrary (Enumeration a) where+ arbitrary = fmap Enumeration TQC.arbitraryBoundedEnum+ shrink (Enumeration x) = if x == minBound+ then []+ else [Enumeration (pred x)]++data Thunk a = Thunk a+ deriving stock (Eq,Ord,Show,Read)++newtype Lazy a = Lazy a+ deriving newtype (Eq,Ord,Show,Read)++newtype SmallLazySet a = SmallLazySet (Set a)+ deriving newtype (Eq,Ord,Show,Read)++instance Arbitrary a => Arbitrary (Thunk a) where+ arbitrary = do+ a <- TQC.arbitrary+ let {-# NOINLINE b #-}+ b () = a+ pure (Thunk (b ()))+ shrink (Thunk x) = map Thunk (TQC.shrink x)++instance Arbitrary a => Arbitrary (Lazy a) where+ arbitrary = do+ a <- TQC.arbitrary+ let {-# NOINLINE b #-}+ b () = a+ pure (Lazy (b ()))+ shrink (Lazy x) = map Lazy (TQC.shrink x)++instance (Arbitrary a, Ord a) => Arbitrary (SmallLazySet a) where+ arbitrary = do+ a <- TQC.arbitrary+ b <- TQC.arbitrary+ c <- TQC.arbitrary+ let {-# NOINLINE a' #-}+ a' () = a+ let {-# NOINLINE b' #-}+ b' () = b+ let {-# NOINLINE c' #-}+ c' () = c+ pure (SmallLazySet (S.fromList [a' (), b' (), c' (), a' (), b' (), c' ()]))+
test/Spec.hs view
@@ -5,6 +5,10 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE DeriveFunctor #-} +#if HAVE_QUANTIFIED_CONSTRAINTS+{-# LANGUAGE QuantifiedConstraints #-}+#endif+ import Control.Monad import Control.Monad.Zip (MonadZip) import Control.Applicative@@ -13,23 +17,21 @@ #endif import Data.Bits import Data.Foldable-#if defined(VERSION_containers) import Data.Map (Map)-#endif+import qualified Data.Map as M #if MIN_VERSION_containers(0,5,9) import qualified Data.Map.Merge.Strict as MM #endif import Data.Traversable-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)-#if defined(VERSION_semigroupoids)+#if HAVE_SEMIGROUPOIDS import Data.Functor.Apply (Apply((<.>))) #endif-#endif-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)+#if HAVE_UNARY_LAWS import Data.Functor.Classes #endif import Data.Int-import Data.Monoid (Sum,Monoid,mappend,mconcat,mempty)+import Data.Monoid (Sum(..),Monoid,mappend,mconcat,mempty)+import Data.Orphans () import Data.Primitive import Data.Proxy import Data.Vector (Vector)@@ -42,10 +44,11 @@ import qualified Data.Foldable as F import Test.QuickCheck.Classes+import qualified Spec.ShowRead main :: IO () main = do-#if defined(VERSION_semigroupoids)+#if HAVE_SEMIGROUPOIDS #if MIN_VERSION_containers(0,5,9) quickCheck prop_map_apply_equals #endif@@ -53,30 +56,25 @@ lawsCheckMany allPropsApplied allPropsApplied :: [(String,[Laws])]-allPropsApplied = +allPropsApplied = M.toList . M.fromListWith (++) $ [ ("Int",allLaws (Proxy :: Proxy Int)) , ("Int64",allLaws (Proxy :: Proxy Int64)) , ("Word",allLaws (Proxy :: Proxy Word))-#if MIN_VERSION_QuickCheck(2,10,0)-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)+#if HAVE_UNARY_LAWS , ("Maybe",allHigherLaws (Proxy1 :: Proxy1 Maybe)) , ("List",allHigherLaws (Proxy1 :: Proxy1 [])) #endif-#endif-#if MIN_VERSION_QuickCheck(2,10,0)-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)-#if defined(VERSION_semigroupoids)-#if MIN_VERSION_containers(0,5,9)+#if defined(HAVE_SEMIGROUPOIDS) && defined(HAVE_UNARY_LAWS)+#if MIN_VERSION_base(4,9,0) && MIN_VERSION_containers(0,5,9) , ("Map", someHigherLaws (Proxy1 :: Proxy1 (Map Int))) , ("Pound", someHigherLaws (Proxy1 :: Proxy1 (Pound Int))) #endif #endif-#endif-#endif #if MIN_VERSION_base(4,7,0) , ("Vector",[isListLaws (Proxy :: Proxy (Vector Word))]) #endif ]+ ++ Spec.ShowRead.lawsApplied allLaws :: forall a. ( Integral a@@ -101,7 +99,6 @@ , storableLaws p , semigroupLaws (Proxy :: Proxy (Sum a)) , monoidLaws (Proxy :: Proxy (Sum a))- , showReadLaws p , boundedEnumLaws p #if defined(VERSION_aeson) , jsonLaws p@@ -117,10 +114,17 @@ foldlMapM :: (Foldable t, Monoid b, Monad m) => (a -> m b) -> t a -> m b foldlMapM f = foldlM (\b a -> liftM (mappend b) (f a)) mempty -#if MIN_VERSION_QuickCheck(2,10,0)-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)-allHigherLaws :: (Traversable f, MonadZip f, MonadPlus f, Applicative f, Eq1 f, Arbitrary1 f, Show1 f) => proxy f -> [Laws]-allHigherLaws p = +#if HAVE_UNARY_LAWS+allHigherLaws ::+ (Traversable f, MonadZip f, MonadPlus f, Applicative f,+#if HAVE_QUANTIFIED_CONSTRAINTS+ forall a. Eq a => Eq (f a), forall a. Arbitrary a => Arbitrary (f a),+ forall a. Show a => Show (f a)+#else+ Eq1 f, Arbitrary1 f, Show1 f+#endif+ ) => proxy f -> [Laws]+allHigherLaws p = [ functorLaws p , applicativeLaws p , monadLaws p@@ -130,47 +134,60 @@ , traversableLaws p ] #endif-#endif -#if MIN_VERSION_QuickCheck(2,10,0)-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)-#if defined(VERSION_semigroupoids)-someHigherLaws :: (Apply f, Eq1 f, Arbitrary1 f, Show1 f) => proxy f -> [Laws]-someHigherLaws p = +#if defined(HAVE_SEMIGROUPOIDS) && defined(HAVE_UNARY_LAWS)+someHigherLaws ::+ (Apply f,+#if HAVE_QUANTIFIED_CONSTRAINTS+ forall a. Eq a => Eq (f a), forall a. Arbitrary a => Arbitrary (f a),+ forall a. Show a => Show (f a)+#else+ Eq1 f, Arbitrary1 f, Show1 f+#endif+ ) => proxy f -> [Laws]+someHigherLaws p = [ applyLaws p ] #endif-#endif-#endif -- This type fails the laws for the strict functions -- in Foldable. It is used just to confirm that -- those property tests actually work.-newtype Rouge a = Rouge [a]-#if MIN_VERSION_QuickCheck(2,10,0) && (MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0))- deriving (Eq,Show,Arbitrary,Arbitrary1,Eq1,Show1)-#else- deriving (Eq,Show,Arbitrary)+newtype Rogue a = Rogue [a]+ deriving+ ( Eq, Show, Arbitrary+#if HAVE_UNARY_LAWS+ , Arbitrary1+ , Eq1+ , Show1 #endif+ ) --- Note: when using base < 4.6, the Rouge type does+-- Note: when using base < 4.6, the Rogue type does -- not really test anything. -instance Foldable Rouge where- foldMap f (Rouge xs) = F.foldMap f xs- foldl f x (Rouge xs) = F.foldl f x xs+instance Foldable Rogue where+ foldMap f (Rogue xs) = F.foldMap f xs+ foldl f x (Rogue xs) = F.foldl f x xs #if MIN_VERSION_base(4,6,0)- foldl' f x (Rouge xs) = F.foldl f x xs- foldr' f x (Rouge xs) = F.foldr f x xs+ foldl' f x (Rogue xs) = F.foldl f x xs+ foldr' f x (Rogue xs) = F.foldr f x xs #endif newtype Pound k v = Pound { getPound :: Map k v }-#if MIN_VERSION_QuickCheck(2,10,0) && (MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)) && MIN_VERSION_containers(0,5,9)- deriving (Eq,Functor,Show,Arbitrary,Arbitrary1,Eq1,Show1)-#else- deriving (Eq,Show,Arbitrary)+ deriving+ ( Eq, Functor, Show, Arbitrary+#if HAVE_UNARY_LAWS+ , Arbitrary1+ -- The following instances are only available for the variants+ -- of the type classes in base, not for those in transformers.+#if MIN_VERSION_base(4,9,0) && MIN_VERSION_containers(0,5,9)+ , Eq1+ , Show1 #endif+#endif+ ) -#if defined(VERSION_semigroupoids)+#if HAVE_SEMIGROUPOIDS #if MIN_VERSION_containers(0,5,9) instance Ord k => Apply (Pound k) where Pound m1 <.> Pound m2 = Pound $@@ -183,7 +200,7 @@ #endif #endif -#if defined(VERSION_semigroupoids)+#if HAVE_SEMIGROUPOIDS #if MIN_VERSION_containers(0,5,9) prop_map_apply_equals :: Map Int (Int -> Int) -> Map Int Int@@ -205,3 +222,14 @@ arbitrary = V.fromList <$> arbitrary shrink v = map V.fromList (shrink (V.toList v)) +#if !MIN_VERSION_QuickCheck(2,8,2)+instance (Ord k, Arbitrary k, Arbitrary v) => Arbitrary (Map k v) where+ arbitrary = M.fromList <$> arbitrary+ shrink m = map M.fromList (shrink (M.toList m))+#endif++#if !MIN_VERSION_QuickCheck(2,9,0)+instance Arbitrary a => Arbitrary (Sum a) where+ arbitrary = Sum <$> arbitrary+ shrink = map Sum . shrink . getSum+#endif
+ test/Spec/ShowRead.hs view
@@ -0,0 +1,121 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -Wall #-}++module Spec.ShowRead where++import Control.Applicative (liftA2)+import Data.Complex (Complex)+import Data.Fixed (E0, E1, E12, Fixed, HasResolution)+import Data.Int (Int64, Int8)+import Data.Orphans ()+import Data.Proxy (Proxy(Proxy))+import Data.Ratio (Ratio)+import Data.Word+import Test.QuickCheck (Arbitrary(arbitrary), elements)+#if MIN_VERSION_QuickCheck(2,8,2)+import Data.IntMap (IntMap)+import Data.IntSet (IntSet)+import Data.Map (Map)+import Data.Sequence (Seq)+import Data.Set (Set)+#endif+#if MIN_VERSION_QuickCheck(2,9,0)+import Control.Applicative (Const, ZipList)+import Data.Functor.Constant (Constant)+import Data.Functor.Identity (Identity)+import Data.Version (Version)+#endif+#if MIN_VERSION_QuickCheck(2,10,0)+import Data.Functor.Compose (Compose)+import Data.Functor.Product (Product)+#endif++import Test.QuickCheck.Classes++data Prefix = Prefix | Prefix' | Prefix_+ deriving (Eq, Read, Show)++instance Arbitrary Prefix where+ arbitrary = elements [Prefix, Prefix', Prefix_]++data WeirdRecord = (:*) { left :: Int, right :: Int }+ deriving (Eq, Read, Show)++instance Arbitrary WeirdRecord where+ arbitrary = liftA2 (:*) arbitrary arbitrary++lawsApplied :: [(String,[Laws])]+lawsApplied =+ [ -- local+ ("Prefix", allShowReadLaws (Proxy :: Proxy Prefix))+ , ("WeirdRecord", allShowReadLaws (Proxy :: Proxy WeirdRecord))++ -- base+ , ("()", allShowReadLaws (Proxy :: Proxy ()))+ , ("Bool", allShowReadLaws (Proxy :: Proxy Bool))+ , ("Char", allShowReadLaws (Proxy :: Proxy Char))+ , ("Complex Float", allShowReadLaws (Proxy :: Proxy (Complex Float)))+ , ("Complex Double", allShowReadLaws (Proxy :: Proxy (Complex Double)))+ , ("Double", allShowReadLaws (Proxy :: Proxy Double))+ , ("Either", allShowReadLaws (Proxy :: Proxy (Either Int Int)))+ , ("Fixed E12", allFixedLaws (Proxy :: Proxy (Fixed E12)))+ -- , ("Fixed E9", allFixedLaws (Proxy :: Proxy (Fixed E9)))+ -- , ("Fixed E6", allFixedLaws (Proxy :: Proxy (Fixed E6)))+ -- , ("Fixed E3", allFixedLaws (Proxy :: Proxy (Fixed E3)))+ -- , ("Fixed E2", allFixedLaws (Proxy :: Proxy (Fixed E2)))+ , ("Fixed E1", allFixedLaws (Proxy :: Proxy (Fixed E1)))+ , ("Fixed E0", allFixedLaws (Proxy :: Proxy (Fixed E0)))+ , ("Float", allShowReadLaws (Proxy :: Proxy Float))+ , ("Int", allShowReadLaws (Proxy :: Proxy Int))+ -- , ("Int16", allShowReadLaws (Proxy :: Proxy Int16))+ -- , ("Int32", allShowReadLaws (Proxy :: Proxy Int32))+ , ("Int64", allShowReadLaws (Proxy :: Proxy Int64))+ , ("Int8", allShowReadLaws (Proxy :: Proxy Int8))+ , ("Integer", allShowReadLaws (Proxy :: Proxy Integer))+ , ("List", allShowReadLaws (Proxy :: Proxy [Int]))+ , ("Maybe", allShowReadLaws (Proxy :: Proxy (Maybe Int)))+ , ("Ordering", allShowReadLaws (Proxy :: Proxy Ordering))+ , ("Ratio", allShowReadLaws (Proxy :: Proxy (Ratio Int)))+ , ("Tuple2", allShowReadLaws (Proxy :: Proxy (Int,Int)))+ , ("Tuple3", allShowReadLaws (Proxy :: Proxy (Int,Int,Int)))+ , ("Word", allShowReadLaws (Proxy :: Proxy Word))+ -- , ("Word16", allShowReadLaws (Proxy :: Proxy Word16))+ -- , ("Word32", allShowReadLaws (Proxy :: Proxy Word32))+ , ("Word64", allShowReadLaws (Proxy :: Proxy Word64))+ , ("Word8", allShowReadLaws (Proxy :: Proxy Word8))+#if MIN_VERSION_QuickCheck(2,9,0)+ , ("Const", allShowReadLaws (Proxy :: Proxy (Const Int Int)))+ , ("Constant", allShowReadLaws (Proxy :: Proxy (Constant Int Int)))+ , ("Identity", allShowReadLaws (Proxy :: Proxy (Identity Int)))+ , ("Version", allShowReadLaws (Proxy :: Proxy Version))+ , ("ZipList", allShowReadLaws (Proxy :: Proxy (ZipList Int)))+#endif+#if MIN_VERSION_QuickCheck(2,10,0)+ , ("Compose", allShowReadLaws (Proxy :: Proxy (Compose [] Maybe Int)))+ , ("Product", allShowReadLaws (Proxy :: Proxy (Product [] Maybe Int)))+#endif++ -- containers+#if MIN_VERSION_QuickCheck(2,8,2)+ , ("IntMap", allShowReadLaws (Proxy :: Proxy (IntMap Int)))+ , ("IntSet", allShowReadLaws (Proxy :: Proxy IntSet))+ , ("Map", allShowReadLaws (Proxy :: Proxy (Map Int Int)))+ , ("Seq", allShowReadLaws (Proxy :: Proxy (Seq Int)))+ , ("Set", allShowReadLaws (Proxy :: Proxy (Set Int)))+#endif+ ]++allShowReadLaws :: (Show a, Read a, Eq a, Arbitrary a) => Proxy a -> [Laws]+allShowReadLaws p = map ($p)+ [ showLaws+ , showReadLaws+ ]++allFixedLaws :: HasResolution e => Proxy (Fixed e) -> [Laws]+allFixedLaws p = map ($p)+ [ showLaws+#if MIN_VERSION_base(4,7,0)+ -- Earlier versions of base have a buggy read instance.+ , showReadLaws+#endif+ ]