1
1
mirror of https://github.com/github/semantic.git synced 2024-12-22 14:21:31 +03:00

Interpose with an upcast.

This commit is contained in:
Rob Rix 2018-10-23 11:30:58 -04:00
parent 92ac53252e
commit c53a6aa511

View File

@ -163,10 +163,10 @@ instance ( Member (Reader ModuleInfo) sig
interpose :: (Member eff sig, HFunctor eff, Carrier sig m) interpose :: (Member eff sig, HFunctor eff, Carrier sig m)
=> (forall v. eff m (m v) -> m v) => (forall v. eff (Eff m) (Eff m v) -> Eff m v)
-> Eff (InterposeC eff m) a -> Eff m a
-> m a -> Eff m a
interpose handler = runInterposeC handler . interpret interpose handler = runInterposeC handler . interpret . upcast
upcast :: Eff m a -> Eff (InterposeC eff (Eff m)) a upcast :: Eff m a -> Eff (InterposeC eff (Eff m)) a
upcast m = Eff (\ k -> InterposeC (\ f -> m >>= runInterposeC f . k)) upcast m = Eff (\ k -> InterposeC (\ f -> m >>= runInterposeC f . k))