module Algebra.Monad.Cont (
  -- * The MonadCont class
  MonadCont(..),
  
  -- * The Continuation transformer
  ContT(..),Cont,
  evalContT,
  evalCont
  ) where

import Algebra.Monad.Base

{-| A simple continuation monad implementation  -}
newtype ContT r m a = ContT { runContT :: (a -> m r) -> m r }
                      deriving (Semigroup,Monoid,Ring)
type Cont r a = ContT r Id a
instance Unit m => Unit (ContT r m) where pure a = ContT ($a)
instance Functor f => Functor (ContT r f) where
  map f (ContT c) = ContT (\kb -> c (kb . f))
instance Applicative m => Applicative (ContT r m) where
  ContT cf <*> ContT ca = ContT (\kb -> cf (\f -> ca (\a -> kb (f a))))
instance Monad m => Monad (ContT r m) where
  ContT k >>= f = ContT (\cc -> k (\a -> runContT (f a) cc))
instance MonadTrans (ContT r) where
  lift m = ContT (m >>=)
  generalize = undefined
instance Monad m => MonadCont (ContT r m) where
  callCC f = ContT (\k -> runContT (f (\a -> ContT (\_ -> k a))) k)

evalContT :: Unit m => ContT r m r -> m r
evalContT c = runContT c return
evalCont :: Cont r r -> r
evalCont = getId . evalContT