2 % (c) The AQUA Project, Glasgow University, 1994-1995
4 \section[ErrsUtils]{Utilities for error reporting}
7 #include "HsVersions.h"
12 addErrLoc, addShortErrLocLine,
13 dontAddErrLoc, pprBagOfErrors,
15 TcError(..), TcWarning(..), Message(..),
22 import Bag ( bagToList )
23 import PprStyle ( PprStyle(..) )
25 import SrcLoc ( mkUnknownSrcLoc, SrcLoc{-instance-} )
29 type Error = PprStyle -> Pretty
31 addErrLoc :: SrcLoc -> String -> Error -> Error
32 addErrLoc locn title rest_of_err_msg sty
33 = ppHang (ppBesides [ppr PprForUser locn,
34 if null title then ppNil else ppStr (": " ++ title),
36 4 (rest_of_err_msg sty)
38 addShortErrLocLine :: SrcLoc -> Error -> Error
39 addShortErrLocLine locn rest_of_err_msg sty
40 = ppHang (ppBeside (ppr PprForUser locn) (ppChar ':'))
41 4 (rest_of_err_msg sty)
43 dontAddErrLoc :: String -> Error -> Error
44 dontAddErrLoc title rest_of_err_msg sty
45 = ppHang (ppBesides [ppStr title, ppChar ':'])
46 4 (rest_of_err_msg sty)
48 pprBagOfErrors :: PprStyle -> Bag Error -> Pretty
49 pprBagOfErrors sty bag_of_errors
50 = let pretties = map ( \ e -> e sty ) (bagToList bag_of_errors) in
51 ppAboves (map (\ p -> ppAbove ppSP p) pretties)
58 type Message = PprStyle -> Pretty
59 type TcError = Message
60 type TcWarning = Message
63 mkTcErr :: SrcLoc -- Where
64 -> [Message] -- Context
65 -> Message -- What went wrong
66 -> TcError -- The complete error report
68 mkTcErr locn ctxt msg sty
69 = ppHang (ppBesides [ppr PprForUser locn, ppStr ": ", msg sty])
70 4 (ppAboves [msg sty | msg <- ctxt])
73 arityErr kind name n m sty =
74 ppBesides [ ppStr "`", ppr sty name, ppStr "' should have ",
75 n_arguments, ppStr ", but has been given ", ppInt m, ppChar '.']
77 errmsg = kind ++ " has too " ++ quantity ++ " arguments"
78 quantity | m < n = "few"
80 n_arguments | n == 0 = ppStr "no arguments"
81 | n == 1 = ppStr "1 argument"
82 | True = ppCat [ppInt n, ppStr "arguments"]