{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
#if MIN_VERSION_random_fu(0,3,0)
module Polysemy.ConstraintAbsorber.MonadRandom () where
#else
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
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 #-}
|])
absorbMonadRandom :: forall r a. (Member RandomFu r)
=> (R.MonadRandom (Sem r) => Sem r a)
-> Sem r a
absorbMonadRandom = absorbWithSem @R.MonadRandom @Action
(RandomDict (getRandomPrim @r))
(Sub Dict)
{-# INLINEABLE absorbMonadRandom #-}
#endif