Skip to content

Commit

Permalink
Rename unSeedGen and seedGen
Browse files Browse the repository at this point in the history
  • Loading branch information
lehins committed Dec 28, 2024
1 parent 04a7b56 commit b002c60
Show file tree
Hide file tree
Showing 5 changed files with 51 additions and 53 deletions.
2 changes: 2 additions & 0 deletions CHANGELOG.md
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,8 @@
* Add `Uniform` instance for `Maybe` and `Either`: [#167](https://github.com/haskell/random/pull/167)
* Add `Seed`, `SeedGen`, `seedSize`, `seedSizeProxy`, `mkSeed` and `unSeed`:
[#162](https://github.com/haskell/random/pull/162)
* Add `mkSeedFromByteString`, `unSeedToByteString`, `withSeed`, `withSeedM`, `withSeedFile`,
`seedGenTypeName`, `nonEmptyToSeed`, `nonEmptyFromSeed`, `withSeedM`, `withSeedMutableGen` and `withSeedMutableGen_`
* Add `SplitGen` and `splitGen`: [#160](https://github.com/haskell/random/pull/160)
* Add `unifromShuffleList` and `unifromShuffleListM`: [#140](https://github.com/haskell/random/pull/140)
* Add `uniformWordR`: [#140](https://github.com/haskell/random/pull/140)
Expand Down
58 changes: 29 additions & 29 deletions src/System/Random/Seed.hs
Original file line number Diff line number Diff line change
Expand Up @@ -67,7 +67,7 @@ import qualified System.Random.SplitMix32 as SM32
-- It is not trivial to implement platform independence. For this reason this type class
-- has two alternative ways of creating an instance for this class. The easiest way for
-- constructing a platform indepent seed is by converting the inner state of a generator
-- to and from a list of 64 bit words using `unSeedGen64` and `seedGen64` respectively. In
-- to and from a list of 64 bit words using `toSeed64` and `fromSeed64` respectively. In
-- that case cross-platform support will be handled automaticaly.
--
-- >>> :set -XDataKinds -XTypeFamilies
Expand All @@ -78,41 +78,41 @@ import qualified System.Random.SplitMix32 as SM32
-- >>> :{
-- instance SeedGen FiveByteGen where
-- type SeedSize FiveByteGen = 5
-- seedGen64 (w64 :| _) =
-- fromSeed64 (w64 :| _) =
-- FiveByteGen (fromIntegral (w64 `shiftR` 32)) (fromIntegral w64)
-- unSeedGen64 (FiveByteGen x1 x4) =
-- toSeed64 (FiveByteGen x1 x4) =
-- let w64 = (fromIntegral x1 `shiftL` 32) .|. fromIntegral x4
-- in (w64 :| [])
-- :}
--
-- >>> FiveByteGen 0x80 0x01020304
-- FiveByteGen 128 16909060
-- >>> seedGen (unSeedGen (FiveByteGen 0x80 0x01020304))
-- >>> fromSeed (toSeed (FiveByteGen 0x80 0x01020304))
-- FiveByteGen 128 16909060
-- >>> unSeedGen (FiveByteGen 0x80 0x01020304)
-- >>> toSeed (FiveByteGen 0x80 0x01020304)
-- Seed [0x04, 0x03, 0x02, 0x01, 0x80]
-- >>> unSeedGen64 (FiveByteGen 0x80 0x01020304)
-- >>> toSeed64 (FiveByteGen 0x80 0x01020304)
-- 549772722948 :| []
--
-- However, when performance is of utmost importance or default handling of cross platform
-- independence is not sufficient, then an adventurous developer can try implementing
-- conversion into bytes directly with `unSeedGen` and `seedGen`.
-- conversion into bytes directly with `toSeed` and `fromSeed`.
--
-- Properties that must hold:
--
-- @
-- > seedGen (unSeedGen gen) == gen
-- > fromSeed (toSeed gen) == gen
-- @
--
-- @
-- > seedGen64 (unSeedGen64 gen) == gen
-- > fromSeed64 (toSeed64 gen) == gen
-- @
--
-- Note, that there is no requirement for every `Seed` to roundtrip, eg. this proprty does
-- not even hold for `StdGen`:
--
-- >>> let seed = nonEmptyToSeed (0xab :| [0xff00]) :: Seed StdGen
-- >>> seed == unSeedGen (seedGen seed)
-- >>> seed == toSeed (fromSeed seed)
-- False
--
-- @since 1.3.0
Expand All @@ -121,23 +121,23 @@ class (KnownNat (SeedSize g), 1 <= SeedSize g, Typeable g) => SeedGen g where
-- number generator. It should be big enough to satisfy the roundtrip property:
--
-- @
-- > seedGen (unSeedGen gen) == gen
-- > fromSeed (toSeed gen) == gen
-- @
--
type SeedSize g :: Nat
{-# MINIMAL (seedGen, unSeedGen)|(seedGen64, unSeedGen64) #-}
{-# MINIMAL (fromSeed, toSeed)|(fromSeed64, toSeed64) #-}

-- | Convert from a binary representation to a pseudo-random number generator
--
-- @since 1.3.0
seedGen :: Seed g -> g
seedGen = seedGen64 . nonEmptyFromSeed
fromSeed :: Seed g -> g
fromSeed = fromSeed64 . nonEmptyFromSeed

-- | Convert to a binary representation of a pseudo-random number generator
--
-- @since 1.3.0
unSeedGen :: g -> Seed g
unSeedGen = nonEmptyToSeed . unSeedGen64
toSeed :: g -> Seed g
toSeed = nonEmptyToSeed . toSeed64

-- | Construct pseudo-random number generator from a list of words. Whenever list does
-- not have enough bytes to satisfy the `SeedSize` requirement, it will be padded with
Expand All @@ -147,33 +147,33 @@ class (KnownNat (SeedSize g), 1 <= SeedSize g, Typeable g) => SeedGen g where
-- element in the list will be used.
--
-- @since 1.3.0
seedGen64 :: NonEmpty Word64 -> g
seedGen64 = seedGen . nonEmptyToSeed
fromSeed64 :: NonEmpty Word64 -> g
fromSeed64 = fromSeed . nonEmptyToSeed

-- | Convert pseudo-random number generator to a list of words
--
-- In case when `SeedSize` is not a multiple of 8, then the upper bits of the last word
-- in the list will be set to zero.
--
-- @since 1.3.0
unSeedGen64 :: g -> NonEmpty Word64
unSeedGen64 = nonEmptyFromSeed . unSeedGen
toSeed64 :: g -> NonEmpty Word64
toSeed64 = nonEmptyFromSeed . toSeed

instance SeedGen StdGen where
type SeedSize StdGen = SeedSize SM.SMGen
seedGen = coerce (seedGen :: Seed SM.SMGen -> SM.SMGen)
unSeedGen = coerce (unSeedGen :: SM.SMGen -> Seed SM.SMGen)
fromSeed = coerce (fromSeed :: Seed SM.SMGen -> SM.SMGen)
toSeed = coerce (toSeed :: SM.SMGen -> Seed SM.SMGen)

instance SeedGen g => SeedGen (StateGen g) where
type SeedSize (StateGen g) = SeedSize g
seedGen = coerce (seedGen :: Seed g -> g)
unSeedGen = coerce (unSeedGen :: g -> Seed g)
fromSeed = coerce (fromSeed :: Seed g -> g)
toSeed = coerce (toSeed :: g -> Seed g)

instance SeedGen SM.SMGen where
type SeedSize SM.SMGen = 16
seedGen (Seed ba) =
fromSeed (Seed ba) =
SM.seedSMGen (indexWord64LE ba 0) (indexWord64LE ba 8)
unSeedGen g =
toSeed g =
case SM.unseedSMGen g of
(seed, gamma) -> Seed $ runST $ do
mba <- newMutableByteArray 16
Expand All @@ -183,13 +183,13 @@ instance SeedGen SM.SMGen where

instance SeedGen SM32.SMGen where
type SeedSize SM32.SMGen = 8
seedGen (Seed ba) =
fromSeed (Seed ba) =
let x = indexWord64LE ba 0
seed, gamma :: Word32
seed = fromIntegral (shiftR x 32)
gamma = fromIntegral x
in SM32.seedSMGen seed gamma
unSeedGen g =
toSeed g =
let seed, gamma :: Word32
(seed, gamma) = SM32.unseedSMGen g
in Seed $ runST $ do
Expand Down Expand Up @@ -252,7 +252,7 @@ withSeed seed f = runIdentity (withSeedM seed (pure . f))
--
-- @since 1.3.0
withSeedM :: (SeedGen g, Functor f) => Seed g -> (g -> f (a, g)) -> f (a, Seed g)
withSeedM seed f = fmap unSeedGen <$> f (seedGen seed)
withSeedM seed f = fmap toSeed <$> f (fromSeed seed)

-- | This is a function that shows the name of the generator type, which is useful for
-- error reporting.
Expand Down
24 changes: 10 additions & 14 deletions src/System/Random/Stateful.hs
Original file line number Diff line number Diff line change
Expand Up @@ -333,7 +333,7 @@ withMutableGen_ fg action = thawGen fg >>= action
-- Given a file path, write an `StdGen` seed into the file:
--
-- >>> :seti -XFlexibleContexts -XScopedTypeVariables
-- >>> let writeInitSeed fp = BS.writeFile fp (unSeedToByteString (unSeedGen (mkStdGen 2025)))
-- >>> let writeInitSeed fp = BS.writeFile fp (unSeedToByteString (toSeed (mkStdGen 2025)))
--
-- Apply a `StatefulGen` monadic action that uses @`IOGen` `StdGen`@, restored from the seed in the given path:
--
Expand Down Expand Up @@ -362,11 +362,7 @@ withSeedMutableGen seed f = withSeedM seed (`withMutableGen` f)
--
-- @since 1.3.0
withSeedMutableGen_ :: (SeedGen g, ThawedGen g m) => Seed g -> (MutableGen g m -> m a) -> m a
withSeedMutableGen_ seed = withMutableGen_ (seedGen seed)

withSeedFileMutableGen_ :: forall g m. (SeedGen g, ThawedGen g m, MonadIO m) => Seed g -> (MutableGen g m -> m a) -> m a
withSeedFileMutableGen_ seed =
withMutableGen_ (seedGen seed)
withSeedMutableGen_ seed = withMutableGen_ (fromSeed seed)


-- | Generates a pseudo-random value using monadic interface and `Random` instance.
Expand Down Expand Up @@ -431,8 +427,8 @@ newtype AtomicGen g = AtomicGen { unAtomicGen :: g}
-- Standalone definition due to GHC-8.0 not supporting deriving with associated type families
instance SeedGen g => SeedGen (AtomicGen g) where
type SeedSize (AtomicGen g) = SeedSize g
seedGen = coerce (seedGen :: Seed g -> g)
unSeedGen = coerce (unSeedGen :: g -> Seed g)
fromSeed = coerce (fromSeed :: Seed g -> g)
toSeed = coerce (toSeed :: g -> Seed g)

-- | Creates a new 'AtomicGenM'.
--
Expand Down Expand Up @@ -544,8 +540,8 @@ newtype IOGen g = IOGen { unIOGen :: g }
-- Standalone definition due to GHC-8.0 not supporting deriving with associated type families
instance SeedGen g => SeedGen (IOGen g) where
type SeedSize (IOGen g) = SeedSize g
seedGen = coerce (seedGen :: Seed g -> g)
unSeedGen = coerce (unSeedGen :: g -> Seed g)
fromSeed = coerce (fromSeed :: Seed g -> g)
toSeed = coerce (toSeed :: g -> Seed g)

-- | Creates a new 'IOGenM'.
--
Expand Down Expand Up @@ -620,8 +616,8 @@ newtype STGen g = STGen { unSTGen :: g }
-- Standalone definition due to GHC-8.0 not supporting deriving with associated type families
instance SeedGen g => SeedGen (STGen g) where
type SeedSize (STGen g) = SeedSize g
seedGen = coerce (seedGen :: Seed g -> g)
unSeedGen = coerce (unSeedGen :: g -> Seed g)
fromSeed = coerce (fromSeed :: Seed g -> g)
toSeed = coerce (toSeed :: g -> Seed g)

-- | Creates a new 'STGenM'.
--
Expand Down Expand Up @@ -721,8 +717,8 @@ newtype TGen g = TGen { unTGen :: g }
-- Standalone definition due to GHC-8.0 not supporting deriving with associated type families
instance SeedGen g => SeedGen (TGen g) where
type SeedSize (TGen g) = SeedSize g
seedGen = coerce (seedGen :: Seed g -> g)
unSeedGen = coerce (unSeedGen :: g -> Seed g)
fromSeed = coerce (fromSeed :: Seed g -> g)
toSeed = coerce (toSeed :: g -> Seed g)

-- | Creates a new 'TGenM' in `STM`.
--
Expand Down
4 changes: 2 additions & 2 deletions test/Spec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -304,8 +304,8 @@ newtype ConstGen = ConstGen Word64

instance SeedGen ConstGen where
type SeedSize ConstGen = 8
seedGen64 (w :| _) = ConstGen w
unSeedGen64 (ConstGen w) = pure w
fromSeed64 (w :| _) = ConstGen w
toSeed64 (ConstGen w) = pure w

instance RandomGen ConstGen where
genWord64 g@(ConstGen c) = (c, g)
Expand Down
16 changes: 8 additions & 8 deletions test/Spec/Seed.hs
Original file line number Diff line number Diff line change
Expand Up @@ -49,26 +49,26 @@ instance (KnownNat n, Monad m) => Serial m (Gen64 n) where

instance (1 <= n, KnownNat n) => SeedGen (GenN n) where
type SeedSize (GenN n) = n
unSeedGen (GenN bs) = fromJust . mkSeed . GHC.fromList $ BS.unpack bs
seedGen = GenN . BS.pack . GHC.toList . unSeed
toSeed (GenN bs) = fromJust . mkSeed . GHC.fromList $ BS.unpack bs
fromSeed = GenN . BS.pack . GHC.toList . unSeed

newtype Gen64 (n :: Nat) = Gen64 (NonEmpty Word64)
deriving (Eq, Show)

instance (1 <= n, KnownNat n) => SeedGen (Gen64 n) where
type SeedSize (Gen64 n) = n
unSeedGen64 (Gen64 ws) = ws
seedGen64 = Gen64
toSeed64 (Gen64 ws) = ws
fromSeed64 = Gen64

seedGenSpec ::
forall g. (SeedGen g, Eq g, Show g, Serial IO g)
=> TestTree
seedGenSpec =
testGroup (seedGenTypeName @g)
[ testProperty "seedGen/unSeedGen" $
forAll $ \(g :: g) -> g == seedGen (unSeedGen g)
, testProperty "seedGen64/unSeedGen64" $
forAll $ \(g :: g) -> g == seedGen64 (unSeedGen64 g)
[ testProperty "fromSeed/toSeed" $
forAll $ \(g :: g) -> g == fromSeed (toSeed g)
, testProperty "fromSeed64/toSeed64" $
forAll $ \(g :: g) -> g == fromSeed64 (toSeed64 g)
]


Expand Down

0 comments on commit b002c60

Please sign in to comment.