2 % (c) The AQUA Project, Glasgow University, 1994-1998
4 \section[ErrsUtils]{Utilities for error reporting}
8 ErrMsg, WarnMsg, Message,
9 addShortErrLocLine, addShortWarnLocLine,
12 printErrorsAndWarnings, pprBagOfErrors, pprBagOfWarnings,
17 #include "HsVersions.h"
19 import Bag ( Bag, bagToList, isEmptyBag )
20 import SrcLoc ( SrcLoc, noSrcLoc )
21 import Util ( sortLt )
23 import IO ( hPutStr, stderr )
27 type MsgWithLoc = (SrcLoc, SDoc)
29 type ErrMsg = MsgWithLoc
30 type WarnMsg = MsgWithLoc
33 addShortErrLocLine :: SrcLoc -> Message -> ErrMsg
34 addErrLocHdrLine :: SrcLoc -> Message -> Message -> ErrMsg
35 addShortWarnLocLine :: SrcLoc -> Message -> WarnMsg
37 addShortErrLocLine locn rest_of_err_msg
39 , hang (ppr locn <> colon)
43 addErrLocHdrLine locn hdr rest_of_err_msg
45 , hang (ppr locn <> colon<+> hdr)
49 addShortWarnLocLine locn rest_of_err_msg
51 , hang (ppr locn <> colon)
52 4 (ptext SLIT("Warning:") <+> rest_of_err_msg)
55 dontAddErrLoc :: String -> Message -> ErrMsg
56 dontAddErrLoc title rest_of_err_msg
57 | null title = (noSrcLoc, rest_of_err_msg)
59 ( noSrcLoc, hang (text title <> colon) 4 rest_of_err_msg )
61 printErrorsAndWarnings :: Bag ErrMsg -> Bag WarnMsg -> IO ()
62 -- Don't print any warnings if there are errors
63 printErrorsAndWarnings errs warns
64 | no_errs && no_warns = return ()
65 | no_errs = printErrs (pprBagOfWarnings warns)
66 | otherwise = printErrs (pprBagOfErrors errs)
68 no_warns = isEmptyBag warns
69 no_errs = isEmptyBag errs
71 pprBagOfErrors :: Bag ErrMsg -> SDoc
72 pprBagOfErrors bag_of_errors
73 = vcat [text "" $$ p | (_,p) <- sorted_errs ]
75 bag_ls = bagToList bag_of_errors
76 sorted_errs = sortLt occ'ed_before bag_ls
78 occ'ed_before (a,_) (b,_) = LT == compare a b
80 pprBagOfWarnings :: Bag WarnMsg -> SDoc
81 pprBagOfWarnings bag_of_warns = pprBagOfErrors bag_of_warns
85 ghcExit :: Int -> IO ()
89 then hPutStr stderr "Compilation had errors\n"
94 doIfSet :: Bool -> IO () -> IO ()
95 doIfSet flag action | flag = action
96 | otherwise = return ()
100 dumpIfSet :: Bool -> String -> SDoc -> IO ()
101 dumpIfSet flag hdr doc
102 | not flag = return ()
103 | otherwise = printDump dump
105 dump = vcat [text "",
106 line <+> text hdr <+> line,
109 line = text (take 20 (repeat '='))