[commit: ghc] master: Better layout for coercion error message (70d263e)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/70d263ecdcb5d11044c7fab570b70f1bf496a9fd/ghc

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

commit 70d263ecdcb5d11044c7fab570b70f1bf496a9fd
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Mon Apr 14 09:59:08 2014 +0100

    Better layout for coercion error message


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

70d263ecdcb5d11044c7fab570b70f1bf496a9fd
 compiler/typecheck/TcErrors.lhs  |   11 ++++++-----
 compiler/typecheck/TcRnTypes.lhs |    6 +++---
 2 files changed, 9 insertions(+), 8 deletions(-)

diff --git a/compiler/typecheck/TcErrors.lhs b/compiler/typecheck/TcErrors.lhs
index 629c7a8..3ca1319 100644
--- a/compiler/typecheck/TcErrors.lhs
+++ b/compiler/typecheck/TcErrors.lhs
@@ -1083,8 +1083,9 @@ mk_dict_err ctxt (ct, (matches, unifiers, safe_haskell))
     no_inst_msg
       | clas == coercibleClass
       = let (ty1, ty2) = getEqPredTys pred
-        in ptext (sLit "Could not coerce from") <+> quotes (ppr ty1) <+>
-           ptext (sLit "to") <+> quotes (ppr ty2)
+        in sep [ ptext (sLit "Could not coerce from") <+> quotes (ppr ty1)
+               , nest 19 (ptext (sLit "to") <+> quotes (ppr ty2)) ]
+                 -- The nesting makes the types line up
       | null givens && null matches
       = ptext (sLit "No instance for")  <+> pprParendType pred
       | otherwise
@@ -1192,9 +1193,9 @@ mk_dict_err ctxt (ct, (matches, unifiers, safe_haskell))
         Just msg <- coercible_msg_for_tycon rdr_env tc
       = msg
       | otherwise
-      = nest 2 $ hsep [ ptext $ sLit "because", quotes (ppr ty1),
-                        ptext $ sLit "and", quotes (ppr ty2),
-                        ptext $ sLit "are different types." ]
+      = nest 2 $ sep [ ptext (sLit "because") <+> quotes (ppr ty1)
+                     , nest 4 (vcat [ ptext (sLit "and") <+> quotes (ppr ty2)
+                                    , ptext (sLit "are different types.") ]) ]
       where
         (ty1, ty2) = getEqPredTys pred
 
diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs
index 44dc3fa..0355dab 100644
--- a/compiler/typecheck/TcRnTypes.lhs
+++ b/compiler/typecheck/TcRnTypes.lhs
@@ -1850,9 +1850,9 @@ pprO (DerivOriginDC dc n)  = hsep [ ptext (sLit "the"), speakNth n,
                                     parens (ptext (sLit "type") <+> quotes (ppr ty)) ]
     where ty = dataConOrigArgTys dc !! (n-1)
 pprO (DerivOriginCoerce meth ty1 ty2)
-                           = fsep [ ptext (sLit "the coercion"), ptext (sLit "of the method")
-                                  , quotes (ppr meth), ptext (sLit "from type"), quotes (ppr ty1)
-                                  , ptext (sLit "to type"), quotes (ppr ty2) ]
+                           = sep [ ptext (sLit "the coercion of the method") <+> quotes (ppr meth)
+                                 , ptext (sLit "from type") <+> quotes (ppr ty1)
+                                 , nest 2 (ptext (sLit "to type") <+> quotes (ppr ty2)) ]
 pprO StandAloneDerivOrigin = ptext (sLit "a 'deriving' declaration")
 pprO DefaultOrigin         = ptext (sLit "a 'default' declaration")
 pprO DoOrigin              = ptext (sLit "a do statement")