[commit: ghc] master: Be more selective about when to print out roles with :info (8854d9e)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/8854d9e246de9bb7b87499c24ebb55468326bc59/ghc

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

commit 8854d9e246de9bb7b87499c24ebb55468326bc59
Author: Richard Eisenberg <eir at cis.upenn.edu>
Date:   Tue Oct 22 11:16:42 2013 -0400

    Be more selective about when to print out roles with :info


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

8854d9e246de9bb7b87499c24ebb55468326bc59
 compiler/main/PprTyThing.hs |   20 ++++++++++++--------
 1 file changed, 12 insertions(+), 8 deletions(-)

diff --git a/compiler/main/PprTyThing.hs b/compiler/main/PprTyThing.hs
index 1f458f0..c83552b 100644
--- a/compiler/main/PprTyThing.hs
+++ b/compiler/main/PprTyThing.hs
@@ -197,18 +197,22 @@ pprTyCon ss tyCon
 
                                                  -- e.g. type T = forall a. a->a
   | Just cls <- tyConClass_maybe tyCon
-  = pp_roles $$ pprClass ss cls
+  = (pp_roles (== Nominal)) $$ pprClass ss cls
 
   | otherwise
-  = pp_roles $$ pprAlgTyCon ss tyCon
+  = (pp_roles (== Representational)) $$ pprAlgTyCon ss tyCon
 
   where
-    pp_roles = sdocWithDynFlags $ \dflags ->
-               let roles = suppressKinds dflags (tyConKind tyCon) (tyConRoles tyCon)
-               in ppUnless (all (== Representational) roles) $
-                  ptext (sLit "type role") <+> ppr tyCon <+> hsep (map ppr roles)
-
-    pp_tc_with_kind = vcat [ pp_roles
+      -- if, for each role, suppress_if role is True, then suppress the role
+      -- output
+    pp_roles :: (Role -> Bool) -> SDoc
+    pp_roles suppress_if
+      = sdocWithDynFlags $ \dflags ->
+        let roles = suppressKinds dflags (tyConKind tyCon) (tyConRoles tyCon)
+        in ppUnless (all suppress_if roles) $
+           ptext (sLit "type role") <+> ppr tyCon <+> hsep (map ppr roles)
+
+    pp_tc_with_kind = vcat [ pp_roles (const True)
                            , pprTyConHdr tyCon <+> dcolon
                              <+> pprTypeForUser (synTyConResKind tyCon) ]
     closed_family_header