Adding IdentityT to mtl

Donald Bruce Stewart dons at cse.unsw.edu.au
Fri Jun 1 01:35:14 EDT 2007


I wanted an IdentityT today, for extending xmonad. (The idea is to
allower user-defined monad transformers, so users can plug in their own
semantics easily).

By default it would use IdentityT, which I note is not in mtl!

Here's roughly what it would be:

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Identity.hs
    -- License     :  BSD3-style (see LICENSE)
    -- 
    module IdentityT where

    import Control.Monad.Trans

    --
    -- IdentityT , a parameterisable identity monad, with an inner monad
    -- The user's default monad transformer
    --

    newtype IdentityT m a = IdentityT { runIdentityT :: m a }

    instance (Functor m, Monad m) => Functor (IdentityT m) where
        fmap f = IdentityT . fmap f . runIdentityT

    instance (Monad m) => Monad (IdentityT m) where
        return   = IdentityT . return
        m >>= k  = IdentityT $ runIdentityT . k =<< runIdentityT m
        fail msg = IdentityT $ fail msg

    instance (MonadIO m) => MonadIO (IdentityT m) where
        liftIO = IdentityT . liftIO

Any reasons why this shouldn't be in mtl? 

-- Don


More information about the Libraries mailing list