Commit 767d5a87 authored by Ian Lynagh's avatar Ian Lynagh
Browse files

Make it possible to show SrcSpans without going via Doc

This shouldn't be any slower; the FilePaths were already going via
String so that we could normalise them.

This means that very early on, when printing flag parsing errors, we
can do so without having a DynFlags yet.
parent 0dcfe36a
......@@ -45,6 +45,7 @@ module SrcLoc (
srcSpanStart, srcSpanEnd,
realSrcSpanStart, realSrcSpanEnd,
srcSpanFileName_maybe,
showUserSpan,
-- ** Unsafely deconstructing SrcSpan
-- These are dubious exports, because they crash on some inputs
......@@ -81,6 +82,7 @@ import FastString
import Data.Bits
import Data.Data
import System.FilePath
\end{code}
%************************************************************************
......@@ -434,7 +436,7 @@ instance Outputable RealSrcSpan where
ppr span
= getPprStyle $ \ sty ->
if userStyle sty || debugStyle sty then
pprUserRealSpan True span
text (showUserRealSpan True span)
else
hcat [text "{-# LINE ", int (srcSpanStartLine span), space,
char '\"', pprFastFilePath $ srcSpanFile span, text " #-}"]
......@@ -451,30 +453,30 @@ instance Outputable SrcSpan where
pprUserSpan :: Bool -> SrcSpan -> SDoc
pprUserSpan _ (UnhelpfulSpan s) = ftext s
pprUserSpan show_path (RealSrcSpan s) = pprUserRealSpan show_path s
pprUserRealSpan :: Bool -> RealSrcSpan -> SDoc
pprUserRealSpan show_path (SrcSpanOneLine src_path line start_col end_col)
= hcat [ ppWhen show_path (pprFastFilePath src_path <> colon)
, int line, char ':', int start_col
, ppUnless (end_col - start_col <= 1)
(char '-' <> int (end_col-1))
pprUserSpan show_path (RealSrcSpan s) = text (showUserRealSpan show_path s)
showUserSpan :: Bool -> SrcSpan -> String
showUserSpan _ (UnhelpfulSpan s) = unpackFS s
showUserSpan show_path (RealSrcSpan s) = showUserRealSpan show_path s
showUserRealSpan :: Bool -> RealSrcSpan -> String
showUserRealSpan show_path (SrcSpanOneLine src_path line start_col end_col)
= (if show_path then normalise (unpackFS src_path) ++ ":" else "")
++ show line ++ ":" ++ show start_col
++ (if end_col - start_col <= 1 then "" else '-' : show (end_col - 1))
-- For single-character or point spans, we just
-- output the starting column number
]
pprUserRealSpan show_path (SrcSpanMultiLine src_path sline scol eline ecol)
= hcat [ ppWhen show_path (pprFastFilePath src_path <> colon)
, parens (int sline <> char ',' <> int scol)
, char '-'
, parens (int eline <> char ',' <>
if ecol == 0 then int ecol else int (ecol-1))
]
showUserRealSpan show_path (SrcSpanMultiLine src_path sline scol eline ecol)
= (if show_path then normalise (unpackFS src_path) ++ ":" else "")
++ "(" ++ show sline ++ "," ++ show scol ++ ")"
++ "-"
++ "(" ++ show eline ++ "," ++ show ecol' ++ ")"
where ecol' = if ecol == 0 then ecol else ecol - 1
pprUserRealSpan show_path (SrcSpanPoint src_path line col)
= hcat [ ppWhen show_path $ (pprFastFilePath src_path <> colon)
, int line, char ':', int col ]
showUserRealSpan show_path (SrcSpanPoint src_path line col)
= (if show_path then normalise (unpackFS src_path) ++ ":" else "")
++ show line ++ ":" ++ show col
\end{code}
%************************************************************************
......
......@@ -243,6 +243,5 @@ missingArgErr f = Left ("missing argument for flag: " ++ f)
errorsToGhcException :: [Located String] -> GhcException
errorsToGhcException errs =
let errors = vcat [ ppr l <> text ": " <> text e | L l e <- errs ]
in UsageError (renderWithStyle errors cmdlineParserStyle)
UsageError $ unlines [ showUserSpan True l ++ ": " ++ e | L l e <- errs ]
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment