[commit: ghc] master: ErrUtils: Spruce up Haddocks (0d1a2d2)
git at git.haskell.org
git at git.haskell.org
Wed Dec 2 20:56:06 UTC 2015
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/0d1a2d23be3c980d9710294fe52d010690a2e56e/ghc
>---------------------------------------------------------------
commit 0d1a2d23be3c980d9710294fe52d010690a2e56e
Author: Ben Gamari <ben at smart-cactus.org>
Date: Wed Dec 2 20:59:25 2015 +0100
ErrUtils: Spruce up Haddocks
This is a pretty commonly needed module; Haddocks are worth the effort.
>---------------------------------------------------------------
0d1a2d23be3c980d9710294fe52d010690a2e56e
compiler/main/ErrUtils.hs | 59 ++++++++++++++++++++++++++---------------------
1 file changed, 33 insertions(+), 26 deletions(-)
diff --git a/compiler/main/ErrUtils.hs b/compiler/main/ErrUtils.hs
index 9fc9e49..5e585da 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
More information about the ghc-commits
mailing list