Remove ErrDoc and MsgDoc

This commit boldly removes the ErrDoc and the MsgDoc from the codebase.
The former was introduced with the only purpose of classifying errors
according to their importance, but a similar result can be obtained just
by having a simple [SDoc], and placing bullets after each of them.

On top of that I have taken the perhaps controversial decision to also
banish MsgDoc, as it was merely a type alias over an SDoc and as such it wasn't
offering any extra type safety. Granted, it was perhaps making type
signatures slightly more "focused", but at the expense of cognitive
burden: if it's really just an SDoc, let's call it with its proper name.

1 files changed, 22 insertions, 23 deletions

diff --git a/compiler/GHC/Utils/Error.hs b/compiler/GHC/Utils/Error.hs
index f371b17953..05d98c9ed8 100644
--- a/compiler/GHC/Utils/Error.hs
+++ b/compiler/GHC/Utils/Error.hs
@@ -15,9 +15,8 @@ module GHC.Utils.Error (
 
         -- * Messages
         ErrMsg(..),
-        ErrDoc(..), errDoc,
-        mapErrDoc,
-        WarnMsg, MsgDoc,
+        WarnMsg,
+        SDoc,
         Messages, ErrorMessages, WarningMessages,
         unionMessages,
         errorsFound, isEmptyMessages,
@@ -91,11 +90,10 @@ import System.IO
 import GHC.Conc         ( getAllocationCounter )
 import System.CPUTime
 
-
 -------------------------
 data Validity
   = IsValid            -- ^ Everything is fine
-  | NotValid MsgDoc    -- ^ A problem, and some indication of why
+  | NotValid SDoc    -- ^ A problem, and some indication of why
 
 isValid :: Validity -> Bool
 isValid IsValid       = True
@@ -110,7 +108,7 @@ allValid :: [Validity] -> Validity
 allValid []       = IsValid
 allValid (v : vs) = v `andValid` allValid vs
 
-getInvalids :: [Validity] -> [MsgDoc]
+getInvalids :: [Validity] -> [SDoc]
 getInvalids vs = [d | NotValid d <- vs]
 
 orValid :: Validity -> Validity -> Validity
@@ -121,17 +119,18 @@ orValid _       v = v
 -- Collecting up messages for later ordering and printing.
 
 ----------------
-formatErrDoc :: SDocContext -> ErrDoc -> SDoc
-formatErrDoc ctx (ErrDoc important context supplementary)
+-- | Formats the input list of structured document, where each element of the list gets a bullet.
+formatErrDoc :: SDocContext -> [SDoc] -> SDoc
+formatErrDoc ctx docs
   = case msgs of
-        [msg] -> vcat msg
-        _ -> vcat $ map starred msgs
+        []    -> Outputable.empty
+        [msg] -> msg
+        _     -> vcat $ map starred msgs
     where
-    msgs = filter (not . null) $ map (filter (not . Outputable.isEmpty ctx))
-        [important, context, supplementary]
-    starred = (bullet<+>) . vcat
+    msgs    = filter (not . Outputable.isEmpty ctx) docs
+    starred = (bullet<+>)
 
-pprErrMsgBagWithLoc :: Bag (ErrMsg ErrDoc) -> [SDoc]
+pprErrMsgBagWithLoc :: Bag (ErrMsg [SDoc]) -> [SDoc]
 pprErrMsgBagWithLoc bag = [ pprLocErrMsg item | item <- sortMsgBag Nothing bag ]
 
 pprLocErrMsg :: RenderableDiagnostic e => ErrMsg e -> SDoc
@@ -353,15 +352,15 @@ ifVerbose dflags val act
   | otherwise               = return ()
 {-# INLINE ifVerbose #-}  -- see Note [INLINE conditional tracing utilities]
 
-errorMsg :: DynFlags -> MsgDoc -> IO ()
+errorMsg :: DynFlags -> SDoc -> IO ()
 errorMsg dflags msg
    = putLogMsg dflags NoReason SevError noSrcSpan $ withPprStyle defaultErrStyle msg
 
-warningMsg :: DynFlags -> MsgDoc -> IO ()
+warningMsg :: DynFlags -> SDoc -> IO ()
 warningMsg dflags msg
    = putLogMsg dflags NoReason SevWarning noSrcSpan $ withPprStyle defaultErrStyle msg
 
-fatalErrorMsg :: DynFlags -> MsgDoc -> IO ()
+fatalErrorMsg :: DynFlags -> SDoc -> IO ()
 fatalErrorMsg dflags msg =
     putLogMsg dflags NoReason SevFatal noSrcSpan $ withPprStyle defaultErrStyle msg
 
@@ -528,29 +527,29 @@ withTiming' dflags what force_result prtimings action
           eventBeginsDoc ctx w = showSDocOneLine ctx $ text "GHC:started:" <+> w
           eventEndsDoc   ctx w = showSDocOneLine ctx $ text "GHC:finished:" <+> w
 
-debugTraceMsg :: DynFlags -> Int -> MsgDoc -> IO ()
+debugTraceMsg :: DynFlags -> Int -> SDoc -> IO ()
 debugTraceMsg dflags val msg =
    ifVerbose dflags val $
       logInfo dflags (withPprStyle defaultDumpStyle msg)
 {-# INLINE debugTraceMsg #-}  -- see Note [INLINE conditional tracing utilities]
 
-putMsg :: DynFlags -> MsgDoc -> IO ()
+putMsg :: DynFlags -> SDoc -> IO ()
 putMsg dflags msg = logInfo dflags (withPprStyle defaultUserStyle msg)
 
-printInfoForUser :: DynFlags -> PrintUnqualified -> MsgDoc -> IO ()
+printInfoForUser :: DynFlags -> PrintUnqualified -> SDoc -> IO ()
 printInfoForUser dflags print_unqual msg
   = logInfo dflags (withUserStyle print_unqual AllTheWay msg)
 
-printOutputForUser :: DynFlags -> PrintUnqualified -> MsgDoc -> IO ()
+printOutputForUser :: DynFlags -> PrintUnqualified -> SDoc -> IO ()
 printOutputForUser dflags print_unqual msg
   = logOutput dflags (withUserStyle print_unqual AllTheWay msg)
 
-logInfo :: DynFlags -> MsgDoc -> IO ()
+logInfo :: DynFlags -> SDoc -> IO ()
 logInfo dflags msg
   = putLogMsg dflags NoReason SevInfo noSrcSpan msg
 
 -- | Like 'logInfo' but with 'SevOutput' rather then 'SevInfo'
-logOutput :: DynFlags -> MsgDoc -> IO ()
+logOutput :: DynFlags -> SDoc -> IO ()
 logOutput dflags msg
   = putLogMsg dflags NoReason SevOutput noSrcSpan msg