From a3ec12812df4656b7f7a8a05d6681ef7b38639af Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Sat, 28 Oct 2023 14:41:52 +0200 Subject: [PATCH 1/4] Deprecate `RandomGenM` in favor of a more powerful `FrozenGen` * Addition of `modifyGen` totally removes the need for `RandomGenM`, because every frozen generator that is a wrapper around `RandomGen` also derives an instance for `RandomGen` * Add `splitMutableM` and `splitFrozenM` * Avoid redundant freeze in `withMutableGen_` --- CHANGELOG.md | 4 ++++ src/System/Random/Internal.hs | 38 ++++++++++++++++++++++-------- src/System/Random/Stateful.hs | 44 +++++++++++++++++++++++++++++------ test/Spec/Stateful.hs | 36 ++++++++++++++++++++-------- 4 files changed, 95 insertions(+), 27 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 94dd3213..94de1605 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,9 @@ # 1.3.0 +* Add `modifyGen` 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..86cf4b9a 100644 --- a/src/System/Random/Internal.hs +++ b/src/System/Random/Internal.hs @@ -30,6 +30,8 @@ module System.Random.Internal RandomGen(..) , StatefulGen(..) , FrozenGen(..) + , splitGen + , splitMutableGen -- ** Standard pseudo-random number generator , StdGen(..) @@ -40,7 +42,6 @@ module System.Random.Internal -- ** Pure adapter , StateGen(..) , StateGenM(..) - , splitGen , runStateGen , runStateGen_ , runStateGenT @@ -67,7 +68,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 @@ -289,6 +290,9 @@ class Monad m => StatefulGen g m where -- | This class is designed for stateful pseudo-random number generators that -- can be saved as and restored from an immutable data type. -- +-- It also works great on working with mutable generators that are based on a pure +-- generator that has a `RandomGen` instance. +-- -- @since 1.2.0 class StatefulGen (MutableGen f m) m => FrozenGen f m where -- | Represents the state of the pseudo-random number generator for use with @@ -305,6 +309,26 @@ class StatefulGen (MutableGen f m) m => FrozenGen f m where -- @since 1.2.0 thawGen :: f -> m (MutableGen f m) + -- | Apply a pure function to the frozen generator. + -- + -- @since 1.3.0 + modifyGen :: MutableGen f m -> (f -> (a, f)) -> m a + + +-- | Splits a pseudo-random number generator into two. Overwrites the mutable +-- wrapper with one of the resulting generators 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. +-- +-- @since 1.3.0 +splitMutableGen :: (RandomGen f, FrozenGen f m) => MutableGen f m -> m (MutableGen f m) +splitMutableGen = splitGen >=> thawGen + data MBA = MBA (MutableByteArray# RealWorld) @@ -452,14 +476,8 @@ 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 #-} -- | 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..890af7a2 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,15 @@ module System.Random.Stateful -- $interfaces , StatefulGen(..) , FrozenGen(..) - , RandomGenM(..) , withMutableGen , withMutableGen_ , randomM , randomRM + , splitGen + , splitMutableGen + + -- ** Deprecated + , RandomGenM(..) , splitGenM -- * Monadic adapters for pure pseudo-random number generators #monadicadapters# @@ -216,6 +221,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 +230,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 @@ -267,7 +275,7 @@ withMutableGen fg action = do -- -- @since 1.2.0 withMutableGen_ :: FrozenGen f m => f -> (MutableGen f m -> m a) -> m a -withMutableGen_ fg action = fst <$> withMutableGen fg action +withMutableGen_ fg action = thawGen fg >>= action -- | Generates a list of pseudo-random values. @@ -301,8 +309,8 @@ 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 -- | Generates a pseudo-random value using monadic interface and `Random` instance. -- @@ -321,8 +329,8 @@ 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) -- | Wraps an 'IORef' that holds a pure pseudo-random number generator. All -- operations are performed atomically. @@ -379,6 +387,11 @@ instance (RandomGen g, MonadIO m) => FrozenGen (AtomicGen g) m where type MutableGen (AtomicGen g) m = AtomicGenM g freezeGen = fmap AtomicGen . liftIO . readIORef . unAtomicGenM thawGen (AtomicGen g) = newAtomicGenM g + modifyGen (AtomicGenM ioRef) f = + liftIO $ atomicModifyIORef' ioRef $ \g -> + case f (AtomicGen g) of + (a, AtomicGen g') -> (g', a) + {-# INLINE modifyGen #-} -- | Atomically applies a pure operation to the wrapped pseudo-random number -- generator. @@ -454,7 +467,12 @@ instance (RandomGen g, MonadIO m) => FrozenGen (IOGen g) m where type MutableGen (IOGen g) m = IOGenM g freezeGen = fmap IOGen . liftIO . readIORef . unIOGenM thawGen (IOGen g) = newIOGenM g - + 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 #-} -- | Applies a pure operation to the wrapped pseudo-random number generator. -- @@ -514,6 +532,12 @@ instance RandomGen g => FrozenGen (STGen g) (ST s) where type MutableGen (STGen g) (ST s) = STGenM g s freezeGen = fmap STGen . readSTRef . unSTGenM thawGen (STGen g) = newSTGenM g + modifyGen (STGenM ref) f = do + g <- readSTRef ref + let (a, STGen g') = f (STGen g) + g' `seq` writeSTRef ref g' + pure a + {-# INLINE modifyGen #-} -- | Applies a pure operation to the wrapped pseudo-random number generator. @@ -609,6 +633,12 @@ instance RandomGen g => FrozenGen (TGen g) STM where type MutableGen (TGen g) STM = TGenM g freezeGen = fmap TGen . readTVar . unTGenM thawGen (TGen g) = newTGenM g + modifyGen (TGenM ref) f = do + g <- readTVar ref + let (a, TGen g') = f (TGen g) + g' `seq` writeTVar ref g' + pure a + {-# INLINE modifyGen #-} -- | Applies a pure operation to the wrapped pseudo-random number generator. diff --git a/test/Spec/Stateful.hs b/test/Spec/Stateful.hs index 8c951d43..50ed2331 100644 --- a/test/Spec/Stateful.hs +++ b/test/Spec/Stateful.hs @@ -36,18 +36,20 @@ 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 b f m. (RandomGen f, FrozenGen f m, Eq f, Show f, Eq b) => (forall a. m a -> IO a) -> (MutableGen f m -> m b) - -> (StdGen -> (b, StdGen)) + -> (forall g. RandomGen g => g -> (b, g)) -> (f -> StdGen) -> 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 + (x2, fg2) <- toIO $ withMutableGen frozen (`modifyGen` gen) + let (x3, g3) = gen $ toStdGen frozen + let (x4, g4) = toStdGen <$> gen frozen + pure $ and [x1 == x2, x2 == x3, x3 == x4, fg1 == fg2, toStdGen fg1 == g3, g3 == g4] withMutableGenSpec :: forall f m. (FrozenGen f m, Eq f, Show f) @@ -55,15 +57,27 @@ withMutableGenSpec :: -> 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' +splitMutableGenSpec :: + forall f m. (RandomGen f, FrozenGen f m, Eq f, Show f) + => (forall a. m a -> IO a) + -> 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 statefulSpecFor :: - forall f m. (FrozenGen f m, Eq f, Show f, Serial IO f, Typeable f) + forall f m. (RandomGen f, FrozenGen f m, Eq f, Show f, Serial IO f, Typeable f) => (forall a. m a -> IO a) -> (f -> StdGen) -> TestTree @@ -72,6 +86,8 @@ statefulSpecFor toIO toStdGen = (showsTypeRep (typeRep (Proxy :: Proxy f)) "") [ testProperty "withMutableGen" $ forAll $ \(f :: f) -> withMutableGenSpec toIO f + , testProperty "splitGen" $ + forAll $ \(f :: f) -> splitMutableGenSpec toIO f , testGroup "matchRandomGenSpec" [ testProperty "uniformWord8/genWord8" $ From 28920e058d1bc3f0612f71edf04ad796b6ff850f Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Fri, 24 Nov 2023 15:40:46 +0100 Subject: [PATCH 2/4] Add `overwriteGen` to `FrozenGen` --- CHANGELOG.md | 2 +- src/System/Random/Internal.hs | 10 +++++++++- src/System/Random/Stateful.hs | 6 ++++++ test/Spec/Stateful.hs | 18 ++++++++++++++++++ 4 files changed, 34 insertions(+), 2 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 94de1605..2461c3d9 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,6 @@ # 1.3.0 -* Add `modifyGen` to the `FrozenGen` type class +* 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` diff --git a/src/System/Random/Internal.hs b/src/System/Random/Internal.hs index 86cf4b9a..afa5fa42 100644 --- a/src/System/Random/Internal.hs +++ b/src/System/Random/Internal.hs @@ -309,11 +309,17 @@ class StatefulGen (MutableGen f m) m => FrozenGen f m where -- @since 1.2.0 thawGen :: f -> m (MutableGen f m) - -- | Apply a pure function to the frozen generator. + -- | Apply a pure function to the frozen pseudo-random number generator. -- -- @since 1.3.0 modifyGen :: MutableGen f m -> (f -> (a, f)) -> m a + -- | 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)) -- | Splits a pseudo-random number generator into two. Overwrites the mutable -- wrapper with one of the resulting generators and returns the other. @@ -478,6 +484,8 @@ instance (RandomGen g, MonadState g m) => FrozenGen (StateGen g) m where thawGen (StateGen g) = StateGenM <$ put g 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 890af7a2..f3bb057c 100644 --- a/src/System/Random/Stateful.hs +++ b/src/System/Random/Stateful.hs @@ -473,6 +473,8 @@ instance (RandomGen g, MonadIO m) => FrozenGen (IOGen g) m where g' `seq` writeIORef ref g' pure a {-# INLINE modifyGen #-} + overwriteGen (IOGenM ref) = liftIO . writeIORef ref . unIOGen + {-# INLINE overwriteGen #-} -- | Applies a pure operation to the wrapped pseudo-random number generator. -- @@ -538,6 +540,8 @@ instance RandomGen g => FrozenGen (STGen g) (ST s) where g' `seq` writeSTRef ref g' pure a {-# INLINE modifyGen #-} + overwriteGen (STGenM ref) = writeSTRef ref . unSTGen + {-# INLINE overwriteGen #-} -- | Applies a pure operation to the wrapped pseudo-random number generator. @@ -639,6 +643,8 @@ instance RandomGen g => FrozenGen (TGen g) STM where g' `seq` writeTVar ref g' pure a {-# INLINE modifyGen #-} + overwriteGen (TGenM ref) = writeTVar ref . unTGen + {-# INLINE overwriteGen #-} -- | Applies a pure operation to the wrapped pseudo-random number generator. diff --git a/test/Spec/Stateful.hs b/test/Spec/Stateful.hs index 50ed2331..26e2685d 100644 --- a/test/Spec/Stateful.hs +++ b/test/Spec/Stateful.hs @@ -64,6 +64,22 @@ withMutableGenSpec toIO frozen = r' <- withMutableGen_ frozen action pure $ x == y && r == r' +overwriteMutableGenSpec :: + forall f m. (FrozenGen 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' + splitMutableGenSpec :: forall f m. (RandomGen f, FrozenGen f m, Eq f, Show f) => (forall a. m a -> IO a) @@ -86,6 +102,8 @@ statefulSpecFor toIO toStdGen = (showsTypeRep (typeRep (Proxy :: Proxy f)) "") [ testProperty "withMutableGen" $ forAll $ \(f :: f) -> withMutableGenSpec toIO f + , testProperty "overwriteGen" $ + forAll $ \(f :: f) -> overwriteMutableGenSpec toIO f , testProperty "splitGen" $ forAll $ \(f :: f) -> splitMutableGenSpec toIO f , testGroup From 4c1dbd6668d3fe6614b10a33776a2bb64fca9c82 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Sun, 19 Nov 2023 20:18:37 +0100 Subject: [PATCH 3/4] Move `thawGen` from`FrozenGen` into new `ThawedGen` type class: * Also add some laws for `FrozenGen` and `ThawedGen` This split of `FrozenGen` type class into two is needed because some mutable generators can't be cloned, becase the mutable state is stored in the monad they are running in, rather than in the mutable generator itself. --- CHANGELOG.md | 2 + src/System/Random/Internal.hs | 74 ++++++++++++--- src/System/Random/Stateful.hs | 41 +++++---- test/Spec.hs | 2 +- test/Spec/Stateful.hs | 166 +++++++++++++++++++++++----------- 5 files changed, 200 insertions(+), 85 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 2461c3d9..bc2cda35 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,7 @@ # 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` diff --git a/src/System/Random/Internal.hs b/src/System/Random/Internal.hs index afa5fa42..6724ad34 100644 --- a/src/System/Random/Internal.hs +++ b/src/System/Random/Internal.hs @@ -30,6 +30,7 @@ module System.Random.Internal RandomGen(..) , StatefulGen(..) , FrozenGen(..) + , ThawedGen(..) , splitGen , splitMutableGen @@ -286,33 +287,57 @@ 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: -- --- It also works great on working with mutable generators that are based on a pure --- generator that has a `RandomGen` instance. +-- @ +-- 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. - -- - -- @since 1.2.0 - thawGen :: f -> m (MutableGen f m) + 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 @@ -320,19 +345,41 @@ class StatefulGen (MutableGen f m) m => FrozenGen f m where -- @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 --- wrapper with one of the resulting generators and returns the other. +-- 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. +-- | 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, FrozenGen f m) => MutableGen f m -> m (MutableGen f m) +splitMutableGen :: (RandomGen f, ThawedGen f m) => MutableGen f m -> m (MutableGen f m) splitMutableGen = splitGen >=> thawGen @@ -481,7 +528,6 @@ 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 modifyGen _ f = state (coerce f) {-# INLINE modifyGen #-} overwriteGen _ f = put (coerce f) diff --git a/src/System/Random/Stateful.hs b/src/System/Random/Stateful.hs index f3bb057c..cb1c75cc 100644 --- a/src/System/Random/Stateful.hs +++ b/src/System/Random/Stateful.hs @@ -30,6 +30,7 @@ module System.Random.Stateful -- $interfaces , StatefulGen(..) , FrozenGen(..) + , ThawedGen(..) , withMutableGen , withMutableGen_ , randomM @@ -257,7 +258,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 @@ -274,7 +275,7 @@ withMutableGen fg action = do -- 4 -- -- @since 1.2.0 -withMutableGen_ :: FrozenGen f m => f -> (MutableGen f m -> m a) -> m a +withMutableGen_ :: ThawedGen f m => f -> (MutableGen f m -> m a) -> m a withMutableGen_ fg action = thawGen fg >>= action @@ -311,6 +312,7 @@ uniformListM n gen = replicateM n (uniformM gen) -- @since 1.2.0 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. -- @@ -331,6 +333,7 @@ randomM = flip modifyGen random -- @since 1.2.0 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. @@ -386,13 +389,15 @@ 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 - thawGen (AtomicGen g) = newAtomicGenM g 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 -- generator. -- @@ -466,7 +471,6 @@ 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 - thawGen (IOGen g) = newIOGenM g modifyGen (IOGenM ref) f = liftIO $ do g <- readIORef ref let (a, IOGen g') = f (IOGen g) @@ -476,6 +480,9 @@ instance (RandomGen g, MonadIO m) => FrozenGen (IOGen g) m where 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__ @@ -533,7 +540,6 @@ 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 - thawGen (STGen g) = newSTGenM g modifyGen (STGenM ref) f = do g <- readSTRef ref let (a, STGen g') = f (STGen g) @@ -543,6 +549,9 @@ instance RandomGen g => FrozenGen (STGen g) (ST s) where overwriteGen (STGenM ref) = writeSTRef ref . unSTGen {-# INLINE overwriteGen #-} +instance RandomGen g => ThawedGen (STGen g) (ST s) where + thawGen (STGen g) = newSTGenM g + -- | Applies a pure operation to the wrapped pseudo-random number generator. -- @@ -636,7 +645,6 @@ 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 - thawGen (TGen g) = newTGenM g modifyGen (TGenM ref) f = do g <- readTVar ref let (a, TGen g') = f (TGen g) @@ -646,6 +654,9 @@ instance RandomGen g => FrozenGen (TGen g) STM where overwriteGen (TGenM ref) = writeTVar ref . unTGen {-# INLINE overwriteGen #-} +instance RandomGen g => ThawedGen (TGen g) STM where + thawGen (TGen g) = newTGenM g + -- | Applies a pure operation to the wrapped pseudo-random number generator. -- @@ -797,19 +808,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 26e2685d..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,23 +36,24 @@ instance (Monad m, Serial m g) => Serial m (StateGen g) where matchRandomGenSpec :: - forall b f m. (RandomGen f, FrozenGen f m, Eq f, Show f, Eq b) - => (forall a. m a -> IO a) - -> (MutableGen f m -> m b) - -> (forall g. RandomGen g => g -> (b, g)) + 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 - (x2, fg2) <- toIO $ withMutableGen frozen (`modifyGen` gen) - let (x3, g3) = gen $ toStdGen frozen - let (x4, g4) = toStdGen <$> gen frozen - pure $ and [x1 == x2, x2 == x3, x3 == x4, fg1 == fg2, toStdGen fg1 == g3, g3 == g4] +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 @@ -65,7 +66,7 @@ withMutableGenSpec toIO frozen = pure $ x == y && r == r' overwriteMutableGenSpec :: - 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 @@ -80,8 +81,27 @@ overwriteMutableGenSpec toIO 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 + splitMutableGenSpec :: - forall f m. (RandomGen f, FrozenGen f m, Eq f, Show f) + forall f m. (RandomGen f, ThawedGen f m, Eq f, Show f) => (forall a. m a -> IO a) -> f -> Property IO @@ -92,56 +112,94 @@ splitMutableGenSpec toIO frozen = sfg3 <- freezeGen smg2 pure $ fg1 == fg2 && sfg1 == sfg3 -statefulSpecFor :: - forall f m. (RandomGen f, FrozenGen f m, Eq f, Show f, Serial IO f, Typeable f) +thawedGenSpecFor :: + forall f m. (RandomGen f, ThawedGen f m, Eq f, Show f, Serial IO f, Typeable f) => (forall a. m a -> IO a) - -> (f -> StdGen) + -> 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 , 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 - , 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 - ] ] +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') + ] ] From bc58313888c29df42745cb20da7a992a0815b4b0 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Fri, 24 Nov 2023 16:20:37 +0100 Subject: [PATCH 4/4] Fix Haddock link for `StateT` --- src/System/Random/Stateful.hs | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/src/System/Random/Stateful.hs b/src/System/Random/Stateful.hs index cb1c75cc..0e42cc3c 100644 --- a/src/System/Random/Stateful.hs +++ b/src/System/Random/Stateful.hs @@ -164,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] @@ -183,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. -- @@ -198,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.