-- |
-- Module      : Random.Stream
-- Copyright   : (c) 2009 Manlio Perillo (manlio.perillo@gmail.com)
-- License     : BSD3 (see LICENSE file)
--
-- Pure interface to the system pseudo random number generator.
-- The generator is assumed to provide an infinite stream of random
-- data, and to be implicitly defined.
--

module System.Random.Stream
    (
     -- Constructor is exposed, so it is possible to access the
     -- underlying lazy ByteString.
     Stream (..)
     , mkStream
     )
    where

import Data.Binary.Get (runGetState, getWordhost)
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.Internal as LI
import System.IO.Unsafe (unsafeInterleaveIO, unsafePerformIO)
import System.Random (RandomGen(..))

import System.Random.URandom (urandom)


newtype Stream = Stream L.ByteString


-- TODO: value should be configurable
defaultChunkSize :: Int
defaultChunkSize = 128 - LI.chunkOverhead

mkStream :: Stream
mkStream = Stream $ unsafePerformIO $ pseudoBytesStream defaultChunkSize

pseudoBytesStream :: Int -> IO L.ByteString
pseudoBytesStream n = lazyGet
    where
      lazyGet = unsafeInterleaveIO loop

      loop = do
        c <- urandom n
        cs <- lazyGet
        return $ LI.Chunk c cs


-- We provide an instance for RandomGen, using native integers.
-- If you need any other type, you can do it by yourself.
instance RandomGen Stream where
   next = randomInt
   -- TODO
   split = error "System.Random.Stream: split not implemented"


randomInt :: Stream -> (Int, Stream)
randomInt (Stream s) = (fromIntegral i, Stream s')
    where
      (i, s', _) = runGetState getWordhost s 0