diff options
| -rw-r--r-- | compiler/main/ErrUtils.hs | 59 |
1 files changed, 33 insertions, 26 deletions
diff --git a/compiler/main/ErrUtils.hs b/compiler/main/ErrUtils.hs index 9fc9e4902b..5e585da26e 100644 --- a/compiler/main/ErrUtils.hs +++ b/compiler/main/ErrUtils.hs @@ -7,29 +7,35 @@ {-# LANGUAGE CPP #-} module ErrUtils ( - MsgDoc, + -- * Basic types Validity(..), andValid, allValid, isValid, getInvalids, + Severity(..), - ErrMsg, ErrDoc, errDoc, WarnMsg, Severity(..), + -- * Messages + MsgDoc, ErrMsg, ErrDoc, errDoc, WarnMsg, Messages, ErrorMessages, WarningMessages, errMsgSpan, errMsgContext, - mkLocMessage, pprMessageBag, pprErrMsgBagWithLoc, - pprLocErrMsg, makeIntoWarning, + errorsFound, isEmptyMessages, - errorsFound, emptyMessages, isEmptyMessages, + -- ** Formatting + pprMessageBag, pprErrMsgBagWithLoc, + pprLocErrMsg, printBagOfErrors, + + -- ** Construction + emptyMessages, mkLocMessage, makeIntoWarning, mkErrMsg, mkPlainErrMsg, mkErrDoc, mkLongErrMsg, mkWarnMsg, mkPlainWarnMsg, - printBagOfErrors, warnIsErrorMsg, mkLongWarnMsg, - ghcExit, + -- * Utilities doIfSet, doIfSet_dyn, + + -- * Dump files dumpIfSet, dumpIfSet_dyn, dumpIfSet_dyn_printer, mkDumpDoc, dumpSDoc, - openDumpFiles, closeDumpFiles, - -- * Messages during compilation + -- * Issuing messages during compilation putMsg, printInfoForUser, printOutputForUser, logInfo, logOutput, errorMsg, warningMsg, @@ -37,7 +43,7 @@ module ErrUtils ( compilationProgressMsg, showPass, debugTraceMsg, - + ghcExit, prettyPrintGhcErrors, ) where @@ -69,8 +75,8 @@ type MsgDoc = SDoc ------------------------- data Validity - = IsValid -- Everything is fine - | NotValid MsgDoc -- A problem, and some indication of why + = IsValid -- ^ Everything is fine + | NotValid MsgDoc -- ^ A problem, and some indication of why isValid :: Validity -> Bool isValid IsValid = True @@ -80,7 +86,8 @@ andValid :: Validity -> Validity -> Validity andValid IsValid v = v andValid v _ = v -allValid :: [Validity] -> Validity -- If they aren't all valid, return the first +-- | If they aren't all valid, return the first +allValid :: [Validity] -> Validity allValid [] = IsValid allValid (v : vs) = v `andValid` allValid vs @@ -127,16 +134,16 @@ data Severity | SevInteractive | SevDump - -- Log messagse intended for compiler developers + -- ^ Log messagse intended for compiler developers -- No file/line/column stuff | SevInfo - -- Log messages intended for end users. + -- ^ Log messages intended for end users. -- No file/line/column stuff. | SevWarning | SevError - -- SevWarning and SevError are used for warnings and errors + -- ^ SevWarning and SevError are used for warnings and errors -- o The message has a file/line/column heading, -- plus "warning:" or "error:", -- added by mkLocMessags @@ -186,11 +193,11 @@ mkErrDoc :: DynFlags -> SrcSpan -> PrintUnqualified -> ErrDoc -> ErrMsg mkErrDoc dflags = mk_err_msg dflags SevError mkLongErrMsg, mkLongWarnMsg :: DynFlags -> SrcSpan -> PrintUnqualified -> MsgDoc -> MsgDoc -> ErrMsg --- A long (multi-line) error message +-- ^ A long (multi-line) error message mkErrMsg, mkWarnMsg :: DynFlags -> SrcSpan -> PrintUnqualified -> MsgDoc -> ErrMsg --- A short (one-line) error message +-- ^ A short (one-line) error message mkPlainErrMsg, mkPlainWarnMsg :: DynFlags -> SrcSpan -> MsgDoc -> ErrMsg --- Variant that doesn't care about qualified/unqualified names +-- ^ Variant that doesn't care about qualified/unqualified names mkLongErrMsg dflags locn unqual msg extra = mk_err_msg dflags SevError locn unqual (ErrDoc [msg] [] [extra]) mkErrMsg dflags locn unqual msg = mk_err_msg dflags SevError locn unqual (ErrDoc [msg] [] []) @@ -330,14 +337,14 @@ closeDumpFiles dflags mapM_ hClose $ Map.elems gd -- | Write out a dump. --- If --dump-to-file is set then this goes to a file. --- otherwise emit to stdout. +-- If --dump-to-file is set then this goes to a file. +-- otherwise emit to stdout. -- --- When hdr is empty, we print in a more compact format (no separators and +-- When @hdr@ is empty, we print in a more compact format (no separators and -- blank lines) -- --- The DumpFlag is used only to choose the filename to use if --dump-to-file is --- used; it is not used to decide whether to dump the output +-- The 'DumpFlag' is used only to choose the filename to use if @--dump-to-file@ +-- is used; it is not used to decide whether to dump the output dumpSDoc :: DynFlags -> PrintUnqualified -> DumpFlag -> String -> SDoc -> IO () dumpSDoc dflags print_unqual flag hdr doc = do let mFile = chooseDumpFile dflags flag @@ -361,7 +368,7 @@ dumpSDoc dflags print_unqual flag hdr doc | otherwise = (mkDumpDoc hdr doc, SevDump) log_action dflags dflags severity noSrcSpan dump_style doc' --- | Return a handle assigned to the 'fileName' +-- | Return a handle assigned to the given filename. -- -- If the requested file doesn't exist the new one will be created getDumpFileHandle :: DynFlags -> FilePath -> IO Handle @@ -486,7 +493,7 @@ logInfo :: DynFlags -> PprStyle -> MsgDoc -> IO () logInfo dflags sty msg = log_action dflags dflags SevInfo noSrcSpan sty msg logOutput :: DynFlags -> PprStyle -> MsgDoc -> IO () --- Like logInfo but with SevOutput rather then SevInfo +-- ^ Like 'logInfo' but with 'SevOutput' rather then 'SevInfo' logOutput dflags sty msg = log_action dflags dflags SevOutput noSrcSpan sty msg prettyPrintGhcErrors :: ExceptionMonad m => DynFlags -> m a -> m a |