diff --git a/src/System/Random/Effect.hs b/src/System/Random/Effect.hs --- a/src/System/Random/Effect.hs +++ b/src/System/Random/Effect.hs @@ -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 ) diff --git a/src/System/Random/Effect/Raw.hs b/src/System/Random/Effect/Raw.hs --- a/src/System/Random/Effect/Raw.hs +++ b/src/System/Random/Effect/Raw.hs @@ -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') diff --git a/system-random-effect.cabal b/system-random-effect.cabal --- a/system-random-effect.cabal +++ b/system-random-effect.cabal @@ -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 diff --git a/test/Test.hs b/test/Test.hs --- a/test/Test.hs +++ b/test/Test.hs @@ -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 ]