{-# OPTIONS -XRank2Types  #-}

{- |
Module      :  Control.Monad.Codensity
Copyright   :  (c) Mauro Jaskelioff 2008,
License     :  BSD-style (see the file libraries/base/LICENSE)

Maintainer  :  mjj@cs.nott.ac.uk
Stability   :  experimental
Portability :  non-portable (Rank-2 Types)

[Useful for:] Algebraization of operations

The Codensity monad (also called the Backtracking monad).
-}


module Control.Monad.Codensity (
    Codensity(..),
    toCodensity,
    fromCodensity,
    module Control.Monad,
   ) where

import Control.Monad
import Control.Monad.Fix

-- requires -XRank2Types 
newtype Codensity f a = Codensity { 
      runCodensity :: forall b. (a -> f b) -> f b 
}

-- ---------------------------------------------------------------------------
-- Codensity instances for Functor and Monad

instance Functor (Codensity f) where
    fmap f m = Codensity (\k -> runCodensity m (k. f))

instance Monad (Codensity f) where
    return a = Codensity (\k -> k a)
    c >>= f  = Codensity (\k -> runCodensity c (\a -> runCodensity (f a) k))

toCodensity :: Monad m => m a -> Codensity m a
toCodensity m = Codensity (m >>=)

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

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

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