smallcheck 1.1.7 → 1.2.0
raw patch · 3 files changed
+314/−10 lines, 3 filesdep +semigroupsdep +transformersdep +void
Dependencies added: semigroups, transformers, void
Files
- CHANGELOG.md +15/−0
- Test/SmallCheck/Series.hs +290/−8
- smallcheck.cabal +9/−2
CHANGELOG.md view
@@ -1,6 +1,21 @@ 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 -------------
Test/SmallCheck/Series.hs view
@@ -25,6 +25,9 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}@@ -39,6 +42,8 @@ {-# LANGUAGE Trustworthy #-} #endif +#define HASCBOOL MIN_VERSION_base(4,10,0)+ module Test.SmallCheck.Series ( -- {{{ -- * Generic instances@@ -88,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@@ -115,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,@@ -142,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@@ -169,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(..),@@ -179,7 +184,7 @@ genericCoseries, -- * Convenient wrappers- Positive(..), NonNegative(..), NonEmpty(..),+ Positive(..), NonNegative(..), NonZero(..), NonEmpty(..), -- * Other useful definitions (\/), (><), (<~>), (>>-),@@ -201,14 +206,24 @@ 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 (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 (Generic, (:+:)(..), (:*:)(..), C1, K1(..), M1(..), U1(..), Rep, to, from)+import GHC.Generics (Generic, (:+:)(..), (:*:)(..), C1, K1(..), M1(..), U1(..), V1(..), Rep, to, from) ------------------------------ -- Main types and classes@@ -316,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@@ -395,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 @@ -428,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@@ -465,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 #-}@@ -655,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@@ -683,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@@ -727,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+ -- }}} ------------------------------@@ -737,11 +837,15 @@ -------------------------------------------------------------------------- -- | @Positive x@: guarantees that @x \> 0@. newtype Positive a = Positive { getPositive :: a }- deriving (Eq, Ord)+ 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@@ -768,11 +872,15 @@ -- | @NonNegative x@: guarantees that @x \>= 0@. newtype NonNegative a = NonNegative { getNonNegative :: a }- deriving (Eq, Ord)+ 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@@ -797,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] } @@ -805,5 +948,144 @@ instance Show a => Show (NonEmpty a) where 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 -- }}}
smallcheck.cabal view
@@ -1,5 +1,5 @@ name: smallcheck-version: 1.1.7+version: 1.2.0 license: BSD3 license-file: LICENSE maintainer: Andrew Lelechenko <andrew.lelechenko@gmail.com>@@ -47,8 +47,15 @@ logict, pretty + if impl(ghc <8.0)+ build-depends:+ semigroups,+ transformers+ if impl(ghc <7.10)- build-depends: nats+ build-depends:+ nats,+ void if impl(ghc <7.6) build-depends: ghc-prim >=0.2