    {-# 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 :: forall a r. ((a -> r) -> r) -> Cont r a
    cont (a -> r) -> r
    f = ((a -> Identity r) -> Identity r) -> ContT r Identity a
    forall {k} (r :: k) (m :: k -> *) a.
    ((a -> m r) -> m r) -> ContT r m a
    ContT (\ a -> Identity r
    c -> r -> Identity r
    forall a. a -> Identity a
    Identity ((a -> r) -> r
    f (Identity r -> r
    forall a. Identity a -> a
    runIdentity (Identity r -> r) -> (a -> Identity r) -> a -> r
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Identity r
    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 :: forall r a. Cont r a -> (a -> r) -> r
    runCont Cont r a
    m a -> r
    k = Identity r -> r
    forall a. Identity a -> a
    runIdentity (Cont r a -> (a -> Identity r) -> Identity r
    forall {k} (r :: k) (m :: k -> *) a.
    ContT r m a -> (a -> m r) -> m r
    runContT Cont r a
    m (r -> Identity r
    forall a. a -> Identity a
    Identity (r -> Identity r) -> (a -> r) -> a -> Identity r
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> r
    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 :: forall r. Cont r r -> r
    evalCont Cont r r
    m = Identity r -> r
    forall a. Identity a -> a
    runIdentity (Cont r r -> Identity r
    forall (m :: * -> *) r. Monad m => ContT r m r -> m r
    evalContT Cont r r
    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 :: forall r a. (r -> r) -> Cont r a -> Cont r a
    mapCont r -> r
    f = (Identity r -> Identity r)
    -> ContT r Identity a -> ContT r Identity a
    forall {k} (m :: k -> *) (r :: k) a.
    (m r -> m r) -> ContT r m a -> ContT r m a
    mapContT (r -> Identity r
    forall a. a -> Identity a
    Identity (r -> Identity r) -> (Identity r -> r) -> Identity r -> Identity r
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . r -> r
    f (r -> r) -> (Identity r -> r) -> Identity r -> r
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Identity r -> r
    forall a. Identity a -> a
    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 :: forall b r a. ((b -> r) -> a -> r) -> Cont r a -> Cont r b
    withCont (b -> r) -> a -> r
    f = ((b -> Identity r) -> a -> Identity r)
    -> ContT r Identity a -> ContT r Identity b
    forall {k} b (m :: k -> *) (r :: k) a.
    ((b -> m r) -> a -> m r) -> ContT r m a -> ContT r m b
    withContT ((r -> Identity r
    forall a. a -> Identity a
    Identity (r -> Identity r) -> (a -> r) -> a -> Identity r
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .) ((a -> r) -> a -> Identity r)
    -> ((b -> Identity r) -> a -> r)
    -> (b -> Identity r)
    -> a
    -> Identity r
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (b -> r) -> a -> r
    f ((b -> r) -> a -> r)
    -> ((b -> Identity r) -> b -> r) -> (b -> Identity r) -> a -> r
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Identity r -> r
    forall a. Identity a -> a
    runIdentity (Identity r -> r) -> (b -> Identity r) -> b -> r
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .))
    {-# 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 :: forall r r'. Cont r r -> Cont r' r
    reset = ContT r Identity r -> ContT r' Identity r
    forall (m :: * -> *) r r'. Monad m => ContT r m r -> ContT r' m r
    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 :: forall a r. ((a -> r) -> Cont r r) -> Cont r a
    shift (a -> r) -> Cont r r
    f = ((a -> Identity r) -> Cont r r) -> ContT r Identity a
    forall (m :: * -> *) a r.
    Monad m =>
    ((a -> m r) -> ContT r m r) -> ContT r m a
    shiftT ((a -> r) -> Cont r r
    f ((a -> r) -> Cont r r)
    -> ((a -> Identity r) -> a -> r) -> (a -> Identity r) -> Cont r r
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Identity r -> r
    forall a. Identity a -> a
    runIdentity (Identity r -> r) -> (a -> Identity r) -> a -> r
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .))
    {-# 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 { forall {k} (r :: k) (m :: k -> *) a.
    ContT r m a -> (a -> m r) -> m r
    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 :: forall (m :: * -> *) r. Monad m => ContT r m r -> m r
    evalContT ContT r m r
    m = ContT r m r -> (r -> m r) -> m r
    forall {k} (r :: k) (m :: k -> *) a.
    ContT r m a -> (a -> m r) -> m r
    runContT ContT r m r
    m r -> m r
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    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 :: forall {k} (m :: k -> *) (r :: k) a.
    (m r -> m r) -> ContT r m a -> ContT r m a
    mapContT m r -> m r
    f ContT r m a
    m = ((a -> m r) -> m r) -> ContT r m a
    forall {k} (r :: k) (m :: k -> *) a.
    ((a -> m r) -> m r) -> ContT r m a
    ContT (((a -> m r) -> m r) -> ContT r m a)
    -> ((a -> m r) -> m r) -> ContT r m a
    forall a b. (a -> b) -> a -> b
    $ m r -> m r
    f (m r -> m r) -> ((a -> m r) -> m r) -> (a -> m r) -> m r
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ContT r m a -> (a -> m r) -> m r
    forall {k} (r :: k) (m :: k -> *) a.
    ContT r m a -> (a -> m r) -> m r
    runContT ContT r m a
    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 :: forall {k} b (m :: k -> *) (r :: k) a.
    ((b -> m r) -> a -> m r) -> ContT r m a -> ContT r m b
    withContT (b -> m r) -> a -> m r
    f ContT r m a
    m = ((b -> m r) -> m r) -> ContT r m b
    forall {k} (r :: k) (m :: k -> *) a.
    ((a -> m r) -> m r) -> ContT r m a
    ContT (((b -> m r) -> m r) -> ContT r m b)
    -> ((b -> m r) -> m r) -> ContT r m b
    forall a b. (a -> b) -> a -> b
    $ ContT r m a -> (a -> m r) -> m r
    forall {k} (r :: k) (m :: k -> *) a.
    ContT r m a -> (a -> m r) -> m r
    runContT ContT r m a
    m ((a -> m r) -> m r)
    -> ((b -> m r) -> a -> m r) -> (b -> m r) -> m r
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (b -> m r) -> a -> m r
    f
    {-# INLINE withContT #-}

    instance Functor (ContT r m) where
        fmap :: forall a b. (a -> b) -> ContT r m a -> ContT r m b
    fmap a -> b
    f ContT r m a
    m = ((b -> m r) -> m r) -> ContT r m b
    forall {k} (r :: k) (m :: k -> *) a.
    ((a -> m r) -> m r) -> ContT r m a
    ContT (((b -> m r) -> m r) -> ContT r m b)
    -> ((b -> m r) -> m r) -> ContT r m b
    forall a b. (a -> b) -> a -> b
    $ \ b -> m r
    c -> ContT r m a -> (a -> m r) -> m r
    forall {k} (r :: k) (m :: k -> *) a.
    ContT r m a -> (a -> m r) -> m r
    runContT ContT r m a
    m (b -> m r
    c (b -> m r) -> (a -> b) -> a -> m r
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> b
    f)
        {-# INLINE fmap #-}

    instance Applicative (ContT r m) where
        pure :: forall a. a -> ContT r m a
    pure a
    x  = ((a -> m r) -> m r) -> ContT r m a
    forall {k} (r :: k) (m :: k -> *) a.
    ((a -> m r) -> m r) -> ContT r m a
    ContT ((a -> m r) -> a -> m r
    forall a b. (a -> b) -> a -> b
    $ a
    x)
        {-# INLINE pure #-}
        ContT r m (a -> b)
    f <*> :: forall a b. ContT r m (a -> b) -> ContT r m a -> ContT r m b
    <*> ContT r m a
    v = ((b -> m r) -> m r) -> ContT r m b
    forall {k} (r :: k) (m :: k -> *) a.
    ((a -> m r) -> m r) -> ContT r m a
    ContT (((b -> m r) -> m r) -> ContT r m b)
    -> ((b -> m r) -> m r) -> ContT r m b
    forall a b. (a -> b) -> a -> b
    $ \ b -> m r
    c -> ContT r m (a -> b) -> ((a -> b) -> m r) -> m r
    forall {k} (r :: k) (m :: k -> *) a.
    ContT r m a -> (a -> m r) -> m r
    runContT ContT r m (a -> b)
    f (((a -> b) -> m r) -> m r) -> ((a -> b) -> m r) -> m r
    forall a b. (a -> b) -> a -> b
    $ \ a -> b
    g -> ContT r m a -> (a -> m r) -> m r
    forall {k} (r :: k) (m :: k -> *) a.
    ContT r m a -> (a -> m r) -> m r
    runContT ContT r m a
    v (b -> m r
    c (b -> m r) -> (a -> b) -> a -> m r
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> b
    g)
        {-# INLINE (<*>) #-}
        ContT r m a
    m *> :: forall a b. ContT r m a -> ContT r m b -> ContT r m b
    *> ContT r m b
    k = ContT r m a
    m ContT r m a -> (a -> ContT r m b) -> ContT r m b
    forall a b. ContT r m a -> (a -> ContT r m b) -> ContT r m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \a
    _ -> ContT r m b
    k
        {-# INLINE (*>) #-}

    instance Monad (ContT r m) where
    #if !(MIN_VERSION_base(4,8,0))
        return x = ContT ($ x)
        {-# INLINE return #-}
    #endif
        ContT r m a
    m >>= :: forall a b. ContT r m a -> (a -> ContT r m b) -> ContT r m b
    >>= a -> ContT r m b
    k  = ((b -> m r) -> m r) -> ContT r m b
    forall {k} (r :: k) (m :: k -> *) a.
    ((a -> m r) -> m r) -> ContT r m a
    ContT (((b -> m r) -> m r) -> ContT r m b)
    -> ((b -> m r) -> m r) -> ContT r m b
    forall a b. (a -> b) -> a -> b
    $ \ b -> m r
    c -> ContT r m a -> (a -> m r) -> m r
    forall {k} (r :: k) (m :: k -> *) a.
    ContT r m a -> (a -> m r) -> m r
    runContT ContT r m a
    m (\ a
    x -> ContT r m b -> (b -> m r) -> m r
    forall {k} (r :: k) (m :: k -> *) a.
    ContT r m a -> (a -> m r) -> m r
    runContT (a -> ContT r m b
    k a
    x) b -> m r
    c)
        {-# INLINE (>>=) #-}

    #if MIN_VERSION_base(4,9,0)
    instance (Fail.MonadFail m) => Fail.MonadFail (ContT r m) where
        fail :: forall a. String -> ContT r m a
    fail String
    msg = ((a -> m r) -> m r) -> ContT r m a
    forall {k} (r :: k) (m :: k -> *) a.
    ((a -> m r) -> m r) -> ContT r m a
    ContT (((a -> m r) -> m r) -> ContT r m a)
    -> ((a -> m r) -> m r) -> ContT r m a
    forall a b. (a -> b) -> a -> b
    $ \ a -> m r
    _ -> String -> m r
    forall a. String -> m a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    Fail.fail String
    msg
        {-# INLINE fail #-}
    #endif

    instance MonadTrans (ContT r) where
        lift :: forall (m :: * -> *) a. Monad m => m a -> ContT r m a
    lift m a
    m = ((a -> m r) -> m r) -> ContT r m a
    forall {k} (r :: k) (m :: k -> *) a.
    ((a -> m r) -> m r) -> ContT r m a
    ContT (m a
    m m a -> (a -> m r) -> m r
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=)
        {-# INLINE lift #-}

    instance (MonadIO m) => MonadIO (ContT r m) where
        liftIO :: forall a. IO a -> ContT r m a
    liftIO = m a -> ContT r m a
    forall (m :: * -> *) a. Monad m => m a -> ContT r m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (m a -> ContT r m a) -> (IO a -> m a) -> IO a -> ContT r m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IO a -> m a
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    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 :: forall {k} a (r :: k) (m :: k -> *) b.
    ((a -> ContT r m b) -> ContT r m a) -> ContT r m a
    callCC (a -> ContT r m b) -> ContT r m a
    f = ((a -> m r) -> m r) -> ContT r m a
    forall {k} (r :: k) (m :: k -> *) a.
    ((a -> m r) -> m r) -> ContT r m a
    ContT (((a -> m r) -> m r) -> ContT r m a)
    -> ((a -> m r) -> m r) -> ContT r m a
    forall a b. (a -> b) -> a -> b
    $ \ a -> m r
    c -> ContT r m a -> (a -> m r) -> m r
    forall {k} (r :: k) (m :: k -> *) a.
    ContT r m a -> (a -> m r) -> m r
    runContT ((a -> ContT r m b) -> ContT r m a
    f (\ a
    x -> ((b -> m r) -> m r) -> ContT r m b
    forall {k} (r :: k) (m :: k -> *) a.
    ((a -> m r) -> m r) -> ContT r m a
    ContT (((b -> m r) -> m r) -> ContT r m b)
    -> ((b -> m r) -> m r) -> ContT r m b
    forall a b. (a -> b) -> a -> b
    $ \ b -> m r
    _ -> a -> m r
    c a
    x)) a -> m r
    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 :: forall (m :: * -> *) r r'. Monad m => ContT r m r -> ContT r' m r
    resetT = m r -> ContT r' m r
    forall (m :: * -> *) a. Monad m => m a -> ContT r' m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (m r -> ContT r' m r)
    -> (ContT r m r -> m r) -> ContT r m r -> ContT r' m r
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ContT r m r -> m r
    forall (m :: * -> *) r. Monad m => ContT r m r -> m r
    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 :: forall (m :: * -> *) a r.
    Monad m =>
    ((a -> m r) -> ContT r m r) -> ContT r m a
    shiftT (a -> m r) -> ContT r m r
    f = ((a -> m r) -> m r) -> ContT r m a
    forall {k} (r :: k) (m :: k -> *) a.
    ((a -> m r) -> m r) -> ContT r m a
    ContT (ContT r m r -> m r
    forall (m :: * -> *) r. Monad m => ContT r m r -> m r
    evalContT (ContT r m r -> m r)
    -> ((a -> m r) -> ContT r m r) -> (a -> m r) -> m r
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a -> m r) -> ContT r m r
    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 :: forall (m :: * -> *) r' r a.
    Monad m =>
    m r'
    -> ((r' -> r') -> m r -> m r)
    -> (r' -> r')
    -> ContT r m a
    -> ContT r m a
    liftLocal m r'
    ask (r' -> r') -> m r -> m r
    local r' -> r'
    f ContT r m a
    m = ((a -> m r) -> m r) -> ContT r m a
    forall {k} (r :: k) (m :: k -> *) a.
    ((a -> m r) -> m r) -> ContT r m a
    ContT (((a -> m r) -> m r) -> ContT r m a)
    -> ((a -> m r) -> m r) -> ContT r m a
    forall a b. (a -> b) -> a -> b
    $ \ a -> m r
    c -> do
        r'
    r <- m r'
    ask
        (r' -> r') -> m r -> m r
    local r' -> r'
    f (ContT r m a -> (a -> m r) -> m r
    forall {k} (r :: k) (m :: k -> *) a.
    ContT r m a -> (a -> m r) -> m r
    runContT ContT r m a
    m ((r' -> r') -> m r -> m r
    local (r' -> r' -> r'
    forall a b. a -> b -> a
    const r'
    r) (m r -> m r) -> (a -> m r) -> a -> m r
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> m r
    c))
    {-# INLINE liftLocal #-}