{-# LANGUAGE TemplateHaskell       #-}
{-|
Module      : Polysemy.RandomFu
Description : Polysemy random-fu effect

Polysemy "random-fu" effect.
This can be run in a few ways:
1. Directly in 'IO'
2. Using any 'Data.Random.RandomSource' from "random-fu"
3. In 'IO', using a given 'Data.Random.Source.PureMT' source.
('IO' is used to put the source in an 'IORef')

This module also contains the type-class instances to enable "absorbing"
MonadRandom, ala Polysemy.MTL.  See the tests for MTL or RandomFu for
examples of that in use.
-}

module Polysemy.RandomFu
  (
    -- * Effect
    RandomFu (..)

    -- * Actions
  , sampleRVar
  , getRandomPrim
  , sampleDist

    -- * Interpretations
  , runRandomSource
  , runRandomIO
  , runRandomIOPureMT
  )
where

import           Polysemy
--import           Polysemy.MTL

import           Data.IORef                     ( newIORef )
import qualified Data.Random                   as R
import qualified Data.Random.Internal.Source   as R
import qualified Data.Random.Source.PureMT     as R
import           Control.Monad.IO.Class         ( MonadIO(..) )


------------------------------------------------------------------------------
{- | An effect capable of sampling from a "random-fu" RVar or generating a
single random-variate of any type, @t@ with a
@Data.Random.Prim t@ constructor, currently one of @Word8@, @Word16@,
@Word32@, @Word64@, @Double@ or N-byte integer.
-}
data RandomFu m r where
  SampleRVar ::  R.RVar t -> RandomFu m t
  GetRandomPrim :: R.Prim t -> RandomFu m t

makeSem ''RandomFu

------------------------------------------------------------------------------
-- | use the 'RandomFu` effect to sample from a "random-fu" @Distribution@.
sampleDist
  :: (Member RandomFu r, R.Distribution d t) => d t -> Sem r t
sampleDist :: d t -> Sem r t
sampleDist = RVar t -> Sem r t
forall (r :: [Effect]) t.
MemberWithError RandomFu r =>
RVar t -> Sem r t
sampleRVar (RVar t -> Sem r t) -> (d t -> RVar t) -> d t -> Sem r t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. d t -> RVar t
forall (d :: * -> *) t. Distribution d t => d t -> RVar t
R.rvar
{-# INLINEABLE sampleDist #-}

------------------------------------------------------------------------------
-- | Run a 'Random' effect using a given 'R.RandomSource'
runRandomSource
  :: forall s m r a
   . ( R.RandomSource m s
     , Member (Embed m) r
     )
  => s
  -> Sem (RandomFu ': r) a
  -> Sem r a
runRandomSource :: s -> Sem (RandomFu : r) a -> Sem r a
runRandomSource s
source = (forall x (rInitial :: [Effect]).
 RandomFu (Sem rInitial) x -> Sem r x)
-> Sem (RandomFu : r) a -> Sem r a
forall (e :: Effect) (r :: [Effect]) a.
FirstOrder e "interpret" =>
(forall x (rInitial :: [Effect]). e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret ((forall x (rInitial :: [Effect]).
  RandomFu (Sem rInitial) x -> Sem r x)
 -> Sem (RandomFu : r) a -> Sem r a)
-> (forall x (rInitial :: [Effect]).
    RandomFu (Sem rInitial) x -> Sem r x)
-> Sem (RandomFu : r) a
-> Sem r a
forall a b. (a -> b) -> a -> b
$ \case
    SampleRVar    rv -> m x -> Sem r x
forall (m :: * -> *) (r :: [Effect]) a.
Member (Embed m) r =>
m a -> Sem r a
embed (m x -> Sem r x) -> m x -> Sem r x
forall a b. (a -> b) -> a -> b
$ RVar x -> s -> m x
forall (m :: * -> *) s a. RandomSource m s => RVar a -> s -> m a
R.runRVar (RVar x -> RVar x
forall (d :: * -> *) (m :: * -> *) t.
(Sampleable d m t, MonadRandom m) =>
d t -> m t
R.sample RVar x
rv) s
source
    GetRandomPrim pt -> m x -> Sem r x
forall (m :: * -> *) (r :: [Effect]) a.
Member (Embed m) r =>
m a -> Sem r a
embed (m x -> Sem r x) -> m x -> Sem r x
forall a b. (a -> b) -> a -> b
$ RVar x -> s -> m x
forall (m :: * -> *) s a. RandomSource m s => RVar a -> s -> m a
R.runRVar (Prim x -> RVar x
forall (m :: * -> *) t. MonadRandom m => Prim t -> m t
R.getRandomPrim Prim x
pt) s
source
{-# INLINEABLE runRandomSource #-}

------------------------------------------------------------------------------
-- | Run a 'Random` effect by using the default "random-fu" 'IO' source
runRandomIO
  :: forall r a
   . MonadIO (Sem r)
  => Sem (RandomFu ': r) a
  -> Sem r a
runRandomIO :: Sem (RandomFu : r) a -> Sem r a
runRandomIO = (forall x (rInitial :: [Effect]).
 RandomFu (Sem rInitial) x -> Sem r x)
-> Sem (RandomFu : r) a -> Sem r a
forall (e :: Effect) (r :: [Effect]) a.
FirstOrder e "interpret" =>
(forall x (rInitial :: [Effect]). e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret ((forall x (rInitial :: [Effect]).
  RandomFu (Sem rInitial) x -> Sem r x)
 -> Sem (RandomFu : r) a -> Sem r a)
-> (forall x (rInitial :: [Effect]).
    RandomFu (Sem rInitial) x -> Sem r x)
-> Sem (RandomFu : r) a
-> Sem r a
forall a b. (a -> b) -> a -> b
$ \case
    SampleRVar    rv -> IO x -> Sem r x
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO x -> Sem r x) -> IO x -> Sem r x
forall a b. (a -> b) -> a -> b
$ RVarT Identity x -> IO x
forall (d :: * -> *) (m :: * -> *) t.
(Sampleable d m t, MonadRandom m) =>
d t -> m t
R.sample RVarT Identity x
rv
    GetRandomPrim pt -> IO x -> Sem r x
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO x -> Sem r x) -> IO x -> Sem r x
forall a b. (a -> b) -> a -> b
$ Prim x -> IO x
forall (m :: * -> *) t. MonadRandom m => Prim t -> m t
R.getRandomPrim Prim x
pt
{-# INLINEABLE runRandomIO #-}

------------------------------------------------------------------------------
-- | Run in 'IO', using the given 'R.PureMT' source, stored in an 'IORef'
runRandomIOPureMT
  :: Member (Embed IO) r
  => R.PureMT
  -> Sem (RandomFu ': r) a
  -> Sem r a
runRandomIOPureMT :: PureMT -> Sem (RandomFu : r) a -> Sem r a
runRandomIOPureMT PureMT
source Sem (RandomFu : r) a
re =
  IO (IORef PureMT) -> Sem r (IORef PureMT)
forall (m :: * -> *) (r :: [Effect]) a.
Member (Embed m) r =>
m a -> Sem r a
embed (PureMT -> IO (IORef PureMT)
forall a. a -> IO (IORef a)
newIORef PureMT
source) Sem r (IORef PureMT) -> (IORef PureMT -> Sem r a) -> Sem r a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (IORef PureMT -> Sem (RandomFu : r) a -> Sem r a)
-> Sem (RandomFu : r) a -> IORef PureMT -> Sem r a
forall a b c. (a -> b -> c) -> b -> a -> c
flip IORef PureMT -> Sem (RandomFu : r) a -> Sem r a
forall s (m :: * -> *) (r :: [Effect]) a.
(RandomSource m s, Member (Embed m) r) =>
s -> Sem (RandomFu : r) a -> Sem r a
runRandomSource Sem (RandomFu : r) a
re
{-# INLINEABLE runRandomIOPureMT #-}