[Haskell-cafe] Switching monadic encapsulations
David Menendez
zednenem at psualum.com
Mon Jun 28 18:59:41 EDT 2004
Graham Klyne writes:
> Is there a function that switches monadic layering?
>
> f :: (Monad m1,Monad m2) => m1 (m2 a) -> m2 (m1 a)
>
> Does this even make sense in the general case? I'm thinking along the
> lines of a generalization of sequence to non-list monads.
In order to do that, the two monads have to be composable. Mark Jones's
paper "Functional Programming with Overloading and Higher-Order
Polymorphism"[1] brings up a similar function while discussing monad
composition and transformers:
swap :: m (n a) -> n (m a)
He ends up defining two classes of monads with appropriate swap
functions:
class Monad m => Into m where
into :: Monad n => m (n a) -> n (m a)
class Monad m => OutOf m where
outof :: Monad n => n (m a) -> m (n a)
List, Maybe, Error, and Writer are instances of Into, and Reader is an
instance of OutOf.
For Either String, the instance would be something like this:
instance Into (Either String) where
into (Left e) = return (Left e)
into (Right m) = fmap Right m
The only wrinkle is that Jones declares Monad as a subclass of Functor,
but the Prelude doesn't for some reason. In that case, you could still
use:
into (Right m) = m >>= return . Right
[1] <http://www.cse.ogi.edu/~mpj/pubs/springschool.html>
> ... map looks like a version of liftM specialized to lists:
> ... Similarly, concat appears to be a monadic join on lists.
They are. It's easier to see with a slightly different definition of
Monad:
class Functor f where
fmap :: (a -> b) -> f a -> f b
-- when f is a Monad and (>>=) is defined, fmap may be defined as
-- fmap f m = m >>= return . f
class Functor m => Monad m where
return :: a -> m a
join :: m (m a) -> m a
(>>=) :: m a -> (a -> m b) -> m b
(>>) :: m a -> m b -> m b
fail :: String -> m a
-- minimal definition: return and (>>=) or return, join, and fmap
join m = m >>= id
m >>= k = join (fmap k m)
m >> n = m >>= (\_ -> n)
fail s = error s
Then you can define the list monad like so:
instance Functor [] where
fmap = map
instance Monad [] where
return x = [x]
join = concat
fail _ = []
liftM plays the same role as fmap.
--
David Menendez <zednenem at psualum.com> <http://www.eyrie.org/~zednenem/>
More information about the Haskell-Cafe
mailing list