#ifdef MTL
#endif
module Control.Effect.Lift (
EffectLift, Lift, runLift, lift
) where
import Control.Monad.Effect
import Control.Monad (join, liftM)
#ifdef MTL
import Control.Monad.Trans (MonadIO (..))
instance EffectLift IO es => MonadIO (Effect es) where
liftIO = lift
#endif
newtype Lift m a = Lift { unLift :: m a }
instance Monad m => Functor (Lift m) where
fmap f = Lift . liftM f . unLift
type EffectLift m es = (Member (Lift m) es, m ~ LiftType es, Monad m)
type family LiftType es where
LiftType (Lift m ': es) = m
LiftType (e ': es) = LiftType es
lift :: EffectLift m es => m a -> Effect es a
lift = send . Lift
runLift :: Monad m => Effect '[Lift m] a -> m a
runLift =
handle return
$ eliminate (join . unLift)
$ emptyRelay