[commit: ghc] wip/spj-wibbles: Small refactor (ba3b196)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/spj-wibbles
Link       : http://ghc.haskell.org/trac/ghc/changeset/ba3b196fbcb16b2bf96a847419567053e9492bdc/ghc

>---------------------------------------------------------------

commit ba3b196fbcb16b2bf96a847419567053e9492bdc
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Thu Jan 10 12:08:47 2019 +0000

    Small refactor
    
    ...to use the same error message rather than duplicating it


>---------------------------------------------------------------

ba3b196fbcb16b2bf96a847419567053e9492bdc
 compiler/typecheck/TcInstDcls.hs | 14 ++++++--------
 1 file changed, 6 insertions(+), 8 deletions(-)

diff --git a/compiler/typecheck/TcInstDcls.hs b/compiler/typecheck/TcInstDcls.hs
index ba33fe2..fccf8b7 100644
--- a/compiler/typecheck/TcInstDcls.hs
+++ b/compiler/typecheck/TcInstDcls.hs
@@ -21,7 +21,7 @@ import TcBinds
 import TcTyClsDecls
 import TcTyDecls ( addTyConsToGblEnv )
 import TcClassDcl( tcClassDecl2, tcATDefault,
-                   HsSigFun, mkHsSigFun,
+                   HsSigFun, mkHsSigFun, badMethodErr,
                    findMethodBind, instantiateMethod )
 import TcSigs
 import TcRnMonad
@@ -1539,13 +1539,11 @@ tcMethods dfun_id clas tyvars dfun_ev_vars inst_tys
     -- Check if any method bindings do not correspond to the class.
     -- See Note [Mismatched class methods and associated type families].
     checkMethBindMembership
-      = let bind_nms         = map unLoc $ collectMethodBinders binds
-            cls_meth_nms     = map (idName . fst) op_items
-            mismatched_meths = bind_nms `minusList` cls_meth_nms
-        in forM_ mismatched_meths $ \mismatched_meth ->
-             addErrTc $ hsep
-             [ text "Class", quotes (ppr (className clas))
-             , text "does not have a method", quotes (ppr mismatched_meth)]
+      = mapM_ (addErrTc . badMethodErr clas) mismatched_meths
+      where
+        bind_nms         = map unLoc $ collectMethodBinders binds
+        cls_meth_nms     = map (idName . fst) op_items
+        mismatched_meths = bind_nms `minusList` cls_meth_nms
 
 {-
 Note [Mismatched class methods and associated type families]