{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}
module Knit.Effect.RandomFu
(
RandomFu
, sampleRVar
, sampleDist
, runRandomFuIOSimple
, runRandomFuIOPureMT
, runRandomFuFromSource
, absorbMonadRandom
, Random
)
where
import qualified Polysemy as P
import Polysemy.Internal ( send )
import Data.IORef ( newIORef )
import qualified Data.Random as R
import qualified Data.Random.Source as R
import qualified Data.Random.Internal.Source as R
import qualified Data.Random.Source.PureMT as R
import Control.Monad.IO.Class ( MonadIO(..) )
data RandomFu m r where
SampleRVar :: R.RVar t -> RandomFu m t
GetRandomPrim :: R.Prim t -> RandomFu m t
type Random = RandomFu
{-# DEPRECATED Random "Use RandomFu instead" #-}
sampleRVar :: (P.Member RandomFu effs) => R.RVar t -> P.Sem effs t
sampleRVar = send . SampleRVar
sampleDist
:: (P.Member RandomFu effs, R.Distribution d t) => d t -> P.Sem effs t
sampleDist = sampleRVar . R.rvar
getRandomPrim :: P.Member RandomFu effs => R.Prim t -> P.Sem effs t
getRandomPrim = send . GetRandomPrim
runRandomFuIOSimple
:: forall effs a
. MonadIO (P.Sem effs)
=> P.Sem (RandomFu ': effs) a
-> P.Sem effs a
runRandomFuIOSimple = P.interpret f
where
f :: forall m x . (RandomFu m x -> P.Sem effs x)
f r = case r of
SampleRVar rv -> liftIO $ R.sample rv
GetRandomPrim pt -> liftIO $ R.getRandomPrim pt
runRandomFuFromSource
:: forall s effs a
. R.RandomSource (P.Sem effs) s
=> s
-> P.Sem (RandomFu ': effs) a
-> P.Sem effs a
runRandomFuFromSource source = P.interpret f
where
f :: forall m x . (RandomFu m x -> P.Sem effs x)
f r = case r of
SampleRVar rv -> R.runRVar (R.sample rv) source
GetRandomPrim pt -> R.runRVar (R.getRandomPrim pt) source
runRandomFuIOPureMT
:: MonadIO (P.Sem effs)
=> R.PureMT
-> P.Sem (RandomFu ': effs) a
-> P.Sem effs a
runRandomFuIOPureMT source re =
liftIO (newIORef source) >>= flip runRandomFuFromSource re
newtype RandomFuSem r a = RandomFuSem { unRandomFuSem :: P.Sem r a } deriving (Functor, Applicative, Monad)
$(R.monadRandom [d|
instance P.Member RandomFu r => R.MonadRandom (RandomFuSem r) where
getRandomPrim = RandomFuSem . getRandomPrim
|])
absorbMonadRandom
:: P.Member RandomFu r => (forall m . R.MonadRandom m => m a) -> P.Sem r a
absorbMonadRandom = unRandomFuSem