random-source-0.3.0.6/0000755000000000000000000000000012171155071012622 5ustar0000000000000000random-source-0.3.0.6/random-source.cabal0000644000000000000000000000740412171155071016371 0ustar0000000000000000name: random-source version: 0.3.0.6 stability: provisional cabal-version: >= 1.6 build-type: Simple author: James Cook maintainer: James Cook license: PublicDomain homepage: https://github.com/mokus0/random-fu category: Math synopsis: Generic basis for random number generators description: Random number generation based on entropy sources able to produce a small but well-defined set of primitive variates. Also includes facilities for \"completing\" partial implementations, making it easy to define new entropy sources in a way that is naturally forward-compatible. . Changes in 0.3.0.6: Fixed overzealous fix in 0.3.0.5. The people responsible for sacking the people who have been sacked, etc., have been sacked. . Changes in 0.3.0.5: Renamed some internal modules and accidentally some external ones too. Whoops. Please don't use this version, it will only end in tears. . Changes in 0.3.0.4: Fixed a typo that broke building with MTL-1 . Changes in 0.3.0.3: Fixes for GHC's deprecation of Foreign.unsafePerformIO . Changes in 0.3.0.2: Fixes for GHC 7.2.*'s crazy Template Haskell changes. tested-with: GHC == 7.4.2, GHC == 7.6.1 source-repository head type: git location: https://github.com/mokus0/random-fu.git subdir: random-source Flag base4 Description: base-4 and above do not include syb Flag mtl2 Description: mtl-2 has State, etc., as "type" rather than "newtype" Library ghc-options: -Wall hs-source-dirs: src exposed-modules: Data.Random.Source Data.Random.Source.IO Data.Random.Source.PureMT Data.Random.Source.Std Data.Random.Source.StdGen Data.Random.Internal.Words Data.Random.Internal.Source other-modules: Data.Random.Source.Internal.Prim Data.Random.Source.Internal.TH if impl(ghc >= 6.10) -- mwc-random depends on vector, which doesn't build on GHC < 6.10. -- I considered breaking this module out into another package, but I -- think this is sufficient; anyone compiling something which wants -- this module has pretty much no hope of working on earlier GHCs anyway, -- because the mwc-random library won't have built successfully. -- And if they want to get their hands dirty fixing that, altering -- this cabal file is hardly any additional effort. exposed-modules: Data.Random.Source.MWC build-depends: mwc-random if flag(mtl2) build-depends: mtl == 2.* cpp-options: -DMTL2 else build-depends: mtl == 1.* if flag(base4) build-depends: base >= 4 && <5, syb else build-depends: base >= 3 && <4 build-depends: flexible-defaults >= 0.0.0.2, mersenne-random-pure64, random, stateref >= 0.3 && < 0.4, template-haskell, th-extras if os(Windows) cpp-options: -Dwindows else exposed-modules: Data.Random.Source.DevRandom random-source-0.3.0.6/Setup.lhs0000644000000000000000000000011612171155071014430 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain random-source-0.3.0.6/src/0000755000000000000000000000000012171155071013411 5ustar0000000000000000random-source-0.3.0.6/src/Data/0000755000000000000000000000000012171155071014262 5ustar0000000000000000random-source-0.3.0.6/src/Data/Random/0000755000000000000000000000000012171155071015502 5ustar0000000000000000random-source-0.3.0.6/src/Data/Random/Source.hs0000644000000000000000000000246612171155071017306 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TemplateHaskell, GADTs #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Data.Random.Source ( MonadRandom ( getRandomWord8 , getRandomWord16 , getRandomWord32 , getRandomWord64 , getRandomDouble , getRandomNByteInteger ) , RandomSource ( getRandomWord8From , getRandomWord16From , getRandomWord32From , getRandomWord64From , getRandomDoubleFrom , getRandomNByteIntegerFrom ) , monadRandom, randomSource ) where import Data.Word import Data.Random.Internal.Source import Data.Random.Source.Internal.TH $(randomSource [d| instance Monad m => RandomSource m (m Word8) where getRandomWord8From = id |]) $(randomSource [d| instance Monad m => RandomSource m (m Word16) where getRandomWord16From = id |]) $(randomSource [d| instance Monad m => RandomSource m (m Word32) where getRandomWord32From = id |]) $(randomSource [d| instance Monad m => RandomSource m (m Word64) where getRandomWord64From = id |]) $(randomSource [d| instance Monad m => RandomSource m (m Double) where getRandomDoubleFrom = id |]) random-source-0.3.0.6/src/Data/Random/Internal/0000755000000000000000000000000012171155071017256 5ustar0000000000000000random-source-0.3.0.6/src/Data/Random/Internal/Source.hs0000644000000000000000000001406212171155071021055 0ustar0000000000000000{-# LANGUAGE TemplateHaskell, GADTs, RankNTypes, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-} module Data.Random.Internal.Source ( Prim(..) , MonadRandom(..) , RandomSource(..) , GetPrim(..) ) where import Data.Random.Source.Internal.Prim import Data.Word -- |A typeclass for monads with a chosen source of entropy. For example, -- 'RVar' is such a monad - the source from which it is (eventually) sampled -- is the only source from which a random variable is permitted to draw, so -- when directly requesting entropy for a random variable these functions -- are used. -- -- Minimum implementation is either the internal 'getRandomPrim' or all -- other functions. Additionally, this class's interface is subject to -- extension at any time, so it is very, very strongly recommended that -- the 'monadRandom' Template Haskell function be used to implement this -- function rather than directly implementing it. That function takes care -- of choosing default implementations for any missing functions; as long as -- at least one function is implemented, it will derive sensible -- implementations of all others. -- -- To use 'monadRandom', just wrap your instance declaration as follows (and -- enable the TemplateHaskell and GADTs language extensions): -- -- > $(monadRandom [d| -- > instance MonadRandom FooM where -- > getRandomDouble = return pi -- > getRandomWord16 = return 4 -- > {- etc... -} -- > |]) class Monad m => MonadRandom m where -- |Generate a random value corresponding to the specified primitive. -- -- This is an internal interface; use at your own risk. It may change or -- disappear at any time. getRandomPrim :: Prim t -> m t getRandomPrim PrimWord8 = getRandomWord8 getRandomPrim PrimWord16 = getRandomWord16 getRandomPrim PrimWord32 = getRandomWord32 getRandomPrim PrimWord64 = getRandomWord64 getRandomPrim PrimDouble = getRandomDouble getRandomPrim (PrimNByteInteger n) = getRandomNByteInteger n -- |Generate a uniformly distributed random 'Word8' getRandomWord8 :: m Word8 getRandomWord8 = getRandomPrim PrimWord8 -- |Generate a uniformly distributed random 'Word16' getRandomWord16 :: m Word16 getRandomWord16 = getRandomPrim PrimWord16 -- |Generate a uniformly distributed random 'Word32' getRandomWord32 :: m Word32 getRandomWord32 = getRandomPrim PrimWord32 -- |Generate a uniformly distributed random 'Word64' getRandomWord64 :: m Word64 getRandomWord64 = getRandomPrim PrimWord64 -- |Generate a uniformly distributed random 'Double' in the range 0 <= U < 1 getRandomDouble :: m Double getRandomDouble = getRandomPrim PrimDouble -- |Generate a uniformly distributed random 'Integer' in the range 0 <= U < 256^n getRandomNByteInteger :: MonadRandom m => Int -> m Integer getRandomNByteInteger n = getRandomPrim (PrimNByteInteger n) -- |A source of entropy which can be used in the given monad. -- -- See also 'MonadRandom'. -- -- Minimum implementation is either the internal 'getRandomPrimFrom' or all -- other functions. Additionally, this class's interface is subject to -- extension at any time, so it is very, very strongly recommended that -- the 'randomSource' Template Haskell function be used to implement this -- function rather than directly implementing it. That function takes care -- of choosing default implementations for any missing functions; as long as -- at least one function is implemented, it will derive sensible -- implementations of all others. -- -- To use 'randomSource', just wrap your instance declaration as follows (and -- enable the TemplateHaskell, MultiParamTypeClasses and GADTs language -- extensions, as well as any others required by your instances, such as -- FlexibleInstances): -- -- > $(randomSource [d| -- > instance RandomSource FooM Bar where -- > {- at least one RandomSource function... -} -- > |]) class Monad m => RandomSource m s where -- |Generate a random value corresponding to the specified primitive. -- -- This is an internal interface; use at your own risk. It may change or -- disappear at any time. getRandomPrimFrom :: s -> Prim t -> m t getRandomPrimFrom src PrimWord8 = getRandomWord8From src getRandomPrimFrom src PrimWord16 = getRandomWord16From src getRandomPrimFrom src PrimWord32 = getRandomWord32From src getRandomPrimFrom src PrimWord64 = getRandomWord64From src getRandomPrimFrom src PrimDouble = getRandomDoubleFrom src getRandomPrimFrom src (PrimNByteInteger n) = getRandomNByteIntegerFrom src n -- |Generate a uniformly distributed random 'Word8' getRandomWord8From :: s -> m Word8 getRandomWord8From src = getRandomPrimFrom src PrimWord8 -- |Generate a uniformly distributed random 'Word16' getRandomWord16From :: s -> m Word16 getRandomWord16From src = getRandomPrimFrom src PrimWord16 -- |Generate a uniformly distributed random 'Word32' getRandomWord32From :: s -> m Word32 getRandomWord32From src = getRandomPrimFrom src PrimWord32 -- |Generate a uniformly distributed random 'Word64' getRandomWord64From :: s -> m Word64 getRandomWord64From src = getRandomPrimFrom src PrimWord64 -- |Generate a uniformly distributed random 'Double' in the range 0 <= U < 1 getRandomDoubleFrom :: s -> m Double getRandomDoubleFrom src = getRandomPrimFrom src PrimDouble -- |Generate a uniformly distributed random 'Integer' in the range 0 <= U < 256^n getRandomNByteIntegerFrom :: s -> Int -> m Integer getRandomNByteIntegerFrom src n = getRandomPrimFrom src (PrimNByteInteger n) -- |This type provides a way to define a 'RandomSource' for a monad without actually -- having to declare an instance. newtype GetPrim m = GetPrim (forall t. Prim t -> m t) instance Monad m => RandomSource m (GetPrim m) where getRandomPrimFrom (GetPrim f) = frandom-source-0.3.0.6/src/Data/Random/Internal/Words.hs0000644000000000000000000001216212171155071020712 0ustar0000000000000000-- |A few little functions I found myself writing inline over and over again. module Data.Random.Internal.Words where import Data.Bits import Data.Word import Foreign.Marshal (allocaBytes) import Foreign.Ptr (castPtr) import Foreign.Storable (peek, pokeByteOff) import System.IO.Unsafe (unsafePerformIO) -- TODO: add a build flag for endianness-invariance, or just find a way -- to make sure these operations all do the right thing without costing -- anything extra at runtime {-# INLINE buildWord16 #-} -- |Build a word out of 2 bytes. No promises are made regarding the order -- in which the bytes are stuffed. Note that this means that a 'RandomSource' -- or 'MonadRandom' making use of the default definition of 'getRandomWord', etc., -- may return different random values on different platforms when started -- with the same seed, depending on the platform's endianness. buildWord16 :: Word8 -> Word8 -> Word16 buildWord16 b0 b1 = unsafePerformIO . allocaBytes 2 $ \p -> do pokeByteOff p 0 b0 pokeByteOff p 1 b1 peek (castPtr p) {-# INLINE buildWord32 #-} -- |Build a word out of 4 bytes. No promises are made regarding the order -- in which the bytes are stuffed. Note that this means that a 'RandomSource' -- or 'MonadRandom' making use of the default definition of 'getRandomWord', etc., -- may return different random values on different platforms when started -- with the same seed, depending on the platform's endianness. buildWord32 :: Word8 -> Word8 -> Word8 -> Word8 -> Word32 buildWord32 b0 b1 b2 b3 = unsafePerformIO . allocaBytes 4 $ \p -> do pokeByteOff p 0 b0 pokeByteOff p 1 b1 pokeByteOff p 2 b2 pokeByteOff p 3 b3 peek (castPtr p) {-# INLINE buildWord32' #-} buildWord32' :: Word16 -> Word16 -> Word32 buildWord32' w0 w1 = unsafePerformIO . allocaBytes 4 $ \p -> do pokeByteOff p 0 w0 pokeByteOff p 2 w1 peek (castPtr p) {-# INLINE buildWord64 #-} -- |Build a word out of 8 bytes. No promises are made regarding the order -- in which the bytes are stuffed. Note that this means that a 'RandomSource' -- or 'MonadRandom' making use of the default definition of 'getRandomWord', etc., -- may return different random values on different platforms when started -- with the same seed, depending on the platform's endianness. buildWord64 :: Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word64 buildWord64 b0 b1 b2 b3 b4 b5 b6 b7 = unsafePerformIO . allocaBytes 8 $ \p -> do pokeByteOff p 0 b0 pokeByteOff p 1 b1 pokeByteOff p 2 b2 pokeByteOff p 3 b3 pokeByteOff p 4 b4 pokeByteOff p 5 b5 pokeByteOff p 6 b6 pokeByteOff p 7 b7 peek (castPtr p) {-# INLINE buildWord64' #-} buildWord64' :: Word16 -> Word16 -> Word16 -> Word16 -> Word64 buildWord64' w0 w1 w2 w3 = unsafePerformIO . allocaBytes 8 $ \p -> do pokeByteOff p 0 w0 pokeByteOff p 2 w1 pokeByteOff p 4 w2 pokeByteOff p 6 w3 peek (castPtr p) {-# INLINE buildWord64'' #-} buildWord64'' :: Word32 -> Word32 -> Word64 buildWord64'' w0 w1 = unsafePerformIO . allocaBytes 8 $ \p -> do pokeByteOff p 0 w0 pokeByteOff p 4 w1 peek (castPtr p) {-# INLINE word32ToFloat #-} -- |Pack the low 23 bits from a 'Word32' into a 'Float' in the range [0,1). -- Used to convert a 'stdUniform' 'Word32' to a 'stdUniform' 'Double'. word32ToFloat :: Word32 -> Float word32ToFloat x = (encodeFloat $! toInteger (x .&. 0x007fffff {- 2^23-1 -} )) $ (-23) {-# INLINE word32ToFloatWithExcess #-} -- |Same as word32ToFloat, but also return the unused bits (as the 9 -- least significant bits of a 'Word32') word32ToFloatWithExcess :: Word32 -> (Float, Word32) word32ToFloatWithExcess x = (word32ToFloat x, x `shiftR` 23) {-# INLINE wordToFloat #-} -- |Pack the low 23 bits from a 'Word64' into a 'Float' in the range [0,1). -- Used to convert a 'stdUniform' 'Word64' to a 'stdUniform' 'Double'. wordToFloat :: Word64 -> Float wordToFloat x = (encodeFloat $! toInteger (x .&. 0x007fffff {- 2^23-1 -} )) $ (-23) {-# INLINE wordToFloatWithExcess #-} -- |Same as wordToFloat, but also return the unused bits (as the 41 -- least significant bits of a 'Word64') wordToFloatWithExcess :: Word64 -> (Float, Word64) wordToFloatWithExcess x = (wordToFloat x, x `shiftR` 23) {-# INLINE wordToDouble #-} -- |Pack the low 52 bits from a 'Word64' into a 'Double' in the range [0,1). -- Used to convert a 'stdUniform' 'Word64' to a 'stdUniform' 'Double'. wordToDouble :: Word64 -> Double wordToDouble x = (encodeFloat $! toInteger (x .&. 0x000fffffffffffff {- 2^52-1 -})) $ (-52) {-# INLINE word32ToDouble #-} -- |Pack a 'Word32' into a 'Double' in the range [0,1). Note that a Double's -- mantissa is 52 bits, so this does not fill all of them. word32ToDouble :: Word32 -> Double word32ToDouble x = (encodeFloat $! toInteger x) $ (-32) {-# INLINE wordToDoubleWithExcess #-} -- |Same as wordToDouble, but also return the unused bits (as the 12 -- least significant bits of a 'Word64') wordToDoubleWithExcess :: Word64 -> (Double, Word64) wordToDoubleWithExcess x = (wordToDouble x, x `shiftR` 52) random-source-0.3.0.6/src/Data/Random/Source/0000755000000000000000000000000012171155071016742 5ustar0000000000000000random-source-0.3.0.6/src/Data/Random/Source/DevRandom.hs0000644000000000000000000000364712171155071021167 0ustar0000000000000000{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, GADTs #-} module Data.Random.Source.DevRandom ( DevRandom(..) ) where import Data.Random.Source import Foreign.Marshal (allocaBytes) import Foreign.Ptr (castPtr) import Foreign.Storable (peek) import System.IO (openBinaryFile, hGetBuf, Handle, IOMode(..)) import System.IO.Unsafe (unsafePerformIO) -- |On systems that have it, \/dev\/random is a handy-dandy ready-to-use source -- of nonsense. Keep in mind that on some systems, Linux included, \/dev\/random -- collects \"real\" entropy, and if you don't have a good source of it, such as -- special hardware for the purpose or a *lot* of network traffic, it's pretty easy -- to suck the entropy pool dry with entropy-intensive applications. For many -- purposes other than cryptography, \/dev\/urandom is preferable because when it -- runs out of real entropy it'll still churn out pseudorandom data. data DevRandom = DevRandom | DevURandom deriving (Eq, Show) {-# NOINLINE devRandom #-} devRandom :: Handle devRandom = unsafePerformIO (openBinaryFile "/dev/random" ReadMode) {-# NOINLINE devURandom #-} devURandom :: Handle devURandom = unsafePerformIO (openBinaryFile "/dev/urandom" ReadMode) dev :: DevRandom -> Handle dev DevRandom = devRandom dev DevURandom = devURandom $(randomSource [d| instance RandomSource IO DevRandom where getRandomWord8From src = allocaBytes 1 $ \buf -> do 1 <- hGetBuf (dev src) buf 1 peek buf getRandomWord16From src = allocaBytes 2 $ \buf -> do 2 <- hGetBuf (dev src) buf 2 peek (castPtr buf) getRandomWord32From src = allocaBytes 4 $ \buf -> do 4 <- hGetBuf (dev src) buf 4 peek (castPtr buf) getRandomWord64From src = allocaBytes 8 $ \buf -> do 8 <- hGetBuf (dev src) buf 8 peek (castPtr buf) |]) random-source-0.3.0.6/src/Data/Random/Source/IO.hs0000644000000000000000000000170612171155071017611 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- |For convenience, this module defines an instance of 'MonadRandom' for the 'IO' monad. -- On Windows it uses "Data.Random.Source.MWC" (or "Data.Random.Source.StdGen" on older -- versions of GHC where the mwc-random package doesn't build) and on other platforms it uses -- "Data.Random.Source.DevRandom". module Data.Random.Source.IO () where import Data.Random.Internal.Source #ifndef windows import Data.Random.Source.DevRandom instance MonadRandom IO where getRandomPrim = getRandomPrimFrom DevURandom #else #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 610 import Data.Random.Source.MWC import System.Random.MWC instance MonadRandom IO where getRandomPrim = withSystemRandom . (flip getRandomPrimFrom :: Prim t -> Gen RealWorld -> IO t) #else import Data.Random.Source.StdGen instance MonadRandom IO where getRandomPrim = getRandomPrimFromStdGenIO #endif #endifrandom-source-0.3.0.6/src/Data/Random/Source/MWC.hs0000644000000000000000000000215112171155071017723 0ustar0000000000000000{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, GADTs #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- |This module defines the following instances: -- -- > instance RandomSource (ST s) (Gen s) -- > instance RandomSource IO (Gen RealWorld) module Data.Random.Source.MWC ( Gen, RealWorld , create, initialize , save, restore ) where import Data.Random.Internal.Words import Data.Random.Source import System.Random.MWC import Control.Monad.ST $(randomSource [d| instance RandomSource (ST s) (Gen s) where getRandomWord8From = uniform getRandomWord16From = uniform getRandomWord32From = uniform getRandomWord64From = uniform getRandomDoubleFrom = fmap wordToDouble . uniform |]) $(randomSource [d| instance RandomSource IO (Gen RealWorld) where getRandomWord8From = uniform getRandomWord16From = uniform getRandomWord32From = uniform getRandomWord64From = uniform getRandomDoubleFrom = fmap wordToDouble . uniform |]) random-source-0.3.0.6/src/Data/Random/Source/PureMT.hs0000644000000000000000000001215212171155071020453 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell, GADTs #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- |This module provides functions useful for implementing new 'MonadRandom' -- and 'RandomSource' instances for state-abstractions containing 'PureMT' -- values (the pure pseudorandom generator provided by the -- mersenne-random-pure64 package), as well as instances for some common -- cases. -- -- A 'PureMT' generator is immutable, so 'PureMT' by itself cannot be a -- 'RandomSource' (if it were, it would always give the same \"random\" -- values). Some form of mutable state must be used, such as an 'IORef', -- 'State' monad, etc.. A few default instances are provided by this module -- along with a more-general function ('getRandomPrimFromMTRef') usable as -- an implementation for new cases users might need. module Data.Random.Source.PureMT ( PureMT, newPureMT, pureMT , getRandomPrimFromMTRef ) where import Control.Monad.State import qualified Control.Monad.State.Strict as S import Data.Random.Internal.Source import Data.Random.Source.Internal.TH import Data.StateRef import System.Random.Mersenne.Pure64 {-# INLINE withMTRef #-} withMTRef :: (Monad m, ModifyRef sr m PureMT) => (PureMT -> (t, PureMT)) -> sr -> m t withMTRef thing ref = atomicModifyReference ref $ \(!oldMT) -> case thing oldMT of (!w, !newMT) -> (newMT, w) {-# INLINE withMTState #-} withMTState :: MonadState PureMT m => (PureMT -> (t, PureMT)) -> m t withMTState thing = do !mt <- get let (!ws, !newMt) = thing mt put newMt return ws #ifndef MTL2 $(monadRandom [d| instance MonadRandom (State PureMT) where getRandomWord64 = withMTState randomWord64 getRandomDouble = withMTState randomDouble |]) $(monadRandom [d| instance MonadRandom (S.State PureMT) where getRandomWord64 = withMTState randomWord64 getRandomDouble = withMTState randomDouble |]) #endif $(randomSource [d| instance (Monad m1, ModifyRef (Ref m2 PureMT) m1 PureMT) => RandomSource m1 (Ref m2 PureMT) where getRandomWord64From = withMTRef randomWord64 getRandomDoubleFrom = withMTRef randomDouble |]) $(monadRandom [d| instance Monad m => MonadRandom (StateT PureMT m) where getRandomWord64 = withMTState randomWord64 getRandomDouble = withMTState randomDouble |]) $(monadRandom [d| instance Monad m => MonadRandom (S.StateT PureMT m) where getRandomWord64 = withMTState randomWord64 getRandomDouble = withMTState randomDouble |]) $(randomSource [d| instance (MonadIO m) => RandomSource m (IORef PureMT) where getRandomWord64From = withMTRef randomWord64 getRandomDoubleFrom = withMTRef randomDouble |]) $(randomSource [d| instance (Monad m, ModifyRef (STRef s PureMT) m PureMT) => RandomSource m (STRef s PureMT) where getRandomWord64From = withMTRef randomWord64 getRandomDoubleFrom = withMTRef randomDouble |]) -- Note that this instance is probably a Bad Idea. STM allows random variables -- to interact in spooky quantum-esque ways - One transaction can 'retry' until -- it gets a \"random\" answer it likes, which causes it to selectively consume -- entropy, biasing the supply from which other random variables will draw. -- instance (Monad m, ModifyRef (TVar PureMT) m PureMT) => RandomSource m (TVar PureMT) where -- {-# SPECIALIZE instance RandomSource IO (TVar PureMT) #-} -- {-# SPECIALIZE instance RandomSource STM (TVar PureMT) #-} -- getRandomPrimFrom = getRandomPrimFromMTRef -- |Given a mutable reference to a 'PureMT' generator, we can implement -- 'RandomSource' for it in any monad in which the reference can be modified. -- -- Typically this would be used to define a new 'RandomSource' instance for -- some new reference type or new monad in which an existing reference type -- can be modified atomically. As an example, the following instance could -- be used to describe how 'IORef' 'PureMT' can be a 'RandomSource' in the -- 'IO' monad: -- -- > instance RandomSource IO (IORef PureMT) where -- > supportedPrimsFrom _ _ = True -- > getSupportedRandomPrimFrom = getRandomPrimFromMTRef -- -- (note that there is actually a more general instance declared already -- covering this as a a special case, so there's no need to repeat this -- declaration anywhere) -- -- Example usage (using some functions from "Data.Random" in the random-fu -- package): -- -- > main = do -- > src <- newIORef (pureMT 1234) -- OR: newPureMT >>= newIORef -- > x <- runRVar (uniform 0 100) src :: IO Double -- > print x getRandomPrimFromMTRef :: ModifyRef sr m PureMT => sr -> Prim a -> m a getRandomPrimFromMTRef ref = atomicModifyReference' ref . runState . getRandomPrim atomicModifyReference' :: ModifyRef sr m a => sr -> (a -> (b, a)) -> m b atomicModifyReference' ref getR = atomicModifyReference ref (swap' . getR) where swap' (!a,!b) = (b,a) random-source-0.3.0.6/src/Data/Random/Source/Std.hs0000644000000000000000000000111112171155071020022 0ustar0000000000000000{- - ``Data/Random/Source/Std'' -} {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-} module Data.Random.Source.Std where import Data.Random.Internal.Source -- |A token representing the \"standard\" entropy source in a 'MonadRandom' -- monad. Its sole purpose is to make the following true (when the types check): -- -- > runRVar x StdRandom === sampleRVar data StdRandom = StdRandom instance MonadRandom m => RandomSource m StdRandom where {-SPECIALIZE instance MonadRandom m => RandomSource m StdRandom -} getRandomPrimFrom StdRandom = getRandomPrim random-source-0.3.0.6/src/Data/Random/Source/StdGen.hs0000644000000000000000000001337312171155071020471 0ustar0000000000000000{-# LANGUAGE CPP, MultiParamTypeClasses, FlexibleInstances, UndecidableInstances, GADTs, BangPatterns, RankNTypes, ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- |This module provides functions useful for implementing new 'MonadRandom' -- and 'RandomSource' instances for state-abstractions containing 'StdGen' -- values (the pure pseudorandom generator provided by the System.Random -- module in the \"random\" package), as well as instances for some common -- cases. module Data.Random.Source.StdGen ( StdGen , mkStdGen , newStdGen , getRandomPrimFromStdGenIO , getRandomPrimFromRandomGenRef , getRandomPrimFromRandomGenState ) where import Data.Random.Internal.Source import System.Random import Control.Monad.State import qualified Control.Monad.ST.Strict as S import qualified Control.Monad.State.Strict as S import Data.StateRef import Data.Word instance (Monad m1, ModifyRef (Ref m2 StdGen) m1 StdGen) => RandomSource m1 (Ref m2 StdGen) where getRandomPrimFrom = getRandomPrimFromRandomGenRef instance (Monad m, ModifyRef (IORef StdGen) m StdGen) => RandomSource m (IORef StdGen) where {-# SPECIALIZE instance RandomSource IO (IORef StdGen) #-} getRandomPrimFrom = getRandomPrimFromRandomGenRef -- Note that this instance is probably a Bad Idea. STM allows random variables -- to interact in spooky quantum-esque ways - One transaction can 'retry' until -- it gets a \"random\" answer it likes, which causes it to selectively consume -- entropy, biasing the supply from which other random variables will draw. -- instance (Monad m, ModifyRef (TVar StdGen) m StdGen) => RandomSource m (TVar StdGen) where -- {-# SPECIALIZE instance RandomSource IO (TVar StdGen) #-} -- {-# SPECIALIZE instance RandomSource STM (TVar StdGen) #-} -- supportedPrimsFrom _ _ = True -- getSupportedRandomPrimFrom = getRandomPrimFromRandomGenRef instance (Monad m, ModifyRef (STRef s StdGen) m StdGen) => RandomSource m (STRef s StdGen) where {-# SPECIALIZE instance RandomSource (ST s) (STRef s StdGen) #-} {-# SPECIALIZE instance RandomSource (S.ST s) (STRef s StdGen) #-} getRandomPrimFrom = getRandomPrimFromRandomGenRef getRandomPrimFromStdGenIO :: Prim a -> IO a getRandomPrimFromStdGenIO = getStdRandom . runState . getRandomPrim -- |Given a mutable reference to a 'RandomGen' generator, we can make a -- 'RandomSource' usable in any monad in which the reference can be modified. -- -- See "Data.Random.Source.PureMT".'getRandomPrimFromMTRef' for more detailed -- usage hints - this function serves exactly the same purpose except for a -- 'StdGen' generator instead of a 'PureMT' generator. getRandomPrimFromRandomGenRef :: (Monad m, ModifyRef sr m g, RandomGen g) => sr -> Prim a -> m a getRandomPrimFromRandomGenRef ref = atomicModifyReference' ref . runState . getRandomPrimFromRandomGenState atomicModifyReference' :: ModifyRef sr m a => sr -> (a -> (b, a)) -> m b atomicModifyReference' ref getR = atomicModifyReference ref (swap' . getR) where swap' (!a,!b) = (b,a) -- |Similarly, @getRandomWordFromRandomGenState x@ can be used in any \"state\" -- monad in the mtl sense whose state is a 'RandomGen' generator. -- Additionally, the standard mtl state monads have 'MonadRandom' instances -- which do precisely that, allowing an easy conversion of 'RVar's and -- other 'Distribution' instances to \"pure\" random variables. -- -- Again, see "Data.Random.Source.PureMT".'getRandomPrimFromMTState' for more -- detailed usage hints - this function serves exactly the same purpose except -- for a 'StdGen' generator instead of a 'PureMT' generator. {-# SPECIALIZE getRandomPrimFromRandomGenState :: Prim a -> State StdGen a #-} {-# SPECIALIZE getRandomPrimFromRandomGenState :: Monad m => Prim a -> StateT StdGen m a #-} getRandomPrimFromRandomGenState :: forall g m a. (RandomGen g, MonadState g m) => Prim a -> m a getRandomPrimFromRandomGenState = genPrim where {-# INLINE genPrim #-} genPrim :: forall t. Prim t -> m t genPrim PrimWord8 = getThing (randomR (0, 0xff)) (fromIntegral :: Int -> Word8) genPrim PrimWord16 = getThing (randomR (0, 0xffff)) (fromIntegral :: Int -> Word16) genPrim PrimWord32 = getThing (randomR (0, 0xffffffff)) (fromInteger) genPrim PrimWord64 = getThing (randomR (0, 0xffffffffffffffff)) (fromInteger) genPrim PrimDouble = getThing (randomR (0, 0x000fffffffffffff)) (flip encodeFloat (-52)) {- not using the Random Double instance for 2 reasons. 1st, it only generates 32 bits of entropy, when a [0,1) Double has room for 52. Second, it appears there's a bug where it can actually generate a negative number in the case where randomIvalInteger returns minBound::Int32. -} -- genPrim PrimDouble = getThing (randomR (0, 1.0)) (id) genPrim (PrimNByteInteger n) = getThing (randomR (0, iterate (*256) 1 !! n)) id {-# INLINE getThing #-} getThing :: forall b t. (g -> (b, g)) -> (b -> t) -> m t getThing thing f = do !oldGen <- get case thing oldGen of (!i,!newGen) -> do put newGen return (f $! i) #ifndef MTL2 instance MonadRandom (State StdGen) where getRandomPrim = getRandomPrimFromRandomGenState instance MonadRandom (S.State StdGen) where getRandomPrim = getRandomPrimFromRandomGenState #endif instance Monad m => MonadRandom (StateT StdGen m) where getRandomPrim = getRandomPrimFromRandomGenState instance Monad m => MonadRandom (S.StateT StdGen m) where getRandomPrim = getRandomPrimFromRandomGenState random-source-0.3.0.6/src/Data/Random/Source/Internal/0000755000000000000000000000000012171155071020516 5ustar0000000000000000random-source-0.3.0.6/src/Data/Random/Source/Internal/Prim.hs0000644000000000000000000000450012171155071021760 0ustar0000000000000000{-# LANGUAGE GADTs, RankNTypes, DeriveDataTypeable #-} -- |This is an internal interface to support the 'RVar' abstraction. It -- reifies the operations provided by both MonadRandom and RandomSource in a -- uniform and efficient way, as functions of type @Prim a -> m a@. module Data.Random.Source.Internal.Prim (Prim(..)) where import Data.Word import Data.Typeable -- |A 'Prompt' GADT describing a request for a primitive random variate. -- Random variable definitions will request their entropy via these prompts, -- and entropy sources will satisfy those requests. The functions in -- "Data.Random.Source.Internal.TH" extend incomplete entropy-source definitions -- to complete ones, essentially defining a very flexible -- implementation-defaulting system. -- -- Some possible future additions: -- PrimFloat :: Prim Float -- PrimInt :: Prim Int -- PrimPair :: Prim a -> Prim b -> Prim (a :*: b) -- PrimNormal :: Prim Double -- PrimChoice :: [(Double :*: a)] -> Prim a -- PrimBytes :: !Int -> Prim ByteString -- -- Unfortunately, I cannot get Haddock to accept my comments about the -- data constructors, but hopefully they should be reasonably self-explanatory. data Prim a where -- An unsigned byte, uniformly distributed from 0 to 0xff PrimWord8 :: Prim Word8 -- An unsigned 16-bit word, uniformly distributed from 0 to 0xffff PrimWord16 :: Prim Word16 -- An unsigned 32-bit word, uniformly distributed from 0 to 0xffffffff PrimWord32 :: Prim Word32 -- An unsigned 64-bit word, uniformly distributed from 0 to 0xffffffffffffffff PrimWord64 :: Prim Word64 -- A double-precision float U, uniformly distributed 0 <= U < 1 PrimDouble :: Prim Double -- A uniformly distributed 'Integer' 0 <= U < 256^n PrimNByteInteger :: !Int -> Prim Integer deriving (Typeable) instance Show (Prim a) where showsPrec _p PrimWord8 = showString "PrimWord8" showsPrec _p PrimWord16 = showString "PrimWord16" showsPrec _p PrimWord32 = showString "PrimWord32" showsPrec _p PrimWord64 = showString "PrimWord64" showsPrec _p PrimDouble = showString "PrimDouble" showsPrec p (PrimNByteInteger n) = showParen (p > 10) (showString "PrimNByteInteger " . showsPrec 11 n) random-source-0.3.0.6/src/Data/Random/Source/Internal/TH.hs0000644000000000000000000004654712171155071021405 0ustar0000000000000000{-# LANGUAGE TemplateHaskell, GADTs #-} {-# OPTIONS_GHC -fno-warn-type-defaults -fno-warn-missing-signatures #-} module Data.Random.Source.Internal.TH (monadRandom, randomSource) where import Data.Bits import Data.Generics import Data.List import Data.Maybe import Data.Monoid import Data.Random.Internal.Source (Prim(..), MonadRandom(..), RandomSource(..)) import Data.Random.Internal.Words import Language.Haskell.TH import Language.Haskell.TH.Extras import qualified Language.Haskell.TH.FlexibleDefaults as FD import Control.Monad.Reader data Method = GetPrim | GetWord8 | GetWord16 | GetWord32 | GetWord64 | GetDouble | GetNByteInteger deriving (Eq, Ord, Enum, Bounded, Read, Show) allMethods :: [Method] allMethods = [minBound .. maxBound] data Context = Generic | RandomSource | MonadRandom deriving (Eq, Ord, Enum, Bounded, Read, Show) methodNameBase :: Context -> Method -> String methodNameBase c n = nameBase (methodName c n) methodName :: Context -> Method -> Name methodName Generic GetPrim = mkName "getPrim" methodName Generic GetWord8 = mkName "getWord8" methodName Generic GetWord16 = mkName "getWord16" methodName Generic GetWord32 = mkName "getWord32" methodName Generic GetWord64 = mkName "getWord64" methodName Generic GetDouble = mkName "getDouble" methodName Generic GetNByteInteger = mkName "getNByteInteger" methodName RandomSource GetPrim = 'getRandomPrimFrom methodName RandomSource GetWord8 = 'getRandomWord8From methodName RandomSource GetWord16 = 'getRandomWord16From methodName RandomSource GetWord32 = 'getRandomWord32From methodName RandomSource GetWord64 = 'getRandomWord64From methodName RandomSource GetDouble = 'getRandomDoubleFrom methodName RandomSource GetNByteInteger = 'getRandomNByteIntegerFrom methodName MonadRandom GetPrim = 'getRandomPrim methodName MonadRandom GetWord8 = 'getRandomWord8 methodName MonadRandom GetWord16 = 'getRandomWord16 methodName MonadRandom GetWord32 = 'getRandomWord32 methodName MonadRandom GetWord64 = 'getRandomWord64 methodName MonadRandom GetDouble = 'getRandomDouble methodName MonadRandom GetNByteInteger = 'getRandomNByteInteger isMethodName :: Context -> Name -> Bool isMethodName c n = isJust (nameToMethod c n) nameToMethod :: Context -> Name -> Maybe Method nameToMethod c name = lookup name [ (n, m) | m <- allMethods , let n = methodName c m ] -- 'Context'-sensitive version of the FlexibleDefaults DSL scoreBy :: (a -> b) -> ReaderT Context (FD.Defaults a) t -> ReaderT Context (FD.Defaults b) t scoreBy f = mapReaderT (FD.scoreBy f) method :: Method -> ReaderT Context (FD.Function s) t -> ReaderT Context (FD.Defaults s) t method m f = do c <- ask mapReaderT (FD.function (methodNameBase c m)) f requireMethod :: Method -> ReaderT Context (FD.Defaults s) () requireMethod m = do c <- ask lift (FD.requireFunction (methodNameBase c m)) implementation :: ReaderT Context (FD.Implementation s) (Q [Dec]) -> ReaderT Context (FD.Function s) () implementation = mapReaderT FD.implementation score :: s -> ReaderT Context (FD.Implementation s) () score = lift . FD.score cost :: Num s => s -> ReaderT Context (FD.Implementation s) () cost = lift . FD.cost dependsOn :: Method -> ReaderT Context (FD.Implementation s) () dependsOn m = do c <- ask lift (FD.dependsOn (methodNameBase c m)) inline :: ReaderT Context (FD.Implementation s) () inline = lift FD.inline noinline :: ReaderT Context (FD.Implementation s) () noinline = lift FD.noinline replaceMethodName :: (Method -> Name) -> Name -> Name replaceMethodName f = replace (fmap f . nameToMethod Generic) changeContext :: Context -> Context -> Name -> Name changeContext c1 c2 = replace (fmap (methodName c2) . nameToMethod c1) -- map all occurrences of generic method names to the proper local ones -- and introduce a 'src' parameter where needed if the Context is RandomSource specialize :: Monad m => Q [Dec] -> ReaderT Context m (Q [Dec]) specialize futzedDecsQ = do let decQ = fmap genericalizeDecs futzedDecsQ c <- ask let specializeDec = everywhere (mkT (changeContext Generic c)) if c == RandomSource then return $ do src <- newName "_src" decs <- decQ return (map (addSrcParam src) . specializeDec $ decs) else return (fmap specializeDec decQ) stripTypeSigs :: Q [Dec] -> Q [Dec] stripTypeSigs = fmap (filter (not . isSig)) where isSig SigD{} = True; isSig _ = False addSrcParam :: Name -> Dec -> Dec addSrcParam src = everywhere (mkT expandDecs) . everywhere (mkT expandExps) where srcP = VarP src srcE = VarE src expandDecs (ValD (VarP n) body decs) | isMethodName RandomSource n = FunD n [Clause [srcP] body decs] expandDecs (FunD n clauses) | isMethodName RandomSource n = FunD n [Clause (srcP : ps) body decs | Clause ps body decs <- clauses] expandDecs other = other expandExps e@(VarE n) | isMethodName RandomSource n = AppE e srcE expandExps other = other -- dummy expressions which will be remapped by 'specialize' dummy :: Method -> ExpQ dummy = return . VarE . methodName Generic getPrim, getWord8, getWord16, getWord32, getWord64, getDouble, getNByteInteger :: ExpQ getPrim = dummy GetPrim getWord8 = dummy GetWord8 getWord16 = dummy GetWord16 getWord32 = dummy GetWord32 getWord64 = dummy GetWord64 getDouble = dummy GetDouble getNByteInteger = dummy GetNByteInteger -- The defaulting rules for RandomSource and MonadRandom. Costs are rates of -- entropy waste (bits discarded per bit requested) plus the occasional ad-hoc -- penalty where it seems appropriate. -- TODO: figure out a clean way to break these up for individual testing. -- Also analyze to see which of these can never be selected (I suspect that set is non-empty) defaults :: Context -> FD.Defaults (Sum Double) () defaults = runReaderT $ scoreBy Sum $ do method GetPrim $ do implementation $ do mapM_ dependsOn (allMethods \\ [GetPrim]) -- GHC 6 requires type signatures for GADT matches, even -- inside [d||]. This code is evaluated at more than one type, though, -- and at its eventual splice site the signature actually isn't even allowed. -- So, there's a dummy signature here which is immediately stripped out. specialize . stripTypeSigs $ [d| getPrim :: Prim a -> m a getPrim PrimWord8 = $getWord8 getPrim PrimWord16 = $getWord16 getPrim PrimWord32 = $getWord32 getPrim PrimWord64 = $getWord64 getPrim PrimDouble = $getDouble getPrim (PrimNByteInteger n) = $getNByteInteger n |] scoreBy (/8) $ method GetWord8 $ do implementation $ do dependsOn GetPrim specialize [d| getWord8 = $getPrim PrimWord8 |] implementation $ do cost 1 dependsOn GetNByteInteger specialize [d| getWord8 = liftM fromInteger ($getNByteInteger 1) |] implementation $ do cost 8 dependsOn GetWord16 specialize [d| getWord8 = liftM fromIntegral $getWord16 |] implementation $ do cost 24 dependsOn GetWord32 specialize [d| getWord8 = liftM fromIntegral $getWord32 |] implementation $ do cost 56 dependsOn GetWord64 specialize [d| getWord8 = liftM fromIntegral $getWord64 |] implementation $ do cost 64 dependsOn GetDouble specialize [d| getWord8 = liftM (truncate . (256*)) $getDouble |] scoreBy (/16) $ method GetWord16 $ do implementation $ do dependsOn GetPrim specialize [d| getWord16 = $getPrim PrimWord16 |] implementation $ do cost 1 dependsOn GetNByteInteger specialize [d| getWord16 = liftM fromInteger ($getNByteInteger 2) |] implementation $ do dependsOn GetWord8 specialize [d| getWord16 = do a <- $getWord8 b <- $getWord8 return (buildWord16 a b) |] implementation $ do cost 16 dependsOn GetWord32 specialize [d| getWord16 = liftM fromIntegral $getWord32 |] implementation $ do cost 48 dependsOn GetWord64 specialize [d| getWord16 = liftM fromIntegral $getWord64 |] implementation $ do cost 64 dependsOn GetDouble specialize [d| getWord16 = liftM (truncate . (65536*)) $getDouble |] scoreBy (/32) $ method GetWord32 $ do implementation $ do dependsOn GetPrim specialize [d| getWord32 = $getPrim PrimWord32 |] implementation $ do cost 1 dependsOn GetNByteInteger specialize [d| getWord32 = liftM fromInteger ($getNByteInteger 4) |] implementation $ do cost 0.1 dependsOn GetWord8 specialize [d| getWord32 = do a <- $getWord8 b <- $getWord8 c <- $getWord8 d <- $getWord8 return (buildWord32 a b c d) |] implementation $ do dependsOn GetWord16 specialize [d| getWord32 = do a <- $getWord16 b <- $getWord16 return (buildWord32' a b) |] implementation $ do cost 32 dependsOn GetWord64 specialize [d| getWord32 = liftM fromIntegral $getWord64 |] implementation $ do cost 64 dependsOn GetDouble specialize [d| getWord32 = liftM (truncate . (4294967296*)) $getDouble |] scoreBy (/64) $ method GetWord64 $ do implementation $ do dependsOn GetPrim specialize [d| getWord64 = $getPrim PrimWord64 |] implementation $ do cost 1 dependsOn GetNByteInteger specialize [d| getWord64 = liftM fromInteger ($getNByteInteger 8) |] implementation $ do cost 0.2 dependsOn GetWord8 specialize [d| getWord64 = do a <- $getWord8 b <- $getWord8 c <- $getWord8 d <- $getWord8 e <- $getWord8 f <- $getWord8 g <- $getWord8 h <- $getWord8 return (buildWord64 a b c d e f g h) |] implementation $ do cost 0.1 dependsOn GetWord16 specialize [d| getWord64 = do a <- $getWord16 b <- $getWord16 c <- $getWord16 d <- $getWord16 return (buildWord64' a b c d) |] implementation $ do dependsOn GetWord32 specialize [d| getWord64 = do a <- $getWord32 b <- $getWord32 return (buildWord64'' a b) |] scoreBy (/52) $ method GetDouble $ do implementation $ do dependsOn GetPrim specialize [d| getDouble = $getPrim PrimDouble |] implementation $ do cost 12 dependsOn GetWord64 specialize [d| getDouble = do w <- $getWord64 return (wordToDouble w) |] method GetNByteInteger $ do implementation $ do dependsOn GetPrim specialize [d| getNByteInteger n = $getPrim (PrimNByteInteger n) |] implementation $ do when intIs64 (cost 1e-2) dependsOn GetWord8 dependsOn GetWord16 dependsOn GetWord32 specialize [d| getNByteInteger 1 = do x <- $getWord8 return $! toInteger x getNByteInteger 2 = do x <- $getWord16 return $! toInteger x getNByteInteger 4 = do x <- $getWord32 return $! toInteger x getNByteInteger np4 | np4 > 4 = do let n = np4 - 4 x <- $getWord32 y <- $(dummy GetNByteInteger) n return $! (toInteger x `shiftL` (n `shiftL` 3)) .|. y getNByteInteger np2 | np2 > 2 = do let n = np2 - 2 x <- $getWord16 y <- $(dummy GetNByteInteger) n return $! (toInteger x `shiftL` (n `shiftL` 3)) .|. y getNByteInteger _ = return 0 |] implementation $ do when (not intIs64) (cost 1e-2) dependsOn GetWord8 dependsOn GetWord16 dependsOn GetWord32 dependsOn GetWord64 specialize [d| getNByteInteger 1 = do x <- $getWord8 return $! toInteger x getNByteInteger 2 = do x <- $getWord16 return $! toInteger x getNByteInteger 4 = do x <- $getWord32 return $! toInteger x getNByteInteger 8 = do x <- $getWord64 return $! toInteger x getNByteInteger np8 | np8 > 8 = do let n = np8 - 8 x <- $getWord64 y <- $(dummy GetNByteInteger) n return $! (toInteger x `shiftL` (n `shiftL` 3)) .|. y getNByteInteger np4 | np4 > 4 = do let n = np4 - 4 x <- $getWord32 y <- $(dummy GetNByteInteger) n return $! (toInteger x `shiftL` (n `shiftL` 3)) .|. y getNByteInteger np2 | np2 > 2 = do let n = np2 - 2 x <- $getWord16 y <- $(dummy GetNByteInteger) n return $! (toInteger x `shiftL` (n `shiftL` 3)) .|. y getNByteInteger _ = return 0 |] -- |Complete a possibly-incomplete 'RandomSource' implementation. It is -- recommended that this macro be used even if the implementation is currently -- complete, as the 'RandomSource' class may be extended at any time. -- -- To use 'randomSource', just wrap your instance declaration as follows (and -- enable the TemplateHaskell, MultiParamTypeClasses and GADTs language -- extensions, as well as any others required by your instances, such as -- FlexibleInstances): -- -- > $(randomSource [d| -- > instance RandomSource FooM Bar where -- > {- at least one RandomSource function... -} -- > |]) randomSource :: Q [Dec] -> Q [Dec] randomSource = FD.withDefaults (defaults RandomSource) -- |Complete a possibly-incomplete 'MonadRandom' implementation. It is -- recommended that this macro be used even if the implementation is currently -- complete, as the 'MonadRandom' class may be extended at any time. -- -- To use 'monadRandom', just wrap your instance declaration as follows (and -- enable the TemplateHaskell and GADTs language extensions): -- -- > $(monadRandom [d| -- > instance MonadRandom FooM where -- > getRandomDouble = return pi -- > getRandomWord16 = return 4 -- > {- etc... -} -- > |]) monadRandom :: Q [Dec] -> Q [Dec] monadRandom = FD.withDefaults (defaults MonadRandom) -- -- This is nice in theory, but under GHC 7 it never typechecks; without generalizing the let-bound -- -- functions, it gets absurd errors like "cannot match 'm Int' with 'IO t'". Probably need -- -- to mechanically specialize the supplied signature to create a signature for every other -- -- let-bound function. -- primFunction :: Q Type -> Q [Dec] -> ExpQ -- primFunction getPrimType decsQ = do -- getPrimSig <- sigD (mkName (methodName Generic GetPrim)) getPrimType -- decs <- decsQ >>= FD.implementDefaults (defaults Generic) -- f <- getPrim -- return (LetE (getPrimSig : decs) f)