Improve type-error reporting

This patch does two things:

* When reporting a hole, we now include its kind if the
  kind is not just '*'.  This addresses Trac #14265

* When reporting things like "'a' is a rigid type varaible
  bound by ...", this patch arranges to group the type variables
  together, so we don't repeat the "bound by..." stuff endlessly

compiler/typecheck/TcBinds.hs

@@ -42,7 +42,7 @@ import TyCon
 import TcType
 import Type( mkStrLitTy, tidyOpenType, splitTyConApp_maybe)
 import TysPrim
-import TysWiredIn( cTupleTyConName, mkBoxedTupleTy )
+import TysWiredIn( mkBoxedTupleTy )
 import Id
 import Var
 import VarSet

compiler/typecheck/TcErrors.hs

@@ -1083,9 +1083,10 @@ mkHoleError ctxt ct@(CHoleCan { cc_hole = hole })
             valid_substitutions sub_msg}
 
   where
-    occ     = holeOcc hole
-    hole_ty = ctEvPred (ctEvidence ct)
-    tyvars  = tyCoVarsOfTypeList hole_ty
+    occ       = holeOcc hole
+    hole_ty   = ctEvPred (ctEvidence ct)
+    hole_kind = typeKind hole_ty
+    tyvars    = tyCoVarsOfTypeList hole_ty
 
     hole_msg = case hole of
       ExprHole {} -> vcat [ hang (text "Found hole:")
@@ -1094,11 +1095,21 @@ mkHoleError ctxt ct@(CHoleCan { cc_hole = hole })
       TypeHole {} -> vcat [ hang (text "Found type wildcard" <+>
                                   quotes (ppr occ))
                                2 (text "standing for" <+>
-                                  quotes (pprType hole_ty))
+                                  quotes pp_hole_type_with_kind)
                           , tyvars_msg, type_hole_hint ]
 
+    pp_hole_type_with_kind
+      | isLiftedTypeKind hole_kind = pprType hole_ty
+      | otherwise                  = pprType hole_ty <+> dcolon <+> pprKind hole_kind
+
     tyvars_msg = ppUnless (null tyvars) $
-                 text "Where:" <+> vcat (map loc_msg tyvars)
+                 text "Where:" <+> (vcat (map loc_msg other_tvs)
+                                    $$ pprSkols ctxt skol_tvs)
+       where
+         (skol_tvs, other_tvs) = partition is_skol tyvars
+         is_skol tv = isTcTyVar tv && isSkolemTyVar tv
+                      -- Coercion variables can be free in the
+                      -- hole, via kind casts
 
     type_hole_hint
          | HoleError <- cec_type_holes ctxt
@@ -1117,8 +1128,8 @@ mkHoleError ctxt ct@(CHoleCan { cc_hole = hole })
        | isTyVar tv
        = case tcTyVarDetails tv of
            MetaTv {} -> quotes (ppr tv) <+> text "is an ambiguous type variable"
-           _         -> extraTyVarInfo ctxt tv
-       | otherwise
+           _         -> empty  -- Skolems dealt with already
+       | otherwise  -- A coercion variable can be free in the hole type
        = sdocWithDynFlags $ \dflags ->
          if gopt Opt_PrintExplicitCoercions dflags
          then quotes (ppr tv) <+> text "is a coercion variable"
@@ -1886,12 +1897,9 @@ extraTyVarInfo :: ReportErrCtxt -> TcTyVar -> SDoc
 extraTyVarInfo ctxt tv
   = ASSERT2( isTyVar tv, ppr tv )
     case tcTyVarDetails tv of
-          SkolemTv {}   -> pprSkol implics tv
-          RuntimeUnk {} -> pp_tv <+> text "is an interactive-debugger skolem"
+          SkolemTv {}   -> pprSkols ctxt [tv]
+          RuntimeUnk {} -> quotes (ppr tv) <+> text "is an interactive-debugger skolem"
           MetaTv {}     -> empty
-  where
-    implics = cec_encl ctxt
-    pp_tv = quotes (ppr tv)
 
 suggestAddSig :: ReportErrCtxt -> TcType -> TcType -> SDoc
 -- See Note [Suggest adding a type signature]
@@ -1906,7 +1914,8 @@ suggestAddSig ctxt ty1 ty2
     inferred_bndrs = nub (get_inf ty1 ++ get_inf ty2)
     get_inf ty | Just tv <- tcGetTyVar_maybe ty
                , isSkolemTyVar tv
