Cont.hs

{-# LANGUAGE AllowAmbiguousTypes, Trustworthy #-}
module Polysemy.Cont
  (-- * Effect
    Cont(..)

    -- * Actions
  , jump
  , subst
  , callCC

    -- * Interpretations
  , runContPure
  , runContM
  , contToFinal

    -- * Experimental Interpretations
  , runContViaFresh

    -- * Unsafe Interpretations
  , runContUnsafe

  -- * Prompt types
  , Ref(..)
  , ExitRef(..)
  , ViaFreshRef
  ) where

import Data.Void

import Polysemy
import Polysemy.Final

import Polysemy.Cont.Internal

import Polysemy.Error
import Polysemy.Fresh

import Control.Monad.Cont (MonadCont(), ContT(..), runContT)
import qualified Control.Monad.Cont as C (callCC)

-----------------------------------------------------------------------------
-- | Call with current continuation.
-- Executing the provided continuation will abort execution.
--
-- Using the provided continuation
-- will rollback all local effectful state back to the point where
-- 'callCC' was invoked.
--
-- Higher-order effects do not interact with the continuation in any meaningful
-- way; i.e. 'Polysemy.Reader.local' or 'Polysemy.Writer.censor' does not affect
-- it, and 'Polysemy.Error.catch' will fail to catch any of its exceptions.
-- The only exception to this is if you interpret such effects /and/ 'Cont'
-- in terms of the final monad, and the final monad can perform such interactions
-- in a meaningful manner.
callCC :: forall ref r a
       .  Member (Cont ref) r
       => ((forall b. a -> Sem r b) -> Sem r a)
       -> Sem r a
callCC cc = subst @ref (\ref -> cc (jump ref)) pure
{-# INLINE callCC #-}

-----------------------------------------------------------------------------
-- | Runs a 'Cont' effect by providing 'pure' as the final continuation.
--
-- This is a safe variant of 'runContUnsafe', as this may only be used
-- as the final interpreter before 'run'.
runContPure :: Sem '[Cont (Ref (Sem '[]) a)] a -> Sem '[] a
runContPure = runContUnsafe
{-# INLINE runContPure #-}

-----------------------------------------------------------------------------
-- | Runs a 'Cont' effect by providing 'pure' as the final continuation.
--
-- This is a safe variant of 'runContUnsafe', as this may only be used
-- as the final interpreter before 'runM'.
runContM :: Sem '[Cont (Ref (Sem '[Embed m]) a), Embed m] a -> Sem '[Embed m] a
runContM = runContUnsafe
{-# INLINE runContM #-}

-----------------------------------------------------------------------------
-- | Runs a 'Cont' effect in terms of a final 'MonadCont'
--
-- /Beware/: Effects that aren't interpreted in terms of the final monad
-- will have local state semantics in regards to 'Cont' effects
-- interpreted this way. See 'Final'.
contToFinal :: (Member (Final m) r, MonadCont m)
            => Sem (Cont (ExitRef m) ': r) a
            -> Sem r a
contToFinal = interpretFinal $ \case
  Jump ref a    -> pure $ enterExit ref a
  Subst main cb -> do
    main' <- bindS main
    cb'   <- bindS cb
    s     <- getInitialStateS
    pure $ C.callCC $ \exit ->
      main' (ExitRef (\a -> cb' (a <$ s) >>= vacuous . exit) <$ s)
{-# INLINE contToFinal #-}

-----------------------------------------------------------------------------
-- | A highly experimental 'Cont' interpreter that functions
-- through a combination of 'Error' and 'Fresh'. This may be used safely
-- anywhere in the effect stack.
--
-- 'runContViaFresh' is still under development.
-- You're encouraged to experiment with it, but don't rely on it.
-- For best results, use 'runContViaFresh' as the first interpreter you run,
-- such that all other effects are global in respect to it.
--
-- This interpreter may return 'Nothing' if the control flow becomes
-- split into separate, inconsistent parts,
-- such that backtracking fails when trying to invoke continuations.
-- For example, if you reify a continuation inside an
-- 'async':ed thread, and then have that thread return the reified
-- continuation back to the main thread through an 'await', then
-- 'runContViaFresh' will return 'Nothing' upon executing the continuation
-- in the main thread.
runContViaFresh :: forall uniq r a
                 . (Member (Fresh uniq) r, Eq uniq)
                => Sem (Cont (ViaFreshRef uniq) ': r) a
                -> Sem r (Maybe a)
runContViaFresh =
  let
    hush (Right a) = Just a
    hush _         = Nothing
  in
      fmap hush
    . runError
    . (`runContT` pure)
    . runContViaFreshInC
{-# INLINE runContViaFresh #-}

-----------------------------------------------------------------------------
-- | Runs a 'Cont' effect by providing 'pure' as the final continuation.
--
-- __Beware__: This interpreter will invalidate all higher-order effects of any
-- interpreter run after it; i.e. 'Polysemy.Reader.local' and
-- 'Polysemy.Writer.censor' will be no-ops, 'Polysemy.Error.catch' will fail
-- to catch exceptions, and 'Polysemy.Writer.listen' will always return 'mempty'.
--
-- __You should therefore use 'runContUnsafe' only /after/ running all__
-- __interpreters for your higher-order effects.__
--
-- Note that 'Final' is a higher-order effect, and thus 'runContUnsafe' can't
-- safely be used together with 'runFinal'.
runContUnsafe :: Sem (Cont (Ref (Sem r) a) ': r) a -> Sem r a
runContUnsafe = runContWithCUnsafe pure
{-# INLINE runContUnsafe #-}