    {-# 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)