Skip to content

Commit

Permalink
Move thawGen fromFrozenGen into new ThawedGen type class:
Browse files Browse the repository at this point in the history
* 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.
  • Loading branch information
lehins committed Nov 24, 2023
1 parent 4aab7e3 commit c7eb9bd
Show file tree
Hide file tree
Showing 5 changed files with 198 additions and 84 deletions.
2 changes: 2 additions & 0 deletions CHANGELOG.md
Original file line number Diff line number Diff line change
@@ -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`
Expand Down
71 changes: 58 additions & 13 deletions src/System/Random/Internal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -30,6 +30,7 @@ module System.Random.Internal
RandomGen(..)
, StatefulGen(..)
, FrozenGen(..)
, ThawedGen(..)
, splitGen
, splitMutableGen

Expand Down Expand Up @@ -286,40 +287,85 @@ 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 of laws that are important for this interface:
--
-- * Roundtrip and complete destruction on overwrite:
--
-- @
-- (overwriteGen mg fg >> freezeGen mg) = pure fg
-- @
--
-- * Modification of mutable generator:
--
-- @
-- overwriteGen mg fg = modifyGen mg (const ((), fg)
-- @
--
-- It also works great on working with mutable generators that are based on a pure
-- generator that has a `RandomGen` instance.
-- * Freeing of 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
--
-- @since 1.3.0
overwriteGen :: MutableGen f m -> f -> m ()
overwriteGen mg fg = modifyGen mg (const ((), fg))
{-# INLINE overwriteGen #-}

-- | Functionality for thawing frozen generators was split into a separate type 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:
--
-- @
-- (mapM thawGen fgs >>= mapM 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.
Expand All @@ -328,11 +374,11 @@ class StatefulGen (MutableGen f m) m => FrozenGen f m where
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


Expand Down Expand Up @@ -481,7 +527,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)
Expand Down
41 changes: 25 additions & 16 deletions src/System/Random/Stateful.hs
Original file line number Diff line number Diff line change
Expand Up @@ -30,6 +30,7 @@ module System.Random.Stateful
-- $interfaces
, StatefulGen(..)
, FrozenGen(..)
, ThawedGen(..)
, withMutableGen
, withMutableGen_
, randomM
Expand Down Expand Up @@ -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
Expand All @@ -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


Expand Down Expand Up @@ -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.
--
Expand All @@ -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.
Expand Down Expand Up @@ -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.
--
Expand Down Expand Up @@ -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)
Expand All @@ -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__
Expand Down Expand Up @@ -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)
Expand All @@ -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.
--
Expand Down Expand Up @@ -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)
Expand All @@ -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.
--
Expand Down Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion test/Spec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
Loading

0 comments on commit c7eb9bd

Please sign in to comment.