[Haskell-cafe] Re: The mother of all functors/monads/categories

[Max Bolingbroke]

By the way, you can use this stuff to solve the restricted monad
problem (e.g. make Set an instance of Monad). This is not that useful
until we find out what the mother of all MonadPlus is, though, because
we really need a MonadPlus Set instance.

Code below.

Cheers,
Max

\begin{code}
{-# LANGUAGE RankNTypes #-}
import Control.Applicative

import Data.Set (Set)
import qualified Data.Set as S


newtype CodensityOrd m a = CodensityOrd { runCodensityOrd :: forall b.
Ord b => (a -> m b) -> m b }

-- liftCodensityOrd :: Monad m => m a -> CodensityOrd m a
-- liftCodensityOrd m = CodensityOrd ((>>=) m)

-- lowerCodensityOrd :: (Ord a, Monad m) => CodensityOrd m a -> m a
-- lowerCodensityOrd m = runCodensityOrd m return

instance Functor (CodensityOrd f) where
    fmap f m = CodensityOrd (\k -> runCodensityOrd m (k . f))

instance Applicative (CodensityOrd f) where
    pure x = CodensityOrd (\k -> k x)
    mf <*> mx = CodensityOrd (\k -> runCodensityOrd mf (\f ->
runCodensityOrd mx (\x -> k (f x))))

instance Monad (CodensityOrd f) where
    return = pure
    m >>= k = CodensityOrd (\c -> runCodensityOrd m (\a ->
runCodensityOrd (k a) c))



liftSet :: Ord a => Set a -> CodensityOrd Set a
liftSet m = CodensityOrd (bind m)
    where bind :: (Ord a, Ord b) => Set a -> (a -> Set b) -> Set b
          mx `bind` fxmy = S.fold (\x my -> fxmy x `S.union` my) S.empty mx

lowerSet :: Ord a => CodensityOrd Set a -> Set a
lowerSet m = runCodensityOrd m S.singleton


main = print $ lowerSet $ monadicPlus (liftSet $ S.fromList [1, 2, 3])
(liftSet $ S.fromList [1, 2, 3])

monadicPlus :: Monad m => m Int -> m Int -> m Int
monadicPlus mx my = do
    x <- mx
    y <- my
    return (x + y)

\end{code}