[commit: ghc] master: Fix support for deriving Generic1 for data families (FIX #9563) (946cbce)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/946cbcefab9bc02e12b741e5b070d7521b37ba1a/ghc

>---------------------------------------------------------------

commit 946cbcefab9bc02e12b741e5b070d7521b37ba1a
Author: Jose Pedro Magalhaes <jpm at cs.ox.ac.uk>
Date:   Fri Sep 12 17:44:12 2014 +0100

    Fix support for deriving Generic1 for data families (FIX #9563)


>---------------------------------------------------------------

946cbcefab9bc02e12b741e5b070d7521b37ba1a
 compiler/typecheck/TcGenGenerics.lhs |  9 +++++----
 testsuite/tests/generics/T9563.hs    | 18 ++++++++++++++++++
 testsuite/tests/generics/all.T       |  1 +
 3 files changed, 24 insertions(+), 4 deletions(-)

diff --git a/compiler/typecheck/TcGenGenerics.lhs b/compiler/typecheck/TcGenGenerics.lhs
index acdd654..158a1e7 100644
--- a/compiler/typecheck/TcGenGenerics.lhs
+++ b/compiler/typecheck/TcGenGenerics.lhs
@@ -486,10 +486,11 @@ tc_mkRepFamInsts gk tycon metaDts mod =
                      -- `appT` = D Int a b (data families case)
                      Just (famtycon, apps) ->
                        -- `fam` = D
-                       -- `apps` = [Int, a]
-                       let allApps = apps ++
-                                     drop (length apps + length tyvars
-                                           - tyConArity famtycon) tyvar_args
+                       -- `apps` = [Int, a, b]
+                       let allApps = case gk of
+                                       Gen0 -> apps
+                                       Gen1 -> ASSERT(not $ null apps)
+                                               init apps
                        in [mkTyConApp famtycon allApps]
                      -- `appT` = D a b (normal case)
                      Nothing -> [mkTyConApp tycon tyvar_args]
diff --git a/testsuite/tests/generics/T9563.hs b/testsuite/tests/generics/T9563.hs
new file mode 100644
index 0000000..fd12865
--- /dev/null
+++ b/testsuite/tests/generics/T9563.hs
@@ -0,0 +1,18 @@
+{-# LANGUAGE TypeFamilies       #-}
+{-# LANGUAGE DeriveGeneric      #-}
+{-# LANGUAGE FlexibleInstances  #-}
+{-# LANGUAGE StandaloneDeriving #-}
+
+module T9563 where
+
+import GHC.Generics
+
+data family F typ :: * -> *
+data A
+data instance F A a = AData a
+  deriving (Generic, Generic1)
+
+data family G a b c d
+data instance G Int b Float d = H deriving Generic
+
+deriving instance Generic1 (G Int b Float)
diff --git a/testsuite/tests/generics/all.T b/testsuite/tests/generics/all.T
index 1231c61..df95fa6 100644
--- a/testsuite/tests/generics/all.T
+++ b/testsuite/tests/generics/all.T
@@ -32,3 +32,4 @@ test('T7878', extra_clean(['T7878A.o'     ,'T7878A.hi'
 
 test('T8468', normal, compile_fail, [''])
 test('T8479', normal, compile, [''])
+test('T9563', normal, compile, [''])