Hello community, here is the log from the commit of package ghc-smallcheck for openSUSE:Factory checked in at 2020-09-07 21:22:41 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-smallcheck (Old) and /work/SRC/openSUSE:Factory/.ghc-smallcheck.new.3399 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-smallcheck" Mon Sep 7 21:22:41 2020 rev:7 rq:831226 version:1.2.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-smallcheck/ghc-smallcheck.changes 2019-12-27 13:57:31.644778879 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-smallcheck.new.3399/ghc-smallcheck.changes 2020-09-07 21:22:44.289033139 +0200 @@ -1,0 +2,29 @@ +Tue Sep 1 14:41:30 UTC 2020 - [email protected] + +- Update smallcheck to version 1.2.0. + 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`. + +------------------------------------------------------------------- Old: ---- smallcheck-1.1.5.tar.gz New: ---- smallcheck-1.2.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-smallcheck.spec ++++++ --- /var/tmp/diff_new_pack.wE6lPI/_old 2020-09-07 21:22:45.457033675 +0200 +++ /var/tmp/diff_new_pack.wE6lPI/_new 2020-09-07 21:22:45.461033677 +0200 @@ -1,7 +1,7 @@ # # spec file for package ghc-smallcheck # -# Copyright (c) 2019 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2020 SUSE LLC # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -18,7 +18,7 @@ %global pkg_name smallcheck Name: ghc-%{pkg_name} -Version: 1.1.5 +Version: 1.2.0 Release: 0 Summary: A property-based testing library License: BSD-3-Clause @@ -46,7 +46,7 @@ This package provides the Haskell %{pkg_name} library development files. %prep -%setup -q -n %{pkg_name}-%{version} +%autosetup -n %{pkg_name}-%{version} %build %ghc_lib_build ++++++ smallcheck-1.1.5.tar.gz -> smallcheck-1.2.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/smallcheck-1.1.5/CHANGELOG.md new/smallcheck-1.2.0/CHANGELOG.md --- old/smallcheck-1.1.5/CHANGELOG.md 2018-07-05 10:17:01.000000000 +0200 +++ new/smallcheck-1.2.0/CHANGELOG.md 2020-06-15 00:31:09.000000000 +0200 @@ -1,6 +1,31 @@ Changes ======= +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 ------------- diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/smallcheck-1.1.5/README.md new/smallcheck-1.2.0/README.md --- old/smallcheck-1.1.5/README.md 2017-08-08 18:25:03.000000000 +0200 +++ new/smallcheck-1.2.0/README.md 2020-06-10 23:35:08.000000000 +0200 @@ -14,25 +14,17 @@ * 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! +* 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 -[haddock]: http://hackage.haskell.org/packages/archive/smallcheck/latest/doc/html/Test-SmallCheck.html +[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/feuerbach/smallcheck/wiki/Comparison-with-QuickCheck -[github]: https://github.com/feuerbach/smallcheck -[issues]: https://github.com/feuerbach/smallcheck/issues - -Maintainers ------------ - -[Roman Cheplyaka](https://github.com/feuerbach) is the primary maintainer. - -[Oliver Charles](https://github.com/ocharles) is the backup maintainer. Please -get in touch with him if the primary maintainer cannot be reached. +[comparison]: https://github.com/Bodigrim/smallcheck/wiki/Comparison-with-QuickCheck +[github]: https://github.com/Bodigrim/smallcheck +[issues]: https://github.com/Bodigrim/smallcheck/issues diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/smallcheck-1.1.5/Test/SmallCheck/Drivers.hs new/smallcheck-1.2.0/Test/SmallCheck/Drivers.hs --- old/smallcheck-1.1.5/Test/SmallCheck/Drivers.hs 2017-08-08 18:19:53.000000000 +0200 +++ new/smallcheck-1.2.0/Test/SmallCheck/Drivers.hs 2020-06-10 23:14:57.000000000 +0200 @@ -8,8 +8,10 @@ -- You should only need this module if you wish to create your own way to -- run SmallCheck tests -------------------------------------------------------------------- + {-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE Safe #-} +{-# LANGUAGE Safe #-} + module Test.SmallCheck.Drivers ( smallCheck, smallCheckM, smallCheckWithHook, test, @@ -20,7 +22,7 @@ import Control.Monad (when) import Test.SmallCheck.Property import Test.SmallCheck.Property.Result -import Text.Printf +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 @@ -31,11 +33,11 @@ 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) @@ -69,7 +71,7 @@ -- -- * You need to analyse the results rather than just print them 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. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/smallcheck-1.1.5/Test/SmallCheck/Property/Result.hs new/smallcheck-1.2.0/Test/SmallCheck/Property/Result.hs --- old/smallcheck-1.1.5/Test/SmallCheck/Property/Result.hs 2017-08-08 18:19:53.000000000 +0200 +++ new/smallcheck-1.2.0/Test/SmallCheck/Property/Result.hs 2020-06-10 23:14:57.000000000 +0200 @@ -1,5 +1,6 @@ -{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, DefaultSignatures #-} -{-# LANGUAGE Safe #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE Safe #-} + module Test.SmallCheck.Property.Result ( PropertySuccess(..) , PropertyFailure(..) @@ -8,7 +9,7 @@ , Argument ) where -import Text.PrettyPrint +import Text.PrettyPrint (Doc, empty, hsep, nest, render, text, (<+>), ($+$), ($$)) type Argument = String @@ -40,13 +41,13 @@ 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 f pretty (PropertyFalse Nothing) = text "condition is false" pretty (PropertyFalse (Just s)) = text s diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/smallcheck-1.1.5/Test/SmallCheck/Property.hs new/smallcheck-1.2.0/Test/SmallCheck/Property.hs --- old/smallcheck-1.1.5/Test/SmallCheck/Property.hs 2017-08-08 18:19:53.000000000 +0200 +++ new/smallcheck-1.2.0/Test/SmallCheck/Property.hs 2020-06-10 23:14:57.000000000 +0200 @@ -9,11 +9,13 @@ -- -- Properties and tools to construct them. -------------------------------------------------------------------- -{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeFamilies, - ScopedTypeVariables, DeriveDataTypeable #-} --- CPP is for Typeable1 vs Typeable -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} -- Are we using new, polykinded and derivable Typeable yet? #define NEWTYPEABLE MIN_VERSION_base(4,7,0) @@ -24,6 +26,7 @@ -- Trustworthy is needed because of the hand-written Typeable instance {-# LANGUAGE Trustworthy #-} #endif + module Test.SmallCheck.Property ( -- * Constructors forAll, exists, existsUnique, over, (==>), monadic, changeDepth, changeDepth1, @@ -37,11 +40,16 @@ 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 Control.Arrow (first) +import Control.Monad (liftM, mzero) +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(..)) + +#if !NEWTYPEABLE +import Data.Typeable (Typeable1, mkTyConApp, mkTyCon3, typeOf) +#endif ------------------------------ -- Property-related types @@ -354,7 +362,7 @@ 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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/smallcheck-1.1.5/Test/SmallCheck/Series.hs new/smallcheck-1.2.0/Test/SmallCheck/Series.hs --- old/smallcheck-1.1.5/Test/SmallCheck/Series.hs 2018-06-04 16:34:44.000000000 +0200 +++ new/smallcheck-1.2.0/Test/SmallCheck/Series.hs 2020-06-14 16:32:27.000000000 +0200 @@ -23,12 +23,26 @@ -- the instances by hand. -------------------------------------------------------------------- -{-# LANGUAGE CPP, RankNTypes, MultiParamTypeClasses, FlexibleInstances, - GeneralizedNewtypeDeriving, FlexibleContexts, ScopedTypeVariables #-} --- The following is needed for generic instances -{-# LANGUAGE DefaultSignatures, FlexibleContexts, TypeOperators, - TypeSynonymInstances, FlexibleInstances, OverlappingInstances #-} -{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE DeriveFoldable #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeOperators #-} + +#if MIN_VERSION_base(4,8,0) +{-# LANGUAGE Safe #-} +#else +{-# LANGUAGE OverlappingInstances #-} +{-# LANGUAGE Trustworthy #-} +#endif + +#define HASCBOOL MIN_VERSION_base(4,10,0) module Test.SmallCheck.Series ( -- {{{ @@ -79,7 +93,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 @@ -106,7 +120,7 @@ -- -- If @d <= 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, @@ -133,7 +147,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 @@ -160,7 +174,7 @@ -- 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(..), @@ -170,7 +184,7 @@ genericCoseries, -- * Convenient wrappers - Positive(..), NonNegative(..), NonEmpty(..), + Positive(..), NonNegative(..), NonZero(..), NonEmpty(..), -- * Other useful definitions (\/), (><), (<~>), (>>-), @@ -188,17 +202,28 @@ -- }}} ) where -import Control.Monad.Logic -import Control.Monad.Reader -import Control.Applicative -import Control.Monad.Identity +import Control.Monad (liftM, guard, mzero, mplus, msum) +import Control.Monad.Logic (MonadLogic, (>>-), interleave, msplit, observeAllT) +import Control.Monad.Reader (ask, local) +import Control.Applicative (empty, pure, (<$>)) +import Data.Complex (Complex(..)) +import Data.Foldable (Foldable) +import Data.Functor.Compose (Compose(..)) +import Data.Void (Void, absurd) +import Control.Monad.Identity (Identity(..)) import Data.Int (Int, Int8, Int16, Int32, Int64) -import Data.List -import Data.Ratio +import Data.List (intercalate) +import qualified Data.List.NonEmpty as NE +import Data.Ratio (Ratio, numerator, denominator, (%)) +import Data.Traversable (Traversable) import Data.Word (Word, Word8, Word16, Word32, Word64) +import Foreign.C.Types (CFloat(..), CDouble(..), CChar(..), CSChar(..), CUChar(..), CShort(..), CUShort(..), CInt(..), CUInt(..), CLong(..), CULong(..), CPtrdiff(..), CSize(..), CWchar(..), CSigAtomic(..), CLLong(..), CULLong(..), CIntPtr(..), CUIntPtr(..), CIntMax(..), CUIntMax(..), CClock(..), CTime(..), CUSeconds(..), CSUSeconds(..)) +#if HASCBOOL +import Foreign.C.Types (CBool(..)) +#endif import Numeric.Natural (Natural) import Test.SmallCheck.SeriesMonad -import GHC.Generics +import GHC.Generics (Generic, (:+:)(..), (:*:)(..), C1, K1(..), M1(..), U1(..), V1(..), Rep, to, from) ------------------------------ -- Main types and classes @@ -306,6 +331,12 @@ uncurry4 :: (a->b->c->d->e) -> ((a,b,c,d)->e) uncurry4 f (w,x,y,z) = f w x y z +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 getDepth :: Series m Depth getDepth = Series ask @@ -385,6 +416,25 @@ <~> series <~> series +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 + +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 + alts0 :: Series m a -> Series m a alts0 s = s @@ -418,6 +468,22 @@ (constM $ constM $ constM $ constM rs) (coseries $ coseries $ coseries $ coseries rs) +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) + +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. newtypeAlts :: CoSerial m a => Series m b -> Series m (a->b) newtypeAlts = coseries @@ -434,7 +500,7 @@ 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 +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 @@ -455,6 +521,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 #-} @@ -477,7 +550,7 @@ 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 #-} -- }}} @@ -519,7 +592,28 @@ -- | '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, Real, Enum, Num, Integral) +newtype N a = N { unN :: a } deriving (Eq, Ord) + +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..] @@ -539,7 +633,28 @@ 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, Real, Enum, Num, Integral) +newtype M a = M { unM :: a } deriving (Eq, Ord) + +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 @@ -603,6 +718,16 @@ 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 +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 (,,,,) +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 + +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 (,,,,,) +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 @@ -631,6 +756,28 @@ alts2 rs >>- \f -> return $ \xs -> case xs of [] -> y; x:xs' -> f x xs' +instance Serial m a => Serial m (NE.NonEmpty a) where + series = cons2 (NE.:|) + +instance CoSerial m a => CoSerial m (NE.NonEmpty a) where + coseries rs = + alts2 rs >>- \f -> + return $ \(x NE.:| xs') -> f x xs' + +instance Serial m a => Serial m (Complex a) where + series = cons2 (:+) + +instance CoSerial m a => CoSerial m (Complex a) where + coseries rs = + alts2 rs >>- \f -> + return $ \(x :+ xs') -> f x xs' + +instance Monad m => Serial m Void where + series = mzero + +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 @@ -655,13 +802,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 @@ -675,6 +822,11 @@ height = length . lines (widthLimit,lengthLimit,depthLimit) = (80,20,3)::(Int,Int,Depth) +instance (Monad m, Serial m (f (g a))) => Serial m (Compose f g a) where + series = Compose <$> series +instance (Monad m, CoSerial m (f (g a))) => CoSerial m (Compose f g a) where + coseries = fmap (. getCompose) . coseries + -- }}} ------------------------------ @@ -685,7 +837,32 @@ -------------------------------------------------------------------------- -- | @Positive x@: guarantees that @x \> 0@. newtype Positive a = Positive { getPositive :: a } - deriving (Eq, Ord, Num, Integral, Real, Enum) + deriving (Eq, Ord, Functor, Foldable, Traversable) + +instance Real a => Real (Positive a) where + toRational (Positive x) = toRational x + +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) @@ -695,7 +872,32 @@ -- | @NonNegative x@: guarantees that @x \>= 0@. newtype NonNegative a = NonNegative { getNonNegative :: a } - deriving (Eq, Ord, Num, Integral, Real, Enum) + deriving (Eq, Ord, Functor, Foldable, Traversable) + +instance Real a => Real (NonNegative a) where + toRational (NonNegative x) = toRational x + +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) @@ -703,6 +905,41 @@ instance Show a => Show (NonNegative a) where showsPrec n (NonNegative x) = showsPrec n x +-- | @NonZero x@: guarantees that @x /= 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 newtype NonEmpty a = NonEmpty { getNonEmpty :: [a] } @@ -713,3 +950,142 @@ showsPrec n (NonEmpty x) = showsPrec n x -- }}} + +------------------------------ +-- Foreign.C.Types +------------------------------ +-- {{{ + +instance Monad m => Serial m CFloat where + series = newtypeCons CFloat +instance Monad m => CoSerial m CFloat where + coseries rs = newtypeAlts rs >>- \f -> return $ \l -> case l of CFloat x -> f x + +instance Monad m => Serial m CDouble where + series = newtypeCons CDouble +instance Monad m => CoSerial m CDouble where + coseries rs = newtypeAlts rs >>- \f -> return $ \l -> case l of CDouble x -> f x + +#if HASCBOOL +instance Monad m => Serial m CBool where + series = newtypeCons CBool +instance Monad m => CoSerial m CBool where + coseries rs = newtypeAlts rs >>- \f -> return $ \l -> case l of CBool x -> f x +#endif + +instance Monad m => Serial m CChar where + series = newtypeCons CChar +instance Monad m => CoSerial m CChar where + coseries rs = newtypeAlts rs >>- \f -> return $ \l -> case l of CChar x -> f x + +instance Monad m => Serial m CSChar where + series = newtypeCons CSChar +instance Monad m => CoSerial m CSChar where + coseries rs = newtypeAlts rs >>- \f -> return $ \l -> case l of CSChar x -> f x + +instance Monad m => Serial m CUChar where + series = newtypeCons CUChar +instance Monad m => CoSerial m CUChar where + coseries rs = newtypeAlts rs >>- \f -> return $ \l -> case l of CUChar x -> f x + +instance Monad m => Serial m CShort where + series = newtypeCons CShort +instance Monad m => CoSerial m CShort where + coseries rs = newtypeAlts rs >>- \f -> return $ \l -> case l of CShort x -> f x + +instance Monad m => Serial m CUShort where + series = newtypeCons CUShort +instance Monad m => CoSerial m CUShort where + coseries rs = newtypeAlts rs >>- \f -> return $ \l -> case l of CUShort x -> f x + +instance Monad m => Serial m CInt where + series = newtypeCons CInt +instance Monad m => CoSerial m CInt where + coseries rs = newtypeAlts rs >>- \f -> return $ \l -> case l of CInt x -> f x + +instance Monad m => Serial m CUInt where + series = newtypeCons CUInt +instance Monad m => CoSerial m CUInt where + coseries rs = newtypeAlts rs >>- \f -> return $ \l -> case l of CUInt x -> f x + +instance Monad m => Serial m CLong where + series = newtypeCons CLong +instance Monad m => CoSerial m CLong where + coseries rs = newtypeAlts rs >>- \f -> return $ \l -> case l of CLong x -> f x + +instance Monad m => Serial m CULong where + series = newtypeCons CULong +instance Monad m => CoSerial m CULong where + coseries rs = newtypeAlts rs >>- \f -> return $ \l -> case l of CULong x -> f x + +instance Monad m => Serial m CPtrdiff where + series = newtypeCons CPtrdiff +instance Monad m => CoSerial m CPtrdiff where + coseries rs = newtypeAlts rs >>- \f -> return $ \l -> case l of CPtrdiff x -> f x + +instance Monad m => Serial m CSize where + series = newtypeCons CSize +instance Monad m => CoSerial m CSize where + coseries rs = newtypeAlts rs >>- \f -> return $ \l -> case l of CSize x -> f x + +instance Monad m => Serial m CWchar where + series = newtypeCons CWchar +instance Monad m => CoSerial m CWchar where + coseries rs = newtypeAlts rs >>- \f -> return $ \l -> case l of CWchar x -> f x + +instance Monad m => Serial m CSigAtomic where + series = newtypeCons CSigAtomic +instance Monad m => CoSerial m CSigAtomic where + coseries rs = newtypeAlts rs >>- \f -> return $ \l -> case l of CSigAtomic x -> f x + +instance Monad m => Serial m CLLong where + series = newtypeCons CLLong +instance Monad m => CoSerial m CLLong where + coseries rs = newtypeAlts rs >>- \f -> return $ \l -> case l of CLLong x -> f x + +instance Monad m => Serial m CULLong where + series = newtypeCons CULLong +instance Monad m => CoSerial m CULLong where + coseries rs = newtypeAlts rs >>- \f -> return $ \l -> case l of CULLong x -> f x + +instance Monad m => Serial m CIntPtr where + series = newtypeCons CIntPtr +instance Monad m => CoSerial m CIntPtr where + coseries rs = newtypeAlts rs >>- \f -> return $ \l -> case l of CIntPtr x -> f x + +instance Monad m => Serial m CUIntPtr where + series = newtypeCons CUIntPtr +instance Monad m => CoSerial m CUIntPtr where + coseries rs = newtypeAlts rs >>- \f -> return $ \l -> case l of CUIntPtr x -> f x + +instance Monad m => Serial m CIntMax where + series = newtypeCons CIntMax +instance Monad m => CoSerial m CIntMax where + coseries rs = newtypeAlts rs >>- \f -> return $ \l -> case l of CIntMax x -> f x + +instance Monad m => Serial m CUIntMax where + series = newtypeCons CUIntMax +instance Monad m => CoSerial m CUIntMax where + coseries rs = newtypeAlts rs >>- \f -> return $ \l -> case l of CUIntMax x -> f x + +instance Monad m => Serial m CClock where + series = newtypeCons CClock +instance Monad m => CoSerial m CClock where + coseries rs = newtypeAlts rs >>- \f -> return $ \l -> case l of CClock x -> f x + +instance Monad m => Serial m CTime where + series = newtypeCons CTime +instance Monad m => CoSerial m CTime where + coseries rs = newtypeAlts rs >>- \f -> return $ \l -> case l of CTime x -> f x + +instance Monad m => Serial m CUSeconds where + series = newtypeCons CUSeconds +instance Monad m => CoSerial m CUSeconds where + coseries rs = newtypeAlts rs >>- \f -> return $ \l -> case l of CUSeconds x -> f x + +instance Monad m => Serial m CSUSeconds where + series = newtypeCons CSUSeconds +instance Monad m => CoSerial m CSUSeconds where + coseries rs = newtypeAlts rs >>- \f -> return $ \l -> case l of CSUSeconds x -> f x + +-- }}} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/smallcheck-1.1.5/Test/SmallCheck/SeriesMonad.hs new/smallcheck-1.2.0/Test/SmallCheck/SeriesMonad.hs --- old/smallcheck-1.1.5/Test/SmallCheck/SeriesMonad.hs 2017-08-08 18:19:53.000000000 +0200 +++ new/smallcheck-1.2.0/Test/SmallCheck/SeriesMonad.hs 2020-06-10 23:14:57.000000000 +0200 @@ -1,12 +1,12 @@ -{-# LANGUAGE Trustworthy #-} -- GeneralizedNewtypeDeriving -{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE Safe #-} + module Test.SmallCheck.SeriesMonad where -import Control.Applicative -import Control.Monad -import Control.Monad.Logic -import Control.Monad.Reader -import Control.Arrow +import Control.Applicative (Applicative(..), Alternative(..), (<$>)) +import Control.Monad (MonadPlus(..)) +import Control.Monad.Logic (MonadLogic(..), LogicT) +import Control.Monad.Reader (MonadTrans(..), ReaderT, runReaderT) +import Control.Arrow (second) -- | Maximum depth of generated test values. -- @@ -33,17 +33,31 @@ -- It is also desirable that values of smaller depth come before the values -- of greater depth. newtype Series m a = Series (ReaderT Depth (LogicT m) a) - deriving - ( Functor - , Monad - , Applicative - , MonadPlus - , Alternative - ) --- This instance is written manually. Using the GND for it is not safe. +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 (fmap $ second Series) $ msplit a + msplit (Series a) = Series (fmap (second Series) <$> msplit a) instance MonadTrans Series where lift a = Series $ lift . lift $ a diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/smallcheck-1.1.5/Test/SmallCheck.hs new/smallcheck-1.2.0/Test/SmallCheck.hs --- old/smallcheck-1.1.5/Test/SmallCheck.hs 2017-08-08 18:25:03.000000000 +0200 +++ new/smallcheck-1.2.0/Test/SmallCheck.hs 2020-06-10 23:35:08.000000000 +0200 @@ -12,9 +12,11 @@ -- -- 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 Safe #-} + module Test.SmallCheck ( -- * Constructing tests diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/smallcheck-1.1.5/smallcheck.cabal new/smallcheck-1.2.0/smallcheck.cabal --- old/smallcheck-1.1.5/smallcheck.cabal 2018-07-05 10:17:08.000000000 +0200 +++ new/smallcheck-1.2.0/smallcheck.cabal 2020-06-15 00:32:06.000000000 +0200 @@ -1,41 +1,61 @@ -Name: smallcheck -Version: 1.1.5 -Cabal-Version: >= 1.6 -License: BSD3 -License-File: LICENSE -Author: Colin Runciman, Roman Cheplyaka -Maintainer: Roman Cheplyaka <[email protected]> -Homepage: https://github.com/feuerbach/smallcheck -Bug-reports: https://github.com/feuerbach/smallcheck/issues - -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 +name: smallcheck +version: 1.2.0 +license: BSD3 +license-file: LICENSE +maintainer: Andrew Lelechenko <[email protected]> +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 + +homepage: https://github.com/Bodigrim/smallcheck +bug-reports: https://github.com/Bodigrim/smallcheck/issues +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. + +category: Testing +build-type: Simple +extra-source-files: + README.md + CREDITS.md + CHANGELOG.md -Extra-source-files: README.md, CREDITS.md, CHANGELOG.md - - - -Source-repository head +source-repository head type: git - location: git://github.com/feuerbach/smallcheck.git - -Library + location: git://github.com/Bodigrim/smallcheck.git - Build-Depends: base >= 4.5 && < 5, mtl, logict, ghc-prim >= 0.2, pretty +library + default-language: Haskell2010 - if impl(ghc < 7.10) - build-depends: nats + exposed-modules: + Test.SmallCheck + Test.SmallCheck.Drivers + Test.SmallCheck.Series + + other-modules: + Test.SmallCheck.Property + Test.SmallCheck.SeriesMonad + Test.SmallCheck.Property.Result + + build-depends: + base >=4.5 && <5, + mtl, + logict, + pretty + + if impl(ghc <8.0) + build-depends: + semigroups, + transformers + + if impl(ghc <7.10) + build-depends: + nats, + void - 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.6) + build-depends: ghc-prim >=0.2
