From b002c60a5f0f1204d50ab14ef0d8640e8e439f12 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Sat, 28 Dec 2024 09:23:14 -0700 Subject: [PATCH] Rename unSeedGen and seedGen --- CHANGELOG.md | 2 ++ src/System/Random/Seed.hs | 58 +++++++++++++++++------------------ src/System/Random/Stateful.hs | 24 ++++++--------- test/Spec.hs | 4 +-- test/Spec/Seed.hs | 16 +++++----- 5 files changed, 51 insertions(+), 53 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 4b39a7b3..6fffa1d9 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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) diff --git a/src/System/Random/Seed.hs b/src/System/Random/Seed.hs index a4736358..58507e6b 100644 --- a/src/System/Random/Seed.hs +++ b/src/System/Random/Seed.hs @@ -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 @@ -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 @@ -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 @@ -147,8 +147,8 @@ 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 -- @@ -156,24 +156,24 @@ class (KnownNat (SeedSize g), 1 <= SeedSize g, Typeable g) => SeedGen g where -- 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 @@ -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 @@ -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. diff --git a/src/System/Random/Stateful.hs b/src/System/Random/Stateful.hs index d76f0a9e..17eb69e0 100644 --- a/src/System/Random/Stateful.hs +++ b/src/System/Random/Stateful.hs @@ -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: -- @@ -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. @@ -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'. -- @@ -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'. -- @@ -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'. -- @@ -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`. -- diff --git a/test/Spec.hs b/test/Spec.hs index d6cc8f43..de79ca73 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -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) diff --git a/test/Spec/Seed.hs b/test/Spec/Seed.hs index 3367df78..8d31ffd3 100644 --- a/test/Spec/Seed.hs +++ b/test/Spec/Seed.hs @@ -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) ]