diff options
author | Rafal Gwozdzinski <rafal.gwozdzinski@gmail.com> | 2021-04-19 14:29:47 +0200 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-04-26 23:57:29 -0400 |
commit | b9e2491dee6bdc1edc35a023aa25d46f82622f23 (patch) | |
tree | 076c0988c706f88a1368b675db1f941e93686785 | |
parent | 6c7fff0b6f9514d6572cbe6bbfa4aafc259caebe (diff) | |
download | haskell-b9e2491dee6bdc1edc35a023aa25d46f82622f23.tar.gz |
Add GHC.Utils.Error.pprMessages
-rw-r--r-- | compiler/GHC/Driver/Main.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/Parser/Header.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/Types/Error.hs | 3 | ||||
-rw-r--r-- | compiler/GHC/Utils/Error.hs | 4 |
4 files changed, 8 insertions, 3 deletions
diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs index 296a855acf..cac12cae50 100644 --- a/compiler/GHC/Driver/Main.hs +++ b/compiler/GHC/Driver/Main.hs @@ -188,7 +188,7 @@ import GHC.Types.SourceError import GHC.Types.SafeHaskell import GHC.Types.ForeignStubs import GHC.Types.Var.Env ( emptyTidyEnv ) -import GHC.Types.Error +import GHC.Types.Error hiding ( getMessages ) import GHC.Types.Fixity.Env import GHC.Types.CostCentre import GHC.Types.IPE diff --git a/compiler/GHC/Parser/Header.hs b/compiler/GHC/Parser/Header.hs index c45cae45ca..84cbb5e0d4 100644 --- a/compiler/GHC/Parser/Header.hs +++ b/compiler/GHC/Parser/Header.hs @@ -39,7 +39,7 @@ import GHC.Hs import GHC.Unit.Module import GHC.Builtin.Names -import GHC.Types.Error hiding ( getErrorMessages, getWarningMessages ) +import GHC.Types.Error hiding ( getMessages, getErrorMessages, getWarningMessages ) import GHC.Types.SrcLoc import GHC.Types.SourceError import GHC.Types.SourceText diff --git a/compiler/GHC/Types/Error.hs b/compiler/GHC/Types/Error.hs index bf5481cc2c..fe45954310 100644 --- a/compiler/GHC/Types/Error.hs +++ b/compiler/GHC/Types/Error.hs @@ -8,6 +8,7 @@ module GHC.Types.Error , WarningMessages , ErrorMessages , mkMessages + , getMessages , emptyMessages , isEmptyMessages , addMessage @@ -76,7 +77,7 @@ a bit more declarative) or removed altogether. -- | A collection of messages emitted by GHC during error reporting. A diagnostic message is typically -- a warning or an error. See Note [Messages]. -newtype Messages e = Messages (Bag (MsgEnvelope e)) +newtype Messages e = Messages { getMessages :: Bag (MsgEnvelope e) } instance Functor Messages where fmap f (Messages xs) = Messages (mapBag (fmap f) xs) diff --git a/compiler/GHC/Utils/Error.hs b/compiler/GHC/Utils/Error.hs index d18791d0c6..99bff97a5b 100644 --- a/compiler/GHC/Utils/Error.hs +++ b/compiler/GHC/Utils/Error.hs @@ -26,6 +26,7 @@ module GHC.Utils.Error ( -- ** Formatting pprMessageBag, pprMsgEnvelopeBagWithLoc, + pprMessages, pprLocMsgEnvelope, formatBulleted, @@ -222,6 +223,9 @@ formatBulleted ctx (unDecorated -> docs) msgs = filter (not . Outputable.isEmpty ctx) docs starred = (bullet<+>) +pprMessages :: Diagnostic e => Messages e -> SDoc +pprMessages = vcat . pprMsgEnvelopeBagWithLoc . getMessages + pprMsgEnvelopeBagWithLoc :: Diagnostic e => Bag (MsgEnvelope e) -> [SDoc] pprMsgEnvelopeBagWithLoc bag = [ pprLocMsgEnvelope item | item <- sortMsgBag Nothing bag ] |