{-# LANGUAGE CPP #-}
-- Module    : System.Random.TF.Init
-- Copyright : (c) 2013 Michał Pałka
-- License   : BSD3
--
-- Maintainer  : michal.palka@chalmers.se
-- Stability   : experimental
-- Portability : portable
--
module System.Random.TF.Init
 (newTFGen, mkTFGen, mkSeedTime, mkSeedUnix, initTFGen)
 where

import System.Random.TF.Gen (TFGen, seedTFGen, split)

import Control.Monad (when)

import Data.Bits (bitSize)
import Data.IORef
import Data.Word

import Foreign (allocaBytes, peekArray)

import Data.Ratio (numerator, denominator)
import Data.Time
import System.CPUTime
import System.IO
import System.IO.Unsafe (unsafePerformIO)

-- | Use system time create the random seed.
-- This method of seeding may not be relible.
mkSeedTime :: IO (Word64, Word64, Word64, Word64)
mkSeedTime :: IO (Word64, Word64, Word64, Word64)
mkSeedTime = do
  utcTm <- IO UTCTime
getCurrentTime
  cpu <- getCPUTime
  let daytime = DiffTime -> Rational
forall a. Real a => a -> Rational
toRational (DiffTime -> Rational) -> DiffTime -> Rational
forall a b. (a -> b) -> a -> b
$ UTCTime -> DiffTime
utctDayTime UTCTime
utcTm
      t1, t2 :: Word64
      t1 = Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word64) -> Integer -> Word64
forall a b. (a -> b) -> a -> b
$ Rational -> Integer
forall a. Ratio a -> a
numerator Rational
daytime
      t2 = Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word64) -> Integer -> Word64
forall a b. (a -> b) -> a -> b
$ Rational -> Integer
forall a. Ratio a -> a
denominator Rational
daytime
      day = Day -> Integer
toModifiedJulianDay (Day -> Integer) -> Day -> Integer
forall a b. (a -> b) -> a -> b
$ UTCTime -> Day
utctDay UTCTime
utcTm
      d1 :: Word64
      d1 = Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
day
      c1 :: Word64
      c1 = Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
cpu
  return (t1, t2, d1, c1)

-- | Use the UNIX special file @\/dev\/urandom@ to create the seed.
-- Inspired by @random-mwc@.
mkSeedUnix :: IO (Word64, Word64, Word64, Word64)
mkSeedUnix :: IO (Word64, Word64, Word64, Word64)
mkSeedUnix = do
  let bytes :: Int
bytes = Int
32
      rfile :: String
rfile = String
"/dev/urandom"
  l <- Int -> (Ptr Word64 -> IO [Word64]) -> IO [Word64]
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
bytes ((Ptr Word64 -> IO [Word64]) -> IO [Word64])
-> (Ptr Word64 -> IO [Word64]) -> IO [Word64]
forall a b. (a -> b) -> a -> b
$ \Ptr Word64
buf -> do
    nread <- String -> IOMode -> (Handle -> IO Int) -> IO Int
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
rfile IOMode
ReadMode ((Handle -> IO Int) -> IO Int) -> (Handle -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Handle
h ->
      Handle -> Ptr Word64 -> Int -> IO Int
forall a. Handle -> Ptr a -> Int -> IO Int
hGetBuf Handle
h Ptr Word64
buf Int
bytes
    when (nread /= bytes) $
      fail $ "mkSeedUnix: Failed to read " ++
        show bytes ++ " from " ++ rfile
    peekArray 4 buf
  let [x1, x2, x3, x4] = l
  return (x1, x2, x3, x4)

-- | Create a seed and used it to seed an instance of TFGen.
-- Uses 'mkSeedUnix' on UNIX, and 'mkSeedTime' otherwise.
initTFGen :: IO TFGen
initTFGen :: IO TFGen
initTFGen = do
#ifdef UNIX
  s <- mkSeedUnix
#else
  s <- IO (Word64, Word64, Word64, Word64)
mkSeedTime
#endif
  return $ seedTFGen s

-- | Derive a new generator instance from the global RNG using split.
-- This is the default way of obtaining a new RNG instance.
-- Initial generator is seeded using 'mkSeedUnix' on UNIX,
-- and 'mkSeedTime' otherwise. This should be eventually
-- replaced with proper seeding.

-- Inspired by System.Random
newTFGen :: IO TFGen
newTFGen :: IO TFGen
newTFGen = IORef TFGen -> (TFGen -> (TFGen, TFGen)) -> IO TFGen
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef TFGen
theTFGen TFGen -> (TFGen, TFGen)
forall g. RandomGen g => g -> (g, g)
split

{-# NOINLINE theTFGen #-}
theTFGen :: IORef TFGen
theTFGen :: IORef TFGen
theTFGen  = IO (IORef TFGen) -> IORef TFGen
forall a. IO a -> a
unsafePerformIO (IO (IORef TFGen) -> IORef TFGen)
-> IO (IORef TFGen) -> IORef TFGen
forall a b. (a -> b) -> a -> b
$ do
   rng <- IO TFGen
initTFGen
   newIORef rng

-- | Quick and dirty way of creating a deterministically
-- seeded generator.
mkTFGen :: Int -> TFGen
mkTFGen :: Int -> TFGen
mkTFGen Int
n
  | Int -> Int
forall a. Bits a => a -> Int
bitSize Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
64 = String -> TFGen
forall a. HasCallStack => String -> a
error String
"mkTFGen: case where size of Int > 64 not implemented"
  | Bool
otherwise      = (Word64, Word64, Word64, Word64) -> TFGen
seedTFGen (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n, Word64
0, Word64
0, Word64
0)