[Haskell-cafe] existentially quantified data types - restrictions

Ozgur Akgun ozgurakgun at gmail.com
Thu Mar 25 11:48:16 EDT 2010


[for future reference]

After looking into the *cast* function a little bit more, I think we can
simply get rid of the case expression:

data Baz = forall a. (Eq a, Typeable a) => Baz a

instance Eq Baz where
    Baz x == Baz y = cast x == Just y


On 25 March 2010 15:13, andy morris <andy at adradh.org.uk> wrote:

> Can you have Typeable as an extra constraint? If so:
>
> > {-# LANGUAGE ExistentialQuantification #-}
> >
> > import Data.Typeable
> >
> > data Baz = forall a. (Eq a, Typeable a) => Baz a
> >
> > instance Eq Baz where
> >   Baz x == Baz y =
> >     case cast y of
> >          Just y' -> x == y'
> >          Nothing -> False
>
> ghci> Baz 4 == Baz 4
> True
> ghci> Baz 4 == Baz 5
> False
> ghci> Baz 4 == Baz 'a'
> False
>
> On 25 March 2010 15:07, Ozgur Akgun <ozgurakgun at gmail.com> wrote:
> > Dear Cafe,
> >
> > I need to use a language feature which is explicitly documented to be a
> > restriction, and -even worse- I think I reasonably need to use it.
> >
> >
> >> f2 (Baz1 a b) (Baz1 p q) = a==q
> >> It's ok to say a==b or p==q, but a==q is wrong because it equates the
> two
> >> distinct types arising from the two Baz1 constructors.
> >> [from 7.4.4.4. Restrictions at
> >>
> http://www.haskell.org/ghc/docs/latest/html/users_guide/data-type-extensions.html
> ]
> >
> >
> > To simplify, let's say Baz is the only constructor of a data type,
> >
> > data Baz = forall a. Eq a => Baz a
> >
> > -- | this cannot be done:
> > instance Eq (Baz a) where
> >     (Baz x) == (Baz y) = x == y
> >
> >
> > I am quite tempted to use show functions for this equality comparison,
> but
> > after trying to have a nicely type framework I really don't want to do
> that.
> > What I simply want is, haskell to be able to compare them if they belong
> to
> > the same type, and return False otherwise. (not that haskelly way of
> doing
> > things, I know.)
> >
> > Any suggestions better than the following are very welcome:
> >     (==) = (==) `on` show
> >
> >
> > Regards,
> >
> > --
> > Ozgur Akgun
> >
> > _______________________________________________
> > Haskell-Cafe mailing list
> > Haskell-Cafe at haskell.org
> > http://www.haskell.org/mailman/listinfo/haskell-cafe
> >
> >
>



-- 
Ozgur Akgun
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/haskell-cafe/attachments/20100325/a8ea4924/attachment.html


More information about the Haskell-Cafe mailing list