[Haskell-cafe] Re: Nested Monads Questions
Dan Doel
dan.doel at gmail.com
Sat Aug 12 04:05:56 EDT 2006
On 8/11/06, Dan Doel <dan.doel at gmail.com> wrote:
> The difference is in what the parameters to the classes MonadTrans and
> MonadIO represent. MonadIO m means that m is a monad into which
> IO-actions can be lifted. MonadTrans t means that (t m) is a monad
> into which m-actions can be lifted. However, since the type class
> doesn't know about m, it's impossible to exprss that composition of
> two transformers is itself a transformer, whereas you can easily
> declare that the result of transforming a MonadIO with a certain
> transformer results in a MonadIO.
Apologies for replying to myself.
I played around a bit, and I was essentially able to express
composition of transformers without extra class parameters. Ideally,
it'd go something like this:
type CombinatorT (t :: (* -> *) -> * -> *)
(u :: (* -> *) -> * -> *)
(m :: * -> *)
(a :: *) = t (u m) a
instance (MonadTrans t, MonadTrans u) =>
MonadTrans (CombinatorT t u) where
lift = lift . lift
This says that the combinator transformer is a monad transformer if t
and u are. However, since the combinator transformer is just a type
synonym, it would (I think) end up reducing to all combinations of
transformers being transformers.
However, partially applied type synonyms aren't allowed (for good
reasons, I hear; this example is particularly weird; is it possible to
write without using type synonym syntax? MonadTrans (forall m. t (u
m)) ?), so instead, you have to use a data declaration (maybe a
newtype? I don't know):
data (MonadTrans t, MonadTrans u, Monad m) =>
CombinatorT t u m a = CombinatorT (m a)
instance (MonadTrans t, MonadTrans u) =>
MonadTrans (CombinatorT t u) where
lift = CombinatorT
However, that doesn't really give the types we want, and obviously
doesn't do the lift composition, so we need a way to get it out of the
container:
unC :: (MonadTrans t, MonadTrans u, Monad m, Monad (u m)) =>
CombinatorT t u m a -> t (u m) a
unC (CombinatorT m)= lift (lift m)
And for less typing:
liftC = unC . lift
And now an example, shamefully stolen from Mr. Kuklewicz
type Foo a = (WriterT [Int] (ReaderT String [])) a
foo :: Foo String
foo = do
x <- liftC [1, 2, 3]
s <- ask
tell [succ x]
return (s ++ show x)
test = runReaderT (runWriterT foo) "hello"
*Transform> test
[("hello1",[2]),("hello2",[3]),("hello3",[4])]
Viola.
-- Dan
More information about the Haskell-Cafe
mailing list