module Control.Effects (module Control.Effects, module Control.Effects1) where
import Interlude hiding (msg)
import Control.Monad.Reader
import Control.Monad.Trans.Control
import Control.Monad.Base
import Control.Effects1
type family EffectMsg eff :: *
type family EffectRes eff :: *
class Monad m => MonadEffect eff m where
effect :: proxy eff -> EffectMsg eff -> m (EffectRes eff)
newtype EffectHandler eff m a = EffectHandler
{ unpackEffectHandler :: ReaderT (EffectMsg eff -> m (EffectRes eff)) m a }
deriving (Functor, Applicative, Monad, MonadState s, MonadIO, MonadCatch, MonadThrow, MonadRandom)
instance MonadTrans (EffectHandler eff) where
lift = EffectHandler . lift
instance MonadReader s m => MonadReader s (EffectHandler eff m) where
ask = EffectHandler (lift ask)
local f (EffectHandler rdr) = EffectHandler (ReaderT $ local f . runReaderT rdr)
deriving instance MonadBase IO m => MonadBase IO (EffectHandler eff m)
instance MonadBaseControl IO m => MonadBaseControl IO (EffectHandler eff m) where
type StM (EffectHandler eff m) a = StM (ReaderT (EffectMsg eff -> m (EffectRes eff)) m) a
liftBaseWith f = EffectHandler $ liftBaseWith $ \q -> f (q . unpackEffectHandler)
restoreM = EffectHandler . restoreM
instance (MonadEffect eff m, MonadTrans t, Monad (t m))
=> MonadEffect eff (t m) where
effect p msg = lift (effect p msg)
instance Monad m => MonadEffect eff (EffectHandler eff m) where
effect _ msg = EffectHandler (ReaderT ($ msg))
handleEffect :: (EffectMsg eff -> m (EffectRes eff)) -> EffectHandler eff m a -> m a
handleEffect f eh = runReaderT (unpackEffectHandler eh) f