Error message tweaks

6 files changed, 47 insertions, 34 deletions

diff --git a/compiler/typecheck/TcDeriv.lhs b/compiler/typecheck/TcDeriv.lhs
index ef12d5587f..b1eab4b5f4 100644
--- a/compiler/typecheck/TcDeriv.lhs
+++ b/compiler/typecheck/TcDeriv.lhs
@@ -1545,7 +1545,8 @@ mkNewTypeEqn dflags overlap_mode tvs
              cls cls_tys tycon tc_args rep_tycon rep_tc_args mtheta
 -- Want: instance (...) => cls (cls_tys ++ [tycon tc_args]) where ...
   | ASSERT( length cls_tys + 1 == classArity cls )
-    might_derive_via_coercible && (newtype_deriving || std_class_via_coercible cls)
+    might_derive_via_coercible && ((newtype_deriving && not derivingViaGenerics)
+                                  || std_class_via_coercible cls)
   = do traceTc "newtype deriving:" (ppr tycon <+> ppr rep_tys <+> ppr all_preds)
        dfun_name <- new_dfun_name cls tycon
        loc <- getSrcSpanM
@@ -1568,20 +1569,30 @@ mkNewTypeEqn dflags overlap_mode tvs
             , ds_newtype = True }
   | otherwise
   = case checkSideConditions dflags mtheta cls cls_tys rep_tycon rep_tc_args of
-      DerivableClassError msg   -- Error with standard class
+      -- Error with standard class
+      DerivableClassError msg
         | might_derive_via_coercible -> bale_out (msg $$ suggest_nd)
         | otherwise                  -> bale_out msg
-      NonDerivableClass msg     -- Must use newtype deriving
-        | newtype_deriving           -> bale_out cant_derive_err  -- Too hard, even with newtype deriving
-        | might_derive_via_coercible -> bale_out (non_std $$ suggest_nd) -- Try newtype deriving!
+      -- Must use newtype deriving or DerivingViaGenerics
+      NonDerivableClass msg
+        -- Don't know whether to use DerivingViaGenerics or GeneralizedNewtypeDeriving
+        | newtype_deriving && derivingViaGenerics -> bale_out' False msg
+        -- Too hard, even with newtype deriving
+        | newtype_deriving           -> bale_out cant_derive_err
+        -- Try newtype deriving!
+        | might_derive_via_coercible -> bale_out (non_std $$ suggest_nd)
+        -- The MINIMAL set is not empty
         | derivingViaGenerics        -> bale_out msg
         | otherwise                  -> bale_out non_std
-      _                              -> go_for_it -- CanDerive/DerivableViaGenerics
+      -- CanDerive/DerivableViaGenerics
+      _                              -> go_for_it
   where
         newtype_deriving    = xopt Opt_GeneralizedNewtypeDeriving dflags
         derivingViaGenerics = xopt Opt_DerivingViaGenerics        dflags
-        go_for_it        = mk_data_eqn overlap_mode tvs cls tycon tc_args rep_tycon rep_tc_args mtheta
-        bale_out msg     = failWithTc (derivingThingErr newtype_deriving cls cls_tys inst_ty msg)
+        go_for_it       = mk_data_eqn overlap_mode tvs cls tycon tc_args
+                            rep_tycon rep_tc_args mtheta
+        bale_out    = bale_out' newtype_deriving
+        bale_out' b = failWithTc . derivingThingErr b cls cls_tys inst_ty
 
         non_std    = nonStdErr cls
         suggest_nd = ptext (sLit "Try GeneralizedNewtypeDeriving for GHC's newtype-deriving extension")
diff --git a/compiler/typecheck/TcGenDeriv.lhs b/compiler/typecheck/TcGenDeriv.lhs
index 232bfe8ef5..3ae09d5782 100644
--- a/compiler/typecheck/TcGenDeriv.lhs
+++ b/compiler/typecheck/TcGenDeriv.lhs
@@ -130,27 +130,22 @@ genDerivedBinds dflags fix_env clas loc tycon
                , (foldableClassKey,    gen_Foldable_binds)
                , (traversableClassKey, gen_Traversable_binds) ]
 
--- We can derive a given class via Generics iff
+-- We can derive a given class for a given tycon via Generics iff
 canDeriveViaGenerics :: DynFlags -> TyCon -> Class -> Maybe SDoc
 canDeriveViaGenerics dflags tycon clas =
-  let _dfs         = map (defMethSpecOfDefMeth . snd) . classOpItems $ clas
-      b `orElse` s = if b then Nothing else Just (ptext (sLit s))
+  let b `orElse` s = if b then Nothing else Just (ptext (sLit s))
       Just m  <> _ = Just m
       Nothing <> n = n
-  in  -- 1) It is not a "standard" class (like Show, Functor, etc.)
+  in  -- 1) The class is not a "standard" class (like Show, Functor, etc.)
         (not (getUnique clas `elem` standardClassKeys) `orElse` "")
       -- 2) Opt_DerivingViaGenerics is on
      <> (xopt Opt_DerivingViaGenerics dflags `orElse` "Try enabling DerivingViaGenerics")
-      -- 3) It has no non-default methods
-     -- <> (all (/= NoDM) dfs `orElse` "There are methods without a default definition")
-      -- 4) It has at least one generic default method
-     -- <> (any (== GenericDM) dfs `orElse` "There must be at least one method with a default signature")
-      -- 3/4) Its MINIMAL set is empty
+      -- 3) The MINIMAL set of the class is empty
      <> (isTrue (classMinimalDef clas) `orElse` "because its MINIMAL set is not empty")
