[commit: ghc] master: Improve error messages for roles by writing role names out (477bc9b)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/477bc9be26d9ac0c4cd674403c2a57fba9d1ee09/ghc

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

commit 477bc9be26d9ac0c4cd674403c2a57fba9d1ee09
Author: Richard Eisenberg <eir at cis.upenn.edu>
Date:   Tue Aug 27 22:07:39 2013 -0400

    Improve error messages for roles by writing role names out


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

477bc9be26d9ac0c4cd674403c2a57fba9d1ee09
 compiler/typecheck/TcDeriv.lhs      |    2 +-
 compiler/typecheck/TcTyClsDecls.lhs |    4 ++--
 compiler/types/CoAxiom.lhs          |    8 +++++++-
 3 files changed, 10 insertions(+), 4 deletions(-)

diff --git a/compiler/typecheck/TcDeriv.lhs b/compiler/typecheck/TcDeriv.lhs
index 0a69165..144678e 100644
--- a/compiler/typecheck/TcDeriv.lhs
+++ b/compiler/typecheck/TcDeriv.lhs
@@ -1477,7 +1477,7 @@ mkNewTypeEqn orig dflags tvs
                     ptext (sLit "GeneralizedNewtypeDeriving on this class;") $$
                     ptext (sLit "the last parameter of") <+>
                     quotes (ppr (className cls)) <+>
-                    ptext (sLit "is at role N")
+                    ptext (sLit "is at role Nominal")
 
 \end{code}
 
diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs
index 0cd4f2d..70e72f5 100644
--- a/compiler/typecheck/TcTyClsDecls.lhs
+++ b/compiler/typecheck/TcTyClsDecls.lhs
@@ -2147,8 +2147,8 @@ inaccessibleCoAxBranch tc fi
 badRoleAnnot :: Name -> Role -> Role -> SDoc
 badRoleAnnot var annot inferred
   = hang (ptext (sLit "Role mismatch on variable") <+> ppr var <> colon)
-       2 (sep [ ptext (sLit "Annotation says"), ppr annot
-              , ptext (sLit "but role"), ppr inferred
+       2 (sep [ ptext (sLit "Annotation says"), pprFullRole annot
+              , ptext (sLit "but role"), pprFullRole inferred
               , ptext (sLit "is required") ])
 
 \end{code}
diff --git a/compiler/types/CoAxiom.lhs b/compiler/types/CoAxiom.lhs
index e507607..ed1a684 100644
--- a/compiler/types/CoAxiom.lhs
+++ b/compiler/types/CoAxiom.lhs
@@ -26,12 +26,13 @@ module CoAxiom (
        coAxBranchLHS, coAxBranchRHS, coAxBranchSpan, coAxBranchIncomps,
        placeHolderIncomps,
 
-       Role(..)
+       Role(..), pprFullRole
        ) where 
 
 import {-# SOURCE #-} TypeRep ( Type )
 import {-# SOURCE #-} TyCon ( TyCon )
 import Outputable
+import FastString
 import Name
 import Unique
 import Var
@@ -440,6 +441,11 @@ This is defined here to avoid circular dependencies.
 data Role = Nominal | Representational | Phantom
   deriving (Eq, Data.Data, Data.Typeable)
 
+pprFullRole :: Role -> SDoc
+pprFullRole Nominal          = ptext (sLit "Nominal")
+pprFullRole Representational = ptext (sLit "Representational")
+pprFullRole Phantom          = ptext (sLit "Phantom")
+
 instance Outputable Role where
   ppr Nominal          = char 'N'
   ppr Representational = char 'R'