Issue with type families
Daniel Fischer
daniel.is.fischer at web.de
Wed Mar 3 21:10:56 EST 2010
Am Donnerstag 04 März 2010 02:39:30 schrieb Tyson Whitehead:
> On March 3, 2010 18:35:26 Daniel Fischer wrote:
> > Because:
> >
> > instance Applicative ((->) a) -- Defined in Control.Applicative
> >
> > so, from the instance Z (a -> b), with b == c -> d, we have an
> >
> > instance Z (a -> (b -> c))
> >
> > and from instance Z (m (u -> v)), we have, with m == ((->) x), an
> >
> > instance Z (x -> (u -> v))
>
> Thanks Daniel,
>
> That makes sense. Strangely enough though, I had actually originally
> tried it with my own Applicative class just in case I was being tripped
> up by something like the (->) instance you pointed out, and it still
> didn't work.
Well, GHC takes only the class head into account for instance selection,
and
u -> (v -> w)
matches both,
a -> b -- (a == u, b == v -> w)
and
m (c -> d) -- (m == ((->) u), c == v, d == w),
so there's the overlap without any other type classes involved.
And since u -> (v -> w) matches both instance heads,
type W (u -> (v -> w)) = u -> (v -> w)
and
type W (((->) u) (v -> w)) = (u -> v) -> (u -> w)
are indeed conflicting, so you can't even use OverlappingInstances etc. to
make it work.
> That is
>
> {-# LANGUAGE FlexibleInstances, TypeFamilies #-}
>
> newtype I a = I a
>
> class A t where
> ap :: t (a -> b) -> t a -> t b
>
> class Z t where
> type W t
> z :: t -> W t
>
> instance A I where
> ap (I f) (I x) = I $ f x
>
> instance Z (a -> b) where
> type W (a -> b) = a -> b
> z = id
>
> instance A t => Z (t (a -> b)) where
> type W (t (a -> b)) = t a -> t b
> z = ap
>
> also gives me
>
> Temp.hs:17:9:
> Conflicting family instance declarations:
> type instance W (a -> b) -- Defined at Temp.hs:17:9
> type instance W (t (a -> b)) -- Defined at Temp.hs:21:9
> Failed, modules loaded: none.
>
> Is the compiler somehow anticipating that I could add an instance for
> (->) to A and thus be back to the Applicative class situation?
The compiler works on an open-world assumption, if the kinds match, there
could be an instance defined somewhere.
>
> Thanks! -Tyson
>
> PS: I asked this here because type classes is a GHC issue, would the
> haskell- cafe list been a more appropriate place?
Either is fine.
Cheers,
Daniel
More information about the Glasgow-haskell-users
mailing list