-      -- 5) It a newtype and GND is enabled
+      -- 4) It's not the case that the tycon is a newtype and GND is enabled
      <> (not (isNewTyCon tycon && xopt Opt_GeneralizedNewtypeDeriving dflags)
-          `orElse` "I don't know whether to use DerivingViaGenerics or GeneralizedNewtypeDeriving")
-  -- Nothing: we can derive it via Generics
+          `orElse` "Both DerivingViaGenerics and GeneralizedNewtypeDeriving are enabled")
+  -- Nothing: we can (try to) derive it via Generics
   -- Just s:  we can't, reason s
 \end{code}
 
diff --git a/testsuite/tests/generics/T5462No1.hs b/testsuite/tests/generics/T5462No1.hs
index c14c146e63..4b9fe41db3 100644
--- a/testsuite/tests/generics/T5462No1.hs
+++ b/testsuite/tests/generics/T5462No1.hs
@@ -6,6 +6,8 @@
 {-# LANGUAGE StandaloneDeriving     #-}
 {-# LANGUAGE UndecidableInstances   #-}
 
+-- DerivingViaGenerics not enabled
+
 module T5462No1 where
 
 import GHC.Generics hiding (C, C1, D)
@@ -18,7 +20,7 @@ class C2 a where
   c2 :: a -> Int
   c2 _ = 0
 
-newtype F a = F1 a
+newtype F a = F1 [a]
   deriving (Show, Eq, Generic, Generic1, GFunctor)
 
 data G = G1 deriving (C1)
diff --git a/testsuite/tests/generics/T5462No1.stderr b/testsuite/tests/generics/T5462No1.stderr
index 9bc101cb38..59ecdfb8dd 100644
--- a/testsuite/tests/generics/T5462No1.stderr
+++ b/testsuite/tests/generics/T5462No1.stderr
@@ -1,18 +1,19 @@
 [1 of 2] Compiling GFunctor         ( GFunctor/GFunctor.hs, GFunctor/GFunctor.o )
 [2 of 2] Compiling T5462No1         ( T5462No1.hs, T5462No1.o )
 
-T5462No1.hs:22:42:
+T5462No1.hs:24:42:
     Can't make a derived instance of ‘GFunctor F’:
       ‘GFunctor’ is not a derivable class
+      Try GeneralizedNewtypeDeriving for GHC's newtype-deriving extension
     In the newtype declaration for ‘F’
 
-T5462No1.hs:24:23:
+T5462No1.hs:26:23:
     Can't make a derived instance of ‘C1 G’:
       ‘C1’ is not a derivable class
       Try enabling DerivingViaGenerics
     In the data declaration for ‘G’
 
-T5462No1.hs:25:23:
+T5462No1.hs:27:23:
     Can't make a derived instance of ‘C2 H’:
       ‘C2’ is not a derivable class
       Try enabling DerivingViaGenerics
diff --git a/testsuite/tests/generics/T5462No2.hs b/testsuite/tests/generics/T5462No2.hs
index 43b214a9f0..be5db02c1c 100644
--- a/testsuite/tests/generics/T5462No2.hs
+++ b/testsuite/tests/generics/T5462No2.hs
@@ -6,6 +6,7 @@
 {-# LANGUAGE StandaloneDeriving     #-}
 {-# LANGUAGE UndecidableInstances   #-}
 {-# LANGUAGE DerivingViaGenerics    #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving    #-}
 
 module T5462No2 where
 
@@ -16,11 +17,14 @@ class C1 a where
   c1 :: a -> Int
 
 class C2 a where
-  c2 :: a -> Int
-  c2 _ = 0
+  c21 :: a -> Int
+  c21 = c22
+  c22 :: a -> Int
+  c22 = c21
+  {-# MINIMAL c21 | c22 #-}
 
-newtype F a = F1 a
+newtype F a = F1 [a]
   deriving (Show, Eq, Generic, Generic1, GFunctor)
 
 data G = G1 deriving (C1)
-data H = H1 deriving (C2)
\ No newline at end of file
+data H = H1 deriving (C2)
diff --git a/testsuite/tests/generics/T5462No2.stderr b/testsuite/tests/generics/T5462No2.stderr
index dd036fef77..029a4ba954 100644
--- a/testsuite/tests/generics/T5462No2.stderr
+++ b/testsuite/tests/generics/T5462No2.stderr
@@ -1,19 +1,19 @@
 [1 of 2] Compiling GFunctor         ( GFunctor/GFunctor.hs, GFunctor/GFunctor.o )
 [2 of 2] Compiling T5462No2         ( T5462No2.hs, T5462No2.o )
 
-T5462No2.hs:23:42:
+T5462No2.hs:27:42:
     Can't make a derived instance of ‘GFunctor F’:
-      DerivingViaGenerics is not supported for newtypes
+      Both DerivingViaGenerics and GeneralizedNewtypeDeriving are enabled
     In the newtype declaration for ‘F’
 
-T5462No2.hs:25:23:
+T5462No2.hs:29:23:
     Can't make a derived instance of ‘C1 G’:
       ‘C1’ is not a derivable class
-      There are methods without a default definition
+      because its MINIMAL set is not empty
     In the data declaration for ‘G’
 
-T5462No2.hs:26:23:
+T5462No2.hs:30:23:
     Can't make a derived instance of ‘C2 H’:
       ‘C2’ is not a derivable class
-      There must be at least one method with a default signature
+      because its MINIMAL set is not empty
     In the data declaration for ‘H’