Commit 9ee63977 authored by Ian Lynagh's avatar Ian Lynagh
Browse files

Normalise FilePaths before printing them

parent c38ec601
......@@ -43,6 +43,7 @@ module SrcLoc (
import Util
import Outputable
import FastString
import System.FilePath
\end{code}
%************************************************************************
......@@ -129,17 +130,20 @@ cmpSrcLoc (SrcLoc s1 l1 c1) (SrcLoc s2 l2 c2)
= (s1 `compare` s2) `thenCmp` (l1 `compare` l2) `thenCmp` (c1 `compare` c2)
cmpSrcLoc (SrcLoc _ _ _) _other = GT
pprFastFilePath :: FastString -> SDoc
pprFastFilePath path = text $ normalise $ unpackFS path
instance Outputable SrcLoc where
ppr (SrcLoc src_path src_line src_col)
= getPprStyle $ \ sty ->
if userStyle sty || debugStyle sty then
hcat [ ftext src_path, char ':',
int src_line,
char ':', int src_col
]
else
hcat [text "{-# LINE ", int src_line, space,
char '\"', ftext src_path, text " #-}"]
hcat [ pprFastFilePath src_path, char ':',
int src_line,
char ':', int src_col
]
else
hcat [text "{-# LINE ", int src_line, space,
char '\"', pprFastFilePath src_path, text " #-}"]
ppr (UnhelpfulLoc s) = ftext s
\end{code}
......@@ -316,15 +320,15 @@ instance Outputable SrcSpan where
ppr span
= getPprStyle $ \ sty ->
if userStyle sty || debugStyle sty then
pprUserSpan span
else
hcat [text "{-# LINE ", int (srcSpanStartLine span), space,
char '\"', ftext (srcSpanFile span), text " #-}"]
pprUserSpan span
else
hcat [text "{-# LINE ", int (srcSpanStartLine span), space,
char '\"', pprFastFilePath $ srcSpanFile span, text " #-}"]
pprUserSpan :: SrcSpan -> SDoc
pprUserSpan (SrcSpanOneLine src_path line start_col end_col)
= hcat [ ftext src_path, char ':',
= hcat [ pprFastFilePath src_path, char ':',
int line,
char ':', int start_col
]
......@@ -335,7 +339,7 @@ pprUserSpan (SrcSpanOneLine src_path line start_col end_col)
else char '-' <> int (end_col-1)
pprUserSpan (SrcSpanMultiLine src_path sline scol eline ecol)
= hcat [ ftext src_path, char ':',
= hcat [ pprFastFilePath src_path, char ':',
parens (int sline <> char ',' <> int scol),
char '-',
parens (int eline <> char ',' <>
......@@ -343,7 +347,7 @@ pprUserSpan (SrcSpanMultiLine src_path sline scol eline ecol)
]
pprUserSpan (SrcSpanPoint src_path line col)
= hcat [ ftext src_path, char ':',
= hcat [ pprFastFilePath src_path, char ':',
int line,
char ':', int col
]
......
......@@ -115,6 +115,7 @@ import UniqSupply ( UniqSupply )
import FastString ( FastString )
import StringBuffer ( StringBuffer )
import System.FilePath
import System.Time ( ClockTime )
import Data.IORef
import Data.Array ( Array, array )
......@@ -1342,14 +1343,15 @@ instance Outputable ModSummary where
showModMsg :: HscTarget -> Bool -> ModSummary -> String
showModMsg target recomp mod_summary
= showSDoc (hsep [text (mod_str ++ replicate (max 0 (16 - length mod_str)) ' '),
char '(', text (msHsFilePath mod_summary) <> comma,
case target of
HscInterpreted | recomp
-> text "interpreted"
HscNothing -> text "nothing"
_other -> text (msObjFilePath mod_summary),
char ')'])
= showSDoc $
hsep [text (mod_str ++ replicate (max 0 (16 - length mod_str)) ' '),
char '(', text (normalise $ msHsFilePath mod_summary) <> comma,
case target of
HscInterpreted | recomp
-> text "interpreted"
HscNothing -> text "nothing"
_ -> text (normalise $ msObjFilePath mod_summary),
char ')']
where
mod = moduleName (ms_mod mod_summary)
mod_str = showSDoc (ppr mod) ++ hscSourceString (ms_hsc_src mod_summary)
......
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