[commit: ghc] wip/ttypeable: Rework Show (1b2f6a3)

[git at git.haskell.org]

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

On branch  : wip/ttypeable
Link       : http://ghc.haskell.org/trac/ghc/changeset/1b2f6a397add531bcff19a0b57b744b294c043ef/ghc

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

commit 1b2f6a397add531bcff19a0b57b744b294c043ef
Author: Ben Gamari <ben at smart-cactus.org>
Date:   Mon Jul 4 14:43:40 2016 +0200

    Rework Show


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

1b2f6a397add531bcff19a0b57b744b294c043ef
 libraries/base/Data/Typeable/Internal.hs | 48 +++++++++++++++++++-------------
 1 file changed, 28 insertions(+), 20 deletions(-)

diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs
index 8c225a7..e73fee6 100644
--- a/libraries/base/Data/Typeable/Internal.hs
+++ b/libraries/base/Data/Typeable/Internal.hs
@@ -329,29 +329,37 @@ typeRepXFingerprint (TypeRepX t) = typeRepFingerprint t
 ----------------- Showing TypeReps --------------------
 
 instance Show (TypeRep (a :: k)) where
-  showsPrec _ rep
-    | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep *) =
-      showChar '*'
-    | isListTyCon tc, [ty] <- tys =
-      showChar '[' . shows ty . showChar ']'
-    | isTupleTyCon tc =
-      showChar '(' . showArgs (showChar ',') tys . showChar ')'
-    where (tc, tys) = splitApps rep
-  showsPrec p (TrTyCon _ tycon _) = showsPrec p tycon
+    showsPrec = showTypeable
+
+showTypeable :: Int -> TypeRep (a :: k) -> ShowS
+showTypeable p rep =
+    showParen (p > 9) $
+    showTypeable' 8 rep . showString " :: " . showTypeable' 8 (typeRepKind rep)
+
+showTypeable' :: Int -> TypeRep (a :: k) -> ShowS
+showTypeable' _ rep
+  | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep *) =
+    showChar '*'
+  | isListTyCon tc, [ty] <- tys =
+    showChar '[' . shows ty . showChar ']'
+  | isTupleTyCon tc =
+    showChar '(' . showArgs (showChar ',') tys . showChar ')'
+  where (tc, tys) = splitApps rep
+showTypeable' p (TrTyCon _ tycon _) = showsPrec p tycon
   --showsPrec p (TRFun x r) =
   --    showParen (p > 8) $
   --    showsPrec 9 x . showString " -> " . showsPrec 8 r
-  showsPrec p (TrApp _ (TrApp _ (TrTyCon _ tycon _) x) r)
-    | isArrowTyCon tycon =
-      showParen (p > 8) $
-      showsPrec 9 x . showString " -> " . showsPrec p r
-
-  showsPrec p (TrApp _ f x)
-    | otherwise =
-      showParen (p > 9) $
-      showsPrec 8 f .
-      showChar ' ' .
-      showsPrec 9 x
+showTypeable' p (TrApp _ (TrApp _ (TrTyCon _ tycon _) x) r)
+  | isArrowTyCon tycon =
+    showParen (p > 8) $
+    showsPrec 9 x . showString " -> " . showsPrec p r
+
+showTypeable' p (TrApp _ f x)
+  | otherwise =
+    showParen (p > 9) $
+    showsPrec 8 f .
+    showChar ' ' .
+    showsPrec 9 x
 
 -- | @since 4.10.0.0
 instance Show TypeRepX where