2 % (c) The AQUA Project, Glasgow University, 1994-1998
4 \section[ErrsUtils]{Utilities for error reporting}
8 ErrMsg, WarnMsg, Message,
9 addShortErrLocLine, addShortWarnLocLine,
12 pprBagOfErrors, pprBagOfWarnings,
17 #include "HsVersions.h"
19 import Bag ( Bag, bagToList )
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 <> ptext SLIT(": Warning:"))
54 dontAddErrLoc :: String -> Message -> ErrMsg
55 dontAddErrLoc title rest_of_err_msg
56 | null title = (noSrcLoc, rest_of_err_msg)
58 ( noSrcLoc, hang (hcat [text title, char ':'])
61 pprBagOfErrors :: Bag ErrMsg -> SDoc
62 pprBagOfErrors bag_of_errors
63 = vcat [p $$ text "" | (_,p) <- sorted_errs ]
65 bag_ls = bagToList bag_of_errors
66 sorted_errs = sortLt occ'ed_before bag_ls
68 occ'ed_before (a,_) (b,_) = LT == compare a b
70 pprBagOfWarnings :: Bag WarnMsg -> SDoc
71 pprBagOfWarnings bag_of_warns = pprBagOfErrors bag_of_warns
75 ghcExit :: Int -> IO ()
79 then error "Compilation had errors\n"
84 doIfSet :: Bool -> IO () -> IO ()
85 doIfSet flag action | flag = action
86 | otherwise = return ()
90 dumpIfSet :: Bool -> String -> SDoc -> IO ()
91 dumpIfSet flag hdr doc
92 | not flag = return ()
93 | otherwise = printDump dump
96 line <+> text hdr <+> line,
99 line = text (take 20 (repeat '='))