Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Deprecate RandomGenM in favor of a more powerful FrozenGen #149

Merged
merged 4 commits into from
Nov 24, 2023
Merged
Changes from 1 commit
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
Next Next commit
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_`
  • Loading branch information
lehins committed Nov 24, 2023

Verified

This commit was created on GitHub.com and signed with GitHub’s verified signature.
commit a3ec12812df4656b7f7a8a05d6681ef7b38639af
4 changes: 4 additions & 0 deletions CHANGELOG.md
Original file line number Diff line number Diff line change
@@ -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)
38 changes: 28 additions & 10 deletions src/System/Random/Internal.hs
Original file line number Diff line number Diff line change
@@ -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.
44 changes: 37 additions & 7 deletions src/System/Random/Stateful.hs
Original file line number Diff line number Diff line change
@@ -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,13 +221,16 @@ 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.
--
-- @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.
36 changes: 26 additions & 10 deletions test/Spec/Stateful.hs
Original file line number Diff line number Diff line change
@@ -36,34 +36,48 @@ 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)
=> (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'

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" $