{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
module Polysemy.ConstraintAbsorber.MonadRandom
(
absorbMonadRandom
)
where
import Polysemy
import Polysemy.ConstraintAbsorber
import Polysemy.RandomFu
import qualified Data.Random.Source as R
import qualified Data.Random.Internal.Source as R
absorbMonadRandom :: Member RandomFu r
=> (R.MonadRandom (Sem r) => Sem r a) -> Sem r a
absorbMonadRandom = absorbWithSem @R.MonadRandom @Action
(RandomDict getRandomPrim)
(Sub Dict)
{-# INLINEABLE absorbMonadRandom #-}
data RandomDict m = RandomDict { getRandomPrim_ :: forall t. R.Prim t -> m t }
newtype Action m s' a = Action { action :: m a }
deriving (Functor, Applicative, Monad)
$(R.monadRandom [d|
instance ( Monad m
, Reifies s' (RandomDict m)
) => R.MonadRandom (Action m s') where
getRandomPrim t = Action
$ getRandomPrim_ (reflect $ Proxy @s') t
{-# INLINEABLE getRandomPrim #-}
|])