module Haste.Random (Random (..), Seed, next, mkSeed, newSeed) where
import Haste.JSType
import Data.Int
import Data.Word
import Data.List (unfoldr)
import Control.Monad.IO.Class
#ifndef __HASTE__
import System.Random (randomIO)
#endif
#ifdef __HASTE__
foreign import ccall jsRand :: IO Double
#else
jsRand :: IO Double
jsRand = randomIO
#endif
newtype Seed = Seed Int
mkSeed :: Int -> Seed
mkSeed = Seed . convert
newSeed :: MonadIO m => m Seed
newSeed = liftIO $ do
x <- jsRand
s <- jsRand
let sign = if s > 0.5 then 1 else 1
return . mkSeed . round $ x*sign*2147483647
next :: Seed -> Seed
next (Seed s) =
Seed s'
where
a = 69069
c = 1
s' = a*s+c
class Random a where
randomR :: (a, a) -> Seed -> (a, Seed)
randomRs :: (a, a) -> Seed -> [a]
randomRs bounds seed = unfoldr (Just . randomR bounds) seed
instance Random Int where
randomR (low, high) s@(Seed n) =
(n' `mod` (highlow) + low, next s)
where
a = 214013
c = 2531011
n' = a*n+c
instance Random Int32 where
randomR (l,h) seed =
case randomR (convert l :: Int, convert h) seed of
(n, s) -> (convert n, s)
instance Random Word where
randomR (l,h) seed =
case randomR (convert l :: Int, convert h) seed of
(n, s) -> (convert n, s)
instance Random Word32 where
randomR (l,h) seed =
case randomR (convert l :: Int, convert h) seed of
(n, s) -> (convert n, s)
instance Random Double where
randomR (low, high) seed =
(f * (highlow) + low, s)
where
(n, s) = randomR (0, 2000000001 :: Int) seed
f = convert n / 2000000000