smallcheck 1.0.4 → 1.2.1.1
raw patch · 10 files changed
Files
- CHANGELOG.md +171/−0
- CHANGES.md +0/−87
- README.md +8/−16
- Test/SmallCheck.hs +38/−21
- Test/SmallCheck/Drivers.hs +25/−8
- Test/SmallCheck/Property.hs +119/−23
- Test/SmallCheck/Property/Result.hs +33/−8
- Test/SmallCheck/Series.hs +793/−72
- Test/SmallCheck/SeriesMonad.hs +46/−16
- smallcheck.cabal +61/−34
+ CHANGELOG.md view
@@ -0,0 +1,171 @@+Changes+=======++Version 1.2.1.1+-------------++* Annotate everything with `@since` pragmas.++Version 1.2.1+-------------++* Add `Serial` and `CoSerial` instances for `Ordering`.++Version 1.2.0+-------------++* Add `Serial` and `CoSerial` instances for+ `(,,,,)`, `(,,,,,)`,+ `Compose`,+ `Foreign.C.Types`,+ `Data.List.NonEmpty`,+ `Void`,+ `Complex`.+* Add `Bounded`, `Functor`, `Foldable` and `Traversable` instances+ for `Positive` and `NonNegative` wrappers.+* Add `NonZero` wrapper for non-zero integers.+* Add `cons5`, `cons6`, `alts5`, `alts6`.++Version 1.1.7+-------------++* Fix overlapping instances of `GSerial`.++Version 1.1.6+-------------++* Mark modules as `Safe`, not just `Trustworthy`.++Version 1.1.5+-------------++* Add `limit :: Monad m => Int -> Series m a -> Series m a`+* Add `genericSeries` and `genericCoseries`, so that you can use the generic+ implementations more flexibly. Previously, the generic implementation was+ only available as the default method for `series`/`coseries` but not as+ standalone functions.++Version 1.1.4+-------------++* Add instances for fixed-width Int and Word types (Int8, Word8 etc.)++Version 1.1.3.1+---------------++* Fix compatibility with GHC 7.8 and older++Version 1.1.3+-------------++* Add `Serial` and `CoSerial` instances for `Word` and `Natural`++Version 1.1.2+-------------++* Export the `test` function+* Add a `listSeries` function++Version 1.1.1+-------------++Export some auxiliary functions from `T.S.Series`, and document how to express+`consN` and `altsN` for `N > 4`.++Version 1.1.0.1+---------------++Documentation fixes++Version 1.1+-----------++* Add a `Serial` instance for `Ratio`+* Add the `NonEmpty` wrapper for lists+* Add `listM` (the monadic version of `list`)+* Add optional explanation for test outcomes++Version 1.0.4+-------------++Fix compatibility with GHC 7.4.1++Version 1.0.3+-------------++Fix a bug where no test cases were generated for some functional types (#19).++Version 1.0.2+-------------++Fix a bug in the generic instance++Version 1.0.1+-------------++Make SmallCheck build with GHC 7.4++Version 1.0+-----------++This is a major incompatible release of SmallCheck. Virtually every function has+changed its name, type, semantics or module. So please carefully read the docs+when upgrading.++For some highlights, see [this blog post](http://ro-che.info/articles/2013-02-19-smallcheck.html).++Version 0.6.2+-----------+* Derive Typeable Property instance+* Add smallCheckPure++Version 0.6.1+-----------++* Documentation improvements+* Make the package build with GHC 7.4.1++Version 0.6+-----------++* Default Generic implementation of Serial instance (by Bas van Dijk)+* The code is split into modules+* Convert much of README into haddock documentation+* Many small API changes+* Remove impure Testable (IO a) instance++Version 0.5+-----------++Make the package build with GHC 7.2. Some cosmetic changes.++Version 0.4+-----------++The module SmallCheck is now Test.SmallCheck. Packaged with Cabal.++Version 0.3+-----------++Existential quantifiers now have unique variants for which two witnesses+are reported when uniqueness fails. The over-generating coseries method+for functions of functional arguments has been replaced; now 'coseries'+and the 'alts<N>' family take a series argument. Test counters are+now Integers, not Ints. Ord and Eq are now derived for the N types.+Examples extended.++Version 0.2+-----------++The 'smallCheck' driver now takes an argument d and runs test series+at depths 0..d without interaction, stopping if any test fails.+The interactive variant is still available as 'smallCheckI'. All+Prelude numeric types now have Serial instances, including floating-point+types. Serial types Nat and Natural are also defined. Examples extended.++Version 0.1+-----------++The differences from 0.0 are two fixes (space-fault, output buffering),+an 'unsafe' but sometimes useful Testable (IO a) instance and additional+examples.
− CHANGES.md
@@ -1,87 +0,0 @@-Changes-=======--Version 1.0.4----------------Fix compatibility with GHC 7.4.1--Version 1.0.3----------------Fix a bug where no test cases were generated for some functional types (#19).--Version 1.0.2----------------Fix a bug in the generic instance--Version 1.0.1----------------Make SmallCheck build with GHC 7.4--Version 1.0--------------This is a major incompatible release of SmallCheck. Virtually every function has-changed its name, type, semantics or module. So please carefully read the docs-when upgrading.--For some highlights, see [this blog post](http://ro-che.info/articles/2013-02-19-smallcheck.html).--Version 0.6.2-------------* Derive Typeable Property instance-* Add smallCheckPure--Version 0.6.1--------------* Documentation improvements-* Make the package build with GHC 7.4.1--Version 0.6--------------* Default Generic implementation of Serial instance (by Bas van Dijk)-* The code is split into modules-* Convert much of README into haddock documentation-* Many small API changes-* Remove impure Testable (IO a) instance--Version 0.5--------------Make the package build with GHC 7.2. Some cosmetic changes.--Version 0.4--------------The module SmallCheck is now Test.SmallCheck. Packaged with Cabal.--Version 0.3--------------Existential quantifiers now have unique variants for which two witnesses-are reported when uniqueness fails. The over-generating coseries method-for functions of functional arguments has been replaced; now 'coseries'-and the 'alts<N>' family take a series argument. Test counters are-now Integers, not Ints. Ord and Eq are now derived for the N types.-Examples extended.--Version 0.2--------------The 'smallCheck' driver now takes an argument d and runs test series-at depths 0..d without interaction, stopping if any test fails.-The interactive variant is still available as 'smallCheckI'. All-Prelude numeric types now have Serial instances, including floating-point-types. Serial types Nat and Natural are also defined. Examples extended.--Version 0.1--------------The differences from 0.0 are two fixes (space-fault, output buffering),-an 'unsafe' but sometimes useful Testable (IO a) instance and additional-examples.
README.md view
@@ -1,6 +1,10 @@ SmallCheck: a property-based testing library for Haskell ======================================================== +**As of 2023, this library is largely obsolete: arbitrary test generators+with shrinking such as [`falsify`](https://hackage.haskell.org/package/falsify)+offer much better user experience.**+ SmallCheck is a testing library that allows to verify properties for all test cases up to some depth. The test cases are generated automatically by SmallCheck.@@ -10,21 +14,9 @@ > If a program fails to meet its specification in some cases, it almost always > fails in some simple case. -To get started with SmallCheck:+In many ways SmallCheck is very similar to QuickCheck. It uses the idea of type-based generators for test data, and the way testable properties are expressed is closely based on the QuickCheck approach. Like QuickCheck, SmallCheck tests whether properties hold for finite completely defined values at specific types, and reports counter-examples. -* Read the [documentation][haddock]-* If you have experience with QuickCheck, [read the comparison of QuickCheck and SmallCheck][comparison]-* Install it and give it a try! - `cabal update; cabal install smallcheck`-* Read the [paper][paper] or [other materials][oldpage] from the original- authors of SmallCheck (note that that information might be somewhat outdated)-* If you see something that can be improved, please [submit an issue][issues]-* Check out [the source code][github] at GitHub+The big difference is that instead of using a sample of randomly generated values, SmallCheck tests properties for all the finitely many values up to some depth, progressively increasing the depth used. For data values, depth means depth of construction. For functional values, it is a measure combining the depth to which arguments may be evaluated and the depth of possible results. -[haddock]: http://hackage.haskell.org/packages/archive/smallcheck/latest/doc/html/Test-SmallCheck.html-[hackage]: http://hackage.haskell.org/package/smallcheck-[paper]: http://www.cs.york.ac.uk/fp/smallcheck/smallcheck.pdf-[oldpage]: http://www.cs.york.ac.uk/fp/smallcheck/-[comparison]: https://github.com/feuerbach/smallcheck/wiki/Comparison-with-QuickCheck-[github]: https://github.com/feuerbach/smallcheck-[issues]: https://github.com/feuerbach/smallcheck/issues+The package is based on the [paper](http://www.cs.york.ac.uk/fp/smallcheck/smallcheck.pdf)+by Colin Runciman, Matthew Naylor and Fredrik Lindblad.
Test/SmallCheck.hs view
@@ -12,14 +12,20 @@ -- -- For pointers to other sources of information about SmallCheck, please refer -- to the README at--- <https://github.com/feuerbach/smallcheck/blob/master/README.md>+-- <https://github.com/Bodigrim/smallcheck/blob/master/README.md> --------------------------------------------------------------------++{-# LANGUAGE CPP #-}+{-# LANGUAGE NoImplicitPrelude #-}+#if __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE Safe #-}+#endif+ module Test.SmallCheck ( -- * Constructing tests -- | The simplest kind of test is a function (possibly of many- -- arguments) returning 'Bool'. The function arguments are interpreted+ -- arguments) returning 'Data.Bool.Bool'. The function arguments are interpreted -- as being universally, existentially or uniquely quantified, depending -- on the quantification context. --@@ -29,11 +35,11 @@ -- context for function arguments. Depending on the quantification -- context, the test @\\x y -> p x y@ may be equivalent to: --- -- * ∀ x, y. p x y ('forAll')+ -- * \( \forall x, y\colon p\, x \, y \) ('forAll'), --- -- * ∃ x, y: p x y ('exists')+ -- * \( \exists x, y\colon p\, x \, y \) ('exists'), --- -- * ∃! x, y: p x y ('existsUnique')+ -- * \( \exists! x, y\colon p\, x \, y \) ('existsUnique'). -- -- The quantification context affects all the variables immediately -- following the quantification operator, also extending past 'over',@@ -46,21 +52,29 @@ -- ** Examples -- |- -- * @\\x y -> p x y@ means ∀ x, y. p x y+ -- * @\\x y -> p x y@ means+ -- \( \forall x, y\colon p\, x \, y \). --- -- * @'exists' $ \\x y -> p x y@ means ∃ x, y: p x y+ -- * @'exists' $ \\x y -> p x y@ means+ -- \( \exists x, y\colon p\, x \, y \). --- -- * @'exists' $ \\x -> 'forAll' $ \\y -> p x y@ means ∃ x: ∀ y. p x y+ -- * @'exists' $ \\x -> 'forAll' $ \\y -> p x y@ means+ -- \( \exists x\colon \forall y\colon p \, x \, y \). --- -- * @'existsUnique' $ \\x y -> p x y@ means ∃! (x, y): p x y+ -- * @'existsUnique' $ \\x y -> p x y@ means+ -- \( \exists! x, y\colon p\, x \, y \). --- -- * @'existsUnique' $ \\x -> 'over' s $ \\y -> p x y@ means ∃! (x, y): y ∈ s && p x y+ -- * @'existsUnique' $ \\x -> 'over' s $ \\y -> p x y@ means+ -- \( \exists! x, y \colon y \in s \wedge p \, x \, y \). --- -- * @'existsUnique' $ \\x -> 'monadic' $ \\y -> p x y@ means ∃! x: ∀ y. [p x y]+ -- * @'existsUnique' $ \\x -> 'monadic' $ \\y -> p x y@ means+ -- \( \exists! x \colon \forall y \colon [p \, x \, y] \). --- -- * @'existsUnique' $ \\x -> 'existsUnique' $ \\y -> p x y@ means ∃! x: ∃! y: p x y+ -- * @'existsUnique' $ \\x -> 'existsUnique' $ \\y -> p x y@ means+ -- \( \exists! x \colon \exists! y \colon p \, x \, y \). --- -- * @'exists' $ \\x -> (\\y -> p y) '==>' (\\z -> q z)@ means ∃ x: (∀ y. p y) => (∀ z. p z)+ -- * @'exists' $ \\x -> (\\y -> p y) '==>' (\\z -> q z)@ means+ -- \( \exists x \colon (\forall y\colon p\, y) \implies (\forall z\colon q\, z) \). forAll, exists,@@ -75,23 +89,26 @@ -- * Running tests -- | 'smallCheck' is a simple way to run a test. --- -- As an alternative, consider using the @test-framework@ package:- -- <http://hackage.haskell.org/package/test-framework>+ -- As an alternative, consider using a testing framework. --- -- It allows to organize SmallCheck properties into a test suite (possibly- -- together with HUnit or QuickCheck tests), apply timeouts, get nice- -- statistics etc.+ -- The packages+ -- <http://hackage.haskell.org/package/tasty-smallcheck> and+ -- <http://hackage.haskell.org/package/hspec-smallcheck>+ -- provide integration with Tasty and HSpec, two popular testing+ -- frameworks. --- -- To use SmallCheck properties with test-framework, install- -- the @test-framework-smallcheck@ package: <http://hackage.haskell.org/package/test-framework>+ -- They allow to organize SmallCheck properties into a test suite (possibly+ -- together with HUnit or QuickCheck tests) and provide other useful+ -- features. -- -- For more ways to run the tests, see "Test.SmallCheck.Drivers". Depth, smallCheck, -- * Main types and classes- Testable,+ Testable(..), Property,+ Reason ) where
Test/SmallCheck/Drivers.hs view
@@ -8,34 +8,47 @@ -- You should only need this module if you wish to create your own way to -- run SmallCheck tests --------------------------------------------------------------------++{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE NoImplicitPrelude #-}+#if __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE Safe #-}+#endif+ module Test.SmallCheck.Drivers ( smallCheck, smallCheckM, smallCheckWithHook, test, ppFailure,- PropertyFailure(..), PropertySuccess(..), Argument, TestQuality(..)+ PropertyFailure(..), PropertySuccess(..), Argument, Reason, TestQuality(..) ) where -import Control.Monad (when)+import Control.Monad (when, return)+import Data.Function (($), (.), const)+import Data.IORef (readIORef, writeIORef, IORef, newIORef) -- NB: explicit import list to avoid name clash with modifyIORef'+import Data.Maybe (Maybe(Nothing, Just))+import Data.Ord ((>))+import Prelude (Integer, (+), seq)+import System.IO (IO, putStrLn) import Test.SmallCheck.Property import Test.SmallCheck.Property.Result-import Text.Printf-import Data.IORef (readIORef, writeIORef, IORef, newIORef) -- NB: explicit import list to avoid name clash with modifyIORef'+import Text.Printf (printf) -- | A simple driver that runs the test in the 'IO' monad and prints the -- results.+--+-- @since 1.0 smallCheck :: Testable IO a => Depth -> a -> IO () smallCheck d a = do ((good, bad), mbEx) <- runTestWithStats d a let testsRun = good + bad case mbEx of Nothing -> do- printf "Completed %d tests without failure.\n" $ testsRun+ printf "Completed %d tests without failure.\n" testsRun when (bad > 0) $- printf "But %d did not meet ==> condition.\n" $ bad+ printf "But %d did not meet ==> condition.\n" bad Just x -> do- printf "Failed test no. %d.\n" $ testsRun+ printf "Failed test no. %d.\n" testsRun putStrLn $ ppFailure x runTestWithStats :: Testable IO a => Depth -> a -> IO ((Integer, Integer), Maybe PropertyFailure)@@ -68,13 +81,17 @@ -- * You need to run a test in a monad different from 'IO' -- -- * You need to analyse the results rather than just print them+--+-- @since 1.0 smallCheckM :: Testable m a => Depth -> a -> m (Maybe PropertyFailure)-smallCheckM d a = smallCheckWithHook d (const $ return ()) a+smallCheckM d = smallCheckWithHook d (const $ return ()) -- | Like `smallCheckM`, but allows to specify a monadic hook that gets -- executed after each test is run. -- -- Useful for applications that want to report progress information to the -- user.+--+-- @since 1.0 smallCheckWithHook :: Testable m a => Depth -> (TestQuality -> m ()) -> a -> m (Maybe PropertyFailure) smallCheckWithHook d hook a = runProperty d hook $ test a
Test/SmallCheck/Property.hs view
@@ -9,11 +9,28 @@ -- -- Properties and tools to construct them. --------------------------------------------------------------------++{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}++-- Are we using new, polykinded and derivable Typeable yet?+#define NEWTYPEABLE MIN_VERSION_base(4,7,0)++#if NEWTYPEABLE+{-# LANGUAGE Safe #-}+#else+-- Trustworthy is needed because of the hand-written Typeable instance+#if __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE Trustworthy #-}- -- Trustworthy is needed because of the hand-written Typeable instance.- -- Kind-polymorphic Typeable will solve this.-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeFamilies,- ScopedTypeVariables #-}+#endif+#endif+ module Test.SmallCheck.Property ( -- * Constructors forAll, exists, existsUnique, over, (==>), monadic, changeDepth, changeDepth1,@@ -21,25 +38,55 @@ -- * Property's entrails Property, - PropertySuccess(..), PropertyFailure(..), runProperty, TestQuality(..), Argument, Depth, Testable(..),+ PropertySuccess(..), PropertyFailure(..), runProperty, TestQuality(..), Argument, Reason, Depth, Testable(..), ) where +import Control.Applicative (pure, (<$>), (<$))+import Control.Arrow (first)+import Control.Monad (Monad, liftM, mzero, return, (=<<), (>>=))+import Control.Monad.Logic (MonadLogic, runLogicT, ifte, once, msplit, lnot)+import Control.Monad.Reader (Reader, runReader, lift, ask, local, reader)+import Data.Bool (Bool, otherwise)+import Data.Either (Either, either)+import Data.Eq (Eq)+import Data.Function (($), flip, (.), const, id)+import Data.Functor (fmap)+import Data.Int (Int)+import Data.Maybe (Maybe (Nothing, Just))+import Data.Ord (Ord, (<=))+import Data.Typeable (Typeable)+import Prelude (Enum, (-))+import Test.SmallCheck.Property.Result import Test.SmallCheck.Series import Test.SmallCheck.SeriesMonad-import Test.SmallCheck.Property.Result-import Control.Monad-import Control.Monad.Logic-import Control.Monad.Reader-import Control.Applicative-import Data.Typeable+import Text.Show (Show, show) +#if MIN_VERSION_base(4,17,0)+import Data.Type.Equality (type (~))+#endif++#if !NEWTYPEABLE+import Data.Typeable (Typeable1, mkTyConApp, typeOf)+import Prelude (undefined)+#if MIN_VERSION_base(4,4,0)+import Data.Typeable (mkTyCon3)+#else+import Data.Typeable (mkTyCon)+#endif+#endif+ ------------------------------ -- Property-related types ------------------------------ --{{{ --- | The type of properties over the monad @m@+-- | The type of properties over the monad @m@.+--+-- @since 1.0 newtype Property m = Property { unProperty :: Reader (Env m) (PropertySeries m) }+#if NEWTYPEABLE+ deriving Typeable+#endif data PropertySeries m = PropertySeries@@ -59,17 +106,26 @@ | Exists | ExistsUnique +-- | @since 1.0 data TestQuality = GoodTest | BadTest deriving (Eq, Ord, Enum, Show) +#if !NEWTYPEABLE+-- Typeable here is not polykinded yet, and also GHC doesn't know how to+-- derive this. instance Typeable1 m => Typeable (Property m) where typeOf _ = mkTyConApp+#if MIN_VERSION_base(4,4,0) (mkTyCon3 "smallcheck" "Test.SmallCheck.Property" "Property")+#else+ (mkTyCon "smallcheck Test.SmallCheck.Property Property")+#endif [typeOf (undefined :: m ())]+#endif -- }}} @@ -111,12 +167,16 @@ -- variable following the operator and not subsequent variables. -- -- 'over' does not affect the quantification context.+--+-- @since 1.0 over :: (Show a, Testable m b) => Series m a -> (a -> b) -> Property m over = testFunction --- | Execute a monadic test+-- | Execute a monadic test.+--+-- @since 1.0 monadic :: Testable m a => m a -> Property m monadic a = Property $ reader $ \env ->@@ -136,8 +196,11 @@ -- | Class of tests that can be run in a monad. For pure tests, it is -- recommended to keep their types polymorphic in @m@ rather than--- specialising it to 'Identity'.+-- specialising it to 'Data.Functor.Identity'.+--+-- @since 1.0 class Monad m => Testable m a where+ -- | @since 1.0 test :: a -> Property m instance Monad m => Testable m Bool where@@ -145,10 +208,27 @@ let success = do lift $ testHook env GoodTest- if b then return PropertyTrue else mzero- failure = PropertyFalse <$ lnot success+ if b then return $ PropertyTrue Nothing else mzero+ failure = PropertyFalse Nothing <$ lnot success in atomicProperty success failure +-- | Works like the 'Data.Bool.Bool' instance, but includes an explanation of the result.+--+-- 'Data.Either.Left' and 'Data.Either.Right' correspond to test failure and success+-- respectively.+--+-- @since 1.1+instance Monad m => Testable m (Either Reason Reason) where+ test r = Property $ reader $ \env ->+ let+ success = do+ lift $ testHook env GoodTest+ either (const mzero) (pure . PropertyTrue . Just) r+ failure = do+ lift $ testHook env GoodTest+ either (pure . PropertyFalse . Just) (const mzero) r+ in atomicProperty success failure+ instance (Serial m a, Show a, Testable m b) => Testable m (a->b) where test = testFunction series @@ -179,7 +259,7 @@ CounterExample args etc -> CounterExample (arg:args) etc _ -> CounterExample [arg] failure - success = PropertyTrue <$ lnot failure+ success = PropertyTrue Nothing <$ lnot failure -- }}} Exists -> PropertySeries success failure closest@@ -246,28 +326,38 @@ freshContext :: Testable m a => a -> Property m freshContext = forAll --- | Set the universal quantification context+-- | Set the universal quantification context.+--+-- @since 1.0 forAll :: Testable m a => a -> Property m forAll = quantify Forall . test --- | Set the existential quantification context+-- | Set the existential quantification context.+--+-- @since 1.0 exists :: Testable m a => a -> Property m exists = quantify Exists . test -- | Set the uniqueness quantification context. ----- Bear in mind that ∃! (x, y): p x y is not the same as ∃! x: ∃! y: p x y.+-- Bear in mind that \( \exists! x, y\colon p\, x \, y \)+-- is not the same as \( \exists! x \colon \exists! y \colon p \, x \, y \). ----- For example, ∃! x: ∃! y: |x| = |y| is true (it holds only when x=0), but ∃! (x,y): |x| = |y| is false (there are many such pairs).+-- For example, \( \exists! x \colon \exists! y \colon |x| = |y| \)+-- is true (it holds only when \(x=y=0\)),+-- but \( \exists! x, y \colon |x| = |y| \) is false+-- (there are many such pairs). -- -- As is customary in mathematics, -- @'existsUnique' $ \\x y -> p x y@ is equivalent to--- @'existsUnique' $ \\(x,y) -> p x y@ and not to+-- @'existsUnique' $ \\(x, y) -> p x y@ and not to -- @'existsUnique' $ \\x -> 'existsUnique' $ \\y -> p x y@ -- (the latter, of course, may be explicitly written when desired). -- -- That is, all the variables affected by the same uniqueness context are -- quantified simultaneously as a tuple.+--+-- @since 1.0 existsUnique :: Testable m a => a -> Property m existsUnique = quantify ExistsUnique . test @@ -277,6 +367,8 @@ -- -- Note that '==>' resets the quantification context for its operands to -- the default (universal).+--+-- @since 1.0 infixr 0 ==> (==>) :: (Testable m c, Testable m a) => c -> a -> Property m cond ==> prop = Property $ do@@ -315,6 +407,8 @@ -- | Run property with a modified depth. Affects all quantified variables -- in the property.+--+-- @since 1.0 changeDepth :: Testable m a => (Depth -> Depth) -> a -> Property m changeDepth modifyDepth a = Property (changeDepthPS <$> unProperty (test a)) where@@ -322,11 +416,13 @@ PropertySeries (localDepth modifyDepth ss) (localDepth modifyDepth sf)- ((\(prop, args) -> (changeDepth modifyDepth prop, args)) <$>+ (first (changeDepth modifyDepth) <$> localDepth modifyDepth sc) -- | Quantify the function's argument over its 'series', but adjust the -- depth. This doesn't affect any subsequent variables.+--+-- @since 1.0 changeDepth1 :: (Show a, Serial m a, Testable m b) => (Depth -> Depth) -> (a -> b) -> Property m changeDepth1 modifyDepth = over $ localDepth modifyDepth series
Test/SmallCheck/Property/Result.hs view
@@ -1,28 +1,50 @@-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, DefaultSignatures #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE NoImplicitPrelude #-}+#if __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE Safe #-}+#endif+ module Test.SmallCheck.Property.Result ( PropertySuccess(..) , PropertyFailure(..) , ppFailure+ , Reason , Argument ) where -import Text.PrettyPrint+import Data.Bool (Bool (False, True))+import Data.Eq (Eq)+import Data.Function (($), (.))+import Data.Int (Int)+import Data.List (map)+import Data.Maybe (Maybe (Nothing, Just))+import Prelude (String)+import Text.PrettyPrint (Doc, empty, hsep, nest, render, text, (<+>), ($+$), ($$))+import Text.Show (Show) +-- | @since 1.0 type Argument = String +-- | An explanation for the test outcome.+--+-- @since 1.1+type Reason = String++-- | @since 1.0 data PropertySuccess = Exist [Argument] PropertySuccess | ExistUnique [Argument] PropertySuccess- | PropertyTrue+ | PropertyTrue (Maybe Reason) -- ^ @since 1.1 | Vacuously PropertyFailure deriving (Eq, Show) +-- | @since 1.0 data PropertyFailure = NotExist | AtLeastTwo [Argument] PropertySuccess [Argument] PropertySuccess | CounterExample [Argument] PropertyFailure- | PropertyFalse+ | PropertyFalse (Maybe Reason) -- ^ @since 1.1 deriving (Eq, Show) class Pretty a where@@ -36,17 +58,19 @@ text "arguments satisfying the property:" $$ formatExample args1 s1 $$ formatExample args2 s2 where- formatExample args s = nest ind $ text "for" <+> prettyArgs args </> (pretty s)+ formatExample args s = nest ind $ text "for" <+> prettyArgs args </> pretty s pretty (CounterExample args f) = text "there" <+> text (plural args "exists" "exist") <+> prettyArgs args <+> text "such that"- </> (pretty f)- pretty PropertyFalse = text "condition is false"+ </> pretty f+ pretty (PropertyFalse Nothing) = text "condition is false"+ pretty (PropertyFalse (Just s)) = text s instance Pretty PropertySuccess where- pretty PropertyTrue = text "condition is true"+ pretty (PropertyTrue Nothing) = text "condition is true"+ pretty (PropertyTrue (Just s)) = text s pretty (Exist args s) = existsMsg False args s pretty (ExistUnique args s) = existsMsg True args s pretty (Vacuously s) = text "property is vacuously true because" </> pretty s@@ -75,5 +99,6 @@ _:_:_ -> pl _ -> sing +-- | @since 1.0 ppFailure :: PropertyFailure -> String ppFailure = render . pretty
Test/SmallCheck/Series.hs view
@@ -23,12 +23,32 @@ -- the instances by hand. -------------------------------------------------------------------- -{-# LANGUAGE CPP, RankNTypes, MultiParamTypeClasses, FlexibleInstances,- GeneralizedNewtypeDeriving, FlexibleContexts #-}--- The following is needed for generic instances-{-# LANGUAGE DefaultSignatures, FlexibleContexts, TypeOperators,- TypeSynonymInstances, FlexibleInstances, OverlappingInstances #-}+{-# LANGUAGE CPP #-}+#if __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE DefaultSignatures #-}+#endif+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeOperators #-} +#if MIN_VERSION_base(4,8,0)+{-# LANGUAGE Safe #-}+#else+{-# LANGUAGE OverlappingInstances #-}+#if __GLASGOW_HASKELL__ >= 704+{-# LANGUAGE Trustworthy #-}+#endif+#endif++#define HASCBOOL MIN_VERSION_base(4,10,0)+ module Test.SmallCheck.Series ( -- {{{ -- * Generic instances@@ -49,7 +69,7 @@ -- >instance Serial m a => Serial m (Tree a) -- -- Here we enable the @DeriveGeneric@ extension which allows to derive 'Generic'- -- instance for our data type. Then we declare that @Tree a@ is an instance of+ -- instance for our data type. Then we declare that @Tree@ @a@ is an instance of -- 'Serial', but do not provide any definitions. This causes GHC to use the -- default definitions that use the 'Generic' instance. --@@ -77,33 +97,41 @@ -- > -- >instance Serial m a => Serial m (Light a) where -- > series = newtypeCons Light+ --+ -- For data types with more than 6 fields define @consN@ as+ --+ -- >consN f = decDepth $+ -- > f <$> series+ -- > <~> series+ -- > <~> series+ -- > <~> ... {- series repeated N times in total -} - -- ** What does consN do, exactly?+ -- ** What does @consN@ do, exactly? -- | @consN@ has type- -- @(Serial t_1, ..., Serial t_N) => (t_1 -> ... -> t_N -> t) -> Series t@.+ -- @(Serial t₁, ..., Serial tₙ) => (t₁ -> ... -> tₙ -> t) -> Series t@. --- -- @consN f@ is a series which, for a given depth @d > 0@, produces values of the+ -- @consN@ @f@ is a series which, for a given depth \(d > 0\), produces values of the -- form --- -- >f x_1 ... x_N+ -- >f x₁ ... xₙ --- -- where @x_i@ ranges over all values of type @t_i@ of depth up to @d-1@- -- (as defined by the 'series' functions for @t_i@).+ -- where @xₖ@ ranges over all values of type @tₖ@ of depth up to \(d-1\)+ -- (as defined by the 'series' functions for @tₖ@). --- -- @consN@ functions also ensure that x_i are enumerated in the+ -- @consN@ functions also ensure that xₖ are enumerated in the -- breadth-first order. Thus, combinations of smaller depth come first- -- (assuming the same is true for @t_i@).+ -- (assuming the same is true for @tₖ@). --- -- If @d <= 0@, no values are produced.+ -- If \(d \le 0\), no values are produced. - cons0, cons1, cons2, cons3, cons4, newtypeCons,+ cons0, cons1, cons2, cons3, cons4, cons5, cons6, newtypeCons, -- * Function Generators -- | To generate functions of an application-specific argument type, -- make the type an instance of 'CoSerial'. --- -- Again there is a standard pattern, this time using the altsN+ -- Again there is a standard pattern, this time using the @altsN@ -- combinators where again N is constructor arity. Here are @Tree@ and -- @Light@ instances: --@@ -123,32 +151,47 @@ -- > return $ \l -> -- > case l of -- > Light x -> f x+ --+ -- For data types with more than 6 fields define @altsN@ as+ --+ -- >altsN rs = do+ -- > rs <- fixDepth rs+ -- > decDepthChecked+ -- > (constM $ constM $ ... $ constM rs)+ -- > (coseries $ coseries $ ... $ coseries rs)+ -- > {- constM and coseries are repeated N times each -} -- ** What does altsN do, exactly? -- | @altsN@ has type- -- @(Serial t_1, ..., Serial t_N) => Series t -> Series (t_1 -> ... -> t_N -> t)@.+ -- @(Serial t₁, ..., Serial tₙ) => Series t -> Series (t₁ -> ... -> tₙ -> t)@. --- -- @altsN s@ is a series which, for a given depth @d@, produces functions of+ -- @altsN@ @s@ is a series which, for a given depth \( d \), produces functions of -- type --- -- >t_1 -> ... -> t_N -> t+ -- >t₁ -> ... -> tₙ -> t --- -- If @d <= 0@, these are constant functions, one for each value produced+ -- If \( d \le 0 \), these are constant functions, one for each value produced -- by @s@. --- -- If @d > 0@, these functions inspect each of their arguments up to the depth- -- @d-1@ (as defined by the 'coseries' functions for the corresponding+ -- If \( d > 0 \), these functions inspect each of their arguments up to the depth+ -- \( d-1 \) (as defined by the 'coseries' functions for the corresponding -- types) and return values produced by @s@. The depth to which the -- values are enumerated does not depend on the depth of inspection. - alts0, alts1, alts2, alts3, alts4, newtypeAlts,+ alts0, alts1, alts2, alts3, alts4, alts5, alts6, newtypeAlts, -- * Basic definitions Depth, Series, Serial(..), CoSerial(..), +#if __GLASGOW_HASKELL__ >= 702+ -- * Generic implementations+ genericSeries,+ genericCoseries,+#endif+ -- * Convenient wrappers- Positive(..), NonNegative(..),+ Positive(..), NonNegative(..), NonZero(..), NonEmpty(..), -- * Other useful definitions (\/), (><), (<~>), (>>-),@@ -156,38 +199,100 @@ decDepth, getDepth, generate,- list+ limit,+ listSeries,+ list,+ listM,+ fixDepth,+ decDepthChecked,+ constM -- }}} ) where -import Control.Monad.Logic-import Control.Monad.Reader-import Control.Applicative-import Control.Monad.Identity-import Data.List+import Control.Applicative (empty, pure, (<$>), (<|>))+import Control.Monad (Monad, liftM, guard, mzero, mplus, msum, return, (>>), (>>=))+import Control.Monad.Identity (Identity(Identity), runIdentity)+import Control.Monad.Logic (MonadLogic, (>>-), interleave, msplit, observeAllT)+import Control.Monad.Reader (ask, local)+import Data.Bool (Bool (True, False), (&&), (||))+import Data.Char (Char)+import Data.Complex (Complex((:+)))+import Data.Either (Either (Left, Right), either)+import Data.Eq (Eq, (==), (/=))+import Data.Foldable (Foldable)+import Data.Function (($), (.), const)+import Data.Functor (Functor, fmap)+import Data.Functor.Compose (Compose(Compose), getCompose)+import Data.Int (Int, Int8, Int16, Int32, Int64)+import Data.List (intercalate, take, map, length, (++), maximum, sum, unlines, lines, concat)+import qualified Data.List.NonEmpty as NE+import Data.Maybe (Maybe (Just, Nothing), maybe)+import Data.Ord (Ord, Ordering (LT, EQ, GT), max, (<), (>), (>=), compare, (<=))+import Data.Ratio (Ratio, numerator, denominator, (%))+import Data.Traversable (Traversable)+import Data.Tuple (uncurry)+import Data.Void (Void, absurd)+import Data.Word (Word, Word8, Word16, Word32, Word64)+import Numeric.Natural (Natural)+import Prelude (Integer, Real, toRational, Enum, toEnum, fromEnum, Num, (+), (*), Integral, quotRem, toInteger, negate, abs, signum, fromInteger, Bounded, minBound, maxBound, Float, Double, (-), odd, encodeFloat, decodeFloat, realToFrac, seq, subtract) import Test.SmallCheck.SeriesMonad-import GHC.Generics+import Text.Show (Show, showsPrec, show) +#if MIN_VERSION_base(4,5,0)+import Foreign.C.Types (CFloat(CFloat), CDouble(CDouble), CChar(CChar), CSChar(CSChar), CUChar(CUChar), CShort(CShort), CUShort(CUShort), CInt(CInt), CUInt(CUInt), CLong(CLong), CULong(CULong), CPtrdiff(CPtrdiff), CSize(CSize), CWchar(CWchar), CSigAtomic(CSigAtomic), CLLong(CLLong), CULLong(CULLong), CIntPtr(CIntPtr), CUIntPtr(CUIntPtr), CIntMax(CIntMax), CUIntMax(CUIntMax), CClock(CClock), CTime(CTime), CUSeconds(CUSeconds), CSUSeconds(CSUSeconds))+#endif++#if __GLASGOW_HASKELL__ >= 702+import GHC.Generics (Generic, (:+:)(L1, R1), (:*:)((:*:)), C1, K1(K1), unK1, M1(M1), unM1, U1(U1), V1, Rep, to, from)+#else+import Prelude (RealFloat)+#endif+#if HASCBOOL+import Foreign.C.Types (CBool(CBool))+#endif+ ------------------------------ -- Main types and classes ------------------------------ --{{{ +-- | @since 1.0 class Monad m => Serial m a where series :: Series m a +#if __GLASGOW_HASKELL__ >= 704 default series :: (Generic a, GSerial m (Rep a)) => Series m a- series = to <$> gSeries+ series = genericSeries+#endif +#if __GLASGOW_HASKELL__ >= 702+-- | @since 1.1.5+genericSeries+ :: (Monad m, Generic a, GSerial m (Rep a))+ => Series m a+genericSeries = to <$> gSeries+#endif++-- | @since 1.0 class Monad m => CoSerial m a where -- | A proper 'coseries' implementation should pass the depth unchanged to -- its first argument. Doing otherwise will make enumeration of curried -- functions non-uniform in their arguments. coseries :: Series m b -> Series m (a->b) +#if __GLASGOW_HASKELL__ >= 704 default coseries :: (Generic a, GCoSerial m (Rep a)) => Series m b -> Series m (a->b)- coseries rs = (. from) <$> gCoseries rs+ coseries = genericCoseries+#endif +#if __GLASGOW_HASKELL__ >= 702+-- | @since 1.1.5+genericCoseries+ :: (Monad m, Generic a, GCoSerial m (Rep a))+ => Series m b -> Series m (a->b)+genericCoseries rs = (. from) <$> gCoseries rs+#endif+ -- }}} ------------------------------@@ -197,30 +302,78 @@ -- | A simple series specified by a function from depth to the list of -- values up to that depth.+--+-- @since 1.0 generate :: (Depth -> [a]) -> Series m a generate f = do d <- getDepth msum $ map return $ f d +-- | Limit a 'Series' to its first @n@ elements.+--+-- @since 1.1.5+limit :: forall m a . Monad m => Int -> Series m a -> Series m a+limit n0 (Series s) = Series $ go n0 s+ where+ go 0 _ = empty+ go n mb1 = do+ cons :: Maybe (b, ml b) <- msplit mb1+ case cons of+ Nothing -> empty+ Just (b, mb2) -> return b <|> go (n-1) mb2+ suchThat :: Series m a -> (a -> Bool) -> Series m a suchThat s p = s >>= \x -> if p x then pure x else empty +-- | Given a depth, return the list of values generated by a 'Serial' instance.+--+-- For example, list all integers up to depth 1:+--+-- * @listSeries 1 :: [Int] -- returns [0,1,-1]@+--+-- @since 1.1.2+listSeries :: Serial Identity a => Depth -> [a]+listSeries d = list d series+ -- | Return the list of values generated by a 'Series'. Useful for -- debugging 'Serial' instances.+--+-- Examples:+--+-- * @'list' 3 'series' :: ['Int'] -- returns [0,1,-1,2,-2,3,-3]@+--+-- * @'list' 3 ('series' :: 'Series' 'Data.Functor.Identity' 'Int') -- returns [0,1,-1,2,-2,3,-3]@+--+-- * @'list' 2 'series' :: [['Bool']] -- returns [[],['True'],['False']]@+--+-- The first two are equivalent. The second has a more explicit type binding.+--+-- @since 1.0 list :: Depth -> Series Identity a -> [a] list d s = runIdentity $ observeAllT $ runSeries d s --- | Sum (union) of series+-- | Monadic version of 'list'.+--+-- @since 1.1+listM d s = observeAllT $ runSeries d s++-- | Sum (union) of series.+--+-- @since 1.0 infixr 7 \/ (\/) :: Monad m => Series m a -> Series m a -> Series m a (\/) = interleave -- | Product of series+--+-- @since 1.0 infixr 8 >< (><) :: Monad m => Series m a -> Series m b -> Series m (a,b) a >< b = (,) <$> a <~> b --- | Fair version of 'ap' and '<*>'+-- | Fair version of 'Control.Applicative.ap' and 'Control.Applicative.<*>'.+--+-- @since 1.0 infixl 4 <~> (<~>) :: Monad m => Series m (a -> b) -> Series m a -> Series m b a <~> b = a >>- (<$> b)@@ -231,17 +384,29 @@ uncurry4 :: (a->b->c->d->e) -> ((a,b,c,d)->e) uncurry4 f (w,x,y,z) = f w x y z --- | Query the current depth+uncurry5 :: (a->b->c->d->e->f) -> ((a,b,c,d,e)->f)+uncurry5 f (v,w,x,y,z) = f v w x y z++uncurry6 :: (a->b->c->d->e->f->g) -> ((a,b,c,d,e,f)->g)+uncurry6 f (u,v,w,x,y,z) = f u v w x y z++-- | Query the current depth.+--+-- @since 1.0 getDepth :: Series m Depth getDepth = Series ask --- | Run a series with a modified depth+-- | Run a series with a modified depth.+--+-- @since 1.0 localDepth :: (Depth -> Depth) -> Series m a -> Series m a localDepth f (Series a) = Series $ local f a -- | Run a 'Series' with the depth decreased by 1. ----- If the current depth is less or equal to 0, the result is 'mzero'.+-- If the current depth is less or equal to 0, the result is 'empty'.+--+-- @since 1.0 decDepth :: Series m a -> Series m a decDepth a = do checkDepth@@ -252,16 +417,23 @@ d <- getDepth guard $ d > 0 +-- | @'constM' = 'liftM' 'const'@+--+-- @since 1.1.1 constM :: Monad m => m b -> m (a -> b) constM = liftM const -- | Fix the depth of a series at the current level. The resulting series -- will no longer depend on the \"ambient\" depth.+--+-- @since 1.1.1 fixDepth :: Series m a -> Series m (Series m a) fixDepth s = getDepth >>= \d -> return $ localDepth (const d) s -- | If the current depth is 0, evaluate the first argument. Otherwise, -- evaluate the second argument with decremented depth.+--+-- @since 1.1.1 decDepthChecked :: Series m a -> Series m a -> Series m a decDepthChecked b r = do d <- getDepth@@ -281,19 +453,25 @@ ------------------------------ -- {{{ +-- | @since 1.0 cons0 :: a -> Series m a cons0 x = decDepth $ pure x +-- | @since 1.0 cons1 :: Serial m a => (a->b) -> Series m b cons1 f = decDepth $ f <$> series -- | Same as 'cons1', but preserves the depth.+--+-- @since 1.0 newtypeCons :: Serial m a => (a->b) -> Series m b newtypeCons f = f <$> series +-- | @since 1.0 cons2 :: (Serial m a, Serial m b) => (a->b->c) -> Series m c cons2 f = decDepth $ f <$> series <~> series +-- | @since 1.0 cons3 :: (Serial m a, Serial m b, Serial m c) => (a->b->c->d) -> Series m d cons3 f = decDepth $@@ -301,6 +479,7 @@ <~> series <~> series +-- | @since 1.0 cons4 :: (Serial m a, Serial m b, Serial m c, Serial m d) => (a->b->c->d->e) -> Series m e cons4 f = decDepth $@@ -309,14 +488,38 @@ <~> series <~> series +-- | @since 1.2.0+cons5 :: (Serial m a, Serial m b, Serial m c, Serial m d, Serial m e) =>+ (a->b->c->d->e->f) -> Series m f+cons5 f = decDepth $+ f <$> series+ <~> series+ <~> series+ <~> series+ <~> series++-- | @since 1.2.0+cons6 :: (Serial m a, Serial m b, Serial m c, Serial m d, Serial m e, Serial m f) =>+ (a->b->c->d->e->f->g) -> Series m g+cons6 f = decDepth $+ f <$> series+ <~> series+ <~> series+ <~> series+ <~> series+ <~> series++-- | @since 1.0 alts0 :: Series m a -> Series m a alts0 s = s +-- | @since 1.0 alts1 :: CoSerial m a => Series m b -> Series m (a->b) alts1 rs = do rs <- fixDepth rs decDepthChecked (constM rs) (coseries rs) +-- | @since 1.0 alts2 :: (CoSerial m a, CoSerial m b) => Series m c -> Series m (a->b->c)@@ -326,6 +529,7 @@ (constM $ constM rs) (coseries $ coseries rs) +-- | @since 1.0 alts3 :: (CoSerial m a, CoSerial m b, CoSerial m c) => Series m d -> Series m (a->b->c->d) alts3 rs = do@@ -334,6 +538,7 @@ (constM $ constM $ constM rs) (coseries $ coseries $ coseries rs) +-- | @since 1.0 alts4 :: (CoSerial m a, CoSerial m b, CoSerial m c, CoSerial m d) => Series m e -> Series m (a->b->c->d->e) alts4 rs = do@@ -342,7 +547,27 @@ (constM $ constM $ constM $ constM rs) (coseries $ coseries $ coseries $ coseries rs) +-- | @since 1.2.0+alts5 :: (CoSerial m a, CoSerial m b, CoSerial m c, CoSerial m d, CoSerial m e) =>+ Series m f -> Series m (a->b->c->d->e->f)+alts5 rs = do+ rs <- fixDepth rs+ decDepthChecked+ (constM $ constM $ constM $ constM $ constM rs)+ (coseries $ coseries $ coseries $ coseries $ coseries rs)++-- | @since 1.2.0+alts6 :: (CoSerial m a, CoSerial m b, CoSerial m c, CoSerial m d, CoSerial m e, CoSerial m f) =>+ Series m g -> Series m (a->b->c->d->e->f->g)+alts6 rs = do+ rs <- fixDepth rs+ decDepthChecked+ (constM $ constM $ constM $ constM $ constM $ constM rs)+ (coseries $ coseries $ coseries $ coseries $ coseries $ coseries rs)+ -- | Same as 'alts1', but preserves the depth.+--+-- @since 1.0 newtypeAlts :: CoSerial m a => Series m b -> Series m (a->b) newtypeAlts = coseries @@ -358,7 +583,8 @@ class GCoSerial m f where gCoseries :: Series m b -> Series m (f a -> b) -instance GSerial m f => GSerial m (M1 i c f) where+#if __GLASGOW_HASKELL__ >= 702+instance {-# OVERLAPPABLE #-} GSerial m f => GSerial m (M1 i c f) where gSeries = M1 <$> gSeries {-# INLINE gSeries #-} instance GCoSerial m f => GCoSerial m (M1 i c f) where@@ -379,6 +605,13 @@ gCoseries rs = constM rs {-# INLINE gCoseries #-} +instance GSerial m V1 where+ gSeries = mzero+ {-# INLINE gSeries #-}+instance GCoSerial m V1 where+ gCoseries = const $ return (\a -> a `seq` let x = x in x)+ {-# INLINE gCoseries #-}+ instance (Monad m, GSerial m a, GSerial m b) => GSerial m (a :*: b) where gSeries = (:*:) <$> gSeries <~> gSeries {-# INLINE gSeries #-}@@ -401,9 +634,11 @@ R1 y -> g y {-# INLINE gCoseries #-} -instance GSerial m f => GSerial m (C1 c f) where+instance {-# OVERLAPPING #-} GSerial m f => GSerial m (C1 c f) where gSeries = M1 <$> decDepth gSeries {-# INLINE gSeries #-}+#endif+ -- }}} ------------------------------@@ -415,37 +650,91 @@ instance Monad m => CoSerial m () where coseries rs = constM rs -instance Monad m => Serial m Int where- series =- generate (\d -> if d >= 0 then pure 0 else empty) <|>- nats `interleave` (fmap negate nats)- where- nats = generate $ \d -> [1..d]+instance Monad m => Serial m Integer where series = unM <$> series+instance Monad m => CoSerial m Integer where coseries = fmap (. M) . coseries -instance Monad m => CoSerial m Int where- coseries rs =- alts0 rs >>- \z ->- alts1 rs >>- \f ->- alts1 rs >>- \g ->- return $ \i -> case () of { _- | i > 0 -> f (N (i - 1))- | i < 0 -> g (N (abs i - 1))- | otherwise -> z- }+-- | @since 1.1.3+instance Monad m => Serial m Natural where series = unN <$> series+-- | @since 1.1.3+instance Monad m => CoSerial m Natural where coseries = fmap (. N) . coseries -instance Monad m => Serial m Integer where- series = (toInteger :: Int -> Integer) <$> series-instance Monad m => CoSerial m Integer where- coseries rs = (. (fromInteger :: Integer->Int)) <$> coseries rs+instance Monad m => Serial m Int where series = unM <$> series+instance Monad m => CoSerial m Int where coseries = fmap (. M) . coseries +-- | @since 1.1.3+instance Monad m => Serial m Word where series = unN <$> series+-- | @since 1.1.3+instance Monad m => CoSerial m Word where coseries = fmap (. N) . coseries++-- | @since 1.1.4+instance Monad m => Serial m Int8 where series = unM <$> series+-- | @since 1.1.4+instance Monad m => CoSerial m Int8 where coseries = fmap (. M) . coseries++-- | @since 1.1.4+instance Monad m => Serial m Word8 where series = unN <$> series+-- | @since 1.1.4+instance Monad m => CoSerial m Word8 where coseries = fmap (. N) . coseries++-- | @since 1.1.4+instance Monad m => Serial m Int16 where series = unM <$> series+-- | @since 1.1.4+instance Monad m => CoSerial m Int16 where coseries = fmap (. M) . coseries++-- | @since 1.1.4+instance Monad m => Serial m Word16 where series = unN <$> series+-- | @since 1.1.4+instance Monad m => CoSerial m Word16 where coseries = fmap (. N) . coseries++-- | @since 1.1.4+instance Monad m => Serial m Int32 where series = unM <$> series+-- | @since 1.1.4+instance Monad m => CoSerial m Int32 where coseries = fmap (. M) . coseries++-- | @since 1.1.4+instance Monad m => Serial m Word32 where series = unN <$> series+-- | @since 1.1.4+instance Monad m => CoSerial m Word32 where coseries = fmap (. N) . coseries++-- | @since 1.1.4+instance Monad m => Serial m Int64 where series = unM <$> series+-- | @since 1.1.4+instance Monad m => CoSerial m Int64 where coseries = fmap (. M) . coseries++-- | @since 1.1.4+instance Monad m => Serial m Word64 where series = unN <$> series+-- | @since 1.1.4+instance Monad m => CoSerial m Word64 where coseries = fmap (. N) . coseries+ -- | 'N' is a wrapper for 'Integral' types that causes only non-negative values -- to be generated. Generated functions of type @N a -> b@ do not distinguish -- different negative values of @a@.-newtype N a = N a deriving (Eq, Ord, Real, Enum, Num, Integral)+newtype N a = N { unN :: a } deriving (Eq, Ord, Show) -instance (Integral a, Serial m a) => Serial m (N a) where- series = generate $ \d -> map (N . fromIntegral) [0..d]+instance Real a => Real (N a) where+ toRational (N x) = toRational x +instance Enum a => Enum (N a) where+ toEnum x = N (toEnum x)+ fromEnum (N x) = fromEnum x++instance Num a => Num (N a) where+ N x + N y = N (x + y)+ N x * N y = N (x * y)+ negate (N x) = N (negate x)+ abs (N x) = N (abs x)+ signum (N x) = N (signum x)+ fromInteger x = N (fromInteger x)++instance Integral a => Integral (N a) where+ quotRem (N x) (N y) = (N q, N r)+ where+ (q, r) = x `quotRem` y+ toInteger (N x) = toInteger x++instance (Num a, Enum a, Serial m a) => Serial m (N a) where+ series = generate $ \d -> take (d+1) [0..]+ instance (Integral a, Monad m) => CoSerial m (N a) where coseries rs = -- This is a recursive function, because @alts1 rs@ typically calls@@ -460,6 +749,45 @@ then f (N $ i-1) else z +-- | 'M' is a helper type to generate values of a signed type of increasing magnitude.+newtype M a = M { unM :: a } deriving (Eq, Ord, Show)++instance Real a => Real (M a) where+ toRational (M x) = toRational x++instance Enum a => Enum (M a) where+ toEnum x = M (toEnum x)+ fromEnum (M x) = fromEnum x++instance Num a => Num (M a) where+ M x + M y = M (x + y)+ M x * M y = M (x * y)+ negate (M x) = M (negate x)+ abs (M x) = M (abs x)+ signum (M x) = M (signum x)+ fromInteger x = M (fromInteger x)++instance Integral a => Integral (M a) where+ quotRem (M x) (M y) = (M q, M r)+ where+ (q, r) = x `quotRem` y+ toInteger (M x) = toInteger x++instance (Num a, Enum a, Monad m) => Serial m (M a) where+ series = others `interleave` positives+ where positives = generate $ \d -> take d [1..]+ others = generate $ \d -> take (d+1) [0,-1..]++instance (Ord a, Num a, Monad m) => CoSerial m (M a) where+ coseries rs =+ alts0 rs >>- \z ->+ alts1 rs >>- \f ->+ alts1 rs >>- \g ->+ pure $ \ i -> case compare i 0 of+ GT -> f (M (i - 1))+ LT -> g (M (abs i - 1))+ EQ -> z+ instance Monad m => Serial m Float where series = series >>- \(sig, exp) ->@@ -476,6 +804,17 @@ coseries rs = (. (realToFrac :: Double -> Float)) <$> coseries rs +-- | @since 1.1+instance (Integral i, Serial m i) => Serial m (Ratio i) where+ series = pairToRatio <$> series+ where+ pairToRatio (n, Positive d) = n % d+-- | @since 1.1+instance (Integral i, CoSerial m i) => CoSerial m (Ratio i) where+ coseries rs = (. ratioToPair) <$> coseries rs+ where+ ratioToPair r = (numerator r, denominator r)+ instance Monad m => Serial m Char where series = generate $ \d -> take (d+1) ['a'..'z'] instance Monad m => CoSerial m Char where@@ -498,6 +837,20 @@ instance (CoSerial m a, CoSerial m b, CoSerial m c, CoSerial m d) => CoSerial m (a,b,c,d) where coseries rs = uncurry4 <$> alts4 rs +-- | @since 1.2.0+instance (Serial m a, Serial m b, Serial m c, Serial m d, Serial m e) => Serial m (a,b,c,d,e) where+ series = cons5 (,,,,)+-- | @since 1.2.0+instance (CoSerial m a, CoSerial m b, CoSerial m c, CoSerial m d, CoSerial m e) => CoSerial m (a,b,c,d,e) where+ coseries rs = uncurry5 <$> alts5 rs++-- | @since 1.2.0+instance (Serial m a, Serial m b, Serial m c, Serial m d, Serial m e, Serial m f) => Serial m (a,b,c,d,e,f) where+ series = cons6 (,,,,,)+-- | @since 1.2.0+instance (CoSerial m a, CoSerial m b, CoSerial m c, CoSerial m d, CoSerial m e, CoSerial m f) => CoSerial m (a,b,c,d,e,f) where+ coseries rs = uncurry6 <$> alts6 rs+ instance Monad m => Serial m Bool where series = cons0 True \/ cons0 False instance Monad m => CoSerial m Bool where@@ -506,6 +859,20 @@ rs >>- \r2 -> return $ \x -> if x then r1 else r2 +-- | @since 1.2.1+instance Monad m => Serial m Ordering where+ series = cons0 LT \/ cons0 EQ \/ cons0 GT+-- | @since 1.2.1+instance Monad m => CoSerial m Ordering where+ coseries rs =+ rs >>- \r1 ->+ rs >>- \r2 ->+ rs >>- \r3 ->+ pure $ \x -> case x of+ LT -> r1+ EQ -> r2+ GT -> r3+ instance (Serial m a) => Serial m (Maybe a) where series = cons0 Nothing \/ cons1 Just instance (CoSerial m a) => CoSerial m (Maybe a) where@@ -526,6 +893,44 @@ alts2 rs >>- \f -> return $ \xs -> case xs of [] -> y; x:xs' -> f x xs' +-- | @since 1.2.0+instance Serial m a => Serial m (NE.NonEmpty a) where+ series = cons2 (NE.:|)++-- | @since 1.2.0+instance CoSerial m a => CoSerial m (NE.NonEmpty a) where+ coseries rs =+ alts2 rs >>- \f ->+ return $ \(x NE.:| xs') -> f x xs'++#if MIN_VERSION_base(4,4,0)+-- | @since 1.2.0+instance Serial m a => Serial m (Complex a) where+#else+-- | @since 1.2.0+instance (RealFloat a, Serial m a) => Serial m (Complex a) where+#endif+ series = cons2 (:+)++#if MIN_VERSION_base(4,4,0)+-- | @since 1.2.0+instance CoSerial m a => CoSerial m (Complex a) where+#else+-- | @since 1.2.0+instance (RealFloat a, CoSerial m a) => CoSerial m (Complex a) where+#endif+ coseries rs =+ alts2 rs >>- \f ->+ return $ \(x :+ xs') -> f x xs'++-- | @since 1.2.0+instance Monad m => Serial m Void where+ series = mzero++-- | @since 1.2.0+instance Monad m => CoSerial m Void where+ coseries = const $ return absurd+ instance (CoSerial m a, Serial m b) => Serial m (a->b) where series = coseries series -- Thanks to Ralf Hinze for the definition of coseries@@ -550,13 +955,13 @@ -- show the extension of a function (in part, bounded both by -- the number and depth of arguments)-instance (Serial Identity a, Show a, Show b) => Show (a->b) where+instance (Serial Identity a, Show a, Show b) => Show (a -> b) where show f = if maxarheight == 1 && sumarwidth + length ars * length "->;" < widthLimit then- "{"++(- concat $ intersperse ";" $ [a++"->"++r | (a,r) <- ars]- )++"}"+ "{"+++ intercalate ";" [a++"->"++r | (a,r) <- ars]+ ++"}" else concat $ [a++"->\n"++indent r | (a,r) <- ars] where@@ -570,6 +975,13 @@ height = length . lines (widthLimit,lengthLimit,depthLimit) = (80,20,3)::(Int,Int,Depth) +-- | @since 1.2.0+instance (Monad m, Serial m (f (g a))) => Serial m (Compose f g a) where+ series = Compose <$> series+-- | @since 1.2.0+instance (Monad m, CoSerial m (f (g a))) => CoSerial m (Compose f g a) where+ coseries = fmap (. getCompose) . coseries+ -- }}} ------------------------------@@ -578,24 +990,333 @@ -- {{{ ----------------------------------------------------------------------------- | @Positive x@: guarantees that @x \> 0@.+-- | 'Positive' @x@ guarantees that \( x > 0 \).+--+-- @since 1.0 newtype Positive a = Positive { getPositive :: a }- deriving (Eq, Ord, Num, Integral, Real, Enum)+ deriving+ ( Eq+ , Ord+ , Functor -- ^ @since 1.2.0+ , Foldable -- ^ @since 1.2.0+ , Traversable -- ^ @since 1.2.0+ ) +instance Real a => Real (Positive a) where+ toRational (Positive x) = toRational x++-- | @since 1.2.0+instance (Num a, Bounded a) => Bounded (Positive a) where+ minBound = Positive 1+ maxBound = Positive (maxBound :: a)++instance Enum a => Enum (Positive a) where+ toEnum x = Positive (toEnum x)+ fromEnum (Positive x) = fromEnum x++instance Num a => Num (Positive a) where+ Positive x + Positive y = Positive (x + y)+ Positive x * Positive y = Positive (x * y)+ negate (Positive x) = Positive (negate x)+ abs (Positive x) = Positive (abs x)+ signum (Positive x) = Positive (signum x)+ fromInteger x = Positive (fromInteger x)++instance Integral a => Integral (Positive a) where+ quotRem (Positive x) (Positive y) = (Positive q, Positive r)+ where+ (q, r) = x `quotRem` y+ toInteger (Positive x) = toInteger x+ instance (Num a, Ord a, Serial m a) => Serial m (Positive a) where series = Positive <$> series `suchThat` (> 0) instance Show a => Show (Positive a) where showsPrec n (Positive x) = showsPrec n x --- | @NonNegative x@: guarantees that @x \>= 0@.+-- | 'NonNegative' @x@ guarantees that \( x \ge 0 \).+--+-- @since 1.0 newtype NonNegative a = NonNegative { getNonNegative :: a }- deriving (Eq, Ord, Num, Integral, Real, Enum)+ deriving+ ( Eq+ , Ord+ , Functor -- ^ @since 1.2.0+ , Foldable -- ^ @since 1.2.0+ , Traversable -- ^ @since 1.2.0+ ) +instance Real a => Real (NonNegative a) where+ toRational (NonNegative x) = toRational x++-- | @since 1.2.0+instance (Num a, Bounded a) => Bounded (NonNegative a) where+ minBound = NonNegative 0+ maxBound = NonNegative (maxBound :: a)++instance Enum a => Enum (NonNegative a) where+ toEnum x = NonNegative (toEnum x)+ fromEnum (NonNegative x) = fromEnum x++instance Num a => Num (NonNegative a) where+ NonNegative x + NonNegative y = NonNegative (x + y)+ NonNegative x * NonNegative y = NonNegative (x * y)+ negate (NonNegative x) = NonNegative (negate x)+ abs (NonNegative x) = NonNegative (abs x)+ signum (NonNegative x) = NonNegative (signum x)+ fromInteger x = NonNegative (fromInteger x)++instance Integral a => Integral (NonNegative a) where+ quotRem (NonNegative x) (NonNegative y) = (NonNegative q, NonNegative r)+ where+ (q, r) = x `quotRem` y+ toInteger (NonNegative x) = toInteger x+ instance (Num a, Ord a, Serial m a) => Serial m (NonNegative a) where series = NonNegative <$> series `suchThat` (>= 0) instance Show a => Show (NonNegative a) where showsPrec n (NonNegative x) = showsPrec n x++-- | 'NonZero' @x@ guarantees that \( x \ne 0 \).+--+-- @since 1.2.0+newtype NonZero a = NonZero { getNonZero :: a }+ deriving (Eq, Ord, Functor, Foldable, Traversable)++instance Real a => Real (NonZero a) where+ toRational (NonZero x) = toRational x++instance (Eq a, Num a, Bounded a) => Bounded (NonZero a) where+ minBound = let x = minBound in NonZero (if x == 0 then 1 else x)+ maxBound = let x = maxBound in NonZero (if x == 0 then -1 else x)++instance Enum a => Enum (NonZero a) where+ toEnum x = NonZero (toEnum x)+ fromEnum (NonZero x) = fromEnum x++instance Num a => Num (NonZero a) where+ NonZero x + NonZero y = NonZero (x + y)+ NonZero x * NonZero y = NonZero (x * y)+ negate (NonZero x) = NonZero (negate x)+ abs (NonZero x) = NonZero (abs x)+ signum (NonZero x) = NonZero (signum x)+ fromInteger x = NonZero (fromInteger x)++instance Integral a => Integral (NonZero a) where+ quotRem (NonZero x) (NonZero y) = (NonZero q, NonZero r)+ where+ (q, r) = x `quotRem` y+ toInteger (NonZero x) = toInteger x++instance (Num a, Ord a, Serial m a) => Serial m (NonZero a) where+ series = NonZero <$> series `suchThat` (/= 0)++instance Show a => Show (NonZero a) where+ showsPrec n (NonZero x) = showsPrec n x++-- | 'NonEmpty' @xs@ guarantees that @xs@ is not null.+--+-- @since 1.1+newtype NonEmpty a = NonEmpty { getNonEmpty :: [a] }++instance (Serial m a) => Serial m (NonEmpty a) where+ series = NonEmpty <$> cons2 (:)++instance Show a => Show (NonEmpty a) where+ showsPrec n (NonEmpty x) = showsPrec n x++-- }}}++------------------------------+-- Foreign.C.Types+------------------------------+-- {{{++#if MIN_VERSION_base(4,5,0)+-- | @since 1.2.0+instance Monad m => Serial m CFloat where+ series = newtypeCons CFloat+-- | @since 1.2.0+instance Monad m => CoSerial m CFloat where+ coseries rs = newtypeAlts rs >>- \f -> return $ \l -> case l of CFloat x -> f x++-- | @since 1.2.0+instance Monad m => Serial m CDouble where+ series = newtypeCons CDouble+-- | @since 1.2.0+instance Monad m => CoSerial m CDouble where+ coseries rs = newtypeAlts rs >>- \f -> return $ \l -> case l of CDouble x -> f x++#if HASCBOOL+-- | @since 1.2.0+instance Monad m => Serial m CBool where+ series = newtypeCons CBool+-- | @since 1.2.0+instance Monad m => CoSerial m CBool where+ coseries rs = newtypeAlts rs >>- \f -> return $ \l -> case l of CBool x -> f x+#endif++-- | @since 1.2.0+instance Monad m => Serial m CChar where+ series = newtypeCons CChar+-- | @since 1.2.0+instance Monad m => CoSerial m CChar where+ coseries rs = newtypeAlts rs >>- \f -> return $ \l -> case l of CChar x -> f x++-- | @since 1.2.0+instance Monad m => Serial m CSChar where+ series = newtypeCons CSChar+-- | @since 1.2.0+instance Monad m => CoSerial m CSChar where+ coseries rs = newtypeAlts rs >>- \f -> return $ \l -> case l of CSChar x -> f x++-- | @since 1.2.0+instance Monad m => Serial m CUChar where+ series = newtypeCons CUChar+-- | @since 1.2.0+instance Monad m => CoSerial m CUChar where+ coseries rs = newtypeAlts rs >>- \f -> return $ \l -> case l of CUChar x -> f x++-- | @since 1.2.0+instance Monad m => Serial m CShort where+ series = newtypeCons CShort+-- | @since 1.2.0+instance Monad m => CoSerial m CShort where+ coseries rs = newtypeAlts rs >>- \f -> return $ \l -> case l of CShort x -> f x++-- | @since 1.2.0+instance Monad m => Serial m CUShort where+ series = newtypeCons CUShort+-- | @since 1.2.0+instance Monad m => CoSerial m CUShort where+ coseries rs = newtypeAlts rs >>- \f -> return $ \l -> case l of CUShort x -> f x++-- | @since 1.2.0+instance Monad m => Serial m CInt where+ series = newtypeCons CInt+-- | @since 1.2.0+instance Monad m => CoSerial m CInt where+ coseries rs = newtypeAlts rs >>- \f -> return $ \l -> case l of CInt x -> f x++-- | @since 1.2.0+instance Monad m => Serial m CUInt where+ series = newtypeCons CUInt+-- | @since 1.2.0+instance Monad m => CoSerial m CUInt where+ coseries rs = newtypeAlts rs >>- \f -> return $ \l -> case l of CUInt x -> f x++-- | @since 1.2.0+instance Monad m => Serial m CLong where+ series = newtypeCons CLong+-- | @since 1.2.0+instance Monad m => CoSerial m CLong where+ coseries rs = newtypeAlts rs >>- \f -> return $ \l -> case l of CLong x -> f x++-- | @since 1.2.0+instance Monad m => Serial m CULong where+ series = newtypeCons CULong+-- | @since 1.2.0+instance Monad m => CoSerial m CULong where+ coseries rs = newtypeAlts rs >>- \f -> return $ \l -> case l of CULong x -> f x++-- | @since 1.2.0+instance Monad m => Serial m CPtrdiff where+ series = newtypeCons CPtrdiff+-- | @since 1.2.0+instance Monad m => CoSerial m CPtrdiff where+ coseries rs = newtypeAlts rs >>- \f -> return $ \l -> case l of CPtrdiff x -> f x++-- | @since 1.2.0+instance Monad m => Serial m CSize where+ series = newtypeCons CSize+-- | @since 1.2.0+instance Monad m => CoSerial m CSize where+ coseries rs = newtypeAlts rs >>- \f -> return $ \l -> case l of CSize x -> f x++-- | @since 1.2.0+instance Monad m => Serial m CWchar where+ series = newtypeCons CWchar+-- | @since 1.2.0+instance Monad m => CoSerial m CWchar where+ coseries rs = newtypeAlts rs >>- \f -> return $ \l -> case l of CWchar x -> f x++-- | @since 1.2.0+instance Monad m => Serial m CSigAtomic where+ series = newtypeCons CSigAtomic+-- | @since 1.2.0+instance Monad m => CoSerial m CSigAtomic where+ coseries rs = newtypeAlts rs >>- \f -> return $ \l -> case l of CSigAtomic x -> f x++-- | @since 1.2.0+instance Monad m => Serial m CLLong where+ series = newtypeCons CLLong+-- | @since 1.2.0+instance Monad m => CoSerial m CLLong where+ coseries rs = newtypeAlts rs >>- \f -> return $ \l -> case l of CLLong x -> f x++-- | @since 1.2.0+instance Monad m => Serial m CULLong where+ series = newtypeCons CULLong+-- | @since 1.2.0+instance Monad m => CoSerial m CULLong where+ coseries rs = newtypeAlts rs >>- \f -> return $ \l -> case l of CULLong x -> f x++-- | @since 1.2.0+instance Monad m => Serial m CIntPtr where+ series = newtypeCons CIntPtr+-- | @since 1.2.0+instance Monad m => CoSerial m CIntPtr where+ coseries rs = newtypeAlts rs >>- \f -> return $ \l -> case l of CIntPtr x -> f x++-- | @since 1.2.0+instance Monad m => Serial m CUIntPtr where+ series = newtypeCons CUIntPtr+-- | @since 1.2.0+instance Monad m => CoSerial m CUIntPtr where+ coseries rs = newtypeAlts rs >>- \f -> return $ \l -> case l of CUIntPtr x -> f x++-- | @since 1.2.0+instance Monad m => Serial m CIntMax where+ series = newtypeCons CIntMax+-- | @since 1.2.0+instance Monad m => CoSerial m CIntMax where+ coseries rs = newtypeAlts rs >>- \f -> return $ \l -> case l of CIntMax x -> f x++-- | @since 1.2.0+instance Monad m => Serial m CUIntMax where+ series = newtypeCons CUIntMax+-- | @since 1.2.0+instance Monad m => CoSerial m CUIntMax where+ coseries rs = newtypeAlts rs >>- \f -> return $ \l -> case l of CUIntMax x -> f x++-- | @since 1.2.0+instance Monad m => Serial m CClock where+ series = newtypeCons CClock+-- | @since 1.2.0+instance Monad m => CoSerial m CClock where+ coseries rs = newtypeAlts rs >>- \f -> return $ \l -> case l of CClock x -> f x++-- | @since 1.2.0+instance Monad m => Serial m CTime where+ series = newtypeCons CTime+-- | @since 1.2.0+instance Monad m => CoSerial m CTime where+ coseries rs = newtypeAlts rs >>- \f -> return $ \l -> case l of CTime x -> f x++-- | @since 1.2.0+instance Monad m => Serial m CUSeconds where+ series = newtypeCons CUSeconds+-- | @since 1.2.0+instance Monad m => CoSerial m CUSeconds where+ coseries rs = newtypeAlts rs >>- \f -> return $ \l -> case l of CUSeconds x -> f x++-- | @since 1.2.0+instance Monad m => Serial m CSUSeconds where+ series = newtypeCons CSUSeconds+-- | @since 1.2.0+instance Monad m => CoSerial m CSUSeconds where+ coseries rs = newtypeAlts rs >>- \f -> return $ \l -> case l of CSUSeconds x -> f x+#endif -- }}}
Test/SmallCheck/SeriesMonad.hs view
@@ -1,11 +1,19 @@-{-# LANGUAGE Trustworthy #-} -- GeneralizedNewtypeDeriving-{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE NoImplicitPrelude #-}+#if __GLASGOW_HASKELL__ >= 704+{-# LANGUAGE Safe #-}+#endif+ module Test.SmallCheck.SeriesMonad where -import Control.Applicative-import Control.Monad-import Control.Monad.Logic-import Control.Monad.Reader+import Control.Applicative (Applicative, Alternative, (<$>), pure, (<*>), empty, (<|>))+import Control.Arrow (second)+import Control.Monad (Monad, (>>=), return, MonadPlus, mzero, mplus)+import Control.Monad.Logic (MonadLogic, LogicT, msplit)+import Control.Monad.Reader (MonadTrans, ReaderT, runReaderT, lift)+import Data.Function ((.), ($))+import Data.Functor (Functor, fmap)+import Data.Int (Int) -- | Maximum depth of generated test values. --@@ -13,32 +21,54 @@ -- -- For functional values, it is both the depth of nested case analysis -- and the depth of results.+--+-- @since 0.6 type Depth = Int -- | 'Series' is a `MonadLogic` action that enumerates values of a certain -- type, up to some depth. ----- The depth bound is tracked in the 'SC' monad and can be extracted using--- 'getDepth' and changed using 'localDepth'.+-- The depth bound is tracked in the 'Series' monad and can be extracted using+-- 'Test.SmallCheck.Series.getDepth' and changed using 'Test.SmallCheck.Series.localDepth'. -- -- To manipulate series at the lowest level you can use its 'Monad', -- 'MonadPlus' and 'MonadLogic' instances. This module provides some -- higher-level combinators which simplify creating series. -- -- A proper 'Series' should be monotonic with respect to the depth — i.e.--- @localDepth (+1) s@ should emit all the values that @s@ emits (and+-- 'Test.SmallCheck.Series.localDepth' @(+1)@ @s@ should emit all the values that @s@ emits (and -- possibly some more). -- -- It is also desirable that values of smaller depth come before the values -- of greater depth.+--+-- @since 1.0 newtype Series m a = Series (ReaderT Depth (LogicT m) a)- deriving- ( Functor- , Monad- , Applicative- , MonadPlus- , Alternative- , MonadLogic)++instance Functor (Series m) where+ fmap f (Series x) = Series (fmap f x)++instance Monad (Series m) where+ Series x >>= f = Series (x >>= unSeries . f)+ where+ unSeries (Series y) = y+ return = pure++instance Applicative (Series m) where+ pure = Series . pure+ Series x <*> Series y = Series (x <*> y)++instance MonadPlus (Series m) where+ mzero = empty+ mplus = (<|>)++instance Alternative (Series m) where+ empty = Series empty+ Series x <|> Series y = Series (x <|> y)++-- This instance is written manually. Using the GND for it is not safe.+instance Monad m => MonadLogic (Series m) where+ msplit (Series a) = Series (fmap (second Series) <$> msplit a) instance MonadTrans Series where lift a = Series $ lift . lift $ a
smallcheck.cabal view
@@ -1,43 +1,70 @@-Name: smallcheck-Version: 1.0.4-Cabal-Version: >= 1.6-License: BSD3-License-File: LICENSE-Author: Colin Runciman, Roman Cheplyaka-Maintainer: Roman Cheplyaka <roma@ro-che.info>-Homepage: https://github.com/feuerbach/smallcheck-Bug-reports: https://github.com/feuerbach/smallcheck/issues+name: smallcheck+version: 1.2.1.1+license: BSD3+license-file: LICENSE+maintainer: Andrew Lelechenko <andrew.lelechenko@gmail.com>+author: Colin Runciman, Roman Cheplyaka+cabal-version: >=1.10+tested-with:+ ghc ==9.6.1 ghc ==9.4.5+ ghc ==9.2.7 ghc ==9.0.2 ghc ==8.10.7 ghc ==8.8.4 ghc ==8.6.5 ghc ==8.4.4 ghc ==8.2.2+ ghc ==8.0.2 ghc ==7.10.3 ghc ==7.8.4 ghc ==7.6.3 ghc ==7.4.2 ghc ==7.2.2 ghc ==7.0.4 -Stability: Beta-Category: Testing-Synopsis: A property-based testing library-Description: SmallCheck is a testing library that allows to verify properties- for all test cases up to some depth. The test cases are generated- automatically by SmallCheck.-Build-Type: Simple+homepage: https://github.com/Bodigrim/smallcheck+bug-reports: https://github.com/Bodigrim/smallcheck/issues+synopsis: A property-based testing library+description:+ As of 2023, this library is largely obsolete: arbitrary test generators+ with shrinking such as [falsify](https://hackage.haskell.org/package/falsify)+ offer much better user experience.+ .+ SmallCheck is a testing library that allows to verify properties+ for all test cases up to some depth. The test cases are generated+ automatically by SmallCheck. -Extra-source-files: README.md, CREDITS.md, CHANGES.md+category: Testing+build-type: Simple+extra-source-files:+ README.md+ CREDITS.md+ CHANGELOG.md +source-repository head+ type: git+ location: git://github.com/Bodigrim/smallcheck.git +library+ default-language: Haskell2010 -Source-repository head- type: git- location: git://github.com/feuerbach/smallcheck.git+ exposed-modules:+ Test.SmallCheck+ Test.SmallCheck.Drivers+ Test.SmallCheck.Series -Source-repository this- type: git- location: git://github.com/feuerbach/smallcheck.git- tag: v1.0.4+ other-modules:+ Test.SmallCheck.Property+ Test.SmallCheck.SeriesMonad+ Test.SmallCheck.Property.Result -Library+ build-depends:+ base >=4.3 && <5,+ mtl <2.4,+ logict >=0.5 && <0.9,+ pretty <1.2 - Build-Depends: base == 4.*, mtl, logict, ghc-prim >= 0.2, pretty+ if impl(ghc <8.0)+ build-depends:+ semigroups <0.21,+ transformers <0.7 - Exposed-modules:- Test.SmallCheck- Test.SmallCheck.Drivers- Test.SmallCheck.Series- Other-modules:- Test.SmallCheck.Property- Test.SmallCheck.SeriesMonad- Test.SmallCheck.Property.Result+ if impl(ghc <7.10)+ build-depends:+ nats <1.2,+ void <0.8++ if impl(ghc <7.6)+ build-depends:+ ghc-prim >=0.2 && <1++ if impl(ghc >= 8.0)+ ghc-options: -Wcompat