Control/Monad/Trans/Cont.hs

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Control.Monad.Trans.Cont
    -- Copyright   :  (c) The University of Glasgow 2001
    -- License     :  BSD-style (see the file LICENSE)
    --
    -- Maintainer  :  ross@soi.city.ac.uk
    -- Stability   :  experimental
    -- Portability :  portable
    --
    -- Continuation monads.
    --
    -----------------------------------------------------------------------------

    module Control.Monad.Trans.Cont (
        -- * The Cont monad
        Cont,
        cont,
        runCont,
        mapCont,
        withCont,
        -- * The ContT monad transformer
        ContT(..),
        mapContT,
        withContT,
        callCC,
        -- * Lifting other operations
        liftLocal,
      ) where

    import Control.Monad.IO.Class
    import Control.Monad.Trans.Class
    import Data.Functor.Identity

    import Control.Applicative
    import Control.Monad

    {- |
    Continuation monad.
    @Cont r a@ is a CPS computation that produces an intermediate result
    of type @a@ within a CPS computation whose final result type is @r@.

    The @return@ function simply creates a continuation which passes the value on.

    The @>>=@ operator adds the bound function into the continuation chain.
    -}
    type Cont r = ContT r Identity

    -- | Construct a continuation-passing computation from a function.
    -- (The inverse of 'runCont'.)
    cont :: ((a -> r) -> r) -> Cont r a
    cont f = ContT (\ k -> Identity (f (runIdentity . k)))

    -- | Runs a CPS computation, returns its result after applying the final
    -- continuation to it.
    -- (The inverse of 'cont'.)
    runCont :: Cont r a	-- ^ continuation computation (@Cont@).
        -> (a -> r)		-- ^ the final continuation, which produces
    			-- the final result (often 'id').
        -> r
    runCont m k = runIdentity (runContT m (Identity . k))

    -- | Apply a function to transform the result of a continuation-passing
    -- computation.
    --
    -- * @'runCont' ('mapCont' f m) = f . 'runCont' m@
    mapCont :: (r -> r) -> Cont r a -> Cont r a
    mapCont f = mapContT (Identity . f . runIdentity)

    -- | Apply a function to transform the continuation passed to a CPS
    -- computation.
    --
    -- * @'runCont' ('withCont' f m) = 'runCont' m . f@
    withCont :: ((b -> r) -> (a -> r)) -> Cont r a -> Cont r b
    withCont f = withContT ((Identity .) . f . (runIdentity .))

    {- |
    The continuation monad transformer.
    Can be used to add continuation handling to other monads.
    -}
    newtype ContT r m a = ContT { runContT :: (a -> m r) -> m r }

    -- | Apply a function to transform the result of a continuation-passing
    -- computation.
    --
    -- * @'runContT' ('mapContT' f m) = f . 'runContT' m@
    mapContT :: (m r -> m r) -> ContT r m a -> ContT r m a
    mapContT f m = ContT $ f . runContT m

    -- | Apply a function to transform the continuation passed to a CPS
    -- computation.
    --
    -- * @'runContT' ('withContT' f m) = 'runContT' m . f@
    withContT :: ((b -> m r) -> (a -> m r)) -> ContT r m a -> ContT r m b
    withContT f m = ContT $ runContT m . f

    instance Functor (ContT r m) where
        fmap f m = ContT $ \c -> runContT m (c . f)

    instance Applicative (ContT r m) where
        pure a  = ContT ($ a)
        f <*> v = ContT $ \ k -> runContT f $ \ g -> runContT v (k . g)

    instance Monad (ContT r m) where
        return a = ContT ($ a)
        m >>= k  = ContT $ \c -> runContT m (\a -> runContT (k a) c)

    instance MonadTrans (ContT r) where
        lift m = ContT (m >>=)

    instance (MonadIO m) => MonadIO (ContT r m) where
        liftIO = lift . liftIO

    -- | @callCC@ (call-with-current-continuation) calls its argument
    -- function, passing it the current continuation.  It provides
    -- an escape continuation mechanism for use with continuation
    -- monads.  Escape continuations one allow to abort the current
    -- computation and return a value immediately.  They achieve a
    -- similar effect to 'Control.Monad.Trans.Error.throwError'
    -- and 'Control.Monad.Trans.Error.catchError' within an
    -- 'Control.Monad.Trans.Error.ErrorT' monad.  The advantage of this
    -- function over calling 'return' is that it makes the continuation
    -- explicit, allowing more flexibility and better control.
    --
    -- The standard idiom used with @callCC@ is to provide a lambda-expression
    -- to name the continuation. Then calling the named continuation anywhere
    -- within its scope will escape from the computation, even if it is many
    -- layers deep within nested computations.
    callCC :: ((a -> ContT r m b) -> ContT r m a) -> ContT r m a
    callCC f = ContT $ \c -> runContT (f (\a -> ContT $ \_ -> c a)) c

    -- | @'liftLocal' ask local@ yields a @local@ function for @'ContT' r m@.
    liftLocal :: Monad m => m r' -> ((r' -> r') -> m r -> m r) ->
        (r' -> r') -> ContT r m a -> ContT r m a
    liftLocal ask local f m = ContT $ \c -> do
        r <- ask
        local f (runContT m (local (const r) . c))