
On the prompting of napping, I humbly submit the following code to haskell-cafe: ezyang@javelin:~/Dev/haskell/generic-typeclass$ cat > Bar.hs {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleContexts #-} data Foo b = Foo class FooTwo m b where type family Ctor a :: (* -> *) type instance Ctor (f a) = f type family CtorVal a :: * type instance CtorVal (f a) = a instance FooTwo Foo Int where class FooTwo (Ctor mb) (CtorVal mb) => FooOne mb where foo :: FooOne (m Int) => m Int foo = fooGeneric fooGeneric :: FooTwo m b => m b fooGeneric = undefined ezyang@javelin:~/Dev/haskell/generic-typeclass$ ghci Bar.hs GHCi, version 6.12.1: http://www.haskell.org/ghc/ :? for help Loading package ghc-prim ... linking ... done. Loading package integer-gmp ... linking ... done. Loading package base ... linking ... done. [1 of 1] Compiling Main ( Bar.hs, interpreted ) Bar.hs:19:6: Could not deduce (FooTwo m Int) from the context (FooOne (m Int)) arising from a use of `fooGeneric' at Bar.hs:19:6-15 Possible fix: add (FooTwo m Int) to the context of the type signature for `foo' or add an instance declaration for (FooTwo m Int) In the expression: fooGeneric In the definition of `foo': foo = fooGeneric Failed, modules loaded: none. Prelude> Leaving GHCi. It seems that GHC is unable to unify the two instances. So, bug or expected behavior? Cheers, Edward