Dont allow hand-written Generic instances in Safe Haskell.

While they aren't strictly unsafe, it is a similar situation to
Typeable. There are few instances where a programmer will write their
own instance, and having compiler assurance that the Generic
implementation is correct brings a lot of benefits.

compiler/prelude/PrelNames.lhs

@@ -1084,6 +1084,9 @@ datatypeClassName    = clsQual gHC_GENERICS (fsLit "Datatype")    datatypeClassK
 constructorClassName = clsQual gHC_GENERICS (fsLit "Constructor") constructorClassKey
 selectorClassName    = clsQual gHC_GENERICS (fsLit "Selector")    selectorClassKey
 
+genericClassNames :: [Name]
+genericClassNames = [genClassName, gen1ClassName]
+
 -- GHCi things
 ghciIoClassName, ghciStepIoMName :: Name
 ghciIoClassName = clsQual gHC_GHCI (fsLit "GHCiSandboxIO") ghciIoClassKey

compiler/typecheck/TcInstDcls.lhs

@@ -51,8 +51,8 @@ import VarEnv
 import VarSet 
 import CoreUnfold ( mkDFunUnfolding )
 import CoreSyn    ( Expr(Var, Type), CoreExpr, mkTyApps, mkVarApps )
-import PrelNames  ( tYPEABLE_INTERNAL, typeableClassName, oldTypeableClassNames )
-
+import PrelNames  ( tYPEABLE_INTERNAL, typeableClassName,
+                    oldTypeableClassNames, genericClassNames )
 import Bag
 import BasicTypes
 import DynFlags
@@ -415,13 +415,16 @@ tcInstDecls1 tycl_decls inst_decls deriv_decls
        -- hand written instances of old Typeable as then unsafe casts could be
        -- performed. Derived instances are OK.
        ; dflags <- getDynFlags
-       ; when (safeLanguageOn dflags) $
-             mapM_ (\x -> when (typInstCheck x)
-                               (addErrAt (getSrcSpan $ iSpec x) typInstErr))
-                   local_infos
+       ; when (safeLanguageOn dflags) $ forM_ local_infos $ \x -> case x of
+             _ | typInstCheck x -> addErrAt (getSrcSpan $ iSpec x) (typInstErr x)
+             _ | genInstCheck x -> addErrAt (getSrcSpan $ iSpec x) (genInstErr x)
+             _ -> return ()
+
        -- As above but for Safe Inference mode.
-       ; when (safeInferOn dflags) $
-             mapM_ (\x -> when (typInstCheck x) recordUnsafeInfer) local_infos
+       ; when (safeInferOn dflags) $ forM_ local_infos $ \x -> case x of
+             _ | typInstCheck x -> recordUnsafeInfer
+             _ | genInstCheck x -> recordUnsafeInfer
+             _ -> return ()
 
        ; return ( gbl_env
                 , bagToList deriv_inst_info ++ local_infos
@@ -442,8 +445,16 @@ tcInstDecls1 tycl_decls inst_decls deriv_decls
          else (typeableInsts, i:otherInsts)
 
     typInstCheck ty = is_cls_nm (iSpec ty) `elem` oldTypeableClassNames
-    typInstErr = ptext $ sLit $ "Can't create hand written instances of Typeable in Safe"
-                              ++ " Haskell! Can only derive them"
+    typInstErr i = hang (ptext (sLit $ "Typeable instances can only be "
+                            ++ "derived in Safe Haskell.") $+$ 
+                         ptext (sLit "Replace the following instance:"))
+                     2 (pprInstanceHdr (iSpec i))
+
+    genInstCheck ty = is_cls_nm (iSpec ty) `elem` genericClassNames
+    genInstErr i = hang (ptext (sLit $ "Generic instances can only be "
+                            ++ "derived in Safe Haskell.") $+$ 
+                         ptext (sLit "Replace the following instance:"))
+                     2 (pprInstanceHdr (iSpec i))
 
     instMsg i = hang (ptext (sLit $ "Typeable instances can only be derived; replace "
                                  ++ "the following instance:"))