+ too_many = quotes (pprSourceTyCon rep_tc) <+>
+ ptext (sLit "has too many arguments")
+ bad_kind = quotes (pprSourceTyCon rep_tc) <+>
+ ptext (sLit "has arguments of kind other than `*'")
+ fam_inst = quotes (pprSourceTyCon rep_tc) <+>
+ ptext (sLit "is a type family")
+
+
+functorLikeClassKeys :: [Unique]
+functorLikeClassKeys = [functorClassKey, foldableClassKey, traversableClassKey]
+
+cond_functorOK :: Bool -> Condition
+-- OK for Functor class
+-- Currently: (a) at least one argument
+-- (b) don't use argument contravariantly
+-- (c) don't use argument in the wrong place, e.g. data T a = T (X a a)
+-- (d) optionally: don't use function types
+cond_functorOK allowFunctions (dflags, rep_tc)
+ | not (dopt Opt_DeriveFunctor dflags)
+ = Just (ptext (sLit "You need -XDeriveFunctor to derive an instance for this class"))
+ | otherwise
+ = msum (map check_con data_cons) -- msum picks the first 'Just', if any
+ where
+ data_cons = tyConDataCons rep_tc
+ check_con con = msum (check_vanilla con : foldDataConArgs (ft_check con) con)
+
+ check_vanilla :: DataCon -> Maybe SDoc
+ check_vanilla con | isVanillaDataCon con = Nothing
+ | otherwise = Just (badCon con existential)
+
+ ft_check :: DataCon -> FFoldType (Maybe SDoc)
+ ft_check con = FT { ft_triv = Nothing, ft_var = Nothing
+ , ft_co_var = Just (badCon con covariant)
+ , ft_fun = \x y -> if allowFunctions then x `mplus` y
+ else Just (badCon con functions)
+ , ft_tup = \_ xs -> msum xs
+ , ft_ty_app = \_ x -> x
+ , ft_bad_app = Just (badCon con wrong_arg)
+ , ft_forall = \_ x -> x }
+
+ existential = ptext (sLit "has existential arguments")
+ covariant = ptext (sLit "uses the type variable in a function argument")
+ functions = ptext (sLit "contains function types")
+ wrong_arg = ptext (sLit "uses the type variable in an argument other than the last")
+
+checkFlag :: DynFlag -> Condition
+checkFlag flag (dflags, _)
+ | dopt flag dflags = Nothing
+ | otherwise = Just why
+ where
+ why = ptext (sLit "You need -X") <> text flag_str
+ <+> ptext (sLit "to derive an instance for this class")
+ flag_str = case [ s | (s, f, _) <- xFlags, f==flag ] of
+ [s] -> s
+ other -> pprPanic "checkFlag" (ppr other)
+
+std_class_via_iso :: Class -> Bool
+-- These standard classes can be derived for a newtype
+-- using the isomorphism trick *even if no -XGeneralizedNewtypeDeriving
+-- because giving so gives the same results as generating the boilerplate
+std_class_via_iso clas
+ = classKey clas `elem` [eqClassKey, ordClassKey, ixClassKey, boundedClassKey]
+ -- Not Read/Show because they respect the type
+ -- Not Enum, because newtypes are never in Enum
+
+
+non_iso_class :: Class -> Bool
+-- *Never* derive Read,Show,Typeable,Data by isomorphism,
+-- even with -XGeneralizedNewtypeDeriving
+non_iso_class cls
+ = classKey cls `elem` ([readClassKey, showClassKey, dataClassKey] ++
+ typeableClassKeys)
+
+typeableClassKeys :: [Unique]
+typeableClassKeys = map getUnique typeableClassNames
+
+new_dfun_name :: Class -> TyCon -> TcM Name
+new_dfun_name clas tycon -- Just a simple wrapper
+ = do { loc <- getSrcSpanM -- The location of the instance decl, not of the tycon
+ ; newDFunName clas [mkTyConApp tycon []] loc }
+ -- The type passed to newDFunName is only used to generate
+ -- a suitable string; hence the empty type arg list
+
+badCon :: DataCon -> SDoc -> SDoc
+badCon con msg = ptext (sLit "Constructor") <+> quotes (ppr con) <+> msg
+\end{code}
+
+Note [Superclasses of derived instance]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+In general, a derived instance decl needs the superclasses of the derived
+class too. So if we have
+ data T a = ...deriving( Ord )
+then the initial context for Ord (T a) should include Eq (T a). Often this is
+redundant; we'll also generate an Ord constraint for each constructor argument,
+and that will probably generate enough constraints to make the Eq (T a) constraint
+be satisfied too. But not always; consider:
+
+ data S a = S
+ instance Eq (S a)
+ instance Ord (S a)
+
+ data T a = MkT (S a) deriving( Ord )
+ instance Num a => Eq (T a)
+
+The derived instance for (Ord (T a)) must have a (Num a) constraint!
+Similarly consider:
+ data T a = MkT deriving( Data, Typeable )
+Here there *is* no argument field, but we must nevertheless generate
+a context for the Data instances:
+ instance Typable a => Data (T a) where ...
+