-----------------------------------------------------------------------------
{-# LANGUAGE CPP               #-}
{-# LANGUAGE OverloadedStrings #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Miso.Random
-- Copyright   :  (C) 2016-2025 David M. Johnson
-- License     :  BSD3-style (see the file LICENSE)
-- Maintainer  :  David M. Johnson <code@dmj.io>
-- Stability   :  experimental
-- Portability :  non-portable
--
-- A PRNG for use in Component and the Component test infrastructure.
--
-- Uses the splitmix32 algorithm under the hood.
--
----------------------------------------------------------------------------
module Miso.Random
  ( -- ** Types
    StdGen (..)
  , Seed
    -- ** Functions
  , newStdGen
  , mkStdGen
  , next
  , replicateRM
    -- ** Globals
  , globalStdGen
  ) where
-----------------------------------------------------------------------------
import           Data.Tuple (swap)
import           Control.Monad.State (state, runState)
import           Control.Monad (replicateM)
import           Data.IORef
import           System.IO.Unsafe (unsafePerformIO)
-----------------------------------------------------------------------------
import           Miso.DSL
import qualified Miso.FFI.Internal as FFI
-----------------------------------------------------------------------------
-- | t'StdGen' holds a JS t'Function'.
newtype StdGen = StdGen Function
-----------------------------------------------------------------------------
-- | An initial 'Seed' value, useful for simulations or reproducing test failures
type Seed = Int
-----------------------------------------------------------------------------
-- | Like 'Miso.Random.newStdGen' but takes a t'Seed' as an argument and is pure.
mkStdGen :: Seed -> StdGen
mkStdGen :: Seed -> StdGen
mkStdGen Seed
seed = Function -> StdGen
StdGen (Function -> StdGen) -> Function -> StdGen
forall a b. (a -> b) -> a -> b
$ JSVal -> Function
Function (JSVal -> Function) -> JSVal -> Function
forall a b. (a -> b) -> a -> b
$ IO JSVal -> JSVal
forall a. IO a -> a
unsafePerformIO (IO JSVal -> JSVal) -> IO JSVal -> JSVal
forall a b. (a -> b) -> a -> b
$ Double -> IO JSVal
FFI.splitmix32 (Seed -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Seed
seed)
-----------------------------------------------------------------------------
-- | Create a new t'StdGen', defaulting to a random t'Seed'.
newStdGen :: IO StdGen
newStdGen :: IO StdGen
newStdGen = do
  seed <- IO Double
FFI.getRandomValue
  StdGen . Function <$> FFI.splitmix32 seed
-----------------------------------------------------------------------------
-- | Get the next t'StdGen', extracting the value, useful with t'State'.
next :: StdGen -> (Double, StdGen)
next :: StdGen -> (Double, StdGen)
next (StdGen Function
func) = IO (Double, StdGen) -> (Double, StdGen)
forall a. IO a -> a
unsafePerformIO (IO (Double, StdGen) -> (Double, StdGen))
-> IO (Double, StdGen) -> (Double, StdGen)
forall a b. (a -> b) -> a -> b
$ do
  result <- Function -> () -> IO Double
forall a args.
(FromJSVal a, ToArgs args) =>
Function -> args -> IO a
apply Function
func ()
  pure (result, StdGen func)
-----------------------------------------------------------------------------
-- | Global 'StdGen', used by 'replicateRM' and others.
globalStdGen :: IORef StdGen
{-# NOINLINE globalStdGen #-}
globalStdGen :: IORef StdGen
globalStdGen = IO (IORef StdGen) -> IORef StdGen
forall a. IO a -> a
unsafePerformIO (IO (IORef StdGen) -> IORef StdGen)
-> IO (IORef StdGen) -> IORef StdGen
forall a b. (a -> b) -> a -> b
$ do
  seed <- Double -> Seed
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Seed) -> (Double -> Double) -> Double -> Seed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
1e7) (Double -> Seed) -> IO Double -> IO Seed
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Double
FFI.mathRandom
  newIORef (mkStdGen seed)
-----------------------------------------------------------------------------
-- | Generate n amount of random numbers. Uses the global PRNG 'globalStdGen'.
--
-- @
-- replicateRM 10 :: IO [Double]
-- @
--
replicateRM :: Int -> IO [Double]
replicateRM :: Seed -> IO [Double]
replicateRM Seed
n = do
  IORef StdGen -> (StdGen -> (StdGen, [Double])) -> IO [Double]
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef StdGen
globalStdGen ((StdGen -> (StdGen, [Double])) -> IO [Double])
-> (StdGen -> (StdGen, [Double])) -> IO [Double]
forall a b. (a -> b) -> a -> b
$ \StdGen
gen -> do
    ([Double], StdGen) -> (StdGen, [Double])
forall a b. (a, b) -> (b, a)
swap (([Double], StdGen) -> (StdGen, [Double]))
-> ([Double], StdGen) -> (StdGen, [Double])
forall a b. (a -> b) -> a -> b
$ (State StdGen [Double] -> StdGen -> ([Double], StdGen))
-> StdGen -> State StdGen [Double] -> ([Double], StdGen)
forall a b c. (a -> b -> c) -> b -> a -> c
flip State StdGen [Double] -> StdGen -> ([Double], StdGen)
forall s a. State s a -> s -> (a, s)
runState StdGen
gen (State StdGen [Double] -> ([Double], StdGen))
-> State StdGen [Double] -> ([Double], StdGen)
forall a b. (a -> b) -> a -> b
$ Seed -> StateT StdGen Identity Double -> State StdGen [Double]
forall (m :: * -> *) a. Applicative m => Seed -> m a -> m [a]
replicateM Seed
n ((StdGen -> (Double, StdGen)) -> StateT StdGen Identity Double
forall a. (StdGen -> (a, StdGen)) -> StateT StdGen Identity a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state StdGen -> (Double, StdGen)
next)
-----------------------------------------------------------------------------