ghc/compiler/main/ErrUtils.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1994-1995
   3 %
   4 \section[ErrsUtils]{Utilities for error reporting}
   5
   6 \begin{code}
   7 #include "HsVersions.h"
   8
   9 module ErrUtils (
  10         Error(..), Warning(..), Message(..),
  11         addErrLoc,
  12         addShortErrLocLine, addShortWarnLocLine,
  13         dontAddErrLoc,
  14         pprBagOfErrors,
  15         ghcExit
  16     ) where
  17
  18 IMP_Ubiq(){-uitous-}
  19
  20 import Bag              ( bagToList )
  21 import PprStyle         ( PprStyle(..) )
  22 import Pretty
  23 import SrcLoc           ( mkUnknownSrcLoc, SrcLoc{-instance-} )
  24 \end{code}
  25
  26 \begin{code}
  27 type Error   = PprStyle -> Pretty
  28 type Warning = PprStyle -> Pretty
  29 type Message = PprStyle -> Pretty
  30
  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),
  35                        ppChar ':'])
  36          4 (rest_of_err_msg sty)
  37
  38 addShortErrLocLine, addShortWarnLocLine :: SrcLoc -> Error -> Error
  39
  40 addShortErrLocLine locn rest_of_err_msg sty
  41   = ppHang (ppBeside (ppr PprForUser locn) (ppChar ':'))
  42          4 (rest_of_err_msg sty)
  43
  44 addShortWarnLocLine locn rest_of_err_msg sty
  45   = ppHang (ppBeside (ppr PprForUser locn) (ppPStr SLIT(":warning:")))
  46          4 (rest_of_err_msg sty)
  47
  48 dontAddErrLoc :: String -> Error -> Error
  49 dontAddErrLoc title rest_of_err_msg sty
  50   = ppHang (ppBesides [ppStr title, ppChar ':'])
  51          4 (rest_of_err_msg sty)
  52
  53 pprBagOfErrors :: PprStyle -> Bag Error -> Pretty
  54 pprBagOfErrors sty bag_of_errors
  55   = let  pretties = map ( \ e -> e sty ) (bagToList bag_of_errors)  in
  56     ppAboves (map (\ p -> ppAbove ppSP p) pretties)
  57 \end{code}
  58
  59 \begin{code}
  60 ghcExit :: Int -> IO ()
  61
  62 ghcExit val
  63   = if val /= 0
  64     then error "Compilation had errors\n"
  65     else return ()
  66 \end{code}