Changing GHC Error Message Wrapping
Simon Peyton Jones
simonpj at microsoft.com
Fri Jan 10 14:21:16 UTC 2014
Crumbs. You are absolutely right. I'll fix that. (It's a relic from when the flags weren't available to the show functions.)
Simon
From: Andrew Gibiansky [mailto:andrew.gibiansky at gmail.com]
Sent: 08 January 2014 17:23
To: Simon Peyton Jones
Cc: Erik de Castro Lopo; ghc-devs at haskell.org
Subject: Re: Changing GHC Error Message Wrapping
Of course :) It made sense once I realized that the `show` was generating the string, and that it was not generated when the datatype was being constructed.
However, I don't think the `showSDocForUser` call works (I tested). It uses `runSDoc` to generate a `Doc`. It then uses `show` on that Doc:
instance Show Doc where
showsPrec _ doc cont = showDoc doc cont
Looking at `showDoc` we see:
showDoc :: Doc -> String -> String
showDoc doc rest = showDocWithAppend PageMode doc rest
showDocWithAppend :: Mode -> Doc -> String -> String
showDocWithAppend mode doc rest = fullRender mode 100 1.5 string_txt rest doc
It ultimately calls `showDocWithAppend`, which calls `fullRender` with a hard-coded 100-column limit.
-- Andrew
On Wed, Jan 8, 2014 at 12:11 PM, Simon Peyton Jones <simonpj at microsoft.com<mailto:simonpj at microsoft.com>> wrote:
Well, the Show instance for a type (any type) cannot possibly respect pprCols. It can't: show :: a -> String! No command-line inputs.
I suggest something more like
doc sdoc = do { dflags <- getDynFlags; unqual <- getPrintUnqual; return (showSDocForUser dflags unqual doc }
Simon
From: Andrew Gibiansky [mailto:andrew.gibiansky at gmail.com<mailto:andrew.gibiansky at gmail.com>]
Sent: 08 January 2014 00:09
To: Simon Peyton Jones
Cc: Erik de Castro Lopo; ghc-devs at haskell.org<mailto:ghc-devs at haskell.org>
Subject: Re: Changing GHC Error Message Wrapping
Hello all,
I figured out that this isn't quite a bug and figured out how to do what I wanted. It turns out that the `Show` instance for SourceError does not respect `pprCols` - I don't know if that's a reasonable expectation (although it's what I expected). I ended up using the following code to print these messages:
flip gcatch handler $ do
runStmt "let f (x, y, z, w, e, r, d , ax, b ,c,ex ,g ,h) = (x :: Int) + y + z" RunToCompletion
runStmt "f (1, 2, 3)" RunToCompletion
return ()
where
handler :: SourceError -> Ghc ()
handler srcerr = do
let msgs = bagToList $ srcErrorMessages srcerr
forM_ msgs $ \msg -> do
s <- doc $ errMsgShortDoc msg
liftIO $ putStrLn s
doc :: GhcMonad m => SDoc -> m String
doc sdoc = do
flags <- getSessionDynFlags
let cols = pprCols flags
d = runSDoc sdoc (initSDocContext flags defaultUserStyle)
return $ Pretty.fullRender Pretty.PageMode cols 1.5 string_txt "" d
where
string_txt :: Pretty.TextDetails -> String -> String
string_txt (Pretty.Chr c) s = c:s
string_txt (Pretty.Str s1) s2 = s1 ++ s2
string_txt (Pretty.PStr s1) s2 = unpackFS s1 ++ s2
string_txt (Pretty.LStr s1 _) s2 = unpackLitString s1 ++ s2
As far as I can tell, there is no simpler way, every function in `Pretty` except for `fullRender` just assumes a default of 100-char lines.
-- Andrew
On Tue, Jan 7, 2014 at 11:29 AM, Andrew Gibiansky <andrew.gibiansky at gmail.com<mailto:andrew.gibiansky at gmail.com>> wrote:
Simon,
That's exactly what I'm looking for! But it seems that doing it dynamically in the GHC API doesn't work (as in my first email where I tried to adjust pprCols via setSessionDynFlags).
I'm going to look into the source as what ppr-cols=N actually sets and probably file a bug - because this seems like buggy behaviour...
Andrew
On Tue, Jan 7, 2014 at 4:14 AM, Simon Peyton Jones <simonpj at microsoft.com<mailto:simonpj at microsoft.com>> wrote:
-dppr-cols=N changes the width of the output page; you could try a large number there. There isn't a setting meaning "infinity", sadly.
Simon
From: Andrew Gibiansky [mailto:andrew.gibiansky at gmail.com<mailto:andrew.gibiansky at gmail.com>]
Sent: 07 January 2014 03:04
To: Simon Peyton Jones
Cc: Erik de Castro Lopo; ghc-devs at haskell.org<mailto:ghc-devs at haskell.org>
Subject: Re: Changing GHC Error Message Wrapping
Thanks Simon.
In general I think multiline tuples should have many elements per line, but honestly the tuple case was a very specific example. If possible, I'd like to change the *overall* wrapping for *all* error messages - how does `sep` know when to break lines? there's clearly a numeric value for the number of columns somewhere, but where is it, and is it user-adjustable?
For now I am just hacking around this by special-casing some error messages and "un-doing" the line wrapping by parsing the messages and joining lines back together.
Thanks,
Andrew
On Mon, Jan 6, 2014 at 7:44 AM, Simon Peyton-Jones <simonpj at microsoft.com<mailto:simonpj at microsoft.com>> wrote:
I think it's line 705 in types/TypeRep.lhs
pprTcApp p pp tc tys
| isTupleTyCon tc && tyConArity tc == length tys
= pprPromotionQuote tc <>
tupleParens (tupleTyConSort tc) (sep (punctuate comma (map (pp TopPrec) tys)))
If you change 'sep' to 'fsep', you'll get behaviour more akin to paragraph-filling (hence the "f"). Give it a try. You'll get validation failure from the testsuite, but you can see whether you think the result is better or worse. In general, should multi-line tuples be printed with many elements per line, or just one?
Simon
From: ghc-devs [mailto:ghc-devs-bounces at haskell.org<mailto:ghc-devs-bounces at haskell.org>] On Behalf Of Andrew Gibiansky
Sent: 04 January 2014 17:30
To: Erik de Castro Lopo
Cc: ghc-devs at haskell.org<mailto:ghc-devs at haskell.org>
Subject: Re: Changing GHC Error Message Wrapping
Apologize for the broken image formatting.
With the code I posted above, I get the following output:
Couldn't match expected type `(GHC.Types.Int<http://GHC.Types.Int>,
GHC.Types.Int<http://GHC.Types.Int>,
GHC.Types.Int<http://GHC.Types.Int>,
t0,
t10,
t20,
t30,
t40,
t50,
t60,
t70,
t80,
t90)'
with actual type `(t1, t2, t3)'
I would like the types to be on the same line, or at least wrapped to a larger number of columns.
Does anyone know how to do this, or where in the GHC source this wrapping is done?
Thanks!
Andrew
On Sat, Jan 4, 2014 at 2:55 AM, Erik de Castro Lopo <mle+hs at mega-nerd.com<mailto:mle+hs at mega-nerd.com>> wrote:
Carter Schonwald wrote:
> hey andrew, your image link isn't working (i'm using gmail)
I think the list software filters out image attachments.
Erik
--
----------------------------------------------------------------------
Erik de Castro Lopo
http://www.mega-nerd.com/
_______________________________________________
ghc-devs mailing list
ghc-devs at haskell.org<mailto:ghc-devs at haskell.org>
http://www.haskell.org/mailman/listinfo/ghc-devs
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/ghc-devs/attachments/20140110/48076f6c/attachment-0001.html>
More information about the ghc-devs
mailing list