sayo-hs/heftia
1
1
Fork 0
mirror of https://github.com/sayo-hs/heftia.git synced 2024-11-26 23:05:04 +03:00
Code Issues Actions Packages Projects Releases Wiki Activity

[add] subsuming functions.

Browse Source
This commit is contained in:
Yamada Ryo 2023-09-17 19:14:51 +09:00
parent 02d5a21ade
commit e5263b1742
No known key found for this signature in database
GPG Key ID: AAE3C7A542B02DBF
2 changed files with 28 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
heftia/src/Control/Effect/Freer.hs
View File

@ -586,6 +586,20 @@ splitFreerEffects a =
Left e -> liftInsT e
Right e -> liftLowerFT $ freerEffects $ liftInsT e
-- | Transfer the effect to the underlying level.
subsume ::
(TransFreer c fr, SendIns e (FreerEffects fr u es f), Union u, c f) =>
FreerEffects fr u (e ': es) f ~> FreerEffects fr u es f
subsume = interpret sendIns
{-# INLINE subsume #-}
-- | Transfer the effect to the lower carrier.
subsumeLower ::
(TransFreer c fr, SendIns e f, Union u, c f) =>
FreerEffects fr u (e ': es) f ~> FreerEffects fr u es f
subsumeLower = interpret $ liftLower . sendIns
{-# INLINE subsumeLower #-}
-- | Lifts the lower carrier.
liftLower :: (TransFreer c fr, c f) => f ~> FreerEffects fr u es f
liftLower = freerEffects . liftLowerFT

14
heftia/src/Control/Effect/Heftia.hs
View File

@ -713,6 +713,20 @@ interpretLowerH ::
interpretLowerH f = overHeftiaEffects $ interpretLowerHT (unHeftiaEffects . f)
{-# INLINE interpretLowerH #-}
-- | Transfer the higher-order effect to the underlying level.
subsume ::
( TransHeftia c h
, MemberH u e es
, UnionH u
, HFunctor e
, HFunctor (u es)
, HFunctor (u (e : es))
, c f
) =>
HeftiaEffects h u (e ': es) f ~> HeftiaEffects h u es f
subsume = interpretH $ heftiaEffects . liftSigT . hfmap unHeftiaEffects . injectH
{-# INLINE subsume #-}
-- | Lifts the lower carrier.
liftLowerH :: (TransHeftia c h, c f, HFunctor (u es)) => f ~> HeftiaEffects h u es f
liftLowerH = heftiaEffects . liftLowerHT