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         SYN_IE(Error), SYN_IE(Warning), SYN_IE(Message),
  11         addErrLoc,
  12         addShortErrLocLine, addShortWarnLocLine,
  13         dontAddErrLoc,
  14         pprBagOfErrors,
  15         ghcExit
  16     ) where
  17
  18 IMP_Ubiq(){-uitous-}
  19
  20 import CmdLineOpts      ( opt_PprUserLength )
  21 import Bag              --( bagToList )
  22 import Outputable       ( PprStyle(..), Outputable(..) )
  23 import Pretty
  24 import SrcLoc           ( noSrcLoc, SrcLoc{-instance-} )
  25 \end{code}
  26
  27 \begin{code}
  28 type Error   = PprStyle -> Doc
  29 type Warning = PprStyle -> Doc
  30 type Message = PprStyle -> Doc
  31
  32 addErrLoc :: SrcLoc -> String -> Error -> Error
  33 addErrLoc locn title rest_of_err_msg sty
  34   = hang (hcat [ppr (PprForUser opt_PprUserLength) locn,
  35                 if null title then empty else text (": " ++ title),
  36                 char ':'])
  37          4 (rest_of_err_msg sty)
  38
  39 addShortErrLocLine, addShortWarnLocLine :: SrcLoc -> Error -> Error
  40
  41 addShortErrLocLine locn rest_of_err_msg sty
  42   = hang ((<>) (ppr (PprForUser opt_PprUserLength) locn) (char ':'))
  43          4 (rest_of_err_msg sty)
  44
  45 addShortWarnLocLine locn rest_of_err_msg sty
  46   = hang ((<>) (ppr (PprForUser opt_PprUserLength) locn) (ptext SLIT(":warning:")))
  47          4 (rest_of_err_msg sty)
  48
  49 dontAddErrLoc :: String -> Error -> Error
  50 dontAddErrLoc title rest_of_err_msg sty
  51   = hang (hcat [text title, char ':'])
  52          4 (rest_of_err_msg sty)
  53
  54 pprBagOfErrors :: PprStyle -> Bag Error -> Doc
  55 pprBagOfErrors sty bag_of_errors
  56   = let  pretties = map ( \ e -> e sty ) (bagToList bag_of_errors)  in
  57     vcat (map (\ p -> ($$) space p) pretties)
  58 \end{code}
  59
  60 \begin{code}
  61 ghcExit :: Int -> IO ()
  62
  63 ghcExit val
  64   = if val /= 0
  65     then error "Compilation had errors\n"
  66     else return ()
  67 \end{code}