[Haskell-cafe] Re: The mother of all functors/monads/categories
Sebastian Fischer
sebf at informatik.uni-kiel.de
Sun Jun 27 13:26:56 EDT 2010
Hi Max,
very interesting observations!
> 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.
I'm not sure whether this is TMOA MonadPlus, but here is a set monad
with MonadPlus instance (code below).
Cheers,
Sebastian
\begin{code}
{-# LANGUAGE RankNTypes #-}
module SetMonad where
import Data.Set ( Set )
import qualified Data.Set as Set
import Control.Monad ( MonadPlus(..) )
newtype SetMonad a
= SetMonad { (>>-) :: forall b . Ord b => (a -> Set b) -> Set b }
fromSet :: Set a -> SetMonad a
fromSet = Set.fold (mplus . return) mzero
toSet :: Ord a => SetMonad a -> Set a
toSet s = s >>- Set.singleton
instance Monad SetMonad where
return x = SetMonad ($x)
a >>= f = SetMonad (\k -> a >>- \x -> f x >>- k)
instance MonadPlus SetMonad where
mzero = SetMonad (\_ -> Set.empty)
a `mplus` b = SetMonad (\k -> Set.union (a >>- k) (b >>- k))
\end{code}
--
Underestimating the novelty of the future is a time-honored tradition.
(D.G.)
More information about the Haskell-Cafe
mailing list