The FunctorM library
Thomas Jäger
thjaeger at gmail.com
Sun Mar 20 18:29:38 EST 2005
Hello,
Aside from naming issues, there seem to be some problems with the way
FunctorM is currently implemented.
First of all, `FunctorM` should be a superclass of `Functor' because
there is an obvios implementation of fmap in terms of fmapM
> import Data.FunctorM
> import Control.Monad.Identity
>
> fmap' :: FunctorM f => (a -> b) -> f a -> f b
> fmap' f = runIdentity . fmapM (return . f)
It is already annyoing enough that `Funtor' isn't a subclass of
`Monad' although every monad must also be functor.
Now, FunctorM should be based on the simplest operations possible,
which in this case is the distributive law and not a monadic version
of fmap (which might be provided for efficiency reasons).
> class Functor f => FunctorM' f where
> dist' :: Monad m => f (m a) -> m (f a)
> fmapM' :: Monad m => (a -> m b) -> f a -> m (f b)
>
> dist' = fmapM' id
> fmapM' f = dist' . fmap f
>
> -- for example
> instance FunctorM' [] where
> dist' = sequence
> fmapM' = mapM
Thomas
More information about the Libraries
mailing list