    {-# LANGUAGE MultiParamTypeClasses #-}
    -----------------------------------------------------------------------------
    -- |
    -- Copyright   :  (C) 2011-2013 Edward Kmett
    -- License     :  BSD-style (see the file LICENSE)
    --
    -- Maintainer  :  Edward Kmett <ekmett@gmail.com>
    -- Stability   :  provisional
    -- Portability :  MPTCs, fundeps
    --
    -- > Cont r ~ Contravariant.Adjoint (Op r) (Op r)
    -- > Conts r ~ Contravariant.AdjointT (Op r) (Op r)
    -- > ContsT r w m ~ Contravariant.AdjointT (Op (m r)) (Op (m r)) w
    ----------------------------------------------------------------------------

    module Control.Monad.Trans.Conts
      (
      -- * Continuation passing style
        Cont
      , cont
      , runCont
      -- * Multiple-continuation passing style
      , Conts
      , runConts
      , conts
      -- * Multiple-continuation passing style transformer
      , ContsT(..)
      , callCC
      ) where

    import Prelude hiding (sequence)
    import Control.Comonad
    import Control.Monad.Trans.Class
    import Control.Monad (ap)
    import Data.Functor.Apply
    import Data.Functor.Identity

    type Cont r = ContsT r Identity Identity

    cont :: ((a -> r) -> r) -> Cont r a
    cont :: forall a r. ((a -> r) -> r) -> Cont r a
    cont (a -> r) -> r
    f = (Identity (a -> Identity r) -> Identity r)
    -> ContsT r Identity Identity a
    forall r (w :: * -> *) (m :: * -> *) a.
    (w (a -> m r) -> m r) -> ContsT r w m a
    ContsT ((Identity (a -> Identity r) -> Identity r)
     -> ContsT r Identity Identity a)
    -> (Identity (a -> Identity r) -> Identity r)
    -> ContsT r Identity Identity a
    forall a b. (a -> b) -> a -> b
    $ \ (Identity a -> Identity r
    k) -> r -> Identity r
    forall a. a -> Identity a
    Identity (r -> Identity r) -> r -> Identity r
    forall a b. (a -> b) -> a -> b
    $ (a -> r) -> r
    f ((a -> r) -> r) -> (a -> r) -> r
    forall a b. (a -> b) -> a -> b
    $ 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
    k

    runCont :: Cont r a -> (a -> r) -> r
    runCont :: forall r a. Cont r a -> (a -> r) -> r
    runCont (ContsT Identity (a -> Identity r) -> Identity r
    k) a -> r
    f = Identity r -> r
    forall a. Identity a -> a
    runIdentity (Identity r -> r) -> Identity r -> r
    forall a b. (a -> b) -> a -> b
    $ Identity (a -> Identity r) -> Identity r
    k (Identity (a -> Identity r) -> Identity r)
    -> Identity (a -> Identity r) -> Identity r
    forall a b. (a -> b) -> a -> b
    $ (a -> Identity r) -> Identity (a -> Identity r)
    forall a. a -> Identity a
    Identity (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
    f)

    type Conts r w = ContsT r w Identity

    conts :: Functor w => (w (a -> r) -> r) -> Conts r w a
    conts :: forall (w :: * -> *) a r.
    Functor w =>
    (w (a -> r) -> r) -> Conts r w a
    conts w (a -> r) -> r
    k = (w (a -> Identity r) -> Identity r) -> ContsT r w Identity a
    forall r (w :: * -> *) (m :: * -> *) a.
    (w (a -> m r) -> m r) -> ContsT r w m a
    ContsT ((w (a -> Identity r) -> Identity r) -> ContsT r w Identity a)
    -> (w (a -> Identity r) -> Identity r) -> ContsT r w Identity a
    forall a b. (a -> b) -> a -> b
    $ r -> Identity r
    forall a. a -> Identity a
    Identity (r -> Identity r)
    -> (w (a -> Identity r) -> r) -> w (a -> Identity r) -> Identity r
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . w (a -> r) -> r
    k (w (a -> r) -> r)
    -> (w (a -> Identity r) -> w (a -> r)) -> w (a -> Identity r) -> r
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((a -> Identity r) -> a -> r) -> w (a -> Identity r) -> w (a -> r)
    forall a b. (a -> b) -> w a -> w b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (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
    .)

    runConts :: Functor w => Conts r w a -> w (a -> r) -> r
    runConts :: forall (w :: * -> *) r a.
    Functor w =>
    Conts r w a -> w (a -> r) -> r
    runConts (ContsT w (a -> Identity r) -> Identity r
    k) = Identity r -> r
    forall a. Identity a -> a
    runIdentity (Identity r -> r) -> (w (a -> r) -> Identity r) -> w (a -> r) -> r
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . w (a -> Identity r) -> Identity r
    k (w (a -> Identity r) -> Identity r)
    -> (w (a -> r) -> w (a -> Identity r)) -> w (a -> r) -> Identity r
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((a -> r) -> a -> Identity r) -> w (a -> r) -> w (a -> Identity r)
    forall a b. (a -> b) -> w a -> w b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (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
    .)

    newtype ContsT r w m a = ContsT { forall r (w :: * -> *) (m :: * -> *) a.
    ContsT r w m a -> w (a -> m r) -> m r
    runContsT :: w (a -> m r) -> m r }

    instance Functor w => Functor (ContsT r w m) where
      fmap :: forall a b. (a -> b) -> ContsT r w m a -> ContsT r w m b
    fmap a -> b
    f (ContsT w (a -> m r) -> m r
    k) = (w (b -> m r) -> m r) -> ContsT r w m b
    forall r (w :: * -> *) (m :: * -> *) a.
    (w (a -> m r) -> m r) -> ContsT r w m a
    ContsT ((w (b -> m r) -> m r) -> ContsT r w m b)
    -> (w (b -> m r) -> m r) -> ContsT r w m b
    forall a b. (a -> b) -> a -> b
    $ w (a -> m r) -> m r
    k (w (a -> m r) -> m r)
    -> (w (b -> m r) -> w (a -> m r)) -> w (b -> m r) -> m r
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((b -> m r) -> a -> m r) -> w (b -> m r) -> w (a -> m r)
    forall a b. (a -> b) -> w a -> w b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((b -> m r) -> (a -> b) -> a -> m r
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> b
    f)

    instance Comonad w => Apply (ContsT r w m) where
      <.> :: forall a b.
    ContsT r w m (a -> b) -> ContsT r w m a -> ContsT r w m b
    (<.>) = ContsT r w m (a -> b) -> ContsT r w m a -> ContsT r w m b
    forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
    ap

    instance Comonad w => Applicative (ContsT r w m) where
      pure :: forall a. a -> ContsT r w m a
    pure a
    x = (w (a -> m r) -> m r) -> ContsT r w m a
    forall r (w :: * -> *) (m :: * -> *) a.
    (w (a -> m r) -> m r) -> ContsT r w m a
    ContsT ((w (a -> m r) -> m r) -> ContsT r w m a)
    -> (w (a -> m r) -> m r) -> ContsT r w m a
    forall a b. (a -> b) -> a -> b
    $ \w (a -> m r)
    f -> w (a -> m r) -> a -> m r
    forall a. w a -> a
    forall (w :: * -> *) a. Comonad w => w a -> a
    extract w (a -> m r)
    f a
    x
      <*> :: forall a b.
    ContsT r w m (a -> b) -> ContsT r w m a -> ContsT r w m b
    (<*>) = ContsT r w m (a -> b) -> ContsT r w m a -> ContsT r w m b
    forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
    ap

    instance Comonad w => Monad (ContsT r w m) where
      return :: forall a. a -> ContsT r w m a
    return = a -> ContsT r w m a
    forall a. a -> ContsT r w m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
      ContsT w (a -> m r) -> m r
    k >>= :: forall a b.
    ContsT r w m a -> (a -> ContsT r w m b) -> ContsT r w m b
    >>= a -> ContsT r w m b
    f = (w (b -> m r) -> m r) -> ContsT r w m b
    forall r (w :: * -> *) (m :: * -> *) a.
    (w (a -> m r) -> m r) -> ContsT r w m a
    ContsT ((w (b -> m r) -> m r) -> ContsT r w m b)
    -> (w (b -> m r) -> m r) -> ContsT r w m b
    forall a b. (a -> b) -> a -> b
    $ w (a -> m r) -> m r
    k (w (a -> m r) -> m r)
    -> (w (b -> m r) -> w (a -> m r)) -> w (b -> m r) -> m r
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (w (b -> m r) -> a -> m r) -> w (b -> m r) -> w (a -> m r)
    forall a b. (w a -> b) -> w a -> w b
    forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
    extend (\w (b -> m r)
    wa a
    a -> ContsT r w m b -> w (b -> m r) -> m r
    forall r (w :: * -> *) (m :: * -> *) a.
    ContsT r w m a -> w (a -> m r) -> m r
    runContsT (a -> ContsT r w m b
    f a
    a) w (b -> m r)
    wa)

    callCC :: Comonad w => ((a -> ContsT r w m b) -> ContsT r w m a) -> ContsT r w m a
    callCC :: forall (w :: * -> *) a r (m :: * -> *) b.
    Comonad w =>
    ((a -> ContsT r w m b) -> ContsT r w m a) -> ContsT r w m a
    callCC (a -> ContsT r w m b) -> ContsT r w m a
    f = (w (a -> m r) -> m r) -> ContsT r w m a
    forall r (w :: * -> *) (m :: * -> *) a.
    (w (a -> m r) -> m r) -> ContsT r w m a
    ContsT ((w (a -> m r) -> m r) -> ContsT r w m a)
    -> (w (a -> m r) -> m r) -> ContsT r w m a
    forall a b. (a -> b) -> a -> b
    $ \w (a -> m r)
    wamr -> ContsT r w m a -> w (a -> m r) -> m r
    forall r (w :: * -> *) (m :: * -> *) a.
    ContsT r w m a -> w (a -> m r) -> m r
    runContsT ((a -> ContsT r w m b) -> ContsT r w m a
    f (\a
    a -> (w (b -> m r) -> m r) -> ContsT r w m b
    forall r (w :: * -> *) (m :: * -> *) a.
    (w (a -> m r) -> m r) -> ContsT r w m a
    ContsT ((w (b -> m r) -> m r) -> ContsT r w m b)
    -> (w (b -> m r) -> m r) -> ContsT r w m b
    forall a b. (a -> b) -> a -> b
    $ \w (b -> m r)
    _ -> w (a -> m r) -> a -> m r
    forall a. w a -> a
    forall (w :: * -> *) a. Comonad w => w a -> a
    extract w (a -> m r)
    wamr a
    a)) w (a -> m r)
    wamr

    {-
    callCCs :: Comonad w => (w (a -> ContsT r w m b) -> ContsT r w m a) -> ContsT r w m a
    callCCs f =
    -}

    instance Comonad w => MonadTrans (ContsT r w) where
      lift :: forall (m :: * -> *) a. Monad m => m a -> ContsT r w m a
    lift m a
    m = (w (a -> m r) -> m r) -> ContsT r w m a
    forall r (w :: * -> *) (m :: * -> *) a.
    (w (a -> m r) -> m r) -> ContsT r w m a
    ContsT ((w (a -> m r) -> m r) -> ContsT r w m a)
    -> (w (a -> m r) -> m r) -> ContsT r w m a
    forall a b. (a -> b) -> a -> b
    $ w (m r) -> m r
    forall a. w a -> a
    forall (w :: * -> *) a. Comonad w => w a -> a
    extract (w (m r) -> m r)
    -> (w (a -> m r) -> w (m r)) -> w (a -> m r) -> m r
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((a -> m r) -> m r) -> w (a -> m r) -> w (m r)
    forall a b. (a -> b) -> w a -> w b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (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
    >>=)