-               , InferSkol prs <- ic_info (getSkolemInfo (cec_encl ctxt) tv)
+               , (implic, _) : _ <- getSkolemInfo (cec_encl ctxt) [tv]
+               , InferSkol prs <- ic_info implic
                = map fst prs
                | otherwise
                = []
@@ -2846,17 +2855,24 @@ mkAmbigMsg prepend_msg ct
     is_or_are [_] = text "is"
     is_or_are _   = text "are"
 
-pprSkol :: [Implication] -> TcTyVar -> SDoc
-pprSkol implics tv
-  = case skol_info of
-      UnkSkol -> quotes (ppr tv) <+> text "is an unknown type variable"
-      _       -> ppr_rigid (pprSkolInfo skol_info)
+pprSkols :: ReportErrCtxt -> [TcTyVar] -> SDoc
+pprSkols ctxt tvs
+  = vcat (map pp_one (getSkolemInfo (cec_encl ctxt) tvs))
   where
-    Implic { ic_info = skol_info } = getSkolemInfo implics tv
-    ppr_rigid pp_info
-       = hang (quotes (ppr tv) <+> text "is a rigid type variable bound by")
-            2 (sep [ pp_info
-                   , text "at" <+> ppr (getSrcSpan tv) ])
+    pp_one (Implic { ic_info = skol_info }, tvs)
+      | UnkSkol <- skol_info
+      = hang (pprQuotedList tvs)
+           2 (is_or_are tvs "an" "unknown")
+      | otherwise
+      = vcat [ hang (pprQuotedList tvs)
+                  2 (is_or_are tvs "a"  "rigid" <+> text "bound by")
+             , nest 2 (pprSkolInfo skol_info)
+             , nest 2 (text "at" <+> ppr (foldr1 combineSrcSpans (map getSrcSpan tvs))) ]
+
+    is_or_are [_] article adjective = text "is" <+> text article <+> text adjective
+                                      <+> text "type variable"
+    is_or_are _   _       adjective = text "are" <+> text adjective
+                                      <+> text "type variables"
 
 getAmbigTkvs :: Ct -> ([Var],[Var])
 getAmbigTkvs ct
@@ -2866,15 +2882,23 @@ getAmbigTkvs ct
     ambig_tkvs = filter isAmbiguousTyVar tkvs
     dep_tkv_set = tyCoVarsOfTypes (map tyVarKind tkvs)
 
-getSkolemInfo :: [Implication] -> TcTyVar -> Implication
--- Get the skolem info for a type variable
--- from the implication constraint that binds it
-getSkolemInfo [] tv
-  = pprPanic "No skolem info:" (ppr tv)
+getSkolemInfo :: [Implication] -> [TcTyVar]
+              -> [(Implication, [TcTyVar])]
+-- Get the skolem info for some type variables
+-- from the implication constraints that bind them
+--
+-- In the returned (implic, tvs) pairs, the 'tvs' part is non-empty
+getSkolemInfo _ []
+  = []
+
+getSkolemInfo [] tvs
+  = pprPanic "No skolem info:" (ppr tvs)
 
-getSkolemInfo (implic:implics) tv
-  | tv `elem` ic_skols implic = implic
-  | otherwise                 = getSkolemInfo implics tv
+getSkolemInfo (implic:implics) tvs
+  | null tvs_here =                      getSkolemInfo implics tvs
+  | otherwise     = (implic, tvs_here) : getSkolemInfo implics tvs_other
+  where
+    (tvs_here, tvs_other) = partition (`elem` ic_skols implic) tvs
 
 -----------------------
 -- relevantBindings looks at the value environment and finds values whose

compiler/typecheck/TcRnTypes.hs

@@ -3113,9 +3113,9 @@ pprSkolInfo (RuleSkol name)   = text "the RULE" <+> pprRuleName name
 pprSkolInfo ArrowSkol         = text "an arrow form"
 pprSkolInfo (PatSkol cl mc)   = sep [ pprPatSkolInfo cl
                                     , text "in" <+> pprMatchContext mc ]
-pprSkolInfo (InferSkol ids)   = sep [ text "the inferred type of"
-                                    , vcat [ ppr name <+> dcolon <+> ppr ty
-                                           | (name,ty) <- ids ]]
+pprSkolInfo (InferSkol ids)   = hang (text "the inferred type" <> plural ids <+> text "of")
+                                   2 (vcat [ ppr name <+> dcolon <+> ppr ty
+                                                   | (name,ty) <- ids ])
 pprSkolInfo (UnifyForAllSkol ty) = text "the type" <+> ppr ty
 
 -- UnkSkol

