Monday, February 01, 2010

Tagging Monad Transformer Layers

A quick post extracted from some code I was writing at the weekend.


> {-# OPTIONS_GHC -fglasgow-exts #-}
> {-# LANGUAGE ScopedTypeVariables, OverlappingInstances #-}

> import Control.Monad.Trans
> import Control.Monad.State
> import Control.Monad.Writer
> import Control.Monad.Identity


Monad transformers can get a little ugly. Here's a toy example that looks pretty bad:


> test1 :: StateT Int (StateT Int (StateT Int (WriterT String Identity))) Int
> test1 = do
> put 1
> lift $ put 2
> lift $ lift $ put 3
> a <- get
> b <- lift $ get
> c <- lift $ lift $ get
> lift $ lift $ lift $ tell $ show $ a+b+c
> return $ a*b*c

> go1 = runIdentity (runWriterT (runStateT (runStateT (runStateT test1 0) 0) 0))


There are obvious ways to make it prettier, like the suggestions in RWH. But despite what it says there, the monad "layout" is still "hardwired" and the code is fragile if you decide to insert more layers into your transformer stack. It's no way to program.

So here's an alternative I came up with. First we make a bunch of tags:


> data A = A
> data B = B
> data C = C
> data D = D


We can now label each of the monad transformers with a tag:


> test2 :: TStateT A Int (TStateT B Int (TStateT C Int (TWriterT D String Identity))) Int


And now we can have everything lifted to the appropriate layer automatically:


> test2 = do
> tput A 1
> tput B 2
> tput C 3
> a <- tget A
> b <- tget B
> c <- tget C
> ttell D $ show $ a+b+c
> return $ a*b*c

> go2 = runIdentity (runTWriterT (runTStateT (runTStateT (runTStateT test2 0) 0) 0))


Much more readable and much more robust. Change the order of the layers, or insert new ones, and the code still works.

I've tried to make this minimally invasive. It just introduces one new monad transformer that can be used to tag any other. The definitions like TStateT and tput are just trivial wrapped versions of their originals.

Anyway, this is just the first thing that came to mind and I threw it together quickly. Surely nobody else likes all those lifts. So what other solutions already exist? I'd rather use someone else's well tested library than my hastily erected solution:


> data T tag m a = T { runTag :: m a } deriving Show

> instance Monad m => Monad (T tag m) where
> return a = T (return a)
> T x >>= f = T $ x >>= (runTag . f)

> instance MonadTrans (T tag) where
> lift m = T m

> class TWith tag (m :: * -> *) (n :: * -> *) where
> taggedLift :: tag -> m a -> n a

> instance (Monad m, m ~ n) => TWith tag m (T tag n) where
> taggedLift _ x = lift x

> instance (Monad m, Monad n, TWith tag m n, MonadTrans t) => TWith tag m (t n) where
> taggedLift tag x = lift (taggedLift tag x)

> type TStateT tag s m = T tag (StateT s m)
> runTStateT = runStateT . runTag

> tput tag x = taggedLift tag (put x)
> tget tag = taggedLift tag get

> type TWriterT tag w m = T tag (WriterT w m)
> runTWriterT = runWriterT . runTag

> ttell tag x = taggedLift tag (tell x)





10 comments:

單中杰 said...

Might as well just pass values of the (polymorphic) type "forall a. m a -> n a" around, no?

Philippa Cowderoy said...

I've tended to just write fresh toTag functions for each tag in a monad - it's slightly tedious writing toA = lift . lift . lift, but it works with anything.

TuringTest said...

I think you can use "newtype T" instead of "data T" which matter for performance.

Mauro said...

This is a nice solution.
You could talk about tagging instances, or "named" instances in general, not just for monad transformers (Which monoid is Integer?)
I think I heard Conor talk about this once and use phantom types in the same way.

dleimbach said...

I'm not sure I know when I would use a stack of StateT's. I think I'd be more likely to make a structure-like data type with the fields I want, and use modify everywhere to get at the fields I need instead of lifting get and put.

Also, in some other books I've seen (Hudak's perhaps? I've forgotten) there seems to be some value in rolling your own monad when things get complex enough, then perhaps a lot of the need of dealing with complex stacks goes away?

Edward Kmett said...

I have previously implemented this solution on the Haskell channel some time around 2006, when I was advocating that MonadState, MonadReader and MonadWriter should share get and put.

That way you can 'get' from State/Reader and 'put' in State/Writer. The tags were the only way I was able to keep it all straight.

I also tried something similar in scheme to avoid having to plumb a dictionary for the monad through a polymorphic monadic computation, by automatic lifting, but was finally done in by non-commutativities in the interaction with ContT, [], etc, so I ultimately had to plumb the monad dictionary through my 'do' macro.

sigfpe said...

Ed,

Sharing get and put seems like a great idea. Although putting into Writer is different to putting into State so that needs some clarification.

A bit of Googling also turned this up: http://www.fceia.unr.edu.ar/~mauro/pubs/monatron.pdf

Mauro said...

Sharing get and put is a good idea if you want to allow "local" for "Reader" and "collect" (or "pass", or "listen") in "Writer". If that is the case, then all the operations will be ease to lift if you implement them in terms of "get" and "put". I haven't proven this, but I suspect that with all those operations in place, what you obtain is a different presentation for the same structure (i. e. the state monad)

However, you might also want a "Reader", with just an "ask", or a "Writer" with just a "tell" and then you are talking about a different abstraction.

The point is that the abstraction we are working with is not just a monad, but a monad with some effect-manipulating operations.

Edward Kmett said...

> However, you might also want a "Reader", with just an "ask", or a "Writer" with just a "tell" and then you are talking about a different abstraction.

That is exactly what I'm talking about. As I recall, 'pass' and 'local' cause problems with the current MTL when you start mixing in ContT, and should probably be factored into separate classes.

Mitchell said...

I would agree, that is a great solution. That must have taken awhile to figure out... I love when something finally works with the code and you can say "boom-baby! I finally got it!!!"

Blog Archive