- ppr sty (SrcLoc src_file src_line)
- | userStyle sty
- = hcat [ ptext src_file, char ':', text (show IBOX(src_line)) ]
-
- | otherwise
- = hcat [text "{-# LINE ", text (show IBOX(src_line)), space,
- char '\"', ptext src_file, text " #-}"]
- ppr sty (UnhelpfulSrcLoc s) = ptext s
-
- ppr sty NoSrcLoc = text "<NoSrcLoc>"
+ ppr (SrcLoc src_path src_line)
+ = getPprStyle $ \ sty ->
+ if userStyle sty then
+ hcat [ text src_file, char ':', int IBOX(src_line) ]
+ else
+ if debugStyle sty then
+ hcat [ ptext src_path, char ':', int IBOX(src_line) ]
+ else
+ hcat [text "{-# LINE ", int IBOX(src_line), space,
+ char '\"', ptext src_path, text " #-}"]
+ where
+ src_file = remove_directory_prefix (unpackFS src_path)
+
+ remove_directory_prefix path = case break (== '/') path of
+ (filename, []) -> filename
+ (prefix, slash : rest) -> ASSERT( slash == '/' )
+ remove_directory_prefix rest
+
+ ppr (UnhelpfulSrcLoc s) = ptext s
+
+ ppr NoSrcLoc = text "<NoSrcLoc>"