Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package ghc-smallcheck for openSUSE:Factory checked in at 2021-01-20 18:26:19 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-smallcheck (Old) and /work/SRC/openSUSE:Factory/.ghc-smallcheck.new.28504 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-smallcheck" Wed Jan 20 18:26:19 2021 rev:9 rq:864464 version:1.2.1 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-smallcheck/ghc-smallcheck.changes 2020-12-22 11:46:14.113851761 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-smallcheck.new.28504/ghc-smallcheck.changes 2021-01-20 18:26:38.559473190 +0100 @@ -1,0 +2,9 @@ +Mon Jan 18 09:06:54 UTC 2021 - [email protected] + +- Update smallcheck to version 1.2.1. + Version 1.2.1 + ------------- + + * Add `Serial` and `CoSerial` instances for `Ordering`. + +------------------------------------------------------------------- Old: ---- smallcheck-1.2.0.tar.gz New: ---- smallcheck-1.2.1.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-smallcheck.spec ++++++ --- /var/tmp/diff_new_pack.Vt5BYa/_old 2021-01-20 18:26:39.527474110 +0100 +++ /var/tmp/diff_new_pack.Vt5BYa/_new 2021-01-20 18:26:39.531474114 +0100 @@ -1,7 +1,7 @@ # # spec file for package ghc-smallcheck # -# Copyright (c) 2020 SUSE LLC +# Copyright (c) 2021 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.2.0 +Version: 1.2.1 Release: 0 Summary: A property-based testing library License: BSD-3-Clause ++++++ smallcheck-1.2.0.tar.gz -> smallcheck-1.2.1.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/smallcheck-1.2.0/CHANGELOG.md new/smallcheck-1.2.1/CHANGELOG.md --- old/smallcheck-1.2.0/CHANGELOG.md 2020-06-15 00:31:09.000000000 +0200 +++ new/smallcheck-1.2.1/CHANGELOG.md 2001-09-09 03:46:40.000000000 +0200 @@ -1,6 +1,11 @@ Changes ======= +Version 1.2.1 +------------- + +* Add `Serial` and `CoSerial` instances for `Ordering`. + Version 1.2.0 ------------- diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/smallcheck-1.2.0/Test/SmallCheck/Drivers.hs new/smallcheck-1.2.1/Test/SmallCheck/Drivers.hs --- old/smallcheck-1.2.0/Test/SmallCheck/Drivers.hs 2020-06-10 23:14:57.000000000 +0200 +++ new/smallcheck-1.2.1/Test/SmallCheck/Drivers.hs 2001-09-09 03:46:40.000000000 +0200 @@ -9,8 +9,11 @@ -- run SmallCheck tests -------------------------------------------------------------------- +{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE Safe #-} +#if __GLASGOW_HASKELL__ >= 704 +{-# LANGUAGE Safe #-} +#endif module Test.SmallCheck.Drivers ( smallCheck, smallCheckM, smallCheckWithHook, diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/smallcheck-1.2.0/Test/SmallCheck/Property/Result.hs new/smallcheck-1.2.1/Test/SmallCheck/Property/Result.hs --- old/smallcheck-1.2.0/Test/SmallCheck/Property/Result.hs 2020-06-10 23:14:57.000000000 +0200 +++ new/smallcheck-1.2.1/Test/SmallCheck/Property/Result.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,5 +1,8 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE Safe #-} +#if __GLASGOW_HASKELL__ >= 704 +{-# LANGUAGE Safe #-} +#endif module Test.SmallCheck.Property.Result ( PropertySuccess(..) @@ -13,7 +16,7 @@ type Argument = String --- | An explanation for the test outcome +-- | An explanation for the test outcome. type Reason = String data PropertySuccess diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/smallcheck-1.2.0/Test/SmallCheck/Property.hs new/smallcheck-1.2.1/Test/SmallCheck/Property.hs --- old/smallcheck-1.2.0/Test/SmallCheck/Property.hs 2020-06-10 23:14:57.000000000 +0200 +++ new/smallcheck-1.2.1/Test/SmallCheck/Property.hs 2001-09-09 03:46:40.000000000 +0200 @@ -24,8 +24,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 @@ -48,7 +50,12 @@ import Data.Typeable (Typeable(..)) #if !NEWTYPEABLE -import Data.Typeable (Typeable1, mkTyConApp, mkTyCon3, typeOf) +import Data.Typeable (Typeable1, mkTyConApp, typeOf) +#if MIN_VERSION_base(4,4,0) +import Data.Typeable (mkTyCon3) +#else +import Data.Typeable (mkTyCon) +#endif #endif ------------------------------ @@ -56,7 +63,7 @@ ------------------------------ --{{{ --- | The type of properties over the monad @m@ +-- | The type of properties over the monad @m@. newtype Property m = Property { unProperty :: Reader (Env m) (PropertySeries m) } #if NEWTYPEABLE deriving Typeable @@ -92,7 +99,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 @@ -141,7 +152,7 @@ => Series m a -> (a -> b) -> Property m over = testFunction --- | Execute a monadic test +-- | Execute a monadic test. monadic :: Testable m a => m a -> Property m monadic a = Property $ reader $ \env -> @@ -161,7 +172,7 @@ -- | 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'. class Monad m => Testable m a where test :: a -> Property m @@ -286,23 +297,27 @@ freshContext :: Testable m a => a -> Property m freshContext = forAll --- | Set the universal quantification context +-- | Set the universal quantification context. forAll :: Testable m a => a -> Property m forAll = quantify Forall . test --- | Set the existential quantification context +-- | Set the existential quantification context. 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). -- diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/smallcheck-1.2.0/Test/SmallCheck/Series.hs new/smallcheck-1.2.1/Test/SmallCheck/Series.hs --- old/smallcheck-1.2.0/Test/SmallCheck/Series.hs 2020-06-14 16:32:27.000000000 +0200 +++ new/smallcheck-1.2.1/Test/SmallCheck/Series.hs 2001-09-09 03:46:40.000000000 +0200 @@ -24,7 +24,9 @@ -------------------------------------------------------------------- {-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE DefaultSignatures #-} +#endif {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveTraversable #-} @@ -39,8 +41,10 @@ {-# LANGUAGE Safe #-} #else {-# LANGUAGE OverlappingInstances #-} +#if __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE Trustworthy #-} #endif +#endif #define HASCBOOL MIN_VERSION_base(4,10,0) @@ -64,7 +68,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. -- @@ -101,24 +105,24 @@ -- > <~> 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, cons5, cons6, newtypeCons, -- * Function Generators @@ -126,7 +130,7 @@ -- | 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: -- @@ -159,18 +163,18 @@ -- ** 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. @@ -179,9 +183,11 @@ -- * Basic definitions Depth, Series, Serial(..), CoSerial(..), +#if __GLASGOW_HASKELL__ >= 702 -- * Generic implementations genericSeries, genericCoseries, +#endif -- * Convenient wrappers Positive(..), NonNegative(..), NonZero(..), NonEmpty(..), @@ -205,7 +211,7 @@ 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 Control.Applicative (empty, pure, (<$>), (<|>)) import Data.Complex (Complex(..)) import Data.Foldable (Foldable) import Data.Functor.Compose (Compose(..)) @@ -217,13 +223,18 @@ 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(..)) +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(..)) +#if __GLASGOW_HASKELL__ >= 702 +import Foreign.C.Types (CUSeconds(..), CSUSeconds(..)) +#endif #if HASCBOOL import Foreign.C.Types (CBool(..)) #endif import Numeric.Natural (Natural) import Test.SmallCheck.SeriesMonad +#if __GLASGOW_HASKELL__ >= 702 import GHC.Generics (Generic, (:+:)(..), (:*:)(..), C1, K1(..), M1(..), U1(..), V1(..), Rep, to, from) +#endif ------------------------------ -- Main types and classes @@ -233,13 +244,17 @@ 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 genericSeries :: (Monad m, Generic a, GSerial m (Rep a)) => Series m a genericSeries = to <$> gSeries +#endif class Monad m => CoSerial m a where -- | A proper 'coseries' implementation should pass the depth unchanged to @@ -247,13 +262,18 @@ -- 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 genericCoseries :: (Monad m, Generic a, GCoSerial m (Rep a)) => Series m b -> Series m (a->b) genericCoseries rs = (. from) <$> gCoseries rs +#endif + -- }}} ------------------------------ @@ -268,24 +288,23 @@ d <- getDepth msum $ map return $ f d --- | Limit a 'Series' to its first @n@ elements +-- | Limit a 'Series' to its first @n@ elements. 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]@ listSeries :: Serial Identity a => Depth -> [a] @@ -296,21 +315,20 @@ -- -- 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. 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'. listM d s = observeAllT $ runSeries d s --- | Sum (union) of series +-- | Sum (union) of series. infixr 7 \/ (\/) :: Monad m => Series m a -> Series m a -> Series m a (\/) = interleave @@ -320,7 +338,7 @@ (><) :: 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 '<*>'. infixl 4 <~> (<~>) :: Monad m => Series m (a -> b) -> Series m a -> Series m b a <~> b = a >>- (<$> b) @@ -337,17 +355,17 @@ 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 +-- | Query the current depth. getDepth :: Series m Depth getDepth = Series ask --- | Run a series with a modified depth +-- | Run a series with a modified depth. 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'. decDepth :: Series m a -> Series m a decDepth a = do checkDepth @@ -500,6 +518,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 #-} @@ -553,6 +572,8 @@ instance {-# OVERLAPPING #-} GSerial m f => GSerial m (C1 c f) where gSeries = M1 <$> decDepth gSeries {-# INLINE gSeries #-} +#endif + -- }}} ------------------------------ @@ -592,7 +613,7 @@ -- | '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 @@ -633,7 +654,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 @@ -736,6 +757,18 @@ rs >>- \r2 -> return $ \x -> if x then r1 else r2 +instance Monad m => Serial m Ordering where + series = cons0 LT \/ cons0 EQ \/ cons0 GT +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 @@ -764,10 +797,18 @@ alts2 rs >>- \f -> return $ \(x NE.:| xs') -> f x xs' +#if MIN_VERSION_base(4,4,0) instance Serial m a => Serial m (Complex a) where +#else +instance (RealFloat a, Serial m a) => Serial m (Complex a) where +#endif series = cons2 (:+) +#if MIN_VERSION_base(4,4,0) instance CoSerial m a => CoSerial m (Complex a) where +#else +instance (RealFloat a, CoSerial m a) => CoSerial m (Complex a) where +#endif coseries rs = alts2 rs >>- \f -> return $ \(x :+ xs') -> f x xs' @@ -835,7 +876,7 @@ -- {{{ -------------------------------------------------------------------------- --- | @Positive x@: guarantees that @x \> 0@. +-- | 'Positive' @x@ guarantees that \( x > 0 \). newtype Positive a = Positive { getPositive :: a } deriving (Eq, Ord, Functor, Foldable, Traversable) @@ -870,7 +911,7 @@ 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 \). newtype NonNegative a = NonNegative { getNonNegative :: a } deriving (Eq, Ord, Functor, Foldable, Traversable) @@ -905,7 +946,7 @@ instance Show a => Show (NonNegative a) where showsPrec n (NonNegative x) = showsPrec n x --- | @NonZero x@: guarantees that @x /= 0@. +-- | 'NonZero' @x@ guarantees that \( x \ne 0 \). newtype NonZero a = NonZero { getNonZero :: a } deriving (Eq, Ord, Functor, Foldable, Traversable) @@ -940,7 +981,7 @@ instance Show a => Show (NonZero a) where showsPrec n (NonZero x) = showsPrec n x --- | @NonEmpty xs@: guarantees that @xs@ is not null +-- | 'NonEmpty' @xs@ guarantees that @xs@ is not null. newtype NonEmpty a = NonEmpty { getNonEmpty :: [a] } instance (Serial m a) => Serial m (NonEmpty a) where @@ -956,6 +997,7 @@ ------------------------------ -- {{{ +#if MIN_VERSION_base(4,5,0) instance Monad m => Serial m CFloat where series = newtypeCons CFloat instance Monad m => CoSerial m CFloat where @@ -1087,5 +1129,6 @@ series = newtypeCons CSUSeconds instance Monad m => CoSerial m CSUSeconds where coseries rs = newtypeAlts rs >>- \f -> return $ \l -> case l of CSUSeconds x -> f x +#endif -- }}} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/smallcheck-1.2.0/Test/SmallCheck/SeriesMonad.hs new/smallcheck-1.2.1/Test/SmallCheck/SeriesMonad.hs --- old/smallcheck-1.2.0/Test/SmallCheck/SeriesMonad.hs 2020-06-10 23:14:57.000000000 +0200 +++ new/smallcheck-1.2.1/Test/SmallCheck/SeriesMonad.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,4 +1,7 @@ +{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE Safe #-} +#endif module Test.SmallCheck.SeriesMonad where @@ -19,15 +22,15 @@ -- | '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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/smallcheck-1.2.0/Test/SmallCheck.hs new/smallcheck-1.2.1/Test/SmallCheck.hs --- old/smallcheck-1.2.0/Test/SmallCheck.hs 2020-06-10 23:35:08.000000000 +0200 +++ new/smallcheck-1.2.1/Test/SmallCheck.hs 2001-09-09 03:46:40.000000000 +0200 @@ -15,7 +15,10 @@ -- <https://github.com/Bodigrim/smallcheck/blob/master/README.md> -------------------------------------------------------------------- +{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE Safe #-} +#endif module Test.SmallCheck ( -- * Constructing tests @@ -31,11 +34,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 +51,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, diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/smallcheck-1.2.0/smallcheck.cabal new/smallcheck-1.2.1/smallcheck.cabal --- old/smallcheck-1.2.0/smallcheck.cabal 2020-06-15 00:32:06.000000000 +0200 +++ new/smallcheck-1.2.1/smallcheck.cabal 2001-09-09 03:46:40.000000000 +0200 @@ -1,13 +1,13 @@ name: smallcheck -version: 1.2.0 +version: 1.2.1 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 + ghc ==8.10.3 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 @@ -42,7 +42,7 @@ Test.SmallCheck.Property.Result build-depends: - base >=4.5 && <5, + base >=4.3 && <5, mtl, logict, pretty @@ -58,4 +58,5 @@ void if impl(ghc <7.6) - build-depends: ghc-prim >=0.2 + build-depends: + ghc-prim >=0.2
