diff --git a/CHANGELOG.md b/CHANGELOG.md index 94dd3213..bc2cda35 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,11 @@ # 1.3.0 +* Move `thawGen` from `FreezeGen` into the new `ThawGen` type class. Fixes an issue with + an unlawful instance of `StateGen` for `FreezeGen`. +* Add `modifyGen` and `overwriteGen` to the `FrozenGen` type class +* Add `splitGen` and `splitMutableGen` +* Switch `randomM` and `randomRM` to use `FrozenGen` instead of `RandomGenM` +* Deprecate `RandomGenM` in favor of a more powerful `FrozenGen` * Add `isInRange` to `UniformRange`: [#78](https://github.com/haskell/random/pull/78) * Add default implementation for `uniformRM` using `Generics`: [#92](https://github.com/haskell/random/pull/92) diff --git a/src/System/Random/Internal.hs b/src/System/Random/Internal.hs index 6455f732..6724ad34 100644 --- a/src/System/Random/Internal.hs +++ b/src/System/Random/Internal.hs @@ -30,6 +30,9 @@ module System.Random.Internal RandomGen(..) , StatefulGen(..) , FrozenGen(..) + , ThawedGen(..) + , splitGen + , splitMutableGen -- ** Standard pseudo-random number generator , StdGen(..) @@ -40,7 +43,6 @@ module System.Random.Internal -- ** Pure adapter , StateGen(..) , StateGenM(..) - , splitGen , runStateGen , runStateGen_ , runStateGenT @@ -67,7 +69,7 @@ module System.Random.Internal import Control.Arrow import Control.DeepSeq (NFData) -import Control.Monad (when) +import Control.Monad (when, (>=>)) import Control.Monad.Cont (ContT, runContT) import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.ST @@ -285,26 +287,101 @@ class Monad m => StatefulGen g m where {-# INLINE uniformShortByteString #-} - --- | This class is designed for stateful pseudo-random number generators that --- can be saved as and restored from an immutable data type. +-- | This class is designed for mutable pseudo-random number generators that have a frozen +-- imutable counterpart that can be manipulated in pure code. +-- +-- It also works great with frozen generators that are based on pure generators that have +-- a `RandomGen` instance. +-- +-- Here are a few laws, which are important for this type class: +-- +-- * Roundtrip and complete destruction on overwrite: +-- +-- @ +-- overwriteGen mg fg >> freezeGen mg = pure fg +-- @ +-- +-- * Modification of a mutable generator: +-- +-- @ +-- overwriteGen mg fg = modifyGen mg (const ((), fg) +-- @ +-- +-- * Freezing of a mutable generator: +-- +-- @ +-- freezeGen mg = modifyGen mg (\fg -> (fg, fg)) +-- @ -- -- @since 1.2.0 class StatefulGen (MutableGen f m) m => FrozenGen f m where + {-# MINIMAL (modifyGen|(freezeGen,overwriteGen)) #-} -- | Represents the state of the pseudo-random number generator for use with -- 'thawGen' and 'freezeGen'. -- -- @since 1.2.0 type MutableGen f m = (g :: Type) | g -> f + -- | Saves the state of the pseudo-random number generator as a frozen seed. -- -- @since 1.2.0 freezeGen :: MutableGen f m -> m f - -- | Restores the pseudo-random number generator from its frozen seed. + freezeGen mg = modifyGen mg (\fg -> (fg, fg)) + {-# INLINE freezeGen #-} + + -- | Apply a pure function to the frozen pseudo-random number generator. + -- + -- @since 1.3.0 + modifyGen :: MutableGen f m -> (f -> (a, f)) -> m a + modifyGen mg f = do + fg <- freezeGen mg + case f fg of + (a, !fg') -> a <$ overwriteGen mg fg' + {-# INLINE modifyGen #-} + + -- | Overwrite contents of the mutable pseudo-random number generator with the + -- supplied frozen one + -- + -- @since 1.3.0 + overwriteGen :: MutableGen f m -> f -> m () + overwriteGen mg fg = modifyGen mg (const ((), fg)) + {-# INLINE overwriteGen #-} + +-- | Functionality for thawing frozen generators is not part of the `FrozenGen` class, +-- becase not all mutable generators support functionality of creating new mutable +-- generators, which is what thawing is in its essence. For this reason `StateGen` does +-- not have an instance for this type class, but it has one for `FrozenGen`. +-- +-- Here is an important law that relates this type class to `FrozenGen` +-- +-- * Roundtrip and independence of mutable generators: +-- +-- @ +-- traverse thawGen fgs >>= traverse freezeGen = pure fgs +-- @ +-- +-- @since 1.3.0 +class FrozenGen f m => ThawedGen f m where + -- | Create a new mutable pseudo-random number generator from its frozen state. -- -- @since 1.2.0 thawGen :: f -> m (MutableGen f m) +-- | Splits a pseudo-random number generator into two. Overwrites the mutable +-- pseudo-random number generator with one of the immutable pseudo-random number +-- generators produced by a `split` function and returns the other. +-- +-- @since 1.3.0 +splitGen :: (RandomGen f, FrozenGen f m) => MutableGen f m -> m f +splitGen = flip modifyGen split + +-- | Splits a pseudo-random number generator into two. Overwrites the mutable wrapper with +-- one of the resulting generators and returns the other as a new mutable generator. +-- +-- @since 1.3.0 +splitMutableGen :: (RandomGen f, ThawedGen f m) => MutableGen f m -> m (MutableGen f m) +splitMutableGen = splitGen >=> thawGen + data MBA = MBA (MutableByteArray# RealWorld) @@ -451,15 +528,10 @@ instance (RandomGen g, MonadState g m) => StatefulGen (StateGenM g) m where instance (RandomGen g, MonadState g m) => FrozenGen (StateGen g) m where type MutableGen (StateGen g) m = StateGenM g freezeGen _ = fmap StateGen get - thawGen (StateGen g) = StateGenM <$ put g - --- | Splits a pseudo-random number generator into two. Updates the state with --- one of the resulting generators and returns the other. --- --- @since 1.2.0 -splitGen :: (MonadState g m, RandomGen g) => m g -splitGen = state split -{-# INLINE splitGen #-} + modifyGen _ f = state (coerce f) + {-# INLINE modifyGen #-} + overwriteGen _ f = put (coerce f) + {-# INLINE overwriteGen #-} -- | Runs a monadic generating action in the `State` monad using a pure -- pseudo-random number generator. diff --git a/src/System/Random/Stateful.hs b/src/System/Random/Stateful.hs index 10ecb412..0e42cc3c 100644 --- a/src/System/Random/Stateful.hs +++ b/src/System/Random/Stateful.hs @@ -3,6 +3,7 @@ {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE Trustworthy #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} @@ -29,11 +30,16 @@ module System.Random.Stateful -- $interfaces , StatefulGen(..) , FrozenGen(..) - , RandomGenM(..) + , ThawedGen(..) , withMutableGen , withMutableGen_ , randomM , randomRM + , splitGen + , splitMutableGen + + -- ** Deprecated + , RandomGenM(..) , splitGenM -- * Monadic adapters for pure pseudo-random number generators #monadicadapters# @@ -158,9 +164,10 @@ import System.Random.Internal -- > [3,4,3,1,4,6,1,6,1,4] -- -- Given a /pure/ pseudo-random number generator, you can run the monadic pseudo-random --- number computation @rollsM@ in 'StateT', 'IO', 'ST' or 'STM' context by applying a --- monadic adapter like 'StateGenM', 'AtomicGenM', 'IOGenM', 'STGenM' or 'TGenM' (see --- [monadic-adapters](#monadicadapters)) to the pure pseudo-random number generator. +-- number computation @rollsM@ in 'Control.Monad.State.Strict.StateT', 'IO', 'ST' or 'STM' +-- context by applying a monadic adapter like 'StateGenM', 'AtomicGenM', 'IOGenM', +-- 'STGenM' or 'TGenM' (see [monadic-adapters](#monadicadapters)) to the pure +-- pseudo-random number generator. -- -- >>> let pureGen = mkStdGen 42 -- >>> newIOGenM pureGen >>= rollsM 10 :: IO [Word] @@ -177,9 +184,9 @@ import System.Random.Internal -- ['System.Random.RandomGen': pure pseudo-random number generators] -- See "System.Random" module. -- --- ['StatefulGen': monadic pseudo-random number generators] These generators --- mutate their own state as they produce pseudo-random values. They --- generally live in 'StateT', 'ST', 'IO' or 'STM' or some other transformer +-- ['StatefulGen': monadic pseudo-random number generators] These generators mutate their +-- own state as they produce pseudo-random values. They generally live in +-- 'Control.Monad.State.Strict.StateT', 'ST', 'IO' or 'STM' or some other transformer -- on top of those monads. -- @@ -192,10 +199,10 @@ import System.Random.Internal -- Pure pseudo-random number generators can be used in monadic code via the -- adapters 'StateGenM', 'AtomicGenM', 'IOGenM', 'STGenM' and 'TGenM' -- --- * 'StateGenM' can be used in any state monad. With strict 'StateT' there is --- no performance overhead compared to using the 'RandomGen' instance --- directly. 'StateGenM' is /not/ safe to use in the presence of exceptions --- and concurrency. +-- * 'StateGenM' can be used in any state monad. With strict +-- 'Control.Monad.State.Strict.StateT' there is no performance overhead compared to +-- using the 'RandomGen' instance directly. 'StateGenM' is /not/ safe to use in the +-- presence of exceptions and concurrency. -- -- * 'AtomicGenM' is safe in the presence of exceptions and concurrency since -- it performs all actions atomically. @@ -216,6 +223,8 @@ import System.Random.Internal -- @since 1.2.0 class (RandomGen r, StatefulGen g m) => RandomGenM g r m | g -> r where applyRandomGenM :: (r -> (a, r)) -> g -> m a +{-# DEPRECATED applyRandomGenM "In favor of `modifyGen`" #-} +{-# DEPRECATED RandomGenM "In favor of `FrozenGen`" #-} -- | Splits a pseudo-random number generator into two. Overwrites the mutable -- wrapper with one of the resulting generators and returns the other. @@ -223,6 +232,7 @@ class (RandomGen r, StatefulGen g m) => RandomGenM g r m | g -> r where -- @since 1.2.0 splitGenM :: RandomGenM g r m => g -> m r splitGenM = applyRandomGenM split +{-# DEPRECATED splitGenM "In favor of `splitGen`" #-} instance (RandomGen r, MonadIO m) => RandomGenM (IOGenM r) r m where applyRandomGenM = applyIOGen @@ -249,7 +259,7 @@ instance RandomGen r => RandomGenM (TGenM r) r STM where -- ([-74,37,-50,-2,3],IOGen {unIOGen = StdGen {unStdGen = SMGen 4273268533320920145 15251669095119325999}}) -- -- @since 1.2.0 -withMutableGen :: FrozenGen f m => f -> (MutableGen f m -> m a) -> m (a, f) +withMutableGen :: ThawedGen f m => f -> (MutableGen f m -> m a) -> m (a, f) withMutableGen fg action = do g <- thawGen fg res <- action g @@ -266,8 +276,8 @@ withMutableGen fg action = do -- 4 -- -- @since 1.2.0 -withMutableGen_ :: FrozenGen f m => f -> (MutableGen f m -> m a) -> m a -withMutableGen_ fg action = fst <$> withMutableGen fg action +withMutableGen_ :: ThawedGen f m => f -> (MutableGen f m -> m a) -> m a +withMutableGen_ fg action = thawGen fg >>= action -- | Generates a list of pseudo-random values. @@ -301,8 +311,9 @@ uniformListM n gen = replicateM n (uniformM gen) -- 0.6268211351114487 -- -- @since 1.2.0 -randomM :: (Random a, RandomGenM g r m) => g -> m a -randomM = applyRandomGenM random +randomM :: forall a g m. (Random a, RandomGen g, FrozenGen g m) => MutableGen g m -> m a +randomM = flip modifyGen random +{-# INLINE randomM #-} -- | Generates a pseudo-random value using monadic interface and `Random` instance. -- @@ -321,8 +332,9 @@ randomM = applyRandomGenM random -- 2 -- -- @since 1.2.0 -randomRM :: (Random a, RandomGenM g r m) => (a, a) -> g -> m a -randomRM r = applyRandomGenM (randomR r) +randomRM :: forall a g m. (Random a, RandomGen g, FrozenGen g m) => (a, a) -> MutableGen g m -> m a +randomRM r = flip modifyGen (randomR r) +{-# INLINE randomRM #-} -- | Wraps an 'IORef' that holds a pure pseudo-random number generator. All -- operations are performed atomically. @@ -378,6 +390,13 @@ instance (RandomGen g, MonadIO m) => StatefulGen (AtomicGenM g) m where instance (RandomGen g, MonadIO m) => FrozenGen (AtomicGen g) m where type MutableGen (AtomicGen g) m = AtomicGenM g freezeGen = fmap AtomicGen . liftIO . readIORef . unAtomicGenM + modifyGen (AtomicGenM ioRef) f = + liftIO $ atomicModifyIORef' ioRef $ \g -> + case f (AtomicGen g) of + (a, AtomicGen g') -> (g', a) + {-# INLINE modifyGen #-} + +instance (RandomGen g, MonadIO m) => ThawedGen (AtomicGen g) m where thawGen (AtomicGen g) = newAtomicGenM g -- | Atomically applies a pure operation to the wrapped pseudo-random number @@ -453,9 +472,18 @@ instance (RandomGen g, MonadIO m) => StatefulGen (IOGenM g) m where instance (RandomGen g, MonadIO m) => FrozenGen (IOGen g) m where type MutableGen (IOGen g) m = IOGenM g freezeGen = fmap IOGen . liftIO . readIORef . unIOGenM + modifyGen (IOGenM ref) f = liftIO $ do + g <- readIORef ref + let (a, IOGen g') = f (IOGen g) + g' `seq` writeIORef ref g' + pure a + {-# INLINE modifyGen #-} + overwriteGen (IOGenM ref) = liftIO . writeIORef ref . unIOGen + {-# INLINE overwriteGen #-} + +instance (RandomGen g, MonadIO m) => ThawedGen (IOGen g) m where thawGen (IOGen g) = newIOGenM g - -- | Applies a pure operation to the wrapped pseudo-random number generator. -- -- ====__Examples__ @@ -513,6 +541,16 @@ instance RandomGen g => StatefulGen (STGenM g s) (ST s) where instance RandomGen g => FrozenGen (STGen g) (ST s) where type MutableGen (STGen g) (ST s) = STGenM g s freezeGen = fmap STGen . readSTRef . unSTGenM + modifyGen (STGenM ref) f = do + g <- readSTRef ref + let (a, STGen g') = f (STGen g) + g' `seq` writeSTRef ref g' + pure a + {-# INLINE modifyGen #-} + overwriteGen (STGenM ref) = writeSTRef ref . unSTGen + {-# INLINE overwriteGen #-} + +instance RandomGen g => ThawedGen (STGen g) (ST s) where thawGen (STGen g) = newSTGenM g @@ -608,6 +646,16 @@ instance RandomGen g => StatefulGen (TGenM g) STM where instance RandomGen g => FrozenGen (TGen g) STM where type MutableGen (TGen g) STM = TGenM g freezeGen = fmap TGen . readTVar . unTGenM + modifyGen (TGenM ref) f = do + g <- readTVar ref + let (a, TGen g') = f (TGen g) + g' `seq` writeTVar ref g' + pure a + {-# INLINE modifyGen #-} + overwriteGen (TGenM ref) = writeTVar ref . unTGen + {-# INLINE overwriteGen #-} + +instance RandomGen g => ThawedGen (TGen g) STM where thawGen (TGen g) = newTGenM g @@ -761,19 +809,17 @@ applyTGen f (TGenM tvar) = do -- -- === @FrozenGen@ -- --- `FrozenGen` gives us ability to use any stateful pseudo-random number generator in its --- immutable form, if one exists that is. This concept is commonly known as a seed, which --- allows us to save and restore the actual mutable state of a pseudo-random number --- generator. The biggest benefit that can be drawn from a polymorphic access to a --- stateful pseudo-random number generator in a frozen form is the ability to serialize, --- deserialize and possibly even use the stateful generator in a pure setting without --- knowing the actual type of a generator ahead of time. For example we can write a --- function that accepts a frozen state of some pseudo-random number generator and --- produces a short list with random even integers. +-- `FrozenGen` gives us ability to use most of stateful pseudo-random number generator in +-- its immutable form, if one exists that is. The biggest benefit that can be drawn from +-- a polymorphic access to a stateful pseudo-random number generator in a frozen form is +-- the ability to serialize, deserialize and possibly even use the stateful generator in a +-- pure setting without knowing the actual type of a generator ahead of time. For example +-- we can write a function that accepts a frozen state of some pseudo-random number +-- generator and produces a short list with random even integers. -- -- >>> import Data.Int (Int8) -- >>> :{ --- myCustomRandomList :: FrozenGen f m => f -> m [Int8] +-- myCustomRandomList :: ThawedGen f m => f -> m [Int8] -- myCustomRandomList f = -- withMutableGen_ f $ \gen -> do -- len <- uniformRM (5, 10) gen diff --git a/test/Spec.hs b/test/Spec.hs index 8868a6c4..078d4d0a 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -94,7 +94,7 @@ main = , uniformSpec (Proxy :: Proxy (Word8, Word16, Word32, Word64, Word)) , uniformSpec (Proxy :: Proxy (Int8, Word8, Word16, Word32, Word64, Word)) , uniformSpec (Proxy :: Proxy (Int8, Int16, Word8, Word16, Word32, Word64, Word)) - , Stateful.statefulSpec + , Stateful.statefulGenSpec ] floatTests :: TestTree diff --git a/test/Spec/Stateful.hs b/test/Spec/Stateful.hs index 8c951d43..dbed18c4 100644 --- a/test/Spec/Stateful.hs +++ b/test/Spec/Stateful.hs @@ -7,8 +7,8 @@ module Spec.Stateful where import Control.Concurrent.STM +import Control.Monad import Control.Monad.ST -import Control.Monad.Trans.State.Strict import Data.Proxy import Data.Typeable import System.Random.Stateful @@ -36,78 +36,170 @@ instance (Monad m, Serial m g) => Serial m (StateGen g) where matchRandomGenSpec :: - forall b f m. (FrozenGen f m, Eq f, Show f, Eq b) - => (forall a. m a -> IO a) - -> (MutableGen f m -> m b) - -> (StdGen -> (b, StdGen)) + forall f a sg m. (StatefulGen sg m, RandomGen f, Eq f, Show f, Eq a) + => (forall g n. StatefulGen g n => g -> n a) + -> (forall g. RandomGen g => g -> (a, g)) + -> (StdGen -> f) -> (f -> StdGen) - -> f + -> (f -> (sg -> m a) -> IO (a, f)) -> Property IO -matchRandomGenSpec toIO genM gen toStdGen frozen = - monadic $ do - (x1, fg1) <- toIO $ withMutableGen frozen genM - let (x2, g2) = gen $ toStdGen frozen - pure $ x1 == x2 && toStdGen fg1 == g2 +matchRandomGenSpec genM gen fromStdGen toStdGen runStatefulGen = + forAll $ \seed -> monadic $ do + let stdGen = mkStdGen seed + g = fromStdGen stdGen + (x1, g1) = gen stdGen + (x2, g2) = gen g + (x3, g3) <- runStatefulGen g genM + pure $ and [x1 == x2, x2 == x3, g1 == toStdGen g2, g1 == toStdGen g3, g2 == g3] withMutableGenSpec :: - forall f m. (FrozenGen f m, Eq f, Show f) + forall f m. (ThawedGen f m, Eq f, Show f) => (forall a. m a -> IO a) -> f -> Property IO withMutableGenSpec toIO frozen = - forAll $ \n -> monadic $ do - let gen = uniformListM n - x :: ([Word], f) <- toIO $ withMutableGen frozen gen - y <- toIO $ withMutableGen frozen gen - pure $ x == y + forAll $ \n -> monadic $ toIO $ do + let action = uniformListM n + x@(_, _) :: ([Word], f) <- withMutableGen frozen action + y@(r, _) <- withMutableGen frozen action + r' <- withMutableGen_ frozen action + pure $ x == y && r == r' + +overwriteMutableGenSpec :: + forall f m. (ThawedGen f m, Eq f, Show f) + => (forall a. m a -> IO a) + -> f + -> Property IO +overwriteMutableGenSpec toIO frozen = + forAll $ \n -> monadic $ toIO $ do + let action = uniformListM (abs n + 1) -- Non-empty + ((r1, r2), frozen') :: ((String, String), f) <- withMutableGen frozen $ \mutable -> do + r1 <- action mutable + overwriteGen mutable frozen + r2 <- action mutable + modifyGen mutable (const ((), frozen)) + pure (r1, r2) + pure $ r1 == r2 && frozen == frozen' + +indepMutableGenSpec :: + forall f m. (RandomGen f, ThawedGen f m, Eq f, Show f) + => (forall a. m a -> IO a) -> [f] -> Property IO +indepMutableGenSpec toIO fgs = + monadic $ toIO $ do + (fgs ==) <$> (mapM freezeGen =<< mapM thawGen fgs) +immutableFrozenGenSpec :: + forall f m. (RandomGen f, ThawedGen f m, Eq f, Show f) + => (forall a. m a -> IO a) -> f -> Property IO +immutableFrozenGenSpec toIO frozen = + forAll $ \n -> monadic $ toIO $ do + let action = do + mg <- thawGen frozen + (,) <$> uniformWord8 mg <*> freezeGen mg + x <- action + xs <- replicateM n action + pure $ all (x ==) xs -statefulSpecFor :: - forall f m. (FrozenGen f m, Eq f, Show f, Serial IO f, Typeable f) +splitMutableGenSpec :: + forall f m. (RandomGen f, ThawedGen f m, Eq f, Show f) => (forall a. m a -> IO a) - -> (f -> StdGen) + -> f + -> Property IO +splitMutableGenSpec toIO frozen = + monadic $ toIO $ do + (sfg1, fg1) <- withMutableGen frozen splitGen + (smg2, fg2) <- withMutableGen frozen splitMutableGen + sfg3 <- freezeGen smg2 + pure $ fg1 == fg2 && sfg1 == sfg3 + +thawedGenSpecFor :: + forall f m. (RandomGen f, ThawedGen f m, Eq f, Show f, Serial IO f, Typeable f) + => (forall a. m a -> IO a) + -> Proxy f -> TestTree -statefulSpecFor toIO toStdGen = +thawedGenSpecFor toIO px = testGroup - (showsTypeRep (typeRep (Proxy :: Proxy f)) "") + (showsTypeRep (typeRep px) "") [ testProperty "withMutableGen" $ forAll $ \(f :: f) -> withMutableGenSpec toIO f - , testGroup - "matchRandomGenSpec" - [ testProperty "uniformWord8/genWord8" $ - forAll $ \(f :: f) -> - matchRandomGenSpec toIO uniformWord8 genWord8 toStdGen f - , testProperty "uniformWord16/genWord16" $ - forAll $ \(f :: f) -> - matchRandomGenSpec toIO uniformWord16 genWord16 toStdGen f - , testProperty "uniformWord32/genWord32" $ - forAll $ \(f :: f) -> - matchRandomGenSpec toIO uniformWord32 genWord32 toStdGen f - , testProperty "uniformWord64/genWord64" $ - forAll $ \(f :: f) -> - matchRandomGenSpec toIO uniformWord64 genWord64 toStdGen f - , testProperty "uniformWord32R/genWord32R" $ - forAll $ \(w32, f :: f) -> - matchRandomGenSpec toIO (uniformWord32R w32) (genWord32R w32) toStdGen f - , testProperty "uniformWord64R/genWord64R" $ - forAll $ \(w64, f :: f) -> - matchRandomGenSpec toIO (uniformWord64R w64) (genWord64R w64) toStdGen f - , testProperty "uniformShortByteString/genShortByteString" $ - forAll $ \(n', f :: f) -> - let n = abs n' `mod` 1000 -- Ensure it is not too big - in matchRandomGenSpec toIO (uniformShortByteString n) (genShortByteString n) toStdGen f - ] + , testProperty "overwriteGen" $ + forAll $ \(f :: f) -> overwriteMutableGenSpec toIO f + , testProperty "independent mutable generators" $ + forAll $ \(fs :: [f]) -> indepMutableGenSpec toIO fs + , testProperty "immutable frozen generators" $ + forAll $ \(f :: f) -> immutableFrozenGenSpec toIO f + , testProperty "splitGen" $ + forAll $ \(f :: f) -> splitMutableGenSpec toIO f + ] + +frozenGenSpecFor :: + forall f sg m. (RandomGen f, StatefulGen sg m, Eq f, Show f, Typeable f) + => (StdGen -> f) + -> (f -> StdGen) + -> (forall a. f -> (sg -> m a) -> IO (a, f)) + -> TestTree +frozenGenSpecFor fromStdGen toStdGen runStatefulGen = + testGroup (showsTypeRep (typeRep (Proxy :: Proxy f)) "") + [ testGroup "matchRandomGenSpec" + [ testProperty "uniformWord8/genWord8" $ + matchRandomGenSpec uniformWord8 genWord8 fromStdGen toStdGen runStatefulGen + , testProperty "uniformWord16/genWord16" $ + matchRandomGenSpec uniformWord16 genWord16 fromStdGen toStdGen runStatefulGen + , testProperty "uniformWord32/genWord32" $ + matchRandomGenSpec uniformWord32 genWord32 fromStdGen toStdGen runStatefulGen + , testProperty "uniformWord64/genWord64" $ + matchRandomGenSpec uniformWord64 genWord64 fromStdGen toStdGen runStatefulGen + , testProperty "uniformWord32R/genWord32R" $ + forAll $ \w32 -> + matchRandomGenSpec (uniformWord32R w32) (genWord32R w32) fromStdGen toStdGen runStatefulGen + , testProperty "uniformWord64R/genWord64R" $ + forAll $ \w64 -> + matchRandomGenSpec (uniformWord64R w64) (genWord64R w64) fromStdGen toStdGen runStatefulGen + , testProperty "uniformShortByteString/genShortByteString" $ + forAll $ \(NonNegative n') -> + let n = n' `mod` 100000 -- Ensure it is not too big + in matchRandomGenSpec + (uniformShortByteString n) + (genShortByteString n) + fromStdGen + toStdGen + runStatefulGen + ] ] -statefulSpec :: TestTree -statefulSpec = +statefulGenSpec :: TestTree +statefulGenSpec = testGroup - "Stateful" - [ statefulSpecFor id unIOGen - , statefulSpecFor id unAtomicGen - , statefulSpecFor stToIO unSTGen - , statefulSpecFor atomically unTGen - , statefulSpecFor (`evalStateT` mkStdGen 0) unStateGen + "StatefulGen" + [ testGroup "ThawedGen" + [ thawedGenSpecFor id (Proxy :: Proxy (IOGen StdGen)) + , thawedGenSpecFor id (Proxy :: Proxy (AtomicGen StdGen)) + , thawedGenSpecFor stToIO (Proxy :: Proxy (STGen StdGen)) + , thawedGenSpecFor atomically (Proxy :: Proxy (TGen StdGen)) + ] + , testGroup "FrozenGen" + [ frozenGenSpecFor StateGen unStateGen runStateGenT + , frozenGenSpecFor IOGen unIOGen $ \g action -> do + mg <- newIOGenM (unIOGen g) + res <- action mg + g' <- freezeGen mg + pure (res, g') + , frozenGenSpecFor AtomicGen unAtomicGen $ \g action -> do + mg <- newAtomicGenM (unAtomicGen g) + res <- action mg + g' <- freezeGen mg + pure (res, g') + , frozenGenSpecFor STGen unSTGen $ \g action -> stToIO $ do + mg <- newSTGenM (unSTGen g) + res <- action mg + g' <- freezeGen mg + pure (res, g') + , frozenGenSpecFor TGen unTGen $ \g action -> atomically $ do + mg <- newTGenM (unTGen g) + res <- action mg + g' <- freezeGen mg + pure (res, g') + ] ]