content: {-# LANGUAGE CPP #-}
  #if __GLASGOW_HASKELL__ >= 702
  {-# LANGUAGE Safe #-}
  #endif
  #if __GLASGOW_HASKELL__ >= 706
  {-# LANGUAGE PolyKinds #-}
  #endif
  #if __GLASGOW_HASKELL__ >= 710
  {-# LANGUAGE AutoDeriveTypeable #-}
  #endif
  -----------------------------------------------------------------------------
  -- |
  -- Module      :  Control.Monad.Trans.Cont
  -- Copyright   :  (c) The University of Glasgow 2001
  -- License     :  BSD-style (see the file LICENSE)
  --
  -- Maintainer  :  R.Paterson@city.ac.uk
  -- Stability   :  experimental
  -- Portability :  portable
  --
  -- Continuation monads.
  --
  -- Delimited continuation operators are taken from Kenichi Asai and Oleg
  -- Kiselyov's tutorial at CW 2011, \"Introduction to programming with
  -- shift and reset\" (<http://okmij.org/ftp/continuations/#tutorial>).
  --
  -----------------------------------------------------------------------------
  
  module Control.Monad.Trans.Cont (
      -- * The Cont monad
      Cont,
      cont,
      runCont,
      evalCont,
      mapCont,
      withCont,
      -- ** Delimited continuations
      reset, shift,
      -- * The ContT monad transformer
      ContT(..),
      evalContT,
      mapContT,
      withContT,
      callCC,
      -- ** Delimited continuations
      resetT, shiftT,
      -- * Lifting other operations
      liftLocal,
    ) where
  
  import Control.Monad.IO.Class
  import Control.Monad.Trans.Class
  import Data.Functor.Identity
  
  import Control.Applicative
  #if MIN_VERSION_base(4,9,0)
  import qualified Control.Monad.Fail as Fail
  #endif
  
  {- |
  Continuation monad.
  @Cont r a@ is a CPS ("continuation-passing style") 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 (\ c -> Identity (f (runIdentity . c)))
  {-# INLINE cont #-}
  
  -- | The result of running a CPS computation with a given final continuation.
  -- (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))
  {-# INLINE runCont #-}
  
  -- | The result of running a CPS computation with the identity as the
  -- final continuation.
  --
  -- * @'evalCont' ('return' x) = x@
  evalCont :: Cont r r -> r
  evalCont m = runIdentity (evalContT m)
  {-# INLINE evalCont #-}
  
  -- | 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)
  {-# INLINE mapCont #-}
  
  -- | 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 .))
  {-# INLINE withCont #-}
  
  -- | @'reset' m@ delimits the continuation of any 'shift' inside @m@.
  --
  -- * @'reset' ('return' m) = 'return' m@
  --
  reset :: Cont r r -> Cont r' r
  reset = resetT
  {-# INLINE reset #-}
  
  -- | @'shift' f@ captures the continuation up to the nearest enclosing
  -- 'reset' and passes it to @f@:
  --
  -- * @'reset' ('shift' f >>= k) = 'reset' (f ('evalCont' . k))@
  --
  shift :: ((a -> r) -> Cont r r) -> Cont r a
  shift f = shiftT (f . (runIdentity .))
  {-# INLINE shift #-}
  
  -- | The continuation monad transformer.
  -- Can be used to add continuation handling to any type constructor:
  -- the 'Monad' instance and most of the operations do not require @m@
  -- to be a monad.
  --
  -- 'ContT' is not a functor on the category of monads, and many operations
  -- cannot be lifted through it.
  newtype ContT r m a = ContT { runContT :: (a -> m r) -> m r }
  
  -- | The result of running a CPS computation with 'return' as the
  -- final continuation.
  --
  -- * @'evalContT' ('lift' m) = m@
  evalContT :: (Monad m) => ContT r m r -> m r
  evalContT m = runContT m return
  {-# INLINE evalContT #-}
  
  -- | Apply a function to transform the result of a continuation-passing
  -- computation.  This has a more restricted type than the @map@ operations
  -- for other monad transformers, because 'ContT' does not define a functor
  -- in the category of monads.
  --
  -- * @'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
  {-# INLINE mapContT #-}
  
  -- | 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
  {-# INLINE withContT #-}
  
  instance Functor (ContT r m) where
      fmap f m = ContT $ \ c -> runContT m (c . f)
      {-# INLINE fmap #-}
  
  instance Applicative (ContT r m) where
      pure x  = ContT ($ x)
      {-# INLINE pure #-}
      f <*> v = ContT $ \ c -> runContT f $ \ g -> runContT v (c . g)
      {-# INLINE (<*>) #-}
      m *> k = m >>= \_ -> k
      {-# INLINE (*>) #-}
  
  instance Monad (ContT r m) where
  #if !(MIN_VERSION_base(4,8,0))
      return x = ContT ($ x)
      {-# INLINE return #-}
  #endif
      m >>= k  = ContT $ \ c -> runContT m (\ x -> runContT (k x) c)
      {-# INLINE (>>=) #-}
  
  #if MIN_VERSION_base(4,9,0)
  instance (Fail.MonadFail m) => Fail.MonadFail (ContT r m) where
      fail msg = ContT $ \ _ -> Fail.fail msg
      {-# INLINE fail #-}
  #endif
  
  instance MonadTrans (ContT r) where
      lift m = ContT (m >>=)
      {-# INLINE lift #-}
  
  instance (MonadIO m) => MonadIO (ContT r m) where
      liftIO = lift . liftIO
      {-# INLINE 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.Except.throwE'
  -- and 'Control.Monad.Trans.Except.catchE' within an
  -- 'Control.Monad.Trans.Except.ExceptT' 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 (\ x -> ContT $ \ _ -> c x)) c
  {-# INLINE callCC #-}
  
  -- | @'resetT' m@ delimits the continuation of any 'shiftT' inside @m@.
  --
  -- * @'resetT' ('lift' m) = 'lift' m@
  --
  resetT :: (Monad m) => ContT r m r -> ContT r' m r
  resetT = lift . evalContT
  {-# INLINE resetT #-}
  
  -- | @'shiftT' f@ captures the continuation up to the nearest enclosing
  -- 'resetT' and passes it to @f@:
  --
  -- * @'resetT' ('shiftT' f >>= k) = 'resetT' (f ('evalContT' . k))@
  --
  shiftT :: (Monad m) => ((a -> m r) -> ContT r m r) -> ContT r m a
  shiftT f = ContT (evalContT . f)
  {-# INLINE shiftT #-}
  
  -- | @'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))
  {-# INLINE liftLocal #-}
  