+ -- Given data T a b c = ... deriving( C d ),
+ -- we want to drop type variables from T so that (C d (T a)) is well-kinded
+ ; let cls_tyvars = classTyVars cls
+ kind = tyVarKind (last cls_tyvars)
+ (arg_kinds, _) = splitKindFunTys kind
+ n_args_to_drop = length arg_kinds
+ n_args_to_keep = tyConArity tc - n_args_to_drop
+ args_to_drop = drop n_args_to_keep tc_args
+ inst_ty = mkTyConApp tc (take n_args_to_keep tc_args)
+ inst_ty_kind = typeKind inst_ty
+ dropped_tvs = mkVarSet (mapCatMaybes getTyVar_maybe args_to_drop)
+ univ_tvs = (mkVarSet tvs `extendVarSetList` deriv_tvs)
+ `minusVarSet` dropped_tvs
+
+ -- Check that the result really is well-kinded
+ ; checkTc (n_args_to_keep >= 0 && (inst_ty_kind `eqKind` kind))
+ (derivingKindErr tc cls cls_tys kind)
+
+ ; checkTc (sizeVarSet dropped_tvs == n_args_to_drop && -- (a)
+ tyVarsOfTypes (inst_ty:cls_tys) `subVarSet` univ_tvs) -- (b)
+ (derivingEtaErr cls cls_tys inst_ty)
+ -- Check that
+ -- (a) The data type can be eta-reduced; eg reject:
+ -- data instance T a a = ... deriving( Monad )
+ -- (b) The type class args do not mention any of the dropped type
+ -- variables
+ -- newtype T a s = ... deriving( ST s )
+
+ -- Type families can't be partially applied
+ -- e.g. newtype instance T Int a = MkT [a] deriving( Monad )
+ -- Note [Deriving, type families, and partial applications]
+ ; checkTc (not (isOpenTyCon tc) || n_args_to_drop == 0)
+ (typeFamilyPapErr tc cls cls_tys inst_ty)
+
+ ; mkEqnHelp DerivOrigin (varSetElems univ_tvs) cls cls_tys inst_ty Nothing } }
+ where
+ -- Tiresomely we must figure out the "lhs", which is awkward for type families
+ -- E.g. data T a b = .. deriving( Eq )
+ -- Here, the lhs is (T a b)
+ -- data instance TF Int b = ... deriving( Eq )
+ -- Here, the lhs is (TF Int b)
+ -- But if we just look up the tycon_name, we get is the *family*
+ -- tycon, but not pattern types -- they are in the *rep* tycon.
+ get_lhs Nothing = do { tc <- tcLookupTyCon tycon_name
+ ; let tvs = tyConTyVars tc
+ ; return (tvs, tc, mkTyVarTys tvs) }
+ get_lhs (Just pats) = do { let hs_app = nlHsTyConApp tycon_name pats
+ ; (tvs, tc_app) <- tcHsQuantifiedType tv_names hs_app
+ ; let (tc, tc_args) = tcSplitTyConApp tc_app
+ ; return (tvs, tc, tc_args) }
+
+deriveTyData _other
+ = panic "derivTyData" -- Caller ensures that only TyData can happen
+\end{code}
+
+Note [Deriving, type families, and partial applications]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+When there are no type families, it's quite easy:
+
+ newtype S a = MkS [a]
+ -- :CoS :: S ~ [] -- Eta-reduced
+
+ instance Eq [a] => Eq (S a) -- by coercion sym (Eq (coMkS a)) : Eq [a] ~ Eq (S a)
+ instance Monad [] => Monad S -- by coercion sym (Monad coMkS) : Monad [] ~ Monad S
+
+When type familes are involved it's trickier:
+
+ data family T a b
+ newtype instance T Int a = MkT [a] deriving( Eq, Monad )
+ -- :RT is the representation type for (T Int a)
+ -- :CoF:R1T a :: T Int a ~ :RT a -- Not eta reduced
+ -- :Co:R1T :: :RT ~ [] -- Eta-reduced
+
+ instance Eq [a] => Eq (T Int a) -- easy by coercion
+ instance Monad [] => Monad (T Int) -- only if we can eta reduce???
+
+The "???" bit is that we don't build the :CoF thing in eta-reduced form
+Henc the current typeFamilyPapErr, even though the instance makes sense.
+After all, we can write it out
+ instance Monad [] => Monad (T Int) -- only if we can eta reduce???
+ return x = MkT [x]
+ ... etc ...
+
+\begin{code}
+mkEqnHelp :: InstOrigin -> [TyVar] -> Class -> [Type] -> Type
+ -> Maybe ThetaType -- Just => context supplied (standalone deriving)
+ -- Nothing => context inferred (deriving on data decl)
+ -> TcRn EarlyDerivSpec
+-- Make the EarlyDerivSpec for an instance
+-- forall tvs. theta => cls (tys ++ [ty])
+-- where the 'theta' is optional (that's the Maybe part)
+-- Assumes that this declaration is well-kinded
+
+mkEqnHelp orig tvs cls cls_tys tc_app mtheta