Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
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
2 changes: 1 addition & 1 deletion random.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -85,10 +85,10 @@ library
exposed-modules:
System.Random
System.Random.Internal
System.Random.Seed
System.Random.Stateful
other-modules:
System.Random.Array
System.Random.Seed
System.Random.GFinite

hs-source-dirs: src
Expand Down
41 changes: 20 additions & 21 deletions src/System/Random/Seed.hs
Original file line number Diff line number Diff line change
@@ -1,7 +1,6 @@
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
Expand Down Expand Up @@ -67,7 +66,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 `unSeedGen64` and `seedGen64` respectively. In
-- that case cross-platform support will be handled automaticaly.
--
-- >>> :set -XDataKinds -XTypeFamilies
Expand All @@ -80,39 +79,39 @@ import qualified System.Random.SplitMix32 as SM32
-- type SeedSize FiveByteGen = 5
-- seedGen64 (w64 :| _) =
-- FiveByteGen (fromIntegral (w64 `shiftR` 32)) (fromIntegral w64)
-- unseedGen64 (FiveByteGen x1 x4) =
-- unSeedGen64 (FiveByteGen x1 x4) =
-- let w64 = (fromIntegral x1 `shiftL` 32) .|. fromIntegral x4
-- in (w64 :| [])
-- :}
--
-- >>> FiveByteGen 0x80 0x01020304
-- FiveByteGen 128 16909060
-- >>> seedGen (unseedGen (FiveByteGen 0x80 0x01020304))
-- >>> seedGen (unSeedGen (FiveByteGen 0x80 0x01020304))
-- FiveByteGen 128 16909060
-- >>> unseedGen (FiveByteGen 0x80 0x01020304)
-- >>> unSeedGen (FiveByteGen 0x80 0x01020304)
-- Seed [0x04, 0x03, 0x02, 0x01, 0x80]
-- >>> unseedGen64 (FiveByteGen 0x80 0x01020304)
-- >>> unSeedGen64 (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 `unSeedGen` and `seedGen`.
--
-- Properties that must hold:
--
-- @
-- > seedGen (unseedGen gen) == gen
-- > seedGen (unSeedGen gen) == gen
-- @
--
-- @
-- > seedGen64 (unseedGen64 gen) == gen
-- > seedGen64 (unSeedGen64 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 == unSeedGen (seedGen seed)
-- False
--
-- @since 1.3.0
Expand All @@ -121,11 +120,11 @@ 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
-- > seedGen (unSeedGen gen) == gen
-- @
--
type SeedSize g :: Nat
{-# MINIMAL (seedGen, unseedGen)|(seedGen64, unseedGen64) #-}
{-# MINIMAL (seedGen, unSeedGen)|(seedGen64, unSeedGen64) #-}

-- | Convert from a binary representation to a pseudo-random number generator
--
Expand All @@ -136,8 +135,8 @@ class (KnownNat (SeedSize g), 1 <= SeedSize g, Typeable g) => SeedGen g where
-- | Convert to a binary representation of a pseudo-random number generator
--
-- @since 1.3.0
unseedGen :: g -> Seed g
unseedGen = nonEmptyToSeed . unseedGen64
unSeedGen :: g -> Seed g
unSeedGen = nonEmptyToSeed . unSeedGen64

-- | 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 @@ -156,24 +155,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
unSeedGen64 :: g -> NonEmpty Word64
unSeedGen64 = nonEmptyFromSeed . unSeedGen

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)
unSeedGen = coerce (unSeedGen :: 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)
unSeedGen = coerce (unSeedGen :: g -> Seed g)

instance SeedGen SM.SMGen where
type SeedSize SM.SMGen = 16
seedGen (Seed ba) =
SM.seedSMGen (indexWord64LE ba 0) (indexWord64LE ba 8)
unseedGen g =
unSeedGen g =
case SM.unseedSMGen g of
(seed, gamma) -> Seed $ runST $ do
mba <- newMutableByteArray 16
Expand All @@ -189,7 +188,7 @@ instance SeedGen SM32.SMGen where
seed = fromIntegral (shiftR x 32)
gamma = fromIntegral x
in SM32.seedSMGen seed gamma
unseedGen g =
unSeedGen g =
let seed, gamma :: Word32
(seed, gamma) = SM32.unseedSMGen g
in Seed $ runST $ do
Expand Down Expand Up @@ -246,7 +245,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 unSeedGen <$> f (seedGen seed)

-- | This is a function that shows the name of the generator type, which is useful for
-- error reporting.
Expand Down
8 changes: 4 additions & 4 deletions src/System/Random/Stateful.hs
Original file line number Diff line number Diff line change
Expand Up @@ -396,7 +396,7 @@ newtype AtomicGen g = AtomicGen { unAtomicGen :: g}
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)
unSeedGen = coerce (unSeedGen :: g -> Seed g)

-- | Creates a new 'AtomicGenM'.
--
Expand Down Expand Up @@ -509,7 +509,7 @@ newtype IOGen g = IOGen { unIOGen :: g }
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)
unSeedGen = coerce (unSeedGen :: g -> Seed g)

-- | Creates a new 'IOGenM'.
--
Expand Down Expand Up @@ -585,7 +585,7 @@ newtype STGen g = STGen { unSTGen :: g }
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)
unSeedGen = coerce (unSeedGen :: g -> Seed g)

-- | Creates a new 'STGenM'.
--
Expand Down Expand Up @@ -686,7 +686,7 @@ newtype TGen g = TGen { unTGen :: g }
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)
unSeedGen = coerce (unSeedGen :: g -> Seed g)

-- | Creates a new 'TGenM' in `STM`.
--
Expand Down
2 changes: 1 addition & 1 deletion test/Spec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -305,7 +305,7 @@ newtype ConstGen = ConstGen Word64
instance SeedGen ConstGen where
type SeedSize ConstGen = 8
seedGen64 (w :| _) = ConstGen w
unseedGen64 (ConstGen w) = pure w
unSeedGen64 (ConstGen w) = pure w

instance RandomGen ConstGen where
genWord64 g@(ConstGen c) = (c, g)
Expand Down
12 changes: 6 additions & 6 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
unSeedGen (GenN bs) = fromJust . mkSeed . GHC.fromList $ BS.unpack bs
seedGen = 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
unSeedGen64 (Gen64 ws) = ws
seedGen64 = 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 "seedGen/unSeedGen" $
forAll $ \(g :: g) -> g == seedGen (unSeedGen g)
, testProperty "seedGen64/unSeedGen64" $
forAll $ \(g :: g) -> g == seedGen64 (unSeedGen64 g)
]


Expand Down
Loading