system-random-effect 0.4.1.1 → 0.4.1.3
raw patch · 4 files changed
+51/−19 lines, 4 filesdep ~basedep ~extensible-effects
Dependency ranges changed: base, extensible-effects
Files
- src/System/Random/Effect.hs +15/−4
- src/System/Random/Effect/Raw.hs +12/−2
- system-random-effect.cabal +10/−7
- test/Test.hs +14/−6
src/System/Random/Effect.hs view
@@ -5,6 +5,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE CPP #-} -- | A random number effect, using a pure mersenne twister under -- the hood. This algorithm is not suitable for cryptography! --@@ -99,6 +100,16 @@ import System.Random.Effect.Raw +#if MIN_VERSION_base(4,7,0)+#else+#define Typeable Typeable1+#define FiniteBits Bits++finiteBitSize :: Bits a => a -> Int+finiteBitSize = bitSize+{-# INLINE finiteBitSize #-}+#endif+ randomDouble :: Member (State Random) r => Eff r Double randomDouble = do@@ -109,11 +120,11 @@ -- | Yields a set of random from the internal generator, -- using 'randomWord64' internally. randomBits :: ( Member (State Random) r- , Bits x)+ , FiniteBits x) => Eff r x randomBits = do let z = clearBit (bit 0) 0 -- zero, so we can get the number of bits- nBits = bitSize z+ nBits = finiteBitSize z -- we OR with zero to get the number of bits above. -- it shouldn't affect the output.@@ -127,7 +138,7 @@ randomBitList k = do let iters = (k `div` 64) + 1 - breakBits w = map (testBit w) [0..(bitSize w - 1)]+ breakBits w = map (testBit w) [0..(finiteBitSize w - 1)] word64s <- replicateM iters randomWord64 @@ -572,7 +583,7 @@ -- | Shuffle a mutable vector. knuthShuffleM :: ( PrimMonad m , Applicative m- , Typeable1 m+ , Typeable m , Member (State Random) r , SetMember Lift (Lift m) r )
src/System/Random/Effect/Raw.hs view
@@ -11,6 +11,7 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-} module System.Random.Effect.Raw ( Random -- * Seeding , mkRandom@@ -41,6 +42,15 @@ import Control.Eff.Lift import Control.Eff.State.Strict +#if MIN_VERSION_base(4,7,0)+#else+#define FiniteBits Bits++finiteBitSize :: Bits a => a -> Int+finiteBitSize = bitSize+{-# INLINE finiteBitSize #-}+#endif+ -- | A random number generator. Either a fast, insecure mersenne -- twister or a secure one, depending on which smart constructor -- is used to construct this type.@@ -118,13 +128,13 @@ {-# INLINE foldBits #-} -- | Securely generate some random bits.-srandomBits :: ( Bits a+srandomBits :: ( FiniteBits a , Num a ) => CR.SystemRandom -> (a, CR.SystemRandom) srandomBits sr = let z = clearBit (bit 0) 0- nBytes = bitSize z `div` 8+ nBytes = finiteBitSize z `div` 8 in case CR.genBytes nBytes sr of Left err -> error $ "system-random-effect: System.Random.Effect.Secure: genBytes: " ++ show err Right (bs, sr') -> (z .|. foldBits bs, sr')
system-random-effect.cabal view
@@ -1,5 +1,5 @@ name: system-random-effect-version: 0.4.1.1+version: 0.4.1.3 synopsis: Random number generation for extensible effects. homepage: https://github.com/wowus/system-random-effect license: BSD3@@ -16,8 +16,9 @@ exposed-modules: System.Random.Effect other-modules: System.Random.Effect.Raw - build-depends: base == 4.6.*- , extensible-effects == 1.2.*+ build-depends: base >= 4.6+ , base < 4.8+ , extensible-effects == 1.4.* , mersenne-random-pure64 == 0.2.* , statistics == 0.10.* , vector == 0.10.*@@ -35,14 +36,15 @@ ghc-options: -rtsopts=all -threaded -O2 - build-depends: base == 4.6.*+ build-depends: base >= 4.6+ , base < 4.8 , vector == 0.10.* , QuickCheck == 2.* , HUnit == 1.2.* , test-framework == 0.8.* , test-framework-hunit == 0.3.* , test-framework-quickcheck2 == 0.3.*- , extensible-effects == 1.2.*+ , extensible-effects , system-random-effect default-language: Haskell2010@@ -54,10 +56,11 @@ main-is: Bench.hs x-uses-tf: true - build-depends: base == 4.6.*+ build-depends: base >= 4.6+ , base < 4.8 , deepseq == 1.3.* , criterion == 0.8.*- , extensible-effects == 1.2.*+ , extensible-effects , vector == 0.10.* , system-random-effect
test/Test.hs view
@@ -5,7 +5,7 @@ import Prelude hiding (all) -import Control.Eff+import Control.Eff as Eff import Control.Eff.Lift import Control.Eff.State.Strict @@ -22,13 +22,14 @@ import Test.Framework.Providers.QuickCheck2 import Test.QuickCheck+import Test.QuickCheck.Monadic as Test import Test.QuickCheck.Property ( morallyDubiousIOProperty ) main :: IO () main = defaultMain tests runWithSeed :: Word64 -> Eff (State Random :> ()) a -> a-runWithSeed seed = run . runRandomState (mkRandom seed)+runWithSeed seed = Eff.run . runRandomState (mkRandom seed) runIOWithSeed :: Word64 -> Eff (State Random :> Lift IO :> ()) a -> IO a runIOWithSeed seed = runLift . runRandomState (mkRandom seed)@@ -125,7 +126,7 @@ runLift $ do rng <- mkSecureRandomIO- return $ run $ runRandomState rng $+ return $ Eff.run $ runRandomState rng $ checkRange (low, high) <$> uniformIntDist a b (|>) :: b -> (b -> c) -> c@@ -155,6 +156,13 @@ in V.all (\x -> x >= samplesPerBucket - maxDelta && x <= samplesPerBucket + maxDelta) hist +runIOProperty ::+ Testable prop =>+ IO prop ->+ Property+runIOProperty prop+ = monadicIO $ Test.run prop >>= stop+ tests :: [Test] tests = [ testProperty "random range" testUniformRandom@@ -163,8 +171,8 @@ , testProperty "unsafeThaw is okay to use" testUnsafeThaw , testProperty "testUniformIntegralDist == testUniformIntDist" testUniformIntegralDist , testProperty "knuth shuffle" testKnuthShuffle- , testProperty "knuth shuffle (monadic)" (\xs seed -> morallyDubiousIOProperty $ testKnuthShuffleM xs seed)- , testProperty "knuth shuffle equivalence" (\xs seed -> morallyDubiousIOProperty $ testKnuthShuffleEquivalence xs seed)- , testProperty "secure random" (\a b -> morallyDubiousIOProperty $ testSecureRandom a b)+ , testProperty "knuth shuffle (monadic)" (\xs seed -> runIOProperty $ testKnuthShuffleM xs seed)+ , testProperty "knuth shuffle equivalence" (\xs seed -> runIOProperty $ testKnuthShuffleEquivalence xs seed)+ , testProperty "secure random" (\a b -> runIOProperty $ testSecureRandom a b) , testProperty "uniformIntDist is uniform-ish" simpleUniformIntDistTest ]