mirror of
https://github.com/polysemy-research/polysemy.git
synced 2024-11-27 13:52:17 +03:00
loosen constraints so it interops with fused-effects
This commit is contained in:
parent
d59fcb7de5
commit
fc146d9dc9
@ -41,7 +41,7 @@ newtype Lift m (z :: * -> *) a = Lift
|
|||||||
deriving (Functor, Applicative, Monad) via m
|
deriving (Functor, Applicative, Monad) via m
|
||||||
|
|
||||||
|
|
||||||
instance Monad m => Effect (Lift m) where
|
instance Functor m => Effect (Lift m) where
|
||||||
weave s _ (Lift a) = Lift $ fmap (<$ s) a
|
weave s _ (Lift a) = Lift $ fmap (<$ s) a
|
||||||
{-# INLINE weave #-}
|
{-# INLINE weave #-}
|
||||||
|
|
||||||
@ -63,7 +63,7 @@ data Union (r :: [(* -> *) -> * -> *]) (m :: * -> *) a where
|
|||||||
Union :: Effect e => Word -> e m a -> Union r m a
|
Union :: Effect e => Word -> e m a -> Union r m a
|
||||||
|
|
||||||
|
|
||||||
unsafeInj :: (Monad m, Effect e) => Word -> e m a -> Union r m a
|
unsafeInj :: Effect e => Word -> e m a -> Union r m a
|
||||||
unsafeInj w = Union w
|
unsafeInj w = Union w
|
||||||
{-# INLINE unsafeInj #-}
|
{-# INLINE unsafeInj #-}
|
||||||
|
|
||||||
@ -121,16 +121,16 @@ raise :: Eff r a -> Eff (e ': r) a
|
|||||||
raise = runEff pure $ zoop . hoist raise . weaken
|
raise = runEff pure $ zoop . hoist raise . weaken
|
||||||
|
|
||||||
|
|
||||||
instance Monad m => Functor (Union r m) where
|
instance Functor m => Functor (Union r m) where
|
||||||
fmap f (Union w t) = Union w $ fmap f t
|
fmap f (Union w t) = Union w $ fmap f t
|
||||||
{-# INLINE fmap #-}
|
{-# INLINE fmap #-}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
class (∀ m. Monad m => Functor (e m)) => Effect e where
|
class (∀ m. Functor m => Functor (e m)) => Effect e where
|
||||||
weave
|
weave
|
||||||
:: (Functor s, Monad m, Monad n)
|
:: (Functor s, Functor m)
|
||||||
=> s ()
|
=> s ()
|
||||||
-> (∀ x. s (m x) -> n (s x))
|
-> (∀ x. s (m x) -> n (s x))
|
||||||
-> e m a
|
-> e m a
|
||||||
@ -139,7 +139,7 @@ class (∀ m. Monad m => Functor (e m)) => Effect e where
|
|||||||
default weave
|
default weave
|
||||||
:: ( Coercible (e m (s a)) (e n (s a))
|
:: ( Coercible (e m (s a)) (e n (s a))
|
||||||
, Functor s
|
, Functor s
|
||||||
, Monad m
|
, Functor m
|
||||||
)
|
)
|
||||||
=> s ()
|
=> s ()
|
||||||
-> (∀ x. s (m x) -> n (s x))
|
-> (∀ x. s (m x) -> n (s x))
|
||||||
@ -148,7 +148,7 @@ class (∀ m. Monad m => Functor (e m)) => Effect e where
|
|||||||
weave s _ = coerce . fmap (<$ s)
|
weave s _ = coerce . fmap (<$ s)
|
||||||
{-# INLINE weave #-}
|
{-# INLINE weave #-}
|
||||||
|
|
||||||
hoist :: (Monad m, Monad n) => (∀ x. m x -> n x) -> e m a -> e n a
|
hoist :: (Functor m, Functor n) => (∀ x. m x -> n x) -> e m a -> e n a
|
||||||
hoist f = fmap runIdentity . weave (Identity ()) (fmap Identity . f . runIdentity)
|
hoist f = fmap runIdentity . weave (Identity ()) (fmap Identity . f . runIdentity)
|
||||||
{-# INLINE hoist #-}
|
{-# INLINE hoist #-}
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user