module Polysemy.Internal.Union.Inject ( inject , Inject ) where import Polysemy.Internal import Polysemy.Internal.Union ------------------------------------------------------------------------------ -- | Morally: -- -- @ -- 'inject' :: 'Members' effs r => 'Sem' effs a -> 'Sem' r a -- @ inject :: Inject effs r => Sem effs a -> Sem r a inject :: Sem effs a -> Sem r a inject (Sem a :: forall (m :: * -> *). Monad m => (forall x. Union effs (Sem effs) x -> m x) -> m a a) = (forall x. Union effs (Sem effs) x -> Sem r x) -> Sem r a forall (m :: * -> *). Monad m => (forall x. Union effs (Sem effs) x -> m x) -> m a a ((forall x. Union effs (Sem effs) x -> Sem r x) -> Sem r a) -> (forall x. Union effs (Sem effs) x -> Sem r x) -> Sem r a forall a b. (a -> b) -> a -> b $ Union r (Sem r) x -> Sem r x forall (r :: EffectRow) a. Union r (Sem r) a -> Sem r a liftSem (Union r (Sem r) x -> Sem r x) -> (Union effs (Sem effs) x -> Union r (Sem r) x) -> Union effs (Sem effs) x -> Sem r x forall b c a. (b -> c) -> (a -> b) -> a -> c . Union effs (Sem r) x -> Union r (Sem r) x forall (effs :: EffectRow) (r :: EffectRow) a. Inject effs r => Union effs (Sem r) a -> Union r (Sem r) a deject (Union effs (Sem r) x -> Union r (Sem r) x) -> (Union effs (Sem effs) x -> Union effs (Sem r) x) -> Union effs (Sem effs) x -> Union r (Sem r) x forall b c a. (b -> c) -> (a -> b) -> a -> c . (forall x. Sem effs x -> Sem r x) -> Union effs (Sem effs) x -> Union effs (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 (effs :: EffectRow) (r :: EffectRow) a. Inject effs r => Sem effs a -> Sem r a forall x. Sem effs x -> Sem r x inject ------------------------------------------------------------------------------ -- | Helper class for munging the 'Union' so that we can implement 'inject'. class Inject effs r where deject :: Union effs (Sem r) a -> Union r (Sem r) a instance Inject '[] r where deject :: Union '[] (Sem r) a -> Union r (Sem r) a deject = Union '[] (Sem r) a -> Union r (Sem r) a forall (m :: * -> *) a b. Union '[] m a -> b absurdU instance {-# INCOHERENT #-} Inject r r where deject :: Union r (Sem r) a -> Union r (Sem r) a deject = Union r (Sem r) a -> Union r (Sem r) a forall a. a -> a id instance (Member eff r, Inject effs r) => Inject (eff ': effs) r where deject :: Union (eff : effs) (Sem r) a -> Union r (Sem r) a deject u :: Union (eff : effs) (Sem r) a u = case Union (eff : effs) (Sem r) a -> Either (Union effs (Sem r) a) (Weaving eff (Sem r) a) forall (e :: Effect) (r :: EffectRow) (m :: * -> *) a. Union (e : r) m a -> Either (Union r m a) (Weaving e m a) decomp Union (eff : effs) (Sem r) a u of Left u' :: Union effs (Sem r) a u' -> Union effs (Sem r) a -> Union r (Sem r) a forall (effs :: EffectRow) (r :: EffectRow) a. Inject effs r => Union effs (Sem r) a -> Union r (Sem r) a deject Union effs (Sem r) a u' Right w :: Weaving eff (Sem r) a w -> ElemOf eff r -> Weaving eff (Sem r) a -> Union r (Sem r) a forall (e :: Effect) (r :: EffectRow) (mWoven :: * -> *) a. ElemOf e r -> Weaving e mWoven a -> Union r mWoven a Union ElemOf eff r forall a (e :: a) (r :: [a]). Member e r => ElemOf e r membership Weaving eff (Sem r) a w