{-# LANGUAGE AllowAmbiguousTypes #-}
module Data.Effect.ShiftReset where
import Control.Monad ((>=>))
import Data.Functor (void)
data Shift' (r :: Type) b m a where
Shift :: forall r b m a. ((a -> b r) -> (forall x. m x -> b x) -> b r) -> Shift' r b m a
makeKeyedEffect [] [''Shift']
callCC
:: forall r b m a
. (SendHOEBy ShiftKey (Shift' r b) m, Monad m, Monad b)
=> ((a -> b r) -> m a)
-> m a
callCC :: forall r (b :: * -> *) (m :: * -> *) a.
(SendHOEBy ShiftKey (Shift' r b) m, Monad m, Monad b) =>
((a -> b r) -> m a) -> m a
callCC (a -> b r) -> m a
f = ((a -> b r) -> (forall x. m x -> b x) -> b r) -> m a
forall r (b :: * -> *) a (m :: * -> *).
SendHOEBy ShiftKey (Shift' r b) m =>
((a -> b r) -> (forall x. m x -> b x) -> b r) -> m a
shift \a -> b r
k forall x. m x -> b x
run -> m a -> b a
forall x. m x -> b x
run ((a -> b r) -> m a
f ((a -> b r) -> m a) -> (a -> b r) -> m a
forall a b. (a -> b) -> a -> b
$ a -> b r
k (a -> b r) -> (r -> b r) -> a -> b r
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> m r -> b r
forall x. m x -> b x
run (m r -> b r) -> (r -> m r) -> r -> b r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> m r
forall r (b :: * -> *) (m :: * -> *) a.
(SendHOEBy ShiftKey (Shift' r b) m, Applicative b) =>
r -> m a
exit) b a -> (a -> b r) -> b r
forall a b. b a -> (a -> b b) -> b b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> b r
k
exit :: (SendHOEBy ShiftKey (Shift' r b) m, Applicative b) => r -> m a
exit :: forall r (b :: * -> *) (m :: * -> *) a.
(SendHOEBy ShiftKey (Shift' r b) m, Applicative b) =>
r -> m a
exit r
r = ((a -> b r) -> (forall x. m x -> b x) -> b r) -> m a
forall r (b :: * -> *) a (m :: * -> *).
SendHOEBy ShiftKey (Shift' r b) m =>
((a -> b r) -> (forall x. m x -> b x) -> b r) -> m a
shift \a -> b r
_ forall x. m x -> b x
_ -> r -> b r
forall a. a -> b a
forall (f :: * -> *) a. Applicative f => a -> f a
pure r
r
{-# INLINE exit #-}
getCC
:: forall r b m
. (SendHOEBy ShiftKey (Shift' r b) m, Monad m, Monad b)
=> m (b r)
getCC :: forall r (b :: * -> *) (m :: * -> *).
(SendHOEBy ShiftKey (Shift' r b) m, Monad m, Monad b) =>
m (b r)
getCC = ((b r -> b r) -> m (b r)) -> m (b r)
forall r (b :: * -> *) (m :: * -> *) a.
(SendHOEBy ShiftKey (Shift' r b) m, Monad m, Monad b) =>
((a -> b r) -> m a) -> m a
callCC \b r -> b r
exit' -> let a :: b r
a = b r -> b r
exit' b r
a in b r -> m (b r)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b r
a
data Shift_' b m a where
Shift_' :: (forall (r :: Type). (a -> b r) -> (forall x. m x -> b x) -> b r) -> Shift_' b m a
makeKeyedEffect [] [''Shift_']
getCC_ :: (SendHOEBy Shift_Key (Shift_' b) m, Functor b) => m (b ())
getCC_ :: forall (b :: * -> *) (m :: * -> *).
(SendHOEBy Shift_Key (Shift_' b) m, Functor b) =>
m (b ())
getCC_ = (forall r. (b () -> b r) -> (forall x. m x -> b x) -> b r)
-> m (b ())
forall a (b :: * -> *) (m :: * -> *).
SendHOEBy Shift_Key (Shift_' b) m =>
(forall r. (a -> b r) -> (forall x. m x -> b x) -> b r) -> m a
shift_' \b () -> b r
k forall x. m x -> b x
_ -> let k' :: b r
k' = b () -> b r
k (b () -> b r) -> b () -> b r
forall a b. (a -> b) -> a -> b
$ b r -> b ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void b r
k' in b r
k'
data Reset m (a :: Type) where
Reset :: m a -> Reset m a
makeEffectH [''Reset]