{-# OPTIONS -XRank2Types #-}

module Control.Monatron.Codensity (
 Codensity,
 codensity,
 runCodensity
) where

import Control.Monatron.MonadT
import Control.Monad.Fix
import Control.Monatron.AutoInstances()

----------------------------------------------------------
-- Codensity Monad
----------------------------------------------------------

newtype Codensity f a = Codensity { 
      unCodensity :: forall b. (a -> f b) -> f b 
}

codensity :: (forall b. (a -> f b) -> f b) -> Codensity f a
codensity = Codensity

runCodensity :: Monad m => Codensity m a -> m a
runCodensity c = unCodensity c return 

instance MonadT Codensity where
    lift m        = Codensity (m >>=)
    c `tbind` f   = Codensity (\k -> unCodensity c (\a -> unCodensity (f a) k))

-- still need to prove that MonadFix laws hold
instance MonadFix m => MonadFix (Codensity m) where
    mfix f = Codensity $ \k -> mfix (runCodensity. f) >>= k

------------------------