ghc/compiler/main/ErrUtils.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1994-1998
   3 %
   4 \section[ErrsUtils]{Utilities for error reporting}
   5
   6 \begin{code}
   7 module ErrUtils (
   8         ErrMsg, WarnMsg, Message,
   9         addShortErrLocLine, addShortWarnLocLine,
  10         addErrLocHdrLine,
  11         dontAddErrLoc,
  12         pprBagOfErrors, pprBagOfWarnings,
  13         ghcExit,
  14         doIfSet, dumpIfSet
  15     ) where
  16
  17 #include "HsVersions.h"
  18
  19 import Bag              ( Bag, bagToList )
  20 import SrcLoc           ( SrcLoc, noSrcLoc )
  21 import Util             ( sortLt )
  22 import Outputable
  23 \end{code}
  24
  25 \begin{code}
  26 type MsgWithLoc = (SrcLoc, SDoc)
  27
  28 type ErrMsg  = MsgWithLoc
  29 type WarnMsg = MsgWithLoc
  30 type Message = SDoc
  31
  32 addShortErrLocLine  :: SrcLoc -> Message -> ErrMsg
  33 addErrLocHdrLine    :: SrcLoc -> Message -> Message -> ErrMsg
  34 addShortWarnLocLine :: SrcLoc -> Message -> WarnMsg
  35
  36 addShortErrLocLine locn rest_of_err_msg
  37   = ( locn
  38     , hang (ppr locn <> colon)
  39          4 rest_of_err_msg
  40     )
  41
  42 addErrLocHdrLine locn hdr rest_of_err_msg
  43   = ( locn
  44     , hang (ppr locn <> colon<+> hdr)
  45          4 rest_of_err_msg
  46     )
  47
  48 addShortWarnLocLine locn rest_of_err_msg
  49   = ( locn
  50     , hang (ppr locn <> colon)
  51          4 (ptext SLIT("Warning:") <+> rest_of_err_msg)
  52     )
  53
  54 dontAddErrLoc :: String -> Message -> ErrMsg
  55 dontAddErrLoc title rest_of_err_msg
  56  | null title = (noSrcLoc, rest_of_err_msg)
  57  | otherwise  =
  58     ( noSrcLoc, hang (text title <> colon) 4 rest_of_err_msg )
  59
  60 pprBagOfErrors :: Bag ErrMsg -> SDoc
  61 pprBagOfErrors bag_of_errors
  62   = vcat [p $$ text "" | (_,p) <- sorted_errs ]
  63     where
  64       bag_ls      = bagToList bag_of_errors
  65       sorted_errs = sortLt occ'ed_before bag_ls
  66
  67       occ'ed_before (a,_) (b,_) = LT == compare a b
  68
  69 pprBagOfWarnings :: Bag WarnMsg -> SDoc
  70 pprBagOfWarnings bag_of_warns = pprBagOfErrors bag_of_warns
  71 \end{code}
  72
  73 \begin{code}
  74 ghcExit :: Int -> IO ()
  75
  76 ghcExit val
  77   = if val /= 0
  78     then error "Compilation had errors\n"
  79     else return ()
  80 \end{code}
  81
  82 \begin{code}
  83 doIfSet :: Bool -> IO () -> IO ()
  84 doIfSet flag action | flag      = action
  85                     | otherwise = return ()
  86 \end{code}
  87
  88 \begin{code}
  89 dumpIfSet :: Bool -> String -> SDoc -> IO ()
  90 dumpIfSet flag hdr doc
  91   | not flag  = return ()
  92   | otherwise = printDump dump
  93   where
  94     dump = vcat [text "",
  95                  line <+> text hdr <+> line,
  96                  doc,
  97                  text ""]
  98     line = text (take 20 (repeat '='))
  99 \end{code}