polysemy-research/polysemy
1
1
Fork 0
mirror of https://github.com/polysemy-research/polysemy.git synced 2024-11-27 05:43:36 +03:00
Code Issues Projects Releases Wiki Activity

absurd union

Browse Source
This commit is contained in:
Sandy Maguire 2019-03-17 11:35:28 -04:00
parent 53702e82d4
commit 26ffcd4f9e
2 changed files with 8 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
src/Control/Monad/Discount.hs
View File

@ -12,14 +12,12 @@ module Control.Monad.Discount
, Member
, decomp
, prj
, Identity (..)
) where
import Data.OpenUnion
import Control.Monad.Discount.Effect
import Control.Monad (join)
import Control.Monad.Discount.Lift
import Data.Functor.Identity
type Eff r = F (Union r)
@ -130,8 +128,8 @@ runM e = runF e pure $ join . unLift . extract
{-# INLINE runM #-}
run :: Eff '[Lift Identity] a -> a
run = runIdentity . runM
run :: Eff '[] a -> a
run = runEff id absurdU
{-# INLINE run #-}

8
src/Data/OpenUnion.hs
View File

@ -15,13 +15,17 @@ import Control.Monad.Discount.Effect
import Unsafe.Coerce
data Union (r :: [(* -> *) -> * -> *]) (m :: * -> *) a where
Union :: Effect e => Word -> e m a -> Union r m a
extract :: Union '[e] m a -> e m a
extract (Union _ a) = unsafeCoerce a
{-# INLINE extract #-}
data Union (r :: [(* -> *) -> * -> *]) (m :: * -> *) a where
Union :: Effect e => Word -> e m a -> Union r m a
absurdU :: Union '[] m a -> b
absurdU = error "absurd, empty union"
unsafeInj :: Effect e => Word -> e m a -> Union r m a