module Control.Effect.Cont
  ( -- * Effects
    Cont(..)
  , Shift(..)

    -- * Actions
  , callCC
  , shift

    -- * Interpretations
  , runCont

  , runShift

  , contToShift

    -- * Threading constraints
  , ContThreads

    -- * Carriers
  , ContC
  , ShiftC
  , ContToShiftC
  ) where

import Data.Coerce

import Control.Effect
import Control.Effect.Internal.Cont

import Control.Effect.Internal.Utils

import Control.Monad.Trans.Free.Church.Alternate

-- | Call with current continuation. The argument computation is provided
-- the /continuation/ of the program at the point that 'callCC' was invoked.
-- If the continuation is executed, then control will immediately abort
-- and jump to the point 'callCC' was invoked, which will then return
-- the argument provided to the continuation.
--
-- The way higher-order actions interact with the continuation depends
-- on the interpretation of 'Cont'. In general, you cannot expect to interact
-- with the continuation in any meaningful way: for example, you should not
-- assume that you will be able to catch an exception thrown at some point in
-- the future of the computation by using 'Control.Effect.Error.catch' on the
-- continuation.
callCC :: Eff Cont m
       => ((forall b. a -> m b) -> m a) -> m a
callCC :: ((forall b. a -> m b) -> m a) -> m a
callCC (forall b. a -> m b) -> m a
main = Cont m a -> m a
forall (e :: Effect) (m :: * -> *) a.
(Member e (Derivs m), Carrier m) =>
e m a -> m a
send (((forall b. a -> m b) -> m a) -> Cont m a
forall a (m :: * -> *). ((forall b. a -> m b) -> m a) -> Cont m a
CallCC (forall b. a -> m b) -> m a
main)
{-# INLINE callCC #-}

-- | Non-abortive call with current continuation. The argument computation is
-- provided the /continuation/ of the program at the point that 'shift' was invoked.
-- If the continuation is executed, then control will jump to the point 'shift'
-- was invoked, which will then return the argument provided to the continuation.
--
-- Once the program finishes, and produces an @r@, control will jump /back/
-- to where the continuation was executed, and return that @r@.
-- From that point, you may decide whether or not to modify the final @r@,
-- or invoke the continuation again with a different argument.
--
-- You can also use 'shift' to abort the execution of the program early
-- by simply not executing the provided continuation, and instead
-- provide the final @r@ directly.
--
-- The way higher-order actions interact with the continuation depends
-- on the interpretation of 'Shift'. In general, you cannot expect to interact
-- with the continuation in any meaningful way: for example, you should not
-- assume that you will be able to catch an exception thrown at some point in
-- the future of the computation by using 'Control.Effect.Error.catch' on the
-- continuation.
shift :: Eff (Shift r) m
      => ((a -> m r) -> m r) -> m a
shift :: ((a -> m r) -> m r) -> m a
shift = Shift r m a -> m a
forall (e :: Effect) (m :: * -> *) a.
(Member e (Derivs m), Carrier m) =>
e m a -> m a
send (Shift r m a -> m a)
-> (((a -> m r) -> m r) -> Shift r m a)
-> ((a -> m r) -> m r)
-> m a
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# ((a -> m r) -> m r) -> Shift r m a
forall a (m :: * -> *) r. ((a -> m r) -> m r) -> Shift r m a
Shift
{-# INLINE shift #-}

-- | Run a 'Cont' effect.
--
-- @'Derivs' ('ContC' r m) = 'Cont' ': 'Derivs' m@
--
-- @'Control.Effect.Primitive.Prims'  ('ContC' r m) = 'Control.Effect.Primitive.Prims' m@
runCont :: forall a m p
         . ( Carrier m
           , Threaders '[ContThreads] m p
           )
        => ContC a m a -> m a
runCont :: ContC a m a -> m a
runCont =
    (a -> a)
-> (forall x. (x -> m a) -> ContBase (m a) a x -> m a)
-> FreeT (ContBase (m a) a) m a
-> m a
forall (m :: * -> *) a b (f :: * -> *).
Monad m =>
(a -> b)
-> (forall x. (x -> m b) -> f x -> m b) -> FreeT f m a -> m b
foldFreeT
      a -> a
forall a. a -> a
id
      (\x -> m a
c -> \case
        Exit a -> a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
        Attempt m -> m a
m x
m m x -> (x -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= x -> m a
c
        ContBase (m a) a x
GetCont -> x -> m a
c (x -> m a) -> x -> m a
forall a b. (a -> b) -> a -> b
$ (a -> m a) -> Either (a -> m a) a
forall a b. a -> Either a b
Left (x -> m a
c (x -> m a) -> (a -> x) -> a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> x
forall a b. b -> Either a b
Right)
      )
  (FreeT (ContBase (m a) a) m a -> m a)
-> (ContC a m a -> FreeT (ContBase (m a) a) m a)
-> ContC a m a
-> m a
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# ContC a m a -> FreeT (ContBase (m a) a) m a
forall r (m :: * -> *) a.
ContC r m a -> FreeT (ContBase (m r) r) m a
unContC
{-# INLINE runCont #-}

-- | Run a @'Shift' r@ effect if the program returns @r@.
--
-- @'Derivs' ('ShiftC' r m) = 'Shift' r ': 'Derivs' m@
--
-- @'Control.Effect.Primitive.Prims'  ('ShiftC' r m) = 'Control.Effect.Primitive.Prims' m@
runShift :: forall r m p
          . ( Carrier m
            , Threaders '[ContThreads] m p
            )
         => ShiftC r m r -> m r
runShift :: ShiftC r m r -> m r
runShift = (ContC r m r -> m r) -> ShiftC r m r -> m r
coerce ((Carrier m, Threaders '[ContThreads] m p) => ContC r m r -> m r
forall a (m :: * -> *) (p :: [Effect]).
(Carrier m, Threaders '[ContThreads] m p) =>
ContC a m a -> m a
runCont @r @m @p)
{-# INLINE runShift #-}


data ContToShiftH r

instance Eff (Shift r) m
      => Handler (ContToShiftH r) Cont m where
  effHandler :: Cont (Effly z) x -> Effly z x
effHandler = \case
    CallCC (forall b. x -> Effly z b) -> Effly z x
main -> forall r (m :: * -> *) a.
Eff (Shift r) m =>
((a -> m r) -> m r) -> m a
forall (m :: * -> *) a.
Eff (Shift r) m =>
((a -> m r) -> m r) -> m a
shift @r (((x -> Effly z r) -> Effly z r) -> Effly z x)
-> ((x -> Effly z r) -> Effly z r) -> Effly z x
forall a b. (a -> b) -> a -> b
$ \x -> Effly z r
c ->
      (forall b. x -> Effly z b) -> Effly z x
main (\x
a -> ((b -> Effly z r) -> Effly z r) -> Effly z b
forall r (m :: * -> *) a.
Eff (Shift r) m =>
((a -> m r) -> m r) -> m a
shift (((b -> Effly z r) -> Effly z r) -> Effly z b)
-> ((b -> Effly z r) -> Effly z r) -> Effly z b
forall a b. (a -> b) -> a -> b
$ \b -> Effly z r
_ -> x -> Effly z r
c x
a) Effly z x -> (x -> Effly z r) -> Effly z r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= x -> Effly z r
c
  {-# INLINEABLE effHandler #-}

type ContToShiftC r = InterpretC (ContToShiftH r) Cont

-- | Transform a 'Cont' effect into a @'Shift' r@ effect.
contToShift :: Eff (Shift r) m
            => ContToShiftC r m a
            -> m a
contToShift :: ContToShiftC r m a -> m a
contToShift = ContToShiftC r m a -> m a
forall h (e :: Effect) (m :: * -> *) a.
Handler h e m =>
InterpretC h e m a -> m a
interpretViaHandler
{-# INLINE contToShift #-}