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 )
26 type MsgWithLoc = (SrcLoc, SDoc)
28 type ErrMsg = MsgWithLoc
29 type WarnMsg = MsgWithLoc
32 addShortErrLocLine :: SrcLoc -> Message -> ErrMsg
33 addErrLocHdrLine :: SrcLoc -> Message -> Message -> ErrMsg
34 addShortWarnLocLine :: SrcLoc -> Message -> WarnMsg
36 addShortErrLocLine locn rest_of_err_msg
38 , hang (ppr locn <> colon)
42 addErrLocHdrLine locn hdr rest_of_err_msg
44 , hang (ppr locn <> colon<+> hdr)
48 addShortWarnLocLine locn rest_of_err_msg
50 , hang (ppr locn <> colon)
51 4 (ptext SLIT("Warning:") <+> rest_of_err_msg)
54 dontAddErrLoc :: String -> Message -> ErrMsg
55 dontAddErrLoc title rest_of_err_msg
56 | null title = (noSrcLoc, rest_of_err_msg)
58 ( noSrcLoc, hang (text title <> colon) 4 rest_of_err_msg )
60 printErrorsAndWarnings :: Bag ErrMsg -> Bag WarnMsg -> IO ()
61 -- Don't print any warnings if there are errors
62 printErrorsAndWarnings errs warns
63 | no_errs && no_warns = return ()
64 | no_errs = printErrs (pprBagOfWarnings warns)
65 | otherwise = printErrs (pprBagOfErrors errs)
67 no_warns = isEmptyBag warns
68 no_errs = isEmptyBag errs
70 pprBagOfErrors :: Bag ErrMsg -> SDoc
71 pprBagOfErrors bag_of_errors
72 = vcat [text "" $$ p | (_,p) <- sorted_errs ]
74 bag_ls = bagToList bag_of_errors
75 sorted_errs = sortLt occ'ed_before bag_ls
77 occ'ed_before (a,_) (b,_) = LT == compare a b
79 pprBagOfWarnings :: Bag WarnMsg -> SDoc
80 pprBagOfWarnings bag_of_warns = pprBagOfErrors bag_of_warns
84 ghcExit :: Int -> IO ()
88 then error "Compilation had errors\n"
93 doIfSet :: Bool -> IO () -> IO ()
94 doIfSet flag action | flag = action
95 | otherwise = return ()
99 dumpIfSet :: Bool -> String -> SDoc -> IO ()
100 dumpIfSet flag hdr doc
101 | not flag = return ()
102 | otherwise = printDump dump
104 dump = vcat [text "",
105 line <+> text hdr <+> line,
108 line = text (take 20 (repeat '='))