testsuite/tests/ghci/scripts/T10248.stderr

 
 <interactive>:2:10: error:
     • Found hole: _ :: f a
-      Where: ‘f’ is a rigid type variable bound by
-               the inferred type of it :: Functor f => f (Maybe a)
-               at <interactive>:2:1-10
-             ‘a’ is a rigid type variable bound by
+      Where: ‘f’, ‘a’ are rigid type variables bound by
                the inferred type of it :: Functor f => f (Maybe a)
                at <interactive>:2:1-10
     • In the second argument of ‘(<$>)’, namely ‘_’

testsuite/tests/partial-sigs/should_compile/SuperCls.stderr

 
 SuperCls.hs:4:14: warning: [-Wpartial-type-signatures (in -Wdefault)]
-    • Found type wildcard ‘_’ standing for ‘() :: Constraint’
+    • Found type wildcard ‘_’ standing for ‘()’
     • In the type signature: f :: (Ord a, _) => a -> Bool

testsuite/tests/partial-sigs/should_compile/T10403.stderr

 
 T10403.hs:15:7: warning: [-Wpartial-type-signatures (in -Wdefault)]
     • Found type wildcard ‘_’ standing for ‘Functor f’
-      Where: ‘f’ is a rigid type variable bound by
-               the inferred type of h1 :: Functor f => (a -> b) -> f a -> H f
+      Where: ‘f’ is a rigid type variable
+               bound by the inferred type of
+                        h1 :: Functor f => (a -> b) -> f a -> H f
                at T10403.hs:17:1-41
     • In the type signature: h1 :: _ => _
 
 T10403.hs:15:12: warning: [-Wpartial-type-signatures (in -Wdefault)]
     • Found type wildcard ‘_’ standing for ‘(a -> b) -> f a -> H f’
-      Where: ‘b’ is a rigid type variable bound by
-               the inferred type of h1 :: Functor f => (a -> b) -> f a -> H f
-               at T10403.hs:17:1-41
-             ‘a’ is a rigid type variable bound by
-               the inferred type of h1 :: Functor f => (a -> b) -> f a -> H f
-               at T10403.hs:17:1-41
-             ‘f’ is a rigid type variable bound by
-               the inferred type of h1 :: Functor f => (a -> b) -> f a -> H f
+      Where: ‘b’, ‘a’, ‘f’ are rigid type variables
+               bound by the inferred type of
+                        h1 :: Functor f => (a -> b) -> f a -> H f
                at T10403.hs:17:1-41
     • In the type signature: h1 :: _ => _
 
 T10403.hs:19:7: warning: [-Wpartial-type-signatures (in -Wdefault)]
     • Found type wildcard ‘_’ standing for ‘(a -> b) -> f0 a -> H f0’
-      Where: ‘b’ is a rigid type variable bound by
-               the inferred type of h2 :: (a -> b) -> f0 a -> H f0
-               at T10403.hs:22:1-41
-             ‘a’ is a rigid type variable bound by
-               the inferred type of h2 :: (a -> b) -> f0 a -> H f0
+      Where: ‘f0’ is an ambiguous type variable
+             ‘b’, ‘a’ are rigid type variables
+               bound by the inferred type of h2 :: (a -> b) -> f0 a -> H f0
                at T10403.hs:22:1-41
-             ‘f0’ is an ambiguous type variable
     • In the type signature: h2 :: _
 
 T10403.hs:22:15: warning: [-Wdeferred-type-errors (in -Wdefault)]

testsuite/tests/partial-sigs/should_compile/T11016.stderr

 
 T11016.hs:5:19: warning: [-Wpartial-type-signatures (in -Wdefault)]
-    • Found type wildcard ‘_’ standing for ‘() :: Constraint’
+    • Found type wildcard ‘_’ standing for ‘()’
     • In the type signature: f1 :: (?x :: Int, _) => Int
 
 T11016.hs:8:22: warning: [-Wpartial-type-signatures (in -Wdefault)]

testsuite/tests/partial-sigs/should_compile/T11192.stderr

@@ -2,7 +2,8 @@
 T11192.hs:7:14: warning: [-Wpartial-type-signatures (in -Wdefault)]
     • Found type wildcard ‘_’ standing for ‘Int -> p -> p’
       Where: ‘p’ is a rigid type variable bound by
-               the inferred type of go :: Int -> p -> p at T11192.hs:8:8-17
+               the inferred type of go :: Int -> p -> p
+               at T11192.hs:8:8-17
     • In the type signature: go :: _
       In the expression:
         let
@@ -19,10 +20,9 @@ T11192.hs:7:14: warning: [-Wpartial-type-signatures (in -Wdefault)]
 
 T11192.hs:13:14: warning: [-Wpartial-type-signatures (in -Wdefault)]
     • Found type wildcard ‘_’ standing for ‘p -> p1 -> p1’
-      Where: ‘p’ is a rigid type variable bound by
-               the inferred type of go :: p -> p1 -> p1 at T11192.hs:14:8-17
-             ‘p1’ is a rigid type variable bound by
-               the inferred type of go :: p -> p1 -> p1 at T11192.hs:14:8-17
+      Where: ‘p’, ‘p1’ are rigid type variables bound by
+               the inferred type of go :: p -> p1 -> p1
+               at T11192.hs:14:8-17
     • In the type signature: go :: _
       In the expression:
         let

testsuite/tests/partial-sigs/should_compile/T12033.stderr

 
 T12033.hs:12:22: warning: [-Wpartial-type-signatures (in -Wdefault)]
     • Found type wildcard ‘_’ standing for ‘v -> t’
-      Where: ‘v’ is a rigid type variable bound by
+      Where: ‘t’ is a rigid type variable bound by
+               the inferred types of
+                 makeTuple :: v -> t
+                 makeExpression :: v -> t
+               at T12033.hs:(11,4)-(13,39)
+             ‘v’ is a rigid type variable bound by
                the type signature for:
                  tripleStoreToRuleSet :: forall v. v -> v
                at T12033.hs:6:1-30
-             ‘t’ is a rigid type variable bound by
-               the inferred type of
-               makeTuple :: v -> t
-               makeExpression :: v -> t
-               at T12033.hs:(11,4)-(13,39)
     • In the type signature: makeExpression :: _
       In an equation for ‘tripleStoreToRuleSet’:
           tripleStoreToRuleSet getAtom

testsuite/tests/partial-sigs/should_compile/T12844.stderr

@@ -2,24 +2,9 @@
 T12844.hs:12:9: warning: [-Wpartial-type-signatures (in -Wdefault)]
     • Found type wildcard ‘_’
         standing for ‘(Head rngs ~ '(r, r'), Foo rngs)’
-      Where: ‘r’ is a rigid type variable bound by
+      Where: ‘r’, ‘r'’, ‘rngs’, ‘k’, ‘k1’
+               are rigid type variables bound by
                the inferred type of
-               bar :: (Head rngs ~ '(r, r'), Foo rngs) => FooData rngs
-               at T12844.hs:13:1-9
-             ‘r'’ is a rigid type variable bound by
-               the inferred type of
-               bar :: (Head rngs ~ '(r, r'), Foo rngs) => FooData rngs
-               at T12844.hs:13:1-9
-             ‘rngs’ is a rigid type variable bound by
-               the inferred type of
-               bar :: (Head rngs ~ '(r, r'), Foo rngs) => FooData rngs
-               at T12844.hs:13:1-9
-             ‘k’ is a rigid type variable bound by
-               the inferred type of
-               bar :: (Head rngs ~ '(r, r'), Foo rngs) => FooData rngs
-               at T12844.hs:13:1-9
-             ‘k1’ is a rigid type variable bound by
-               the inferred type of
-               bar :: (Head rngs ~ '(r, r'), Foo rngs) => FooData rngs
+                 bar :: (Head rngs ~ '(r, r'), Foo rngs) => FooData rngs
                at T12844.hs:13:1-9
     • In the type signature: bar :: _ => FooData rngs

testsuite/tests/partial-sigs/should_compile/T12845.stderr

 
 T12845.hs:18:70: warning: [-Wpartial-type-signatures (in -Wdefault)]
-    • Found type wildcard ‘_’ standing for ‘() :: Constraint’
+    • Found type wildcard ‘_’ standing for ‘()’
     • In the type signature:
         broken :: forall r r' rngs.
                   ('(r, r') ~ Head rngs, Bar r r' ~  'True, _) =>

testsuite/tests/partial-sigs/should_compile/WarningWildcardInstantiations.stderr

@@ -34,10 +34,7 @@ WarningWildcardInstantiations.hs:8:8: warning: [-Wpartial-type-signatures (in -W
 
 WarningWildcardInstantiations.hs:8:13: warning: [-Wpartial-type-signatures (in -Wdefault)]
     • Found type wildcard ‘_’ standing for ‘t -> w’
-      Where: ‘t’ is a rigid type variable bound by
-               the inferred type of bar :: t -> (t -> w) -> w
-               at WarningWildcardInstantiations.hs:9:1-13
-             ‘w’ is a rigid type variable bound by
+      Where: ‘t’, ‘w’ are rigid type variables bound by
                the inferred type of bar :: t -> (t -> w) -> w
                at WarningWildcardInstantiations.hs:9:1-13
     • In the type signature: bar :: _ -> _ -> _

testsuite/tests/partial-sigs/should_fail/T10045.stderr

 
 T10045.hs:6:18: error:
     • Found type wildcard ‘_’ standing for ‘t1 -> Bool -> t2’
-      Where: ‘t1’ is a rigid type variable bound by
-               the inferred type of copy :: t1 -> Bool -> t2 at T10045.hs:7:10-34
-             ‘t2’ is a rigid type variable bound by
-               the inferred type of copy :: t1 -> Bool -> t2 at T10045.hs:7:10-34
+      Where: ‘t1’, ‘t2’ are rigid type variables bound by
+               the inferred type of copy :: t1 -> Bool -> t2
+               at T10045.hs:7:10-34
       To use the inferred type, enable PartialTypeSignatures
     • In the type signature: copy :: _
       In the expression:

testsuite/tests/partial-sigs/should_fail/T12634.stderr

 
 T12634.hs:14:37: error:
-    • Found type wildcard ‘_’ standing for ‘() :: Constraint’
+    • Found type wildcard ‘_’ standing for ‘()’
       To use the inferred type, enable PartialTypeSignatures
     • In the type signature:
         bench_twacePow :: forall t m m' r.

testsuite/tests/partial-sigs/should_fail/WildcardInstantiations.stderr

@@ -30,10 +30,7 @@ WildcardInstantiations.hs:8:8: error:
 
 WildcardInstantiations.hs:8:13: error:
     • Found type wildcard ‘_’ standing for ‘t -> w’
-      Where: ‘t’ is a rigid type variable bound by
-               the inferred type of bar :: t -> (t -> w) -> w
-               at WildcardInstantiations.hs:9:1-13
-             ‘w’ is a rigid type variable bound by
+      Where: ‘t’, ‘w’ are rigid type variables bound by
                the inferred type of bar :: t -> (t -> w) -> w
                at WildcardInstantiations.hs:9:1-13
       To use the inferred type, enable PartialTypeSignatures

testsuite/tests/perf/compiler/T13035.stderr

 
 T13035.hs:141:28: warning: [-Wpartial-type-signatures (in -Wdefault)]
-    • Found type wildcard ‘_’ standing for ‘'['Author]’
+    • Found type wildcard ‘_’ standing for ‘'['Author] :: [Fields]’
     • In the type signature: g :: MyRec RecipeFormatter _

testsuite/tests/polykinds/T14265.hs

+{-# LANGUAGE PolyKinds #-}
+
+module T124265 where
+
+import Control.Monad.Trans.State( StateT )
+
+f :: proxy _ -> ()
+f _ = ()
+
+foo :: StateT _ _ ()
+foo = undefined

testsuite/tests/polykinds/T14265.stderr

+
+T14265.hs:7:12: error:
+    • Found type wildcard ‘_’ standing for ‘w :: k’
+      Where: ‘w’, ‘k’ are rigid type variables bound by
+               the inferred type of f :: proxy w -> ()
+               at T14265.hs:8:1-8
+      To use the inferred type, enable PartialTypeSignatures
+    • In the type signature: f :: proxy _ -> ()
+
+T14265.hs:10:15: error:
+    • Found type wildcard ‘_’ standing for ‘w’
+      Where: ‘w’ is a rigid type variable bound by
+               the inferred type of foo :: StateT w w1 ()
+               at T14265.hs:11:1-15
+      To use the inferred type, enable PartialTypeSignatures
+    • In the type signature: foo :: StateT _ _ ()
+
+T14265.hs:10:17: error:
+    • Found type wildcard ‘_’ standing for ‘w1 :: * -> *’
+      Where: ‘w1’ is a rigid type variable bound by
+               the inferred type of foo :: StateT w w1 ()
+               at T14265.hs:11:1-15
+      To use the inferred type, enable PartialTypeSignatures
+    • In the type signature: foo :: StateT _ _ ()

testsuite/tests/polykinds/all.T

@@ -168,3 +168,4 @@ test('T14110', normal, compile_fail, [''])
 test('BadKindVar', normal, compile_fail, [''])
 test('T13738', normal, compile_fail, [''])
 test('T14209', normal, compile, [''])
+test('T14265', normal, compile_fail, [''])