diff --git a/src/Polysemy.hs b/src/Polysemy.hs index e9b0bb5..0736fce 100644 --- a/src/Polysemy.hs +++ b/src/Polysemy.hs @@ -39,7 +39,13 @@ newtype Semantic r a = Semantic -> m a } -usingSemantic :: Monad m => (∀ x. Union r (Semantic r) x -> m x) -> Semantic r a -> m a +------------------------------------------------------------------------------ +-- | Like 'runSemantic' but flipped for better ergonomics sometimes. +usingSemantic + :: Monad m + => (∀ x. Union r (Semantic r) x -> m x) + -> Semantic r a + -> m a usingSemantic k m = runSemantic m k {-# INLINE usingSemantic #-} @@ -95,16 +101,23 @@ send = liftSemantic . inj {-# INLINE[3] send #-} +------------------------------------------------------------------------------ +-- | Lift a monadic action @m@ into 'Semantic'. sendM :: Member (Lift m) r => m a -> Semantic r a sendM = send . Lift {-# INLINE sendM #-} +------------------------------------------------------------------------------ +-- | Run a 'Semantic' containing no effects as a pure value. run :: Semantic '[] a -> a run (Semantic m) = runIdentity $ m absurdU {-# INLINE run #-} +------------------------------------------------------------------------------ +-- | Lower a 'Semantic' containing only a single lifted 'Monad' into that +-- monad. runM :: Monad m => Semantic '[Lift m] a -> m a runM (Semantic m) = m $ unLift . extract {-# INLINE runM #-} diff --git a/src/Polysemy/Lift.hs b/src/Polysemy/Lift.hs index 328940d..b8afda9 100644 --- a/src/Polysemy/Lift.hs +++ b/src/Polysemy/Lift.hs @@ -7,6 +7,9 @@ module Polysemy.Lift where import Polysemy.Effect +------------------------------------------------------------------------------ +-- | Lift a regular 'Monad' @m@ into an effect. Monadic actions in @m@ can be +-- lifted into 'Polysemy.Semantic' via 'Polysemy.runM'. newtype Lift m (z :: * -> *) a = Lift { unLift :: m a }