packages feed

smallcheck 1.1.7 → 1.2.1.1

raw patch · 9 files changed

Files

CHANGELOG.md view
@@ -1,6 +1,31 @@ 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 ------------- @@ -17,7 +42,7 @@ * 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 avaialable as the default method for `series`/`coseries` but not as+  only available as the default method for `series`/`coseries` but not as   standalone functions.  Version 1.1.4
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/package/smallcheck/docs/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/Bodigrim/smallcheck/wiki/Comparison-with-QuickCheck-[github]: https://github.com/Bodigrim/smallcheck-[issues]: https://github.com/Bodigrim/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
@@ -15,13 +15,17 @@ -- <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.   --@@ -31,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',@@ -48,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,
Test/SmallCheck/Drivers.hs view
@@ -9,8 +9,12 @@ -- run SmallCheck tests -------------------------------------------------------------------- +{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE Safe             #-}+{-# LANGUAGE NoImplicitPrelude #-}+#if __GLASGOW_HASKELL__ >= 704+{-# LANGUAGE Safe #-}+#endif  module Test.SmallCheck.Drivers (   smallCheck, smallCheckM, smallCheckWithHook,@@ -19,14 +23,21 @@   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 (printf)-import Data.IORef (readIORef, writeIORef, IORef, newIORef) -- NB: explicit import list to avoid name clash with modifyIORef'  -- | 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@@ -70,6 +81,8 @@ -- * 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 = smallCheckWithHook d (const $ return ()) @@ -78,5 +91,7 @@ -- -- 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
@@ -14,8 +14,10 @@ {-# 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)@@ -24,8 +26,10 @@ {-# LANGUAGE Safe #-} #else -- Trustworthy is needed because of the hand-written Typeable instance+#if __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE Trustworthy #-} #endif+#endif  module Test.SmallCheck.Property (   -- * Constructors@@ -37,26 +41,48 @@   PropertySuccess(..), PropertyFailure(..), runProperty, TestQuality(..), Argument, Reason, Depth, Testable(..),   ) where -import Test.SmallCheck.Series-import Test.SmallCheck.SeriesMonad-import Test.SmallCheck.Property.Result+import Control.Applicative (pure, (<$>), (<$)) import Control.Arrow (first)-import Control.Monad (liftM, mzero)+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 Control.Applicative (pure, (<$>), (<$))-import Data.Typeable (Typeable(..))+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 Text.Show (Show, show) +#if MIN_VERSION_base(4,17,0)+import Data.Type.Equality (type (~))+#endif+ #if !NEWTYPEABLE-import Data.Typeable (Typeable1, mkTyConApp, mkTyCon3, typeOf)+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@@ -80,6 +106,7 @@   | Exists   | ExistsUnique +-- | @since 1.0 data TestQuality   = GoodTest   | BadTest@@ -92,7 +119,11 @@   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 @@ -136,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 ->@@ -161,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@@ -174,10 +212,12 @@       failure = PropertyFalse Nothing <$ lnot success     in atomicProperty success failure --- | Works like the 'Bool' instance, but includes an explanation of the result.+-- | Works like the 'Data.Bool.Bool' instance, but includes an explanation of the result. ----- 'Left' and 'Right' correspond to test failure and success+-- '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@@ -286,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 @@ -317,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@@ -355,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@@ -367,6 +421,8 @@  -- | 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,5 +1,9 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE Safe              #-}+{-# LANGUAGE NoImplicitPrelude #-}+#if __GLASGOW_HASKELL__ >= 704+{-# LANGUAGE Safe #-}+#endif  module Test.SmallCheck.Property.Result   ( PropertySuccess(..)@@ -9,25 +13,38 @@   , Argument   ) where +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+-- | An explanation for the test outcome.+--+-- @since 1.1 type Reason = String +-- | @since 1.0 data PropertySuccess   = Exist [Argument] PropertySuccess   | ExistUnique [Argument] PropertySuccess-  | PropertyTrue (Maybe Reason)+  | 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 (Maybe Reason)+  | PropertyFalse (Maybe Reason) -- ^ @since 1.1   deriving (Eq, Show)  class Pretty a where@@ -82,5 +99,6 @@     _:_:_ -> pl     _ -> sing +-- | @since 1.0 ppFailure :: PropertyFailure -> String ppFailure = render . pretty
Test/SmallCheck/Series.hs view
@@ -24,10 +24,16 @@ --------------------------------------------------------------------  {-# 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         #-}@@ -36,9 +42,13 @@ {-# 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@@ -59,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.   --@@ -88,7 +98,7 @@   -- >instance Serial m a => Serial m (Light a) where   -- >  series = newtypeCons Light   ---  -- For data types with more than 4 fields define @consN@ as+  -- For data types with more than 6 fields define @consN@ as   --   -- >consN f = decDepth $   -- >  f <$> series@@ -96,32 +106,32 @@   -- >    <~> 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:   --@@ -142,7 +152,7 @@   -- >      case l of   -- >        Light x -> f x   ---  -- For data types with more than 4 fields define @altsN@ as+  -- For data types with more than 6 fields define @altsN@ as   --   -- >altsN rs = do   -- >  rs <- fixDepth rs@@ -154,32 +164,34 @@   -- ** 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(..), NonEmpty(..),+  Positive(..), NonNegative(..), NonZero(..), NonEmpty(..),    -- * Other useful definitions   (\/), (><), (<~>), (>>-),@@ -197,48 +209,90 @@   -- }}}   ) where -import Control.Monad (liftM, guard, mzero, mplus, msum)+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 Control.Applicative (empty, pure, (<$>))-import Control.Monad.Identity (Identity(..))+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)+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 (Generic, (:+:)(..), (:*:)(..), C1, K1(..), M1(..), U1(..), Rep, to, from)+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 = 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 = 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+ -- }}}  ------------------------------@@ -248,31 +302,36 @@  -- | 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+-- | 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 :: MonadLogic ml => Int -> ml b -> ml b-    go 0 _ = mzero+    go 0 _ = empty     go n mb1 = do       cons :: Maybe (b, ml b) <- msplit mb1       case cons of-        Nothing -> mzero-        Just (b, mb2) -> return b `mplus` go (n-1) mb2+        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.+-- | Given a depth, return the list of values generated by a 'Serial' instance. ----- Example, list all integers up to depth 1:+-- 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 @@ -281,31 +340,40 @@ -- -- Examples: ----- * @list 3 'series' :: [Int]                  -- returns [0,1,-1,2,-2,3,-3]@+-- * @'list' 3 'series' :: ['Int']                  -- returns [0,1,-1,2,-2,3,-3]@ ----- * @list 3 ('series' :: 'Series' 'Identity' 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]]@+-- * @'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 --- | Monadic version of 'list'-listM :: Monad m => Depth -> Series m a -> m [a]+-- | Monadic version of 'list'.+--+-- @since 1.1 listM d s = observeAllT $ runSeries d s --- | Sum (union) of series+-- | 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)@@ -316,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@@ -338,16 +418,22 @@   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@@ -367,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 $@@ -387,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 $@@ -395,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)@@ -412,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@@ -420,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@@ -428,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 @@ -444,6 +583,7 @@ class GCoSerial m f where   gCoseries :: Series m b -> Series m (f a -> b) +#if __GLASGOW_HASKELL__ >= 702 instance {-# OVERLAPPABLE #-} GSerial m f => GSerial m (M1 i c f) where   gSeries = M1 <$> gSeries   {-# INLINE gSeries #-}@@ -465,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 #-}@@ -490,6 +637,8 @@ instance {-# OVERLAPPING #-} GSerial m f => GSerial m (C1 c f) where   gSeries = M1 <$> decDepth gSeries   {-# INLINE gSeries #-}+#endif+ -- }}}  ------------------------------@@ -503,33 +652,64 @@  instance Monad m => Serial m Integer where series = unM <$> series instance Monad m => CoSerial m Integer where coseries = fmap (. M) . coseries++-- | @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 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 { unN :: a } deriving (Eq, Ord)+newtype N a = N { unN :: a } deriving (Eq, Ord, Show)  instance Real a => Real (N a) where   toRational (N x) = toRational x@@ -570,7 +750,7 @@         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)+newtype M a = M { unM :: a } deriving (Eq, Ord, Show)  instance Real a => Real (M a) where   toRational (M x) = toRational x@@ -624,10 +804,12 @@   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@@ -655,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@@ -663,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@@ -683,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@@ -727,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+ -- }}}  ------------------------------@@ -735,13 +990,26 @@ -- {{{  ----------------------------------------------------------------------------- | @Positive x@: guarantees that @x \> 0@.+-- | 'Positive' @x@ guarantees that \( x > 0 \).+--+-- @since 1.0 newtype Positive a = Positive { getPositive :: a }- deriving (Eq, Ord)+  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@@ -766,13 +1034,26 @@ 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)+  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@@ -797,7 +1078,46 @@ instance Show a => Show (NonNegative a) where   showsPrec n (NonNegative x) = showsPrec n x --- | @NonEmpty xs@: guarantees that @xs@ is not null+-- | '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@@ -805,5 +1125,198 @@  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,12 +1,19 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE NoImplicitPrelude #-}+#if __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE Safe #-}+#endif  module Test.SmallCheck.SeriesMonad where -import Control.Applicative (Applicative(..), Alternative(..), (<$>))-import Control.Monad (MonadPlus(..))-import Control.Monad.Logic (MonadLogic(..), LogicT)-import Control.Monad.Reader (MonadTrans(..), ReaderT, runReaderT)+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. --@@ -14,24 +21,28 @@ -- -- 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)  instance Functor (Series m) where
smallcheck.cabal view
@@ -1,18 +1,23 @@ name:               smallcheck-version:            1.1.7+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 ==8.10.1 ghc ==8.8.3 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 ==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  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.@@ -42,13 +47,24 @@     Test.SmallCheck.Property.Result    build-depends:-    base >=4.5 && <5,-    mtl,-    logict,-    pretty+    base >=4.3 && <5,+    mtl <2.4,+    logict >=0.5 && <0.9,+    pretty <1.2 +  if impl(ghc <8.0)+    build-depends:+      semigroups <0.21,+      transformers <0.7+   if impl(ghc <7.10)-    build-depends: nats+    build-depends:+      nats <1.2,+      void <0.8    if impl(ghc <7.6)-    build-depends: ghc-prim >=0.2+    build-depends:+      ghc-prim >=0.2 && <1++  if impl(ghc >= 8.0)+    ghc-options:    -Wcompat