DeriveAnyClass does not fill in associated type defaults
I would expect test1
and test2
below to typecheck.
This is a reduced test case from trying to use DeriveAnyClass
on the Generic
class of the generics-sop
package, which unfortunately fails due to this bug.
{-# LANGUAGE DeriveAnyClass, StandaloneDeriving, TypeFamilies #-}
module Test where
class C1 a where
type T1 a
type instance T1 a = Char
class C2 a where -- equivalent to C1
type T2 a
type instance T2 a = Char
class C3 a where -- equivalent to C1, C2
type T3 a
type instance T3 a = Char
data A = B
deriving C1
deriving instance C2 A
instance C3 A
-- fails
-- test1 :: T1 A
-- test1 = 'x'
-- fails
-- test2 :: T2 A
-- test2 = 'x'
-- succeeds
test3 :: T3 A
test3 = 'x'
Trac metadata
Trac field | Value |
---|---|
Version | 7.10.1 |
Type | Bug |
TypeOfFailure | OtherFailure |
Priority | normal |
Resolution | Unresolved |
Component | Compiler |
Test case | |
Differential revisions | |
BlockedBy | |
Related | |
Blocking | |
CC | |
Operating system | |
Architecture |