Adding IdentityT to mtl
Josef Svenningsson
josef.svenningsson at gmail.com
Tue Aug 28 09:08:41 EDT 2007
Whatever happened to the suggestion of extending mtl with IdentityT? I
think it's reasonable, especially since we have a documented use case.
/Josef
On 6/1/07, Donald Bruce Stewart <dons at cse.unsw.edu.au> wrote:
> 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
> _______________________________________________
> Libraries mailing list
> Libraries at haskell.org
> http://www.haskell.org/mailman/listinfo/libraries
>
More information about the Libraries
mailing list