Remove errShortString, cleanup error-related functions

This commit removes the errShortString field from the ErrMsg type,
allowing us to cleanup a lot of dynflag-dependent error functions, and
move them in a more specialised 'GHC.Driver.Errors' closer to the
driver, where they are actually used.

Metric Increase:
  T4801
  T9961

1 files changed, 43 insertions, 4 deletions

diff --git a/compiler/GHC/Types/Error.hs b/compiler/GHC/Types/Error.hs
index cb624c6c99..6737edcda4 100644
--- a/compiler/GHC/Types/Error.hs
+++ b/compiler/GHC/Types/Error.hs
@@ -18,6 +18,14 @@ module GHC.Types.Error
    , getSeverityColour
    , getCaretDiagnostic
    , makeIntoWarning
+   -- * Constructing individual errors
+   , mkErrMsg
+   , mkPlainErrMsg
+   , mkErrDoc
+   , mkLongErrMsg
+   , mkWarnMsg
+   , mkPlainWarnMsg
+   , mkLongWarnMsg
    )
 where
 
@@ -41,14 +49,12 @@ type ErrorMessages   = Bag ErrMsg
 type MsgDoc          = SDoc
 type WarnMsg         = ErrMsg
 
-
+-- | The main 'GHC' error type.
 data ErrMsg = ErrMsg
    { errMsgSpan        :: SrcSpan
       -- ^ The SrcSpan is used for sorting errors into line-number order
    , errMsgContext     :: PrintUnqualified
    , errMsgDoc         :: ErrDoc
-   , errMsgShortString :: String
-      -- ^ This has the same text as errDocImportant . errMsgDoc.
    , errMsgSeverity    :: Severity
    , errMsgReason      :: WarnReason
    }
@@ -102,7 +108,12 @@ instance ToJson Severity where
   json s = JSString (show s)
 
 instance Show ErrMsg where
-    show em = errMsgShortString em
+    show = showErrMsg
+
+-- | Shows an 'ErrMsg'.
+showErrMsg :: ErrMsg -> String
+showErrMsg err =
+  renderWithContext defaultSDocContext (vcat (errDocImportant $ errMsgDoc err))
 
 pprMessageBag :: Bag MsgDoc -> SDoc
 pprMessageBag msgs = vcat (punctuate blankLine (bagToList msgs))
@@ -238,3 +249,31 @@ makeIntoWarning reason err = err
     { errMsgSeverity = SevWarning
     , errMsgReason = reason }
 
+--
+-- Creating ErrMsg(s)
+--
+
+mk_err_msg :: Severity -> SrcSpan -> PrintUnqualified -> ErrDoc -> ErrMsg
+mk_err_msg sev locn print_unqual err
+ = ErrMsg { errMsgSpan = locn
+          , errMsgContext = print_unqual
+          , errMsgDoc = err
+          , errMsgSeverity = sev
+          , errMsgReason = NoReason }
+
+mkErrDoc :: SrcSpan -> PrintUnqualified -> ErrDoc -> ErrMsg
+mkErrDoc = mk_err_msg SevError
+
+mkLongErrMsg, mkLongWarnMsg   :: SrcSpan -> PrintUnqualified -> MsgDoc -> MsgDoc -> ErrMsg
+-- ^ A long (multi-line) error message
+mkErrMsg, mkWarnMsg           :: SrcSpan -> PrintUnqualified -> MsgDoc            -> ErrMsg
+-- ^ A short (one-line) error message
+mkPlainErrMsg, mkPlainWarnMsg :: SrcSpan ->                     MsgDoc            -> ErrMsg
+-- ^ Variant that doesn't care about qualified/unqualified names
+
+mkLongErrMsg   locn unqual msg extra = mk_err_msg SevError   locn unqual        (ErrDoc [msg] [] [extra])
+mkErrMsg       locn unqual msg       = mk_err_msg SevError   locn unqual        (ErrDoc [msg] [] [])
+mkPlainErrMsg  locn        msg       = mk_err_msg SevError   locn alwaysQualify (ErrDoc [msg] [] [])
+mkLongWarnMsg  locn unqual msg extra = mk_err_msg SevWarning locn unqual        (ErrDoc [msg] [] [extra])
+mkWarnMsg      locn unqual msg       = mk_err_msg SevWarning locn unqual        (ErrDoc [msg] [] [])
+mkPlainWarnMsg locn        msg       = mk_err_msg SevWarning locn alwaysQualify (ErrDoc [msg] [] [])