[Haskell] monad transformers
John Meacham
john at repetae.net
Sat Jan 29 21:48:00 EST 2005
So, I create my own monad transformers quite often, It is great to be
able to compose 5 or 6 transformers to get the perfect one for a given
task. for example here is one for collecting statistics:
-- The stats
newtype Stat = Stat (Map.Map Atom Int)
instance Monoid Stat where
mempty = Stat Map.empty
mappend (Stat a) (Stat b) = Stat $ Map.unionWith (+) a b
-- The Monad transformer.
newtype StatT m a = StatT (WriterT Stat m a)
deriving(MonadIO, Functor, MonadTrans, Monad)
runStatT (StatT m) = runWriterT m
-- The operations on this type of monad
class Monad m => MonadStats m where
mticks' :: Int -> Atom -> m ()
instance Monad m => MonadStats (StatT m) where
mticks' n k = StatT $ tell (Stat $ Map.single k n)
Now all is well and good, I was able to use newtype deriving for most
every interesting property I wanted from the WriterT monad. (note I
specifically did not derive MonadWriter, as the point of my own
transformer is to hide this). However, now we come to the crux, I want
the various interesting monad operations (MonadReader, MonadWriter,
etc.. ) to be able to pass through StatT as well as let MonadStats pass
through other monad transformers.
the second is easy and elegant:
instance (Monad m, Monad (t m), MonadTrans t, MonadStats m) => MonadStats (t m) where
mticks' n k = lift $ mticks' n k
the first, however, is tricky. Right now, it appears that every Monad
type in the libraries defines a rule for commuting with every other
monad type, this seems impracticle for many monads (n^2 rules!) so, my
question is, why arn't the standard monad transformers declared with an
instance like above?
as in:
instance (Monad m, Monad (t m), MonadTrans t, MonadWriter w m) => MonadWriter w (t m) where
...
Then, all that is needed is for everyone to declare theire monads as
MonadTrans providing an appropriate lift and every monad property should
compose nicely.*
Another semi-solution would be to allow newtype-deriving of these monad
properties somehow..
newtype StatT m a = StatT (WriterT Stat m a)
deriving(MonadIO, Functor, MonadTrans, Monad, MonadReader)
doesn't work, how bout something like
newtype StatT m a = StatT (WriterT Stat m a)
deriving(MonadIO, Functor, MonadTrans, Monad, MonadReader r m => MonadReader r )
which should give the newtype-deriving rule enough to figure out how to
derivie the MonadReader rule properly.
* We might need to come up with a more advanced MonadTrans class for
certain monads, as 'lift' has been shown to not be fully capable for
some situtations such as catching exceptions in an arbitrary MonadIO.
** The monad transformer libraries appear to have moved somewhere in the
most recent cvs fptools tree, anyone know where they moved too?
*** Monad transformers rock.
--
John Meacham - ⑆repetae.net⑆john⑈
More information about the Haskell
mailing list