{-# 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 Control.Monad.RWS
import qualified Control.Monad.ST.Strict as S
import qualified Control.Monad.State.Strict as S
import qualified Control.Monad.RWS.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 :: forall t. Ref m2 StdGen -> Prim t -> m1 t
getRandomPrimFrom = Ref m2 StdGen -> Prim t -> m1 t
forall (m :: * -> *) sr g a.
(Monad m, ModifyRef sr m g, RandomGen g) =>
sr -> Prim a -> m a
getRandomPrimFromRandomGenRef

instance (Monad m, ModifyRef (IORef   StdGen) m StdGen) => RandomSource m (IORef   StdGen) where
    {-# SPECIALIZE instance RandomSource IO (IORef StdGen) #-}
    getRandomPrimFrom :: forall t. IORef StdGen -> Prim t -> m t
getRandomPrimFrom = IORef StdGen -> Prim t -> m t
forall (m :: * -> *) sr g a.
(Monad m, ModifyRef sr m g, RandomGen g) =>
sr -> Prim a -> m a
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 :: forall t. STRef s StdGen -> Prim t -> m t
getRandomPrimFrom = STRef s StdGen -> Prim t -> m t
forall (m :: * -> *) sr g a.
(Monad m, ModifyRef sr m g, RandomGen g) =>
sr -> Prim a -> m a
getRandomPrimFromRandomGenRef

getRandomPrimFromStdGenIO :: Prim a -> IO a
getRandomPrimFromStdGenIO :: forall a. Prim a -> IO a
getRandomPrimFromStdGenIO 
    = (StdGen -> (a, StdGen)) -> IO a
forall (m :: * -> *) a. MonadIO m => (StdGen -> (a, StdGen)) -> m a
getStdRandom
    ((StdGen -> (a, StdGen)) -> IO a)
-> (Prim a -> StdGen -> (a, StdGen)) -> Prim a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State StdGen a -> StdGen -> (a, StdGen)
forall s a. State s a -> s -> (a, s)
runState
    (State StdGen a -> StdGen -> (a, StdGen))
-> (Prim a -> State StdGen a) -> Prim a -> StdGen -> (a, StdGen)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prim a -> State StdGen a
forall (m :: * -> *) t. MonadRandom m => Prim t -> m t
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 :: forall (m :: * -> *) sr g a.
(Monad m, ModifyRef sr m g, RandomGen g) =>
sr -> Prim a -> m a
getRandomPrimFromRandomGenRef sr
ref 
    = sr -> (g -> (a, g)) -> m a
forall sr (m :: * -> *) a b.
ModifyRef sr m a =>
sr -> (a -> (b, a)) -> m b
atomicModifyReference' sr
ref 
    ((g -> (a, g)) -> m a) -> (Prim a -> g -> (a, g)) -> Prim a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State g a -> g -> (a, g)
forall s a. State s a -> s -> (a, s)
runState 
    (State g a -> g -> (a, g))
-> (Prim a -> State g a) -> Prim a -> g -> (a, g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prim a -> State g a
forall g (m :: * -> *) a.
(RandomGen g, MonadState g m) =>
Prim a -> m a
getRandomPrimFromRandomGenState

atomicModifyReference' :: ModifyRef sr m a => sr -> (a -> (b, a)) -> m b
atomicModifyReference' :: forall sr (m :: * -> *) a b.
ModifyRef sr m a =>
sr -> (a -> (b, a)) -> m b
atomicModifyReference' sr
ref a -> (b, a)
getR =
    sr -> (a -> (a, b)) -> m b
forall sr (m :: * -> *) a b.
ModifyRef sr m a =>
sr -> (a -> (a, b)) -> m b
atomicModifyReference sr
ref ((b, a) -> (a, b)
forall {b} {a}. (b, a) -> (a, b)
swap' ((b, a) -> (a, b)) -> (a -> (b, a)) -> a -> (a, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (b, a)
getR)
        where swap' :: (b, a) -> (a, b)
swap' (!b
a,!a
b) = (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 :: forall g (m :: * -> *) a.
(RandomGen g, MonadState g m) =>
Prim a -> m a
getRandomPrimFromRandomGenState = Prim a -> m a
forall t. Prim t -> m t
genPrim
    where 
        {-# INLINE genPrim #-}
        genPrim :: forall t. Prim t -> m t
        genPrim :: forall t. Prim t -> m t
genPrim Prim t
PrimWord8            = (g -> (Int, g)) -> (Int -> Word8) -> m Word8
forall b t. (g -> (b, g)) -> (b -> t) -> m t
getThing ((Int, Int) -> g -> (Int, g)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (Int
0, Int
0xff))                (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int -> Word8)
        genPrim Prim t
PrimWord16           = (g -> (Int, g)) -> (Int -> Word16) -> m Word16
forall b t. (g -> (b, g)) -> (b -> t) -> m t
getThing ((Int, Int) -> g -> (Int, g)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (Int
0, Int
0xffff))              (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int -> Word16)
        genPrim Prim t
PrimWord32           = (g -> (Integer, g)) -> (Integer -> t) -> m t
forall b t. (g -> (b, g)) -> (b -> t) -> m t
getThing ((Integer, Integer) -> g -> (Integer, g)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (Integer
0, Integer
0xffffffff))          (Integer -> t
forall a. Num a => Integer -> a
fromInteger)
        genPrim Prim t
PrimWord64           = (g -> (Integer, g)) -> (Integer -> t) -> m t
forall b t. (g -> (b, g)) -> (b -> t) -> m t
getThing ((Integer, Integer) -> g -> (Integer, g)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (Integer
0, Integer
0xffffffffffffffff))  (Integer -> t
forall a. Num a => Integer -> a
fromInteger)
        genPrim Prim t
PrimDouble           = (g -> (Integer, g)) -> (Integer -> t) -> m t
forall b t. (g -> (b, g)) -> (b -> t) -> m t
getThing ((Integer, Integer) -> g -> (Integer, g)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (Integer
0, Integer
0x000fffffffffffff))  ((Integer -> Int -> t) -> Int -> Integer -> t
forall a b c. (a -> b -> c) -> b -> a -> c
flip Integer -> Int -> t
forall a. RealFloat a => Integer -> Int -> a
encodeFloat (-Int
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 Int
n) = (g -> (t, g)) -> (t -> t) -> m t
forall b t. (g -> (b, g)) -> (b -> t) -> m t
getThing ((t, t) -> g -> (t, g)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (t
0, (t -> t) -> t -> [t]
forall a. (a -> a) -> a -> [a]
iterate (t -> t -> t
forall a. Num a => a -> a -> a
*t
256) t
1 [t] -> Int -> t
forall a. [a] -> Int -> a
!! Int
n)) t -> t
forall a. a -> a
id
        
        {-# INLINE getThing #-}
        getThing :: forall b t. (g -> (b, g)) -> (b -> t) -> m t
        getThing :: forall b t. (g -> (b, g)) -> (b -> t) -> m t
getThing g -> (b, g)
thing b -> t
f = do
            !g
oldGen <- m g
forall s (m :: * -> *). MonadState s m => m s
get
            case g -> (b, g)
thing g
oldGen of
                (!b
i,!g
newGen) -> do
                    g -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put g
newGen
                    t -> m t
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> t
f (b -> t) -> b -> t
forall a b. (a -> b) -> a -> b
$! b
i)

#ifndef MTL2
instance MonadRandom (State StdGen) where
    getRandomPrim = getRandomPrimFromRandomGenState

instance MonadRandom (S.State StdGen) where
    getRandomPrim = getRandomPrimFromRandomGenState

instance Monoid w => MonadRandom (RWS r w StdGen) where
    getRandomPrim = getRandomPrimFromRandomGenState

instance Monoid w => MonadRandom (S.RWS r w StdGen) where
    getRandomPrim = getRandomPrimFromRandomGenState
#endif

instance Monad m => MonadRandom (StateT StdGen m) where
    getRandomPrim :: forall t. Prim t -> StateT StdGen m t
getRandomPrim = Prim t -> StateT StdGen m t
forall g (m :: * -> *) a.
(RandomGen g, MonadState g m) =>
Prim a -> m a
getRandomPrimFromRandomGenState

instance Monad m => MonadRandom (S.StateT StdGen m) where
    getRandomPrim :: forall t. Prim t -> StateT StdGen m t
getRandomPrim = Prim t -> StateT StdGen m t
forall g (m :: * -> *) a.
(RandomGen g, MonadState g m) =>
Prim a -> m a
getRandomPrimFromRandomGenState

instance (Monad m, Monoid w) => MonadRandom (RWST r w StdGen m) where
    getRandomPrim :: forall t. Prim t -> RWST r w StdGen m t
getRandomPrim = Prim t -> RWST r w StdGen m t
forall g (m :: * -> *) a.
(RandomGen g, MonadState g m) =>
Prim a -> m a
getRandomPrimFromRandomGenState

instance (Monad m, Monoid w) => MonadRandom (S.RWST r w StdGen m) where
    getRandomPrim :: forall t. Prim t -> RWST r w StdGen m t
getRandomPrim = Prim t -> RWST r w StdGen m t
forall g (m :: * -> *) a.
(RandomGen g, MonadState g m) =>
Prim a -> m a
getRandomPrimFromRandomGenState