summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAaron Allen <aaron@flipstone.com>2021-06-26 16:40:27 -0500
committerAaron Allen <aaron@flipstone.com>2021-08-27 22:19:23 -0500
commit38748530b4530f6a7d4f7ec80ec838efbd13ab35 (patch)
tree5c0f8727c375e81d37bbd7873b272753e2b8e154
parente28773fce96e5252a8addb89535feb57b5738512 (diff)
downloadhaskell-38748530b4530f6a7d4f7ec80ec838efbd13ab35.tar.gz
Convert IFace Rename Errors (#19927)
Converts uses of TcRnUnknownMessage in GHC.Iface.Rename. Closes #19927
-rw-r--r--compiler/GHC/Iface/Rename.hs23
-rw-r--r--compiler/GHC/Tc/Errors/Ppr.hs17
-rw-r--r--compiler/GHC/Tc/Errors/Types.hs19
-rw-r--r--compiler/GHC/Types/Hint.hs4
-rw-r--r--compiler/GHC/Types/Hint/Ppr.hs6
-rw-r--r--testsuite/tests/backpack/should_fail/bkpfail30.stderr2
-rw-r--r--testsuite/tests/backpack/should_fail/bkpfail31.stderr2
-rw-r--r--testsuite/tests/backpack/should_fail/bkpfail34.stderr2
-rw-r--r--testsuite/tests/backpack/should_fail/bkpfail36.stderr2
9 files changed, 57 insertions, 20 deletions
diff --git a/compiler/GHC/Iface/Rename.hs b/compiler/GHC/Iface/Rename.hs
index ce49c7c976..e2a89570d3 100644
--- a/compiler/GHC/Iface/Rename.hs
+++ b/compiler/GHC/Iface/Rename.hs
@@ -68,14 +68,12 @@ tcRnModExports x y = do
hsc_env <- getTopEnv
tcRnMsgMaybe $ rnModExports hsc_env x y
-failWithRn :: SDoc -> ShIfM a
-failWithRn doc = do
+failWithRn :: TcRnMessage -> ShIfM a
+failWithRn tcRnMessage = do
errs_var <- fmap sh_if_errs getGblEnv
errs <- readTcRef errs_var
-- TODO: maybe associate this with a source location?
- let msg = mkPlainErrorMsgEnvelope noSrcSpan $
- TcRnUnknownMessage $
- mkPlainError noHints doc
+ let msg = mkPlainErrorMsgEnvelope noSrcSpan tcRnMessage
writeTcRef errs_var (msg `addMessage` errs)
failM
@@ -329,11 +327,8 @@ rnIfaceGlobal n = do
-- TODO: This will give an unpleasant message if n'
-- is a constructor; then we'll suggest adding T
-- but it won't work.
- Nothing -> failWithRn $ vcat [
- text "The identifier" <+> ppr (occName n') <+>
- text "does not exist in the local signature.",
- parens (text "Try adding it to the export list of the hsig file.")
- ]
+ Nothing ->
+ failWithRn $ TcRnIdNotExportedFromLocalSig n'
Just n'' -> return n''
-- Fastpath: we are renaming p[H=<H>]:A.T, in which case the
-- export list is irrelevant.
@@ -356,12 +351,8 @@ rnIfaceGlobal n = do
$ loadSysInterface (text "rnIfaceGlobal") m''
let nsubst = mkNameShape (moduleName m) (mi_exports iface)
case maybeSubstNameShape nsubst n of
- Nothing -> failWithRn $ vcat [
- text "The identifier" <+> ppr (occName n) <+>
- -- NB: report m' because it's more user-friendly
- text "does not exist in the signature for" <+> ppr m',
- parens (text "Try adding it to the export list in that hsig file.")
- ]
+ -- NB: report m' because it's more user-friendly
+ Nothing -> failWithRn $ TcRnIdNotExportedFromModuleSig n m'
Just n' -> return n'
-- | Rename an implicit name, e.g., a DFun or coercion axiom.
diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs
index c629c5f5e4..90be5526b9 100644
--- a/compiler/GHC/Tc/Errors/Ppr.hs
+++ b/compiler/GHC/Tc/Errors/Ppr.hs
@@ -17,6 +17,7 @@ import GHC.Types.Error
import GHC.Types.Name (pprPrefixName)
import GHC.Types.Name.Reader (pprNameProvenance)
import GHC.Types.SrcLoc (GenLocated(..))
+import GHC.Types.Name.Occurrence (occName)
import GHC.Types.Var.Env (emptyTidyEnv)
import GHC.Driver.Flags
import GHC.Hs
@@ -55,6 +56,14 @@ instance Diagnostic TcRnMessage where
-> mkDecorated [text "Use of plugins makes the module unsafe"]
TcRnModMissingRealSrcSpan mod
-> mkDecorated [text "Module does not have a RealSrcSpan:" <+> ppr mod]
+ TcRnIdNotExportedFromModuleSig name mod
+ -> mkDecorated [ text "The identifier" <+> ppr (occName name) <+>
+ text "does not exist in the signature for" <+> ppr mod
+ ]
+ TcRnIdNotExportedFromLocalSig name
+ -> mkDecorated [ text "The identifier" <+> ppr (occName name) <+>
+ text "does not exist in the local signature."
+ ]
TcRnShadowedName occ provenance
-> let shadowed_locs = case provenance of
ShadowedNameProvenanceLocal n -> [text "bound at" <+> ppr n]
@@ -183,6 +192,10 @@ instance Diagnostic TcRnMessage where
-> WarningWithoutFlag
TcRnModMissingRealSrcSpan{}
-> ErrorWithoutFlag
+ TcRnIdNotExportedFromModuleSig{}
+ -> ErrorWithoutFlag
+ TcRnIdNotExportedFromLocalSig{}
+ -> ErrorWithoutFlag
TcRnShadowedName{}
-> WarningWithFlag Opt_WarnNameShadowing
TcRnDuplicateWarningDecls{}
@@ -258,6 +271,10 @@ instance Diagnostic TcRnMessage where
-> noHints
TcRnModMissingRealSrcSpan{}
-> noHints
+ TcRnIdNotExportedFromModuleSig name mod
+ -> [SuggestAddToHSigExportList name $ Just mod]
+ TcRnIdNotExportedFromLocalSig name
+ -> [SuggestAddToHSigExportList name Nothing]
TcRnShadowedName{}
-> noHints
TcRnDuplicateWarningDecls{}
diff --git a/compiler/GHC/Tc/Errors/Types.hs b/compiler/GHC/Tc/Errors/Types.hs
index 282fccd1d6..82a908cf5a 100644
--- a/compiler/GHC/Tc/Errors/Types.hs
+++ b/compiler/GHC/Tc/Errors/Types.hs
@@ -175,7 +175,26 @@ data TcRnMessage where
Test cases: None
-}
TcRnModMissingRealSrcSpan :: Module -> TcRnMessage
+ {-| TcRnIdNotExportedFromModuleSig is an error pertaining to backpack that occurs
+ when an identifier required by a signature is not exported by the module
+ or signature that is being used as a substitution for that signature.
+ Example(s): None
+
+ Test cases: backpack/should_fail/bkpfail36
+ -}
+ TcRnIdNotExportedFromModuleSig :: Name -> Module -> TcRnMessage
+ {-| TcRnIdNotExportedFromLocalSig is an error pertaining to backpack that
+ occurs when an identifier which is necessary for implementing a module
+ signature is not exported from that signature.
+
+ Example(s): None
+
+ Test cases: backpack/should_fail/bkpfail30
+ backpack/should_fail/bkpfail31
+ backpack/should_fail/bkpfail34
+ -}
+ TcRnIdNotExportedFromLocalSig :: Name -> TcRnMessage
{-| TcRnShadowedName is a warning (controlled by -Wname-shadowing) that occurs whenever
an inner-scope value has the same name as an outer-scope value, i.e. the inner
diff --git a/compiler/GHC/Types/Hint.hs b/compiler/GHC/Types/Hint.hs
index 364bad8355..be8417f19c 100644
--- a/compiler/GHC/Types/Hint.hs
+++ b/compiler/GHC/Types/Hint.hs
@@ -20,6 +20,7 @@ import Data.Typeable
import GHC.Unit.Module (ModuleName, Module)
import GHC.Hs.Extension (GhcTc)
import GHC.Core.Coercion
+import GHC.Types.Name (Name)
import GHC.Types.Basic (Activation, RuleName)
import GHC.Parser.Errors.Basic
import {-# SOURCE #-} Language.Haskell.Syntax.Expr
@@ -190,6 +191,9 @@ data GhcHint
| SuggestAddInlineOrNoInlinePragma !Var !Activation
| SuggestAddPhaseToCompetingRule !RuleName
+ {-| Suggests adding an identifier to the export list of a signature.
+ -}
+ | SuggestAddToHSigExportList !Name !(Maybe Module)
{-| Suggests increasing the limit for the number of iterations in the simplifier.
-}
diff --git a/compiler/GHC/Types/Hint/Ppr.hs b/compiler/GHC/Types/Hint/Ppr.hs
index abb30d55d8..ab3478d4c4 100644
--- a/compiler/GHC/Types/Hint/Ppr.hs
+++ b/compiler/GHC/Types/Hint/Ppr.hs
@@ -14,6 +14,7 @@ import GHC.Types.Hint
import GHC.Hs.Expr () -- instance Outputable
import GHC.Types.Id
+import GHC.Unit.Types
import GHC.Utils.Outputable
import Data.List (intersperse)
@@ -98,6 +99,11 @@ instance Outputable GhcHint where
$$ text " including the definition module, you must qualify it."
SuggestTypeSignatureForm
-> text "A type signature should be of form <variables> :: <type>"
+ SuggestAddToHSigExportList _name mb_mod
+ -> let header = text "Try adding it to the export list of"
+ in case mb_mod of
+ Nothing -> header <+> text "the hsig file."
+ Just mod -> header <+> ppr (moduleName mod) <> text "'s hsig file."
perhapsAsPat :: SDoc
perhapsAsPat = text "Perhaps you meant an as-pattern, which must not be surrounded by whitespace"
diff --git a/testsuite/tests/backpack/should_fail/bkpfail30.stderr b/testsuite/tests/backpack/should_fail/bkpfail30.stderr
index 7d332560f6..7c4b8c1fc3 100644
--- a/testsuite/tests/backpack/should_fail/bkpfail30.stderr
+++ b/testsuite/tests/backpack/should_fail/bkpfail30.stderr
@@ -3,4 +3,4 @@
<no location info>: error:
The identifier T does not exist in the local signature.
- (Try adding it to the export list of the hsig file.)
+ Suggested fix: Try adding it to the export list of the hsig file.
diff --git a/testsuite/tests/backpack/should_fail/bkpfail31.stderr b/testsuite/tests/backpack/should_fail/bkpfail31.stderr
index ab599229ad..103e690943 100644
--- a/testsuite/tests/backpack/should_fail/bkpfail31.stderr
+++ b/testsuite/tests/backpack/should_fail/bkpfail31.stderr
@@ -5,4 +5,4 @@
<no location info>: error:
The identifier T does not exist in the local signature.
- (Try adding it to the export list of the hsig file.)
+ Suggested fix: Try adding it to the export list of the hsig file.
diff --git a/testsuite/tests/backpack/should_fail/bkpfail34.stderr b/testsuite/tests/backpack/should_fail/bkpfail34.stderr
index cbe8a1bdbe..f1d5d03153 100644
--- a/testsuite/tests/backpack/should_fail/bkpfail34.stderr
+++ b/testsuite/tests/backpack/should_fail/bkpfail34.stderr
@@ -5,4 +5,4 @@
<no location info>: error:
The identifier T does not exist in the local signature.
- (Try adding it to the export list of the hsig file.)
+ Suggested fix: Try adding it to the export list of the hsig file.
diff --git a/testsuite/tests/backpack/should_fail/bkpfail36.stderr b/testsuite/tests/backpack/should_fail/bkpfail36.stderr
index e031625aac..3ec5c6f56b 100644
--- a/testsuite/tests/backpack/should_fail/bkpfail36.stderr
+++ b/testsuite/tests/backpack/should_fail/bkpfail36.stderr
@@ -7,4 +7,4 @@
<no location info>: error:
The identifier T does not exist in the signature for <A>
- (Try adding it to the export list in that hsig file.)
+ Suggested fix: Try adding it to the export list of A's hsig file.