github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-25 16:02:43 +03:00
Code Issues Projects Releases Wiki Activity

Define a reinterpretEffect handler.

Browse Source
This commit is contained in:
Rob Rix 2018-05-08 16:28:28 -04:00
parent 4799bffeb0
commit a1b1f78c95
1 changed files with 4 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/Control/Effect.hs
View File

@ -13,6 +13,7 @@ module Control.Effect
, run , run
, runM , runM
, runEffect , runEffect
, reinterpretEffect
, raiseHandler , raiseHandler
, runReader , runReader
, runState , runState
@ -70,6 +71,9 @@ runM = Eff.runM . lower
runEffect :: Effectful m => (forall v . effect v -> (v -> m effects a) -> m effects a) -> m (effect ': effects) a -> m effects a runEffect :: Effectful m => (forall v . effect v -> (v -> m effects a) -> m effects a) -> m (effect ': effects) a -> m effects a
runEffect handler = raiseHandler (Eff.relay pure (\ effect yield -> lower (handler effect (raise . yield)))) runEffect handler = raiseHandler (Eff.relay pure (\ effect yield -> lower (handler effect (raise . yield))))
reinterpretEffect :: Effectful m => (forall x . effect x -> m (newEffect ': effects) x) -> m (effect ': effects) a -> m (newEffect ': effects) a
reinterpretEffect handler = raiseHandler (Eff.reinterpret (lower . handler))
-- | Raise a handler on 'Eff.Eff' to a handler on some 'Effectful' @m@. -- | Raise a handler on 'Eff.Eff' to a handler on some 'Effectful' @m@.
raiseHandler :: Effectful m => (Eff.Eff effectsA a -> Eff.Eff effectsB b) -> m effectsA a -> m effectsB b raiseHandler :: Effectful m => (Eff.Eff effectsA a -> Eff.Eff effectsB b) -> m effectsA a -> m effectsB b
raiseHandler handler = raise . handler . lower raiseHandler handler = raise . handler . lower