[Haskell-cafe] Class Instance with ExistentialQuantification

Andrew Gibiansky andrew.gibiansky at gmail.com
Tue Jan 7 15:11:40 UTC 2014


Ah, I see. I wasn't aware that constraints had to be over monotypes. I
figured that since you could write a function

f :: (forall a. a -> a) -> Bool

Then you could also do similar things with a class.

(The reason I was doing this was that I wanted a typeclass to match
something like "return 'a'" without using IncoherentInstances or other
sketchiness, and found that trying to have a typeclass with an instance for
'forall m. Monad m => m Char` gave me this error.)

Thanks!
Andrew


On Tue, Jan 7, 2014 at 5:18 AM, Roman Cheplyaka <roma at ro-che.info> wrote:

> * Andrew Gibiansky <andrew.gibiansky at gmail.com> [2014-01-06 22:17:21-0500]
> > Why is the following not allowed?
> >
> > {-# LANGUAGE ExistentialQuantification, ExplicitForAll, RankNTypes,
> > FlexibleInstances #-}
> >
> > class Class a where
> >   test :: a -> Bool
> >
> > instance Class (forall m. m -> m) where
> >   test _ = True
> >
> > main = do
> >   putStrLn $ test id
> >
> > Is there a reason that this is forbidden? Just curious.
>
> I believe the rule is that all constraints (including class constraints)
> range over monotypes.
>
> What are you trying to achieve?
>
> You can do this, for example:
>
>   newtype Poly = Poly (forall a . a -> a)
>   instance Class Poly where test = const True
>
>   main = print $ test $ Poly id
>
> BTW, this has nothing to do with ExistentialQuantification.
>
> Roman
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20140107/7aee6579/attachment.html>


More information about the Haskell-Cafe mailing list