More precise types for fields of OverlappingInstances and UnsafeOverlap in TcSolverReportMsg

It's clear from asserts in `GHC.Tc.Errors` that `overlappingInstances_matches`
and `unsafeOverlapped` are supposed to be non-empty, and `unsafeOverlap_matches`
contains a single instance, but these invariants are immediately lost afterwards
and not encoded in types. This patch enforces the invariants by pattern matching
and makes types more precise, avoiding asserts and partial functions such as `head`.

1 files changed, 15 insertions, 26 deletions

diff --git a/compiler/GHC/Tc/Errors.hs b/compiler/GHC/Tc/Errors.hs
index 7734a135f5..3a3e474b80 100644
--- a/compiler/GHC/Tc/Errors.hs
+++ b/compiler/GHC/Tc/Errors.hs
@@ -83,6 +83,7 @@ import Data.Foldable      ( toList )
 import Data.Function      ( on )
 import Data.List          ( partition, sort, sortBy )
 import Data.List.NonEmpty ( NonEmpty(..) )
+import qualified Data.List.NonEmpty as NE
 import Data.Ord           ( comparing )
 import qualified Data.Semigroup as S
 
@@ -2205,24 +2206,24 @@ mk_dict_err :: HasCallStack => SolverReportErrCtxt -> (ErrorItem, ClsInstLookupR
             -> TcM TcSolverReportMsg
 -- Report an overlap error if this class constraint results
 -- from an overlap (returning Left clas), otherwise return (Right pred)
-mk_dict_err ctxt (item, (matches, unifiers, unsafe_overlapped))
-  | null matches  -- No matches but perhaps several unifiers
-  = do { (_, rel_binds, item) <- relevantBindings True ctxt item
-       ; candidate_insts <- get_candidate_instances
-       ; (imp_errs, field_suggestions) <- record_field_suggestions
-       ; return (cannot_resolve_msg item candidate_insts rel_binds imp_errs field_suggestions) }
-
-  | null unsafe_overlapped   -- Some matches => overlap errors
-  = return $ overlap_msg
-
-  | otherwise
-  = return $ safe_haskell_msg
+mk_dict_err ctxt (item, (matches, unifiers, unsafe_overlapped)) = case (NE.nonEmpty matches, NE.nonEmpty unsafe_overlapped) of
+  (Nothing, _)  -> do -- No matches but perhaps several unifiers
+    { (_, rel_binds, item) <- relevantBindings True ctxt item
+    ; candidate_insts <- get_candidate_instances
+    ; (imp_errs, field_suggestions) <- record_field_suggestions
+    ; return (cannot_resolve_msg item candidate_insts rel_binds imp_errs field_suggestions) }
+
+  -- Some matches => overlap errors
+  (Just matchesNE, Nothing) -> return $
+    OverlappingInstances item (NE.map fst matchesNE) (getPotentialUnifiers unifiers)
+
+  (Just (match :| []), Just unsafe_overlappedNE) -> return $
+    UnsafeOverlap item (fst match) (NE.map fst unsafe_overlappedNE)
+  (Just (_ :| rest), Just{}) -> pprPanic "should be empty" (ppr rest)
   where
     orig          = errorItemOrigin item
     pred          = errorItemPred item
     (clas, tys)   = getClassPredTys pred
-    ispecs        = [ispec | (ispec, _) <- matches]
-    unsafe_ispecs = [ispec | (ispec, _) <- unsafe_overlapped]
 
     get_candidate_instances :: TcM [ClsInst]
     -- See Note [Report candidate instances]
@@ -2271,18 +2272,6 @@ mk_dict_err ctxt (item, (matches, unifiers, unsafe_overlapped))
     cannot_resolve_msg item candidate_insts binds imp_errs field_suggestions
       = CannotResolveInstance item (getPotentialUnifiers unifiers) candidate_insts imp_errs field_suggestions binds
 
-    -- Overlap errors.
-    overlap_msg, safe_haskell_msg :: TcSolverReportMsg
-    -- Normal overlap error
-    overlap_msg
-      = assert (not (null matches)) $ OverlappingInstances item ispecs (getPotentialUnifiers unifiers)
-
-    -- Overlap error because of Safe Haskell (first
-    -- match should be the most specific match)
-    safe_haskell_msg
-     = assert (matches `lengthIs` 1 && not (null unsafe_ispecs)) $
-       UnsafeOverlap item ispecs unsafe_ispecs
-
 {- Note [Report candidate instances]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 If we have an unsolved (Num Int), where `Int` is not the Prelude Int,