{-# LANGUAGE TypeFamilies #-}

module Bluefin.Random
  ( -- * Handle
    Random,

    -- * Handlers
    withInitStdGen,

    -- ** Special purpose handlers
    -- $specialpurposehandlers
    evalRandom,
    runRandom,

    -- * Effectful operations
    -- $effectfuloperations

    -- * Internal details
    -- $internaldetails
    RandomPure,
  )
where

import Bluefin.Compound (Handle)
import Bluefin.Eff (Eff, Effects, (:&), (:>))
import Bluefin.IO (IOE, effIO)
import Bluefin.State (State, get, put, runState)
import qualified System.Random as Rnd
import qualified System.Random.Stateful as Rnd

-- $specialpurposehandlers
--
-- In the vast majority of cases you should use 'withInitStdGen' and
-- you won't have any need for these special purpose handlers.

-- $effectfuloperations
--
-- To run random operations in Bluefin you should use the random
-- operations in the "System.Random.Stateful" module from the @random@
-- package. Here are their type signatures when restricted to
-- Bluefin's @Random@:
--
-- @
-- 'System.Random.Stateful.uniformM' ::
--   (Uniform a, RandomGen g, e1 :> es) =>
--   Random g e1 ->
--   Eff es a
-- @
--
-- @
-- 'System.Random.Stateful.uniformRM' ::
--   (UniformRange a, RandomGen g, e1 :> es) =>
--   (a, a) ->
--   Random g e1 ->
--   Eff es a
-- @
--
-- @
-- 'System.Random.Stateful.uniformListM' ::
--   (Uniform a, RandomGen g, e1 :> es) =>
--   Int ->
--   Random g e1 ->
--   Eff es [a]
-- @
--
-- @
-- 'System.Random.Stateful.uniformListRM' ::
--   (UniformRange a, RandomGen g, e1 :> es) =>
--   Int ->
--   (a, a) ->
--   Random g e1 ->
--   Eff es [a]
-- @
--
-- @
-- 'System.Random.Stateful.uniformShuffleListM' ::
--   (RandomGen g, e1 :> es) =>
--   [a] ->
--   Random g e1 ->
--   Eff es [a]
-- @
--
-- @
-- 'System.Random.Stateful.uniformByteArrayM' ::
--   (RandomGen g, e1 :> es) =>
--   Bool ->
--   Int ->
--   Random g e1 ->
--   Eff es ByteArray
-- @
--
-- @
-- 'System.Random.Stateful.uniformByteStringM' ::
--   (RandomGen g, e1 :> es) =>
--   Int ->
--   Random g e1 ->
--   Eff es ByteString
-- @
--
-- @
-- 'System.Random.Stateful.uniformShortByteStringM' ::
--   (RandomGen g, e1 :> es) =>
--   Int ->
--   Random g e1 ->
--   Eff es ShortByteString
-- @
--
-- @
-- 'System.Random.Stateful.uniformDouble01M' ::
--   (RandomGen g, e1 :> es) =>
--   Random g e1 ->
--   Eff es Double
-- @
--
-- @
-- 'System.Random.Stateful.uniformDoublePositive01M' ::
--   (RandomGen g, e1 :> es) =>
--   Random g e1 ->
--   Eff es Double
-- @
--
-- @
-- 'System.Random.Stateful.uniformFloat01M' ::
--   (RandomGen g, e1 :> es) =>
--   Random g e1 ->
--   Eff es Float
-- @
--
-- @
-- 'System.Random.Stateful.uniformFloatPositive01M' ::
--   (RandomGen g, e1 :> es) =>
--   Random g e1 ->
--   Eff es Float
-- @

-- $internaldetails
--
-- 'RandomPure' is an internal detail that is used to implement a
-- 'System.Random.Stateful.FrozenGen' instance for 'Random'.  You may
-- see it in error messages, so we include it here from completeness.
-- You will most likely never need to use @RandomPure@ directly.

newtype Random g e = Random (State g e)
  deriving newtype ((forall (e :: Effects) (es :: Effects).
 (e :> es) =>
 Random g e -> Random g es)
-> Handle (Random g)
forall g (e :: Effects) (es :: Effects).
(e :> es) =>
Random g e -> Random g es
forall (e :: Effects) (es :: Effects).
(e :> es) =>
Random g e -> Random g es
forall (h :: Effects -> *).
(forall (e :: Effects) (es :: Effects). (e :> es) => h e -> h es)
-> Handle h
$cmapHandle :: forall g (e :: Effects) (es :: Effects).
(e :> es) =>
Random g e -> Random g es
mapHandle :: forall (e :: Effects) (es :: Effects).
(e :> es) =>
Random g e -> Random g es
Handle)

newtype RandomPure g (e :: Effects) = RandomPure g
  deriving newtype (Int -> RandomPure g e -> (ShortByteString, RandomPure g e)
Word32 -> RandomPure g e -> (Word32, RandomPure g e)
Word64 -> RandomPure g e -> (Word64, RandomPure g e)
RandomPure g e -> (Int, Int)
RandomPure g e -> (Int, RandomPure g e)
RandomPure g e -> (Word8, RandomPure g e)
RandomPure g e -> (Word16, RandomPure g e)
RandomPure g e -> (Word32, RandomPure g e)
RandomPure g e -> (Word64, RandomPure g e)
RandomPure g e -> (RandomPure g e, RandomPure g e)
(RandomPure g e -> (Int, RandomPure g e))
-> (RandomPure g e -> (Word8, RandomPure g e))
-> (RandomPure g e -> (Word16, RandomPure g e))
-> (RandomPure g e -> (Word32, RandomPure g e))
-> (RandomPure g e -> (Word64, RandomPure g e))
-> (Word32 -> RandomPure g e -> (Word32, RandomPure g e))
-> (Word64 -> RandomPure g e -> (Word64, RandomPure g e))
-> (Int -> RandomPure g e -> (ShortByteString, RandomPure g e))
-> (forall s.
    MutableByteArray s
    -> Int -> Int -> RandomPure g e -> ST s (RandomPure g e))
-> (RandomPure g e -> (Int, Int))
-> (RandomPure g e -> (RandomPure g e, RandomPure g e))
-> RandomGen (RandomPure g e)
forall s.
MutableByteArray s
-> Int -> Int -> RandomPure g e -> ST s (RandomPure g e)
forall g.
(g -> (Int, g))
-> (g -> (Word8, g))
-> (g -> (Word16, g))
-> (g -> (Word32, g))
-> (g -> (Word64, g))
-> (Word32 -> g -> (Word32, g))
-> (Word64 -> g -> (Word64, g))
-> (Int -> g -> (ShortByteString, g))
-> (forall s. MutableByteArray s -> Int -> Int -> g -> ST s g)
-> (g -> (Int, Int))
-> (g -> (g, g))
-> RandomGen g
forall g (e :: Effects).
RandomGen g =>
Int -> RandomPure g e -> (ShortByteString, RandomPure g e)
forall g (e :: Effects).
RandomGen g =>
Word32 -> RandomPure g e -> (Word32, RandomPure g e)
forall g (e :: Effects).
RandomGen g =>
Word64 -> RandomPure g e -> (Word64, RandomPure g e)
forall g (e :: Effects).
RandomGen g =>
RandomPure g e -> (Int, Int)
forall g (e :: Effects).
RandomGen g =>
RandomPure g e -> (Int, RandomPure g e)
forall g (e :: Effects).
RandomGen g =>
RandomPure g e -> (Word8, RandomPure g e)
forall g (e :: Effects).
RandomGen g =>
RandomPure g e -> (Word16, RandomPure g e)
forall g (e :: Effects).
RandomGen g =>
RandomPure g e -> (Word32, RandomPure g e)
forall g (e :: Effects).
RandomGen g =>
RandomPure g e -> (Word64, RandomPure g e)
forall g (e :: Effects).
RandomGen g =>
RandomPure g e -> (RandomPure g e, RandomPure g e)
forall g (e :: Effects) s.
RandomGen g =>
MutableByteArray s
-> Int -> Int -> RandomPure g e -> ST s (RandomPure g e)
$cnext :: forall g (e :: Effects).
RandomGen g =>
RandomPure g e -> (Int, RandomPure g e)
next :: RandomPure g e -> (Int, RandomPure g e)
$cgenWord8 :: forall g (e :: Effects).
RandomGen g =>
RandomPure g e -> (Word8, RandomPure g e)
genWord8 :: RandomPure g e -> (Word8, RandomPure g e)
$cgenWord16 :: forall g (e :: Effects).
RandomGen g =>
RandomPure g e -> (Word16, RandomPure g e)
genWord16 :: RandomPure g e -> (Word16, RandomPure g e)
$cgenWord32 :: forall g (e :: Effects).
RandomGen g =>
RandomPure g e -> (Word32, RandomPure g e)
genWord32 :: RandomPure g e -> (Word32, RandomPure g e)
$cgenWord64 :: forall g (e :: Effects).
RandomGen g =>
RandomPure g e -> (Word64, RandomPure g e)
genWord64 :: RandomPure g e -> (Word64, RandomPure g e)
$cgenWord32R :: forall g (e :: Effects).
RandomGen g =>
Word32 -> RandomPure g e -> (Word32, RandomPure g e)
genWord32R :: Word32 -> RandomPure g e -> (Word32, RandomPure g e)
$cgenWord64R :: forall g (e :: Effects).
RandomGen g =>
Word64 -> RandomPure g e -> (Word64, RandomPure g e)
genWord64R :: Word64 -> RandomPure g e -> (Word64, RandomPure g e)
$cgenShortByteString :: forall g (e :: Effects).
RandomGen g =>
Int -> RandomPure g e -> (ShortByteString, RandomPure g e)
genShortByteString :: Int -> RandomPure g e -> (ShortByteString, RandomPure g e)
$cunsafeUniformFillMutableByteArray :: forall g (e :: Effects) s.
RandomGen g =>
MutableByteArray s
-> Int -> Int -> RandomPure g e -> ST s (RandomPure g e)
unsafeUniformFillMutableByteArray :: forall s.
MutableByteArray s
-> Int -> Int -> RandomPure g e -> ST s (RandomPure g e)
$cgenRange :: forall g (e :: Effects).
RandomGen g =>
RandomPure g e -> (Int, Int)
genRange :: RandomPure g e -> (Int, Int)
$csplit :: forall g (e :: Effects).
RandomGen g =>
RandomPure g e -> (RandomPure g e, RandomPure g e)
split :: RandomPure g e -> (RandomPure g e, RandomPure g e)
Rnd.RandomGen)

instance
  (e :> es, Rnd.RandomGen g) =>
  Rnd.StatefulGen (Random g e) (Eff es)
  where
  uniformWord64 :: Random g e -> Eff es Word64
uniformWord64 =
    (Random g e
 -> (RandomPure g e -> (Word64, RandomPure g e)) -> Eff es Word64)
-> (RandomPure g e -> (Word64, RandomPure g e))
-> Random g e
-> Eff es Word64
forall a b c. (a -> b -> c) -> b -> a -> c
flip MutableGen (RandomPure g e) (Eff es)
-> (RandomPure g e -> (Word64, RandomPure g e)) -> Eff es Word64
Random g e
-> (RandomPure g e -> (Word64, RandomPure g e)) -> Eff es Word64
forall a.
MutableGen (RandomPure g e) (Eff es)
-> (RandomPure g e -> (a, RandomPure g e)) -> Eff es a
forall f (m :: * -> *) a.
FrozenGen f m =>
MutableGen f m -> (f -> (a, f)) -> m a
Rnd.modifyGen RandomPure g e -> (Word64, RandomPure g e)
forall g. RandomGen g => g -> (Word64, g)
Rnd.genWord64

  uniformByteArrayM :: Bool -> Int -> Random g e -> Eff es ByteArray
uniformByteArrayM Bool
pinned Int
size =
    (Random g e
 -> (RandomPure g e -> (ByteArray, RandomPure g e))
 -> Eff es ByteArray)
-> (RandomPure g e -> (ByteArray, RandomPure g e))
-> Random g e
-> Eff es ByteArray
forall a b c. (a -> b -> c) -> b -> a -> c
flip MutableGen (RandomPure g e) (Eff es)
-> (RandomPure g e -> (ByteArray, RandomPure g e))
-> Eff es ByteArray
Random g e
-> (RandomPure g e -> (ByteArray, RandomPure g e))
-> Eff es ByteArray
forall a.
MutableGen (RandomPure g e) (Eff es)
-> (RandomPure g e -> (a, RandomPure g e)) -> Eff es a
forall f (m :: * -> *) a.
FrozenGen f m =>
MutableGen f m -> (f -> (a, f)) -> m a
Rnd.modifyGen (Bool -> Int -> RandomPure g e -> (ByteArray, RandomPure g e)
forall g. RandomGen g => Bool -> Int -> g -> (ByteArray, g)
Rnd.uniformByteArray Bool
pinned Int
size)

instance
  (e :> es, Rnd.RandomGen g) =>
  Rnd.FrozenGen (RandomPure g e) (Eff es)
  where
  type MutableGen (RandomPure g e) (Eff es) = Random g e

  modifyGen :: forall a.
MutableGen (RandomPure g e) (Eff es)
-> (RandomPure g e -> (a, RandomPure g e)) -> Eff es a
modifyGen (Random State g e
s) RandomPure g e -> (a, RandomPure g e)
f = do
    (a
a, RandomPure g
g) <- RandomPure g e -> (a, RandomPure g e)
f (RandomPure g e -> (a, RandomPure g e))
-> (g -> RandomPure g e) -> g -> (a, RandomPure g e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> RandomPure g e
forall g (e :: Effects). g -> RandomPure g e
RandomPure (g -> (a, RandomPure g e))
-> Eff es g -> Eff es (a, RandomPure g e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> State g e -> Eff es g
forall (e :: Effects) (es :: Effects) s.
(e :> es) =>
State s e -> Eff es s
get State g e
s
    State g e -> g -> Eff es ()
forall (e :: Effects) (es :: Effects) s.
(e :> es) =>
State s e -> s -> Eff es ()
put State g e
s g
g
    a -> Eff es a
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a

runRandom ::
  g ->
  (forall e. Random g e -> Eff (e :& es) a) ->
  -- | ͘
  Eff es (a, g)
runRandom :: forall g (es :: Effects) a.
g
-> (forall (e :: Effects). Random g e -> Eff (e :& es) a)
-> Eff es (a, g)
runRandom g
g forall (e :: Effects). Random g e -> Eff (e :& es) a
f = g
-> (forall (e :: Effects). State g e -> Eff (e :& es) a)
-> Eff es (a, g)
forall s (es :: Effects) a.
s
-> (forall (e :: Effects). State s e -> Eff (e :& es) a)
-> Eff es (a, s)
runState g
g (Random g e -> Eff (e :& es) a
forall (e :: Effects). Random g e -> Eff (e :& es) a
f (Random g e -> Eff (e :& es) a)
-> (State g e -> Random g e) -> State g e -> Eff (e :& es) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State g e -> Random g e
forall g (e :: Effects). State g e -> Random g e
Random)

evalRandom ::
  g ->
  (forall e. Random g e -> Eff (e :& es) a) ->
  -- | ͘
  Eff es a
evalRandom :: forall g (es :: Effects) a.
g
-> (forall (e :: Effects). Random g e -> Eff (e :& es) a)
-> Eff es a
evalRandom g
g forall (e :: Effects). Random g e -> Eff (e :& es) a
f = (a, g) -> a
forall a b. (a, b) -> a
fst ((a, g) -> a) -> Eff es (a, g) -> Eff es a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> g
-> (forall (e :: Effects). Random g e -> Eff (e :& es) a)
-> Eff es (a, g)
forall g (es :: Effects) a.
g
-> (forall (e :: Effects). Random g e -> Eff (e :& es) a)
-> Eff es (a, g)
runRandom g
g Random g e -> Eff (e :& es) a
forall (e :: Effects). Random g e -> Eff (e :& es) a
f

-- | The simplest way to handle a Bluefin 'Random' effect.  This is
-- the handler you should use unless you know you have a particular
-- need to use a 'Rnd.RandomGen' other than 'Rnd.StdGen' or you know
-- you need to create a 'Rnd.StdGen' seed in a non-standard way.
withInitStdGen ::
  (e1 :> es) =>
  IOE e1 ->
  (forall e. Random Rnd.StdGen e -> Eff (e :& es) a) ->
  -- | ͘
  Eff es a
withInitStdGen :: forall (e1 :: Effects) (es :: Effects) a.
(e1 :> es) =>
IOE e1
-> (forall (e :: Effects). Random StdGen e -> Eff (e :& es) a)
-> Eff es a
withInitStdGen IOE e1
io forall (e :: Effects). Random StdGen e -> Eff (e :& es) a
k = do
  StdGen
g <- IOE e1 -> IO StdGen -> Eff es StdGen
forall (e :: Effects) (es :: Effects) a.
(e :> es) =>
IOE e -> IO a -> Eff es a
effIO IOE e1
io IO StdGen
forall (m :: * -> *). MonadIO m => m StdGen
Rnd.initStdGen
  StdGen
-> (forall (e :: Effects). Random StdGen e -> Eff (e :& es) a)
-> Eff es a
forall g (es :: Effects) a.
g
-> (forall (e :: Effects). Random g e -> Eff (e :& es) a)
-> Eff es a
evalRandom StdGen
g Random StdGen e -> Eff (e :& es) a
forall (e :: Effects). Random StdGen e -> Eff (e :& es) a
k