- -- constraints on all subtypes for classes like Functor
- ordinary_constraints_deep
- = [ mkClassPred cls [deept_ty]
- | data_con <- tyConDataCons rep_tc,
- arg_ty <- ASSERT( isVanillaDataCon data_con )
- dataConInstOrigArgTys data_con (rep_tc_args++[mkTyVarTy dummy_ty]),
- deept_ty <- deepSubtypesContaining dummy_ty arg_ty,
- not (isUnLiftedType deept_ty) ]
- where dummy_ty = last (tyConTyVars tycon) -- don't substitute the last var, this might not be a good idea
-
- ordinary_constraints
- | getUnique cls == functorClassKey = ordinary_constraints_deep
- | getUnique cls == foldableClassKey = ordinary_constraints_deep
- | getUnique cls == traversableClassKey = ordinary_constraints_deep
- | otherwise = ordinary_constraints_simple
+ -- For functor-like classes, two things are different
+ -- (a) We recurse over argument types to generate constraints
+ -- See Functor examples in TcGenDeriv
+ -- (b) The rep_tc_args will be one short
+ is_functor_like = getUnique cls `elem` functorLikeClassKeys
+
+ get_constrained_tys :: [Type] -> [Type]
+ get_constrained_tys tys
+ | is_functor_like = concatMap (deepSubtypesContaining last_tv) tys
+ | otherwise = tys
+
+ rep_tc_tvs = tyConTyVars rep_tc
+ last_tv = last rep_tc_tvs
+ all_rep_tc_args | is_functor_like = rep_tc_args ++ [mkTyVarTy last_tv]
+ | otherwise = rep_tc_args
+