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
  11         Error(..),
  12         addErrLoc, addShortErrLocLine,
  13         dontAddErrLoc, pprBagOfErrors
  14
  15     ) where
  16
  17 import Ubiq{-uitous-}
  18
  19 import Bag              ( bagToList )
  20 import PprStyle         ( PprStyle(..) )
  21 import Pretty
  22 import SrcLoc           ( mkUnknownSrcLoc, SrcLoc{-instance-} )
  23 \end{code}
  24
  25 \begin{code}
  26 type Error   = PprStyle -> Pretty
  27
  28 addErrLoc :: SrcLoc -> String -> Error -> Error
  29 addErrLoc locn title rest_of_err_msg sty
  30   = ppHang (ppBesides [ppr PprForUser locn,
  31                        if null title then ppNil else ppStr (": " ++ title),
  32                        ppChar ':'])
  33          4 (rest_of_err_msg sty)
  34
  35 addShortErrLocLine :: SrcLoc -> Error -> Error
  36 addShortErrLocLine locn rest_of_err_msg sty
  37   = ppHang (ppBeside (ppr PprForUser locn) (ppChar ':'))
  38          4 (rest_of_err_msg sty)
  39
  40 dontAddErrLoc :: String -> Error -> Error
  41 dontAddErrLoc title rest_of_err_msg sty
  42   = ppHang (ppBesides [ppStr title, ppChar ':'])
  43          4 (rest_of_err_msg sty)
  44
  45 pprBagOfErrors :: PprStyle -> Bag Error -> Pretty
  46 pprBagOfErrors sty bag_of_errors
  47   = let  pretties = map ( \ e -> e sty ) (bagToList bag_of_errors)  in
  48     ppAboves (map (\ p -> ppAbove ppSP p) pretties)
  49 \end{code}
  50