[Haskell-cafe] Declaring each instance of a typeclass to be also an instance of another typeclass

Ryan Ingram ryani.spam at gmail.com
Sun Jan 11 14:02:19 EST 2009


No, but you can do this:

> {-# LANGUAGE GeneralizedNewtypeDeriving #-}
> import Control.Monad (liftM)

> newtype Functorize m a = F { unF :: m a } deriving (Eq, Show, Monad)

Insert any other type classes you care about potentially inheriting
from the parent Monad into the deriving clause, like MonadPlus.
Unfortunately it's not possible to derive "everything my internal type
has", which makes it difficult to include things like MonadState or
other multiparameter classes.

> inF f = F . f . unF
> instance Monad m => Functor (Functorize m) where
>    fmap f = inF (liftM f)

  -- ryan


On Sun, Jan 11, 2009 at 5:12 AM, Mikhail Glushenkov
<the.dead.shall.rise at gmail.com> wrote:
> Hi,
>
> Is it possible to write something like this:
>
>> {-# LANGUAGE FlexibleInstances, UndecidableInstances #-}
>>
>> import Control.Monad (liftM)
>>
>> instance (Monad a) => Functor a where
>>     fmap = liftM
>
> without having to use UndecidableInstances (and preferably, other type system
> extensions too)?
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>


More information about the Haskell-Cafe mailing list