Commit 562cf83d authored by Alfredo Di Napoli's avatar Alfredo Di Napoli

Naming consistency for DriverWarning and DriverError

This commit uses a Driver prefix for driver errors and
warnings, as well as converting one more driver warning from
SDoc into something more structured.
parent 2a0c0fcb
......@@ -59,7 +59,7 @@ instance RenderableDiagnostic GhcError where
instance RenderableDiagnostic DriverError where
renderDiagnostic = \case
DriverError d
DriverErrorRaw d
-> d
DriverCannotFindModule dflags m res
......@@ -85,7 +85,7 @@ instance RenderableDiagnostic DriverError where
instance RenderableDiagnostic DriverWarning where
renderDiagnostic = \case
WarnModuleInferredUnsafe df modName badInsts whyUnsafe
DriverWarnModuleInferredUnsafe df modName badInsts whyUnsafe
-> errDoc [ vcat [ quotes (ppr modName) <+> text "has been inferred as unsafe!"
, text "Reason:"
, nest 4 $ (vcat $ badFlags df) $+$
......@@ -110,3 +110,10 @@ instance RenderableDiagnostic DriverWarning where
checkOverlap (NoOverlap _) = False
checkOverlap _ = True
DriverWarnInferredSafeImports modName
-> errDoc [ sep [ text "Importing Safe-Inferred module "
<> ppr modName
<> text " from explicitly Safe module"
]
] [] []
......@@ -2,21 +2,27 @@
module GHC.Driver.Errors.Types (
GhcError(..)
, GhcWarning(..)
, DriverError(..) -- TODO(adinapoli) Naming consistency.
, DriverError(..)
, DriverWarning(..)
-- * Constructing Driver warnings
, mkDriverWarn
-- * Converting an ErrDoc into a GhcError in a lossy way
, ghcErrorRawErrDoc
) where
import GHC.Core.InstEnv ( ClsInst )
import GHC.Driver.Flags
import GHC.Driver.Session ( DynFlags )
import GHC.Prelude ( String )
import GHC.Tc.Errors.Ppr ()
import GHC.Types.Error ( ErrDoc, WarningMessages )
import GHC.Types.Error
import GHC.Types.SrcLoc
import GHC.Unit.Finder.Types ( FindResult )
import GHC.Unit.Module.Name ( ModuleName )
import GHC.Unit.Types ( UnitId, Module )
import GHC.Utils.Outputable
import qualified GHC.Driver.CmdLine as CmdLine
import qualified GHC.Parser.Errors as Parser
import qualified GHC.Tc.Errors.Types as TcRn
......@@ -31,6 +37,7 @@ data GhcWarning
| GhcWarningDs !TcRn.DsWarning
-- ^ A warning raised during desugaring.
| GhcWarningCmdLine !CmdLine.Warn
-- ^ A warning raised in the cmdline.
| GhcWarningDriver !DriverWarning
-- ^ A warning raised in the driver.
| GhcWarningDemotedErr !GhcError
......@@ -62,15 +69,23 @@ data GhcError
ghcErrorRawErrDoc :: ErrDoc -> GhcError
ghcErrorRawErrDoc = GhcErrorRaw
-- | An error which can arise in the driver.
data DriverError
= DriverCannotFindModule DynFlags ModuleName FindResult
| DriverNotAnExpression String
= DriverCannotFindModule !DynFlags !ModuleName !FindResult
| DriverNotAnExpression !String
| DriverParseErrorImport
| DriverPkgRequiredTrusted DynFlags UnitId
| DriverCantLoadIfaceForSafe Module
| DriverError ErrDoc
| DriverPkgRequiredTrusted !DynFlags !UnitId
| DriverCantLoadIfaceForSafe !Module
| DriverErrorRaw !ErrDoc
type Reasons = WarningMessages TcRn.Warning
-- | A warning which can arise in the driver.
data DriverWarning
= WarnModuleInferredUnsafe DynFlags ModuleName [ClsInst] Reasons
= DriverWarnModuleInferredUnsafe !DynFlags !ModuleName [ClsInst] Reasons
| DriverWarnInferredSafeImports !ModuleName
-- | Construct an structured error out of the input driver 'Warning'.
mkDriverWarn :: WarnReason -> SrcSpan -> PrintUnqualified -> DriverWarning -> ErrMsg DriverWarning
mkDriverWarn reason loc qual warn =
makeIntoWarning reason (mkErr loc qual warn)
......@@ -103,6 +103,7 @@ import GHC.Driver.Errors ( GhcWarning(..)
, printOrThrowWarnings
, printBagOfErrors
, warningsToMessages
, mkDriverWarn
)
import GHC.Driver.CodeOutput
import GHC.Driver.Config
......@@ -1313,28 +1314,23 @@ hscCheckSafe' m l = do
&& safeLanguageOn dflags
&& trust == Sf_SafeInferred
then inferredImportWarn
else mempty
else emptyBag
-- General errors we throw but Safe errors we log
errs = case (safeM, safeP) of
(True, True ) -> emptyBag
(True, False) -> pkgTrustErr
(False, _ ) -> modTrustErr
in do
logWarnings warns
logWarnings (mkWarningMessages warns)
logWarnings $
demoteErrorsToWarnings (GhcWarningDemotedErr . GhcErrorRaw) (mkErrorMessages errs)
return (trust == Sf_Trustworthy, pkgRs)
where
state = unitState dflags
inferredImportWarn = fmap GhcWarningRaw $ mkWarningMessages $ unitBag
$ makeIntoWarning (Reason Opt_WarnInferredSafeImports)
$ mkWarnMsg l (pkgQual state)
$ sep
[ text "Importing Safe-Inferred module "
<> ppr (moduleName m)
<> text " from explicitly Safe module"
]
inferredImportWarn = unitBag . fmap GhcWarningDriver $
mkDriverWarn (Reason Opt_WarnInferredSafeImports)
l (pkgQual state) (DriverWarnInferredSafeImports (moduleName m))
pkgTrustErr = unitBag $ mkErrMsg l (pkgQual state) $
sep [ ppr (moduleName m)
<> text ": Can't be safely imported!"
......@@ -1424,8 +1420,8 @@ markUnsafeInfer tcg_env whyUnsafe = do
where
wiped_trust = (tcg_imports tcg_env) { imp_trust_pkgs = S.empty }
whyUnsafe' df = WarnModuleInferredUnsafe df (moduleName $ tcg_mod tcg_env)
(tcg_insts tcg_env) whyUnsafe
whyUnsafe' df = DriverWarnModuleInferredUnsafe df (moduleName $ tcg_mod tcg_env)
(tcg_insts tcg_env) whyUnsafe
-- | Figure out the final correct safe haskell mode
hscGetSafeMode :: TcGblEnv -> Hsc SafeHaskellMode
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment