Tidy user type errors in checkValidType

Trac #11144 showed that we need to tidy the type in the error message
generated in TcValidity.checkUserTypeError.

This is still unsatisfactory.  checkValidType was originally supposed
to be called only on types gotten directly from user-written HsTypes.
So its error messages do no tidying.  But TcBinds calls it checkValidType
on an /inferred/ type, which may need tidying.

Still this at least fixes the bad error message in CustomTypeErrors02,
which was the original ticket.

Some other small refactorings:

* Remove unused Kind result of getUserTypeErrorMsg
* Rename isUserErrorTy  -->   userTypeError_maybe

2 files changed, 22 insertions, 13 deletions

diff --git a/compiler/typecheck/TcBinds.hs b/compiler/typecheck/TcBinds.hs
index bf6c8336c7..6575082c89 100644
--- a/compiler/typecheck/TcBinds.hs
+++ b/compiler/typecheck/TcBinds.hs
@@ -707,7 +707,7 @@ mkExport prag_fn qtvs theta mono_info@(poly_name, mb_sig, mono_id)
               _other   -> checkNoErrs $
                           mkInferredPolyId qtvs theta
                                            poly_name mb_sig mono_ty
-              -- The checkNoErrors ensures that if the type is ambiguous
+              -- The checkNoErrs ensures that if the type is ambiguous
               -- we don't carry on to the impedence matching, and generate
               -- a duplicate ambiguity error.  There is a similar
               -- checkNoErrs for complete type signatures too.
@@ -718,9 +718,8 @@ mkExport prag_fn qtvs theta mono_info@(poly_name, mb_sig, mono_id)
                 -- tcPrags requires a zonked poly_id
 
         -- See Note [Impedence matching]
-        -- NB: we have already done checkValidType on the type
-        --     for a complete sig, when we checked the sig;
-        --     otherwise in mkInferredPolyIe
+        -- NB: we have already done checkValidType, including an ambiguity check,
+        --     on the type; either when we checked the sig or in mkInferredPolyId
         ; let sel_poly_ty = mkSigmaTy qtvs theta mono_ty
               poly_ty     = idType poly_id
         ; wrap <- if sel_poly_ty `eqType` poly_ty
@@ -763,6 +762,7 @@ mkInferredPolyId qtvs inferred_theta poly_name mb_sig mono_ty
                                           , ppr inferred_poly_ty])
        ; addErrCtxtM (mk_inf_msg poly_name inferred_poly_ty) $
          checkValidType (InfSigCtxt poly_name) inferred_poly_ty
+         -- See Note [Validity of inferred types]
 
        ; return (mkLocalId poly_name inferred_poly_ty) }
 
@@ -884,16 +884,12 @@ simply adds the inferred type to the program source, it'll compile fine.
 See #8883.
 
 Examples that might fail:
+ - the type might be ambiguous
+
  - an inferred theta that requires type equalities e.g. (F a ~ G b)
                                 or multi-parameter type classes
  - an inferred type that includes unboxed tuples
 
-However we don't do the ambiguity check (checkValidType omits it for
-InfSigCtxt) because the impedance-matching stage, which follows
-immediately, will do it and we don't want two error messages.
-Moreover, because of the impedance matching stage, the ambiguity-check
-suggestion of -XAllowAmbiguiousTypes will not work.
-
 
 Note [Impedence matching]
 ~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/compiler/typecheck/TcValidity.hs b/compiler/typecheck/TcValidity.hs
index 04bbd46425..8422ba4fe2 100644
--- a/compiler/typecheck/TcValidity.hs
+++ b/compiler/typecheck/TcValidity.hs
@@ -231,19 +231,32 @@ wantAmbiguityCheck ctxt
                          -- E.g.   type family T a :: *  -- T :: forall k. k -> *
                          -- Then :k T should work in GHCi, not complain that
                          -- (T k) is ambiguous!
---      InfSigCtxt {} -> False   -- See Note [Validity of inferred types] in TcBinds
       _ -> True
 
 
 checkUserTypeError :: Type -> TcM ()
+-- Check to see if the type signature mentions "TypeError blah"
+-- anywhere in it, and fail if so.
+--
+-- Very unsatisfactorily (Trac #11144) we need to tidy the type
+-- because it may have come from an /inferred/ signature, not a
+-- user-supplied one.  This is really only a half-baked fix;
+-- the other errors in checkValidType don't do tidying, and so
+-- may give bad error messages when given an inferred type.
 checkUserTypeError = check
   where
   check ty
-    | Just (_,msg) <- isUserErrorTy ty = failWithTc (pprUserTypeErrorTy msg)
+    | Just msg     <- userTypeError_maybe ty  = fail_with msg
     | Just (_,ts)  <- splitTyConApp_maybe ty  = mapM_ check ts
     | Just (t1,t2) <- splitAppTy_maybe ty     = check t1 >> check t2
+    | Just (_,t1)  <- splitForAllTy_maybe ty  = check t1
     | otherwise                               = return ()
 
+  fail_with msg = do { env0 <- tcInitTidyEnv
+                     ; let (env1, tidy_msg) = tidyOpenType env0 msg
+                     ; failWithTcM (env1, pprUserTypeErrorTy tidy_msg) }
+
+
 {-
 ************************************************************************
 *                                                                      *
@@ -280,7 +293,7 @@ This might not necessarily show up in kind checking.
 -}
 
 checkValidType :: UserTypeCtxt -> Type -> TcM ()
--- Checks that the type is valid for the given context
+-- Checks that a user-written type is valid for the given context
 -- Assumes arguemt is fully zonked
 -- Not used for instance decls; checkValidInstance instead
 checkValidType ctxt ty