{-# LANGUAGE TemplateHaskell #-} module Polysemy.Final ( -- * Effect Final(..) , ThroughWeavingToFinal -- * Actions , withWeavingToFinal , withStrategicToFinal , embedFinal -- * Combinators for Interpreting to the Final Monad , interpretFinal -- * Strategy -- | Strategy is a domain-specific language very similar to @Tactics@ -- (see 'Polysemy.Tactical'), and is used to describe how higher-order -- effects are threaded down to the final monad. -- -- Much like @Tactics@, computations can be run and threaded -- through the use of 'runS' and 'bindS', and first-order constructors -- may use 'pureS'. In addition, 'liftS' may be used to -- lift actions of the final monad. -- -- Unlike @Tactics@, the final return value within a 'Strategic' -- must be a monadic value of the target monad -- with the functorial state wrapped inside of it. , Strategic , WithStrategy , pureS , liftS , runS , bindS , getInspectorS , getInitialStateS -- * Interpretations , runFinal , finalToFinal -- * Interpretations for Other Effects , embedToFinal ) where import Polysemy.Internal import Polysemy.Internal.Combinators import Polysemy.Internal.Union import Polysemy.Internal.Strategy import Polysemy.Internal.TH.Effect ----------------------------------------------------------------------------- -- | This represents a function which produces -- an action of the final monad @m@ given: -- -- * The initial effectful state at the moment the action -- is to be executed. -- -- * A way to convert @z@ (which is typically @'Sem' r@) to @m@ by -- threading the effectful state through. -- -- * An inspector that is able to view some value within the -- effectful state if the effectful state contains any values. -- -- A @'Polysemy.Internal.Union.Weaving'@ provides these components, -- hence the name 'ThroughWeavingToFinal'. -- -- @since 1.2.0.0 type ThroughWeavingToFinal m z a = forall f . Functor f => f () -> (forall x. f (z x) -> m (f x)) -> (forall x. f x -> Maybe x) -> m (f a) ----------------------------------------------------------------------------- -- | An effect for embedding higher-order actions in the final target monad -- of the effect stack. -- -- This is very useful for writing interpreters that interpret higher-order -- effects in terms of the final monad. -- -- 'Final' is more powerful than 'Embed', but is also less flexible -- to interpret (compare 'Polysemy.Embed.runEmbedded' with 'finalToFinal'). -- If you only need the power of 'embed', then you should use 'Embed' instead. -- -- /Beware/: 'Final' actions are interpreted as actions of the final monad, -- and the effectful state visible to -- 'withWeavingToFinal' \/ 'withStrategicToFinal' -- \/ 'interpretFinal' -- is that of /all interpreters run in order to produce the final monad/. -- -- This means that any interpreter built using 'Final' will /not/ -- respect local/global state semantics based on the order of -- interpreters run. You should signal interpreters that make use of -- 'Final' by adding a @-'Final'@ suffix to the names of these. -- -- State semantics of effects that are /not/ -- interpreted in terms of the final monad will always -- appear local to effects that are interpreted in terms of the final monad. -- -- State semantics between effects that are interpreted in terms of the final monad -- depend on the final monad. For example, if the final monad is a monad transformer -- stack, then state semantics will depend on the order monad transformers are stacked. -- -- @since 1.2.0.0 newtype Final m z a where WithWeavingToFinal :: ThroughWeavingToFinal m z a -> Final m z a makeSem_ ''Final ----------------------------------------------------------------------------- -- | Allows for embedding higher-order actions of the final monad -- by providing the means of explicitly threading effects through @'Sem' r@ -- to the final monad. -- -- Consider using 'withStrategicToFinal' instead, -- which provides a more user-friendly interface, but is also slightly weaker. -- -- You are discouraged from using 'withWeavingToFinal' directly -- in application code, as it ties your application code directly to -- the final monad. -- -- @since 1.2.0.0 withWeavingToFinal :: forall m r a . Member (Final m) r => ThroughWeavingToFinal m (Sem r) a -> Sem r a ----------------------------------------------------------------------------- -- | 'withWeavingToFinal' admits an implementation of 'embed'. -- -- Just like 'embed', you are discouraged from using this in application code. -- -- @since 1.2.0.0 embedFinal :: (Member (Final m) r, Functor m) => m a -> Sem r a embedFinal :: m a -> Sem r a embedFinal m a m = ThroughWeavingToFinal m (Sem r) a -> Sem r a forall (m :: * -> *) (r :: EffectRow) a. Member (Final m) r => ThroughWeavingToFinal m (Sem r) a -> Sem r a withWeavingToFinal (ThroughWeavingToFinal m (Sem r) a -> Sem r a) -> ThroughWeavingToFinal m (Sem r) a -> Sem r a forall a b. (a -> b) -> a -> b $ \f () s forall x. f (Sem r x) -> m (f x) _ forall x. f x -> Maybe x _ -> (a -> f () -> f a forall (f :: * -> *) a b. Functor f => a -> f b -> f a <$ f () s) (a -> f a) -> m a -> m (f a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> m a m {-# INLINE embedFinal #-} ----------------------------------------------------------------------------- -- | Allows for embedding higher-order actions of the final monad -- by providing the means of explicitly threading effects through @'Sem' r@ -- to the final monad. This is done through the use of the 'Strategic' -- environment, which provides 'runS' and 'bindS'. -- -- You are discouraged from using 'withStrategicToFinal' in application code, -- as it ties your application code directly to the final monad. -- -- @since 1.2.0.0 withStrategicToFinal :: Member (Final m) r => Strategic m (Sem r) a -> Sem r a withStrategicToFinal :: Strategic m (Sem r) a -> Sem r a withStrategicToFinal Strategic m (Sem r) a strat = ThroughWeavingToFinal m (Sem r) a -> Sem r a forall (m :: * -> *) (r :: EffectRow) a. Member (Final m) r => ThroughWeavingToFinal m (Sem r) a -> Sem r a withWeavingToFinal (Sem '[Strategy m f (Sem r)] (m (f a)) -> f () -> (forall x. f (Sem r x) -> m (f x)) -> (forall x. f x -> Maybe x) -> m (f a) forall (f :: * -> *) (m :: * -> *) (n :: * -> *) a. Functor f => Sem '[Strategy m f n] a -> f () -> (forall x. f (n x) -> m (f x)) -> (forall x. f x -> Maybe x) -> a runStrategy Sem '[Strategy m f (Sem r)] (m (f a)) Strategic m (Sem r) a strat) {-# INLINE withStrategicToFinal #-} ------------------------------------------------------------------------------ -- | Like 'interpretH', but may be used to -- interpret higher-order effects in terms of the final monad. -- -- 'interpretFinal' requires less boilerplate than using 'interpretH' -- together with 'withStrategicToFinal' \/ 'withWeavingToFinal', -- but is also less powerful. -- 'interpretFinal' does not provide any means of executing actions -- of @'Sem' r@ as you interpret each action, and the provided interpreter -- is automatically recursively used to process higher-order occurences of -- @'Sem' (e ': r)@ to @'Sem' r@. -- -- If you need greater control of how the effect is interpreted, -- use 'interpretH' together with 'withStrategicToFinal' \/ -- 'withWeavingToFinal' instead. -- -- /Beware/: Effects that aren't interpreted in terms of the final -- monad will have local state semantics in regards to effects -- interpreted using 'interpretFinal'. See 'Final'. -- -- @since 1.2.0.0 interpretFinal :: forall m e r a . Member (Final m) r => (forall x rInitial. e (Sem rInitial) x -> Strategic m (Sem rInitial) x) -- ^ A natural transformation from the handled effect to the final monad. -> Sem (e ': r) a -> Sem r a interpretFinal :: (forall x (rInitial :: EffectRow). e (Sem rInitial) x -> Strategic m (Sem rInitial) x) -> Sem (e : r) a -> Sem r a interpretFinal forall x (rInitial :: EffectRow). e (Sem rInitial) x -> Strategic m (Sem rInitial) x n = let go :: Sem (e ': r) x -> Sem r x go :: Sem (e : r) x -> Sem r x go = (forall x. Union (e : r) (Sem (e : r)) x -> Union r (Sem r) x) -> Sem (e : r) x -> Sem r x forall (r :: EffectRow) (r' :: EffectRow) a. (forall x. Union r (Sem r) x -> Union r' (Sem r') x) -> Sem r a -> Sem r' a hoistSem ((forall x. Union (e : r) (Sem (e : r)) x -> Union r (Sem r) x) -> Sem (e : r) x -> Sem r x) -> (forall x. Union (e : r) (Sem (e : r)) x -> Union r (Sem r) x) -> Sem (e : r) x -> Sem r x forall a b. (a -> b) -> a -> b $ \Union (e : r) (Sem (e : r)) x u -> case Union (e : r) (Sem (e : r)) x -> Either (Union r (Sem (e : r)) x) (Weaving e (Sem (e : r)) x) forall (e :: (* -> *) -> * -> *) (r :: EffectRow) (m :: * -> *) a. Union (e : r) m a -> Either (Union r m a) (Weaving e m a) decomp Union (e : r) (Sem (e : r)) x u of Right (Weaving e (Sem rInitial) a e f () s forall x. f (Sem rInitial x) -> Sem (e : r) (f x) wv f a -> x ex forall x. f x -> Maybe x ins) -> Weaving (Final m) (Sem r) x -> Union r (Sem r) x forall (e :: (* -> *) -> * -> *) (r :: EffectRow) (m :: * -> *) a. Member e r => Weaving e m a -> Union r m a injWeaving (Weaving (Final m) (Sem r) x -> Union r (Sem r) x) -> Weaving (Final m) (Sem r) x -> Union r (Sem r) x forall a b. (a -> b) -> a -> b $ Final m (Sem rInitial) a -> f () -> (forall x. f (Sem rInitial x) -> Sem r (f x)) -> (f a -> x) -> (forall x. f x -> Maybe x) -> Weaving (Final m) (Sem r) x forall (f :: * -> *) (e :: (* -> *) -> * -> *) (rInitial :: EffectRow) a resultType (mAfter :: * -> *). Functor f => e (Sem rInitial) a -> f () -> (forall x. f (Sem rInitial x) -> mAfter (f x)) -> (f a -> resultType) -> (forall x. f x -> Maybe x) -> Weaving e mAfter resultType Weaving (ThroughWeavingToFinal m (Sem rInitial) a -> Final m (Sem rInitial) a forall (m :: * -> *) (z :: * -> *) a. ThroughWeavingToFinal m z a -> Final m z a WithWeavingToFinal (Sem '[Strategy m f (Sem rInitial)] (m (f a)) -> f () -> (forall x. f (Sem rInitial x) -> m (f x)) -> (forall x. f x -> Maybe x) -> m (f a) forall (f :: * -> *) (m :: * -> *) (n :: * -> *) a. Functor f => Sem '[Strategy m f n] a -> f () -> (forall x. f (n x) -> m (f x)) -> (forall x. f x -> Maybe x) -> a runStrategy (e (Sem rInitial) a -> Strategic m (Sem rInitial) a forall x (rInitial :: EffectRow). e (Sem rInitial) x -> Strategic m (Sem rInitial) x n e (Sem rInitial) a e))) f () s (Sem (e : r) (f x) -> Sem r (f x) forall x. Sem (e : r) x -> Sem r x go (Sem (e : r) (f x) -> Sem r (f x)) -> (f (Sem rInitial x) -> Sem (e : r) (f x)) -> f (Sem rInitial x) -> Sem r (f x) forall b c a. (b -> c) -> (a -> b) -> a -> c . f (Sem rInitial x) -> Sem (e : r) (f x) forall x. f (Sem rInitial x) -> Sem (e : r) (f x) wv) f a -> x ex forall x. f x -> Maybe x ins Left Union r (Sem (e : r)) x g -> (forall x. Sem (e : r) x -> Sem r x) -> Union r (Sem (e : r)) x -> Union r (Sem r) x forall (m :: * -> *) (n :: * -> *) (r :: EffectRow) a. (forall x. m x -> n x) -> Union r m a -> Union r n a hoist forall x. Sem (e : r) x -> Sem r x go Union r (Sem (e : r)) x g {-# INLINE go #-} in Sem (e : r) a -> Sem r a forall x. Sem (e : r) x -> Sem r x go {-# INLINE interpretFinal #-} ------------------------------------------------------------------------------ -- | Lower a 'Sem' containing only a single lifted, final 'Monad' into that -- monad. -- -- If you also need to process an @'Embed' m@ effect, use this together with -- 'embedToFinal'. -- -- @since 1.2.0.0 runFinal :: Monad m => Sem '[Final m] a -> m a runFinal :: Sem '[Final m] a -> m a runFinal = (forall x. Union '[Final m] (Sem '[Final m]) x -> m x) -> Sem '[Final m] a -> m a forall (m :: * -> *) (r :: EffectRow) a. Monad m => (forall x. Union r (Sem r) x -> m x) -> Sem r a -> m a usingSem ((forall x. Union '[Final m] (Sem '[Final m]) x -> m x) -> Sem '[Final m] a -> m a) -> (forall x. Union '[Final m] (Sem '[Final m]) x -> m x) -> Sem '[Final m] a -> m a forall a b. (a -> b) -> a -> b $ \Union '[Final m] (Sem '[Final m]) x u -> case Union '[Final m] (Sem '[Final m]) x -> Weaving (Final m) (Sem '[Final m]) x forall (e :: (* -> *) -> * -> *) (m :: * -> *) a. Union '[e] m a -> Weaving e m a extract Union '[Final m] (Sem '[Final m]) x u of Weaving (WithWeavingToFinal wav) f () s forall x. f (Sem rInitial x) -> Sem '[Final m] (f x) wv f a -> x ex forall x. f x -> Maybe x ins -> f a -> x ex (f a -> x) -> m (f a) -> m x forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> f () -> (forall x. f (Sem rInitial x) -> m (f x)) -> (forall x. f x -> Maybe x) -> m (f a) ThroughWeavingToFinal m (Sem rInitial) a wav f () s (Sem '[Final m] (f x) -> m (f x) forall (m :: * -> *) a. Monad m => Sem '[Final m] a -> m a runFinal (Sem '[Final m] (f x) -> m (f x)) -> (f (Sem rInitial x) -> Sem '[Final m] (f x)) -> f (Sem rInitial x) -> m (f x) forall b c a. (b -> c) -> (a -> b) -> a -> c . f (Sem rInitial x) -> Sem '[Final m] (f x) forall x. f (Sem rInitial x) -> Sem '[Final m] (f x) wv) forall x. f x -> Maybe x ins {-# INLINE runFinal #-} ------------------------------------------------------------------------------ -- | Given natural transformations between @m1@ and @m2@, run a @'Final' m1@ -- effect by transforming it into a @'Final' m2@ effect. -- -- @since 1.2.0.0 finalToFinal :: forall m1 m2 r a . Member (Final m2) r => (forall x. m1 x -> m2 x) -> (forall x. m2 x -> m1 x) -> Sem (Final m1 ': r) a -> Sem r a finalToFinal :: (forall x. m1 x -> m2 x) -> (forall x. m2 x -> m1 x) -> Sem (Final m1 : r) a -> Sem r a finalToFinal forall x. m1 x -> m2 x to forall x. m2 x -> m1 x from = let go :: Sem (Final m1 ': r) x -> Sem r x go :: Sem (Final m1 : r) x -> Sem r x go = (forall x. Union (Final m1 : r) (Sem (Final m1 : r)) x -> Union r (Sem r) x) -> Sem (Final m1 : r) x -> Sem r x forall (r :: EffectRow) (r' :: EffectRow) a. (forall x. Union r (Sem r) x -> Union r' (Sem r') x) -> Sem r a -> Sem r' a hoistSem ((forall x. Union (Final m1 : r) (Sem (Final m1 : r)) x -> Union r (Sem r) x) -> Sem (Final m1 : r) x -> Sem r x) -> (forall x. Union (Final m1 : r) (Sem (Final m1 : r)) x -> Union r (Sem r) x) -> Sem (Final m1 : r) x -> Sem r x forall a b. (a -> b) -> a -> b $ \Union (Final m1 : r) (Sem (Final m1 : r)) x u -> case Union (Final m1 : r) (Sem (Final m1 : r)) x -> Either (Union r (Sem (Final m1 : r)) x) (Weaving (Final m1) (Sem (Final m1 : r)) x) forall (e :: (* -> *) -> * -> *) (r :: EffectRow) (m :: * -> *) a. Union (e : r) m a -> Either (Union r m a) (Weaving e m a) decomp Union (Final m1 : r) (Sem (Final m1 : r)) x u of Right (Weaving (WithWeavingToFinal wav) f () s forall x. f (Sem rInitial x) -> Sem (Final m1 : r) (f x) wv f a -> x ex forall x. f x -> Maybe x ins) -> Weaving (Final m2) (Sem r) x -> Union r (Sem r) x forall (e :: (* -> *) -> * -> *) (r :: EffectRow) (m :: * -> *) a. Member e r => Weaving e m a -> Union r m a injWeaving (Weaving (Final m2) (Sem r) x -> Union r (Sem r) x) -> Weaving (Final m2) (Sem r) x -> Union r (Sem r) x forall a b. (a -> b) -> a -> b $ Final m2 (Sem rInitial) a -> f () -> (forall x. f (Sem rInitial x) -> Sem r (f x)) -> (f a -> x) -> (forall x. f x -> Maybe x) -> Weaving (Final m2) (Sem r) x forall (f :: * -> *) (e :: (* -> *) -> * -> *) (rInitial :: EffectRow) a resultType (mAfter :: * -> *). Functor f => e (Sem rInitial) a -> f () -> (forall x. f (Sem rInitial x) -> mAfter (f x)) -> (f a -> resultType) -> (forall x. f x -> Maybe x) -> Weaving e mAfter resultType Weaving (ThroughWeavingToFinal m2 (Sem rInitial) a -> Final m2 (Sem rInitial) a forall (m :: * -> *) (z :: * -> *) a. ThroughWeavingToFinal m z a -> Final m z a WithWeavingToFinal (ThroughWeavingToFinal m2 (Sem rInitial) a -> Final m2 (Sem rInitial) a) -> ThroughWeavingToFinal m2 (Sem rInitial) a -> Final m2 (Sem rInitial) a forall a b. (a -> b) -> a -> b $ \f () s' forall x. f (Sem rInitial x) -> m2 (f x) wv' forall x. f x -> Maybe x ins' -> m1 (f a) -> m2 (f a) forall x. m1 x -> m2 x to (m1 (f a) -> m2 (f a)) -> m1 (f a) -> m2 (f a) forall a b. (a -> b) -> a -> b $ f () -> (forall x. f (Sem rInitial x) -> m1 (f x)) -> (forall x. f x -> Maybe x) -> m1 (f a) ThroughWeavingToFinal m1 (Sem rInitial) a wav f () s' (m2 (f x) -> m1 (f x) forall x. m2 x -> m1 x from (m2 (f x) -> m1 (f x)) -> (f (Sem rInitial x) -> m2 (f x)) -> f (Sem rInitial x) -> m1 (f x) forall b c a. (b -> c) -> (a -> b) -> a -> c . f (Sem rInitial x) -> m2 (f x) forall x. f (Sem rInitial x) -> m2 (f x) wv') forall x. f x -> Maybe x ins' ) f () s (Sem (Final m1 : r) (f x) -> Sem r (f x) forall x. Sem (Final m1 : r) x -> Sem r x go (Sem (Final m1 : r) (f x) -> Sem r (f x)) -> (f (Sem rInitial x) -> Sem (Final m1 : r) (f x)) -> f (Sem rInitial x) -> Sem r (f x) forall b c a. (b -> c) -> (a -> b) -> a -> c . f (Sem rInitial x) -> Sem (Final m1 : r) (f x) forall x. f (Sem rInitial x) -> Sem (Final m1 : r) (f x) wv) f a -> x ex forall x. f x -> Maybe x ins Left Union r (Sem (Final m1 : r)) x g -> (forall x. Sem (Final m1 : r) x -> Sem r x) -> Union r (Sem (Final m1 : r)) x -> Union r (Sem r) x forall (m :: * -> *) (n :: * -> *) (r :: EffectRow) a. (forall x. m x -> n x) -> Union r m a -> Union r n a hoist forall x. Sem (Final m1 : r) x -> Sem r x go Union r (Sem (Final m1 : r)) x g {-# INLINE go #-} in Sem (Final m1 : r) a -> Sem r a forall x. Sem (Final m1 : r) x -> Sem r x go {-# INLINE finalToFinal #-} ------------------------------------------------------------------------------ -- | Transform an @'Embed' m@ effect into a @'Final' m@ effect -- -- @since 1.2.0.0 embedToFinal :: (Member (Final m) r, Functor m) => Sem (Embed m ': r) a -> Sem r a embedToFinal :: Sem (Embed m : r) a -> Sem r a embedToFinal = (forall (rInitial :: EffectRow) x. Embed m (Sem rInitial) x -> Sem r x) -> Sem (Embed m : r) a -> Sem r a forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a. FirstOrder e "interpret" => (forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x) -> Sem (e : r) a -> Sem r a interpret ((forall (rInitial :: EffectRow) x. Embed m (Sem rInitial) x -> Sem r x) -> Sem (Embed m : r) a -> Sem r a) -> (forall (rInitial :: EffectRow) x. Embed m (Sem rInitial) x -> Sem r x) -> Sem (Embed m : r) a -> Sem r a forall a b. (a -> b) -> a -> b $ \(Embed m) -> m x -> Sem r x forall (m :: * -> *) (r :: EffectRow) a. (Member (Final m) r, Functor m) => m a -> Sem r a embedFinal m x m {-# INLINE embedToFinal #-}