[Haskell-cafe] Combining computations
Claus Reinke
claus.reinke at talk21.com
Sun May 3 16:59:44 EDT 2009
> mplus' :: MonadPlus m => Maybe a -> m a -> m a
> mplus' m l = maybeToMonad m `mplus` l
>
> maybeToMonad :: Monad m => Maybe a -> m a
> maybeToMonad = maybe (fail "Nothing") return
>
> In general, however, this operation can't be done. For example,
> how would you write:
>
> mplus' :: IO a -> [a] -> [a]
Perhaps the question should be: is there an interesting structure
that would allow us to capture when this kind of merging Monads
is possible? We can convert every 'Maybe a' to a '[] a', but the
other way round is partial or loses information, so lets focus on
the first direction. Should there be a
type family Up m1 m2
type instance Up Maybe [] = []
so that one could define
mplusUp :: m1 a -> m2 a -> (m1 `Up` m2) a
? Well, we'd need the conversions, too, so perhaps
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeFamilies, TypeOperators #-}
import Control.Monad
class Up m1 m2 where
type m1 :/\: m2 :: * -> *
up :: m1 a -> m2 a -> ((m1 :/\: m2) a, (m1 :/\: m2) a)
instance Up m m where
type m :/\: m = m
up ma1 ma2 = (ma1, ma2)
instance Up Maybe [] where
type Maybe :/\: [] = []
up m1a m2a = (maybe [] (:[]) m1a, m2a)
instance Up [] Maybe where
type [] :/\: Maybe = []
up m1a m2a = (m1a, maybe [] (:[]) m2a)
mplusUp :: (m ~ (m1 :/\: m2), Up m1 m2, MonadPlus m) => m1 a -> m2 a -> m a
m1a `mplusUp` m2a = mUp1a `mplus` mUp2a
where (mUp1a,mUp2a) = up m1a m2a
Whether or not that is interesting, or whether it needs to be defined
differently to correspond to an interesting structure, I'll leave to the
residential (co-)Categorians!-)
Claus
More information about the Haskell-Cafe
mailing list