[Haskell-cafe] Transparent identity instances
Jafet
jafet.vixle at gmail.com
Sun Nov 28 15:59:06 CET 2010
Hi,
Does it make sense to declare a transparent identity instance for
Functor, Applicative, Monad, etc?
For example, I might want to generalize ($) = (<*>) where
> ($) :: (a -> b) -> a -> b
> (<*>) :: (Functor f) => f (a -> b) -> f a -> f b
The traditional definition makes Identity a newtype:
> newtype Identity a = Identity a
> instance Applicative Identity where
> pure a = Identity a
> (Identity f) <*> (Identity a) = Identity (f a)
But using this instance becomes unwieldy. If using Identity was
transparent, eg. if it was a type synonym
> {-# LANGUAGE TypeSynonymInstances #-}
> type Identity a = a
> instance Applicative Identity where
> -- something like
> pure a = a
> f <*> a = f a
But GHC does not accept type synonym instances unless they are fully applied.
Is it sound for such an instance to exist? If so, how might it be defined?
--
Jafet
More information about the Haskell-Cafe
mailing list