Introduce ThawedGen

CHANGELOG.md

@@ -1,6 +1,7 @@
 # 1.3.0
 
-* Remove unlawful `FrozenGen` instance for `StateGen`
+* 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 `splitFrozenGen` and `splitMutableGen`
 * Switch `randomM` and `randomRM` to use `FrozenGen` instead of `RandomGenM`

src/System/Random/Internal.hs

@@ -30,6 +30,7 @@ module System.Random.Internal
     RandomGen(..)
   , StatefulGen(..)
   , FrozenGen(..)
+  , ThawedGen(..)
   , splitFrozenGen
   , splitMutableGen
 
@@ -287,53 +288,85 @@ class Monad m => StatefulGen g m where
   {-# INLINE uniformShortByteString #-}
 
 
--- | This class is designed for mutable 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 that are important for this interface:
+-- Here are a few of laws that are important for this interface:
 --
--- 1. Independence and roundtrip of mutable generators:
+-- * Roundtrip and complete destruction on overwrite:
 --
--- prop> (mapM thawGen fgs >>= mapM freezeGen) = pure fgs
+-- @
+-- (overwriteGen mg fg >> freezeGen mg) = pure fg
+-- @
 --
--- 2. Complete destruction on overwrite:
+-- * Modification of mutable generator:
 --
--- prop> (overwriteGen mg fg >> freezeGen mg) = pure fg
+-- @
+-- overwriteGen mg fg = modifyGen mg (const ((), fg)
+-- @
 --
--- 3. Mutable generator modification:
+-- * Freeing of mutable generator:
 --
--- prop> overwriteGen mg fg = modifyGen mg (const ((), fg)
+-- @
+-- 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.
@@ -342,11 +375,11 @@ class StatefulGen (MutableGen f m) m => FrozenGen f m where
 splitFrozenGen :: (RandomGen f, FrozenGen f m) => MutableGen f m -> m f
 splitFrozenGen = 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 = splitFrozenGen >=> thawGen
 
 
@@ -492,6 +525,14 @@ instance (RandomGen g, MonadState g m) => StatefulGen (StateGenM g) m where
   uniformShortByteString n _ = state (genShortByteString n)
   {-# INLINE uniformShortByteString #-}
 
+instance (RandomGen g, MonadState g m) => FrozenGen (StateGen g) m where
+  type MutableGen (StateGen g) m = StateGenM g
+  freezeGen _ = fmap StateGen get
+  modifyGen _ f = state (coerce f)
+  {-# INLINE modifyGen #-}
+  overwriteGen _ f = put (coerce f)
+  {-# INLINE overwriteGen #-}
+
 -- | Splits a pseudo-random number generator into two. Updates the state with
 -- one of the resulting generators and returns the other.
 --

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

test/Spec.hs

@@ -185,19 +185,18 @@ randomSpec ::
 randomSpec px =
   testGroup
     ("Random " ++ showsType px ")")
-    []
-    -- [ SC.testProperty "randoms" $
-    --   seededWithLen $ \len g ->
-    --     take len (randoms g :: [a]) == runStateGen_ g (replicateM len . randomM)
-    -- , SC.testProperty "randomRs" $
-    --   seededWithLen $ \len g ->
-    --     case random g of
-    --       (l, g') ->
-    --         case random g' of
-    --           (h, g'') ->
-    --             take len (randomRs (l, h) g'' :: [a]) ==
-    --             runStateGen_ g'' (replicateM len . randomRM (l, h))
-    -- ]
+    [ SC.testProperty "randoms" $
+      seededWithLen $ \len g ->
+        take len (randoms g :: [a]) == runStateGen_ g (replicateM len . randomM)
+    , SC.testProperty "randomRs" $
+      seededWithLen $ \len g ->
+        case random g of
+          (l, g') ->
+            case random g' of
+              (h, g'') ->
+                take len (randomRs (l, h) g'' :: [a]) ==
+                runStateGen_ g'' (replicateM len . randomRM (l, h))
+    ]
 
 uniformSpec ::
      forall a.

test/Spec/Stateful.hs

@@ -53,7 +53,7 @@ matchRandomGenSpec genM gen fromStdGen toStdGen runStatefulGen =
     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
@@ -66,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
@@ -82,14 +82,14 @@ overwriteMutableGenSpec toIO frozen =
     pure $ r1 == r2 && frozen == frozen'
 
 indepMutableGenSpec ::
-     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
 indepMutableGenSpec toIO fgs =
   monadic $ toIO $ do
     (fgs ==) <$> (mapM freezeGen =<< mapM thawGen fgs)
 
 immutableFrozenGenSpec ::
-     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
 immutableFrozenGenSpec toIO frozen =
   forAll $ \n -> monadic $ toIO $ do
@@ -101,7 +101,7 @@ immutableFrozenGenSpec toIO frozen =
     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
@@ -113,7 +113,7 @@ splitMutableGenSpec toIO frozen =
     pure $ fg1 == fg2 && sfg1 == sfg3
 
 frozenGenSpecFor ::
-     forall f m. (RandomGen f, FrozenGen f m, Eq f, Show f, Serial IO f, Typeable f)
+     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
@@ -183,22 +183,22 @@ statefulSpec =
         , statefulSpecFor IOGen unIOGen $ \g action -> do
             mg <- newIOGenM (unIOGen g)
             res <- action mg
-            g' <- readGen mg
+            g' <- freezeGen mg
             pure (res, g')
         , statefulSpecFor AtomicGen unAtomicGen $ \g action -> do
             mg <- newAtomicGenM (unAtomicGen g)
             res <- action mg
-            g' <- readGen mg
+            g' <- freezeGen mg
             pure (res, g')
         , statefulSpecFor STGen unSTGen $ \g action -> stToIO $ do
             mg <- newSTGenM (unSTGen g)
             res <- action mg
-            g' <- readGen mg
+            g' <- freezeGen mg
             pure (res, g')
         , statefulSpecFor TGen unTGen $ \g action -> atomically $ do
             mg <- newTGenM (unTGen g)
             res <- action mg
-            g' <- readGen mg
+            g' <- freezeGen mg
             pure (res, g')
         ]
     ]