{-# LANGUAGE AllowAmbiguousTypes #-}

-- This Source Code Form is subject to the terms of the Mozilla Public
-- License, v. 2.0. If a copy of the MPL was not distributed with this
-- file, You can obtain one at https://mozilla.org/MPL/2.0/.

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]