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 )
24 import System ( ExitCode(..), exitWith )
25 import IO ( hPutStr, stderr )
29 type MsgWithLoc = (SrcLoc, SDoc)
31 type ErrMsg = MsgWithLoc
32 type WarnMsg = MsgWithLoc
35 addShortErrLocLine :: SrcLoc -> Message -> ErrMsg
36 addErrLocHdrLine :: SrcLoc -> Message -> Message -> ErrMsg
37 addShortWarnLocLine :: SrcLoc -> Message -> WarnMsg
39 addShortErrLocLine locn rest_of_err_msg
41 , hang (ppr locn <> colon)
45 addErrLocHdrLine locn hdr rest_of_err_msg
47 , hang (ppr locn <> colon<+> hdr)
51 addShortWarnLocLine locn rest_of_err_msg
53 , hang (ppr locn <> colon)
54 4 (ptext SLIT("Warning:") <+> rest_of_err_msg)
57 dontAddErrLoc :: String -> Message -> ErrMsg
58 dontAddErrLoc title rest_of_err_msg
59 | null title = (noSrcLoc, rest_of_err_msg)
61 ( noSrcLoc, hang (text title <> colon) 4 rest_of_err_msg )
63 printErrorsAndWarnings :: Bag ErrMsg -> Bag WarnMsg -> IO ()
64 -- Don't print any warnings if there are errors
65 printErrorsAndWarnings errs warns
66 | no_errs && no_warns = return ()
67 | no_errs = printErrs (pprBagOfWarnings warns)
68 | otherwise = printErrs (pprBagOfErrors errs)
70 no_warns = isEmptyBag warns
71 no_errs = isEmptyBag errs
73 pprBagOfErrors :: Bag ErrMsg -> SDoc
74 pprBagOfErrors bag_of_errors
75 = vcat [text "" $$ p | (_,p) <- sorted_errs ]
77 bag_ls = bagToList bag_of_errors
78 sorted_errs = sortLt occ'ed_before bag_ls
80 occ'ed_before (a,_) (b,_) = LT == compare a b
82 pprBagOfWarnings :: Bag WarnMsg -> SDoc
83 pprBagOfWarnings bag_of_warns = pprBagOfErrors bag_of_warns
87 ghcExit :: Int -> IO ()
89 | val == 0 = exitWith ExitSuccess
90 | otherwise = do hPutStr stderr "\nCompilation had errors\n\n"
91 exitWith (ExitFailure val)
95 doIfSet :: Bool -> IO () -> IO ()
96 doIfSet flag action | flag = action
97 | otherwise = return ()
101 dumpIfSet :: Bool -> String -> SDoc -> IO ()
102 dumpIfSet flag hdr doc
103 | not flag = return ()
104 | otherwise = printDump dump
106 dump = vcat [text "",
107 line <+> text hdr <+> line,
110 line = text (take 20 (repeat '='))