Extra info for GHC warnings.

This commit is contained in:
Kazu Yamamoto 2010-06-14 14:27:35 +09:00
parent badaea4eff
commit 5296ccf38d
2 changed files with 7 additions and 2 deletions

View File

@ -78,13 +78,14 @@ ghcPackage = ExposePackage "ghc"
---------------------------------------------------------------- ----------------------------------------------------------------
showErrMsg :: ErrMsg -> String showErrMsg :: ErrMsg -> String
showErrMsg err = file ++ ":" ++ line ++ ":" ++ col ++ ":" ++ msg showErrMsg err = file ++ ":" ++ line ++ ":" ++ col ++ ":" ++ msg ++ "\0" ++ ext
where where
spn = head (errMsgSpans err) spn = head (errMsgSpans err)
file = unpackFS (srcSpanFile spn) file = unpackFS (srcSpanFile spn)
line = show (srcSpanStartLine spn) line = show (srcSpanStartLine spn)
col = show (srcSpanStartCol spn) col = show (srcSpanStartCol spn)
msg = showSDoc (errMsgShortDoc err) msg = showSDoc (errMsgShortDoc err)
ext = showSDoc (errMsgExtraInfo err)
style :: PprStyle style :: PprStyle
style = mkUserStyle neverQualify AllTheWay style = mkUserStyle neverQualify AllTheWay

View File

@ -70,7 +70,11 @@
(defun ghc-flymake-insert-errors (title errs) (defun ghc-flymake-insert-errors (title errs)
(save-excursion (save-excursion
(insert title "\n") (insert title "\n")
(mapc (lambda (x) (insert (ghc-replace-character x ghc-null ghc-newline) "\n")) errs))) (mapc (lambda (x) (insert (ghc-replace-character x ghc-null ghc-newline) "\n")) errs)
(goto-char (point-min))
(while (re-search-forward "In the [^:\n]+: " nil t)
(replace-match (concat "\n" (match-string 0) "\n ")))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;