ghc-8.4.1: rename/RnUnbound.hs
{-
This module contains helper functions for reporting and creating
unbound variables.
-}
module RnUnbound ( mkUnboundName
, mkUnboundNameRdr
, isUnboundName
, reportUnboundName
, unknownNameSuggestions
, WhereLooking(..)
, unboundName
, unboundNameX
, perhapsForallMsg ) where
import GhcPrelude
import RdrName
import HscTypes
import TcRnMonad
import Name
import Module
import SrcLoc
import Outputable
import PrelNames ( mkUnboundName, forall_tv_RDR, isUnboundName )
import Util
import Maybes
import DynFlags
import FastString
import Data.List
import Data.Function ( on )
{-
************************************************************************
* *
What to do when a lookup fails
* *
************************************************************************
-}
data WhereLooking = WL_Any -- Any binding
| WL_Global -- Any top-level binding (local or imported)
| WL_LocalTop -- Any top-level binding in this module
| WL_LocalOnly
-- Only local bindings
-- (pattern synonyms declaractions,
-- see Note [Renaming pattern synonym variables])
mkUnboundNameRdr :: RdrName -> Name
mkUnboundNameRdr rdr = mkUnboundName (rdrNameOcc rdr)
reportUnboundName :: RdrName -> RnM Name
reportUnboundName rdr = unboundName WL_Any rdr
unboundName :: WhereLooking -> RdrName -> RnM Name
unboundName wl rdr = unboundNameX wl rdr Outputable.empty
unboundNameX :: WhereLooking -> RdrName -> SDoc -> RnM Name
unboundNameX where_look rdr_name extra
= do { dflags <- getDynFlags
; let show_helpful_errors = gopt Opt_HelpfulErrors dflags
what = pprNonVarNameSpace (occNameSpace (rdrNameOcc rdr_name))
err = unknownNameErr what rdr_name $$ extra
; if not show_helpful_errors
then addErr err
else do { local_env <- getLocalRdrEnv
; global_env <- getGlobalRdrEnv
; impInfo <- getImports
; let suggestions = unknownNameSuggestions_ where_look
dflags global_env local_env impInfo rdr_name
; addErr (err $$ suggestions) }
; return (mkUnboundNameRdr rdr_name) }
unknownNameErr :: SDoc -> RdrName -> SDoc
unknownNameErr what rdr_name
= vcat [ hang (text "Not in scope:")
2 (what <+> quotes (ppr rdr_name))
, extra ]
where
extra | rdr_name == forall_tv_RDR = perhapsForallMsg
| otherwise = Outputable.empty
type HowInScope = Either SrcSpan ImpDeclSpec
-- Left loc => locally bound at loc
-- Right ispec => imported as specified by ispec
-- | Called from the typechecker (TcErrors) when we find an unbound variable
unknownNameSuggestions :: DynFlags
-> GlobalRdrEnv -> LocalRdrEnv -> ImportAvails
-> RdrName -> SDoc
unknownNameSuggestions = unknownNameSuggestions_ WL_Any
unknownNameSuggestions_ :: WhereLooking -> DynFlags
-> GlobalRdrEnv -> LocalRdrEnv -> ImportAvails
-> RdrName -> SDoc
unknownNameSuggestions_ where_look dflags global_env local_env imports tried_rdr_name =
similarNameSuggestions where_look dflags global_env local_env tried_rdr_name $$
importSuggestions where_look imports tried_rdr_name $$
extensionSuggestions tried_rdr_name
similarNameSuggestions :: WhereLooking -> DynFlags
-> GlobalRdrEnv -> LocalRdrEnv
-> RdrName -> SDoc
similarNameSuggestions where_look dflags global_env
local_env tried_rdr_name
= case suggest of
[] -> Outputable.empty
[p] -> perhaps <+> pp_item p
ps -> sep [ perhaps <+> text "one of these:"
, nest 2 (pprWithCommas pp_item ps) ]
where
all_possibilities :: [(String, (RdrName, HowInScope))]
all_possibilities
= [ (showPpr dflags r, (r, Left loc))
| (r,loc) <- local_possibilities local_env ]
++ [ (showPpr dflags r, rp) | (r, rp) <- global_possibilities global_env ]
suggest = fuzzyLookup (showPpr dflags tried_rdr_name) all_possibilities
perhaps = text "Perhaps you meant"
pp_item :: (RdrName, HowInScope) -> SDoc
pp_item (rdr, Left loc) = pp_ns rdr <+> quotes (ppr rdr) <+> loc' -- Locally defined
where loc' = case loc of
UnhelpfulSpan l -> parens (ppr l)
RealSrcSpan l -> parens (text "line" <+> int (srcSpanStartLine l))
pp_item (rdr, Right is) = pp_ns rdr <+> quotes (ppr rdr) <+> -- Imported
parens (text "imported from" <+> ppr (is_mod is))
pp_ns :: RdrName -> SDoc
pp_ns rdr | ns /= tried_ns = pprNameSpace ns
| otherwise = Outputable.empty
where ns = rdrNameSpace rdr
tried_occ = rdrNameOcc tried_rdr_name
tried_is_sym = isSymOcc tried_occ
tried_ns = occNameSpace tried_occ
tried_is_qual = isQual tried_rdr_name
correct_name_space occ = nameSpacesRelated (occNameSpace occ) tried_ns
&& isSymOcc occ == tried_is_sym
-- Treat operator and non-operators as non-matching
-- This heuristic avoids things like
-- Not in scope 'f'; perhaps you meant '+' (from Prelude)
local_ok = case where_look of { WL_Any -> True
; WL_LocalOnly -> True
; _ -> False }
local_possibilities :: LocalRdrEnv -> [(RdrName, SrcSpan)]
local_possibilities env
| tried_is_qual = []
| not local_ok = []
| otherwise = [ (mkRdrUnqual occ, nameSrcSpan name)
| name <- localRdrEnvElts env
, let occ = nameOccName name
, correct_name_space occ]
gre_ok :: GlobalRdrElt -> Bool
gre_ok = case where_look of
WL_LocalTop -> isLocalGRE
WL_LocalOnly -> const False
_ -> const True
global_possibilities :: GlobalRdrEnv -> [(RdrName, (RdrName, HowInScope))]
global_possibilities global_env
| tried_is_qual = [ (rdr_qual, (rdr_qual, how))
| gre <- globalRdrEnvElts global_env
, gre_ok gre
, let name = gre_name gre
occ = nameOccName name
, correct_name_space occ
, (mod, how) <- quals_in_scope gre
, let rdr_qual = mkRdrQual mod occ ]
| otherwise = [ (rdr_unqual, pair)
| gre <- globalRdrEnvElts global_env
, gre_ok gre
, let name = gre_name gre
occ = nameOccName name
rdr_unqual = mkRdrUnqual occ
, correct_name_space occ
, pair <- case (unquals_in_scope gre, quals_only gre) of
(how:_, _) -> [ (rdr_unqual, how) ]
([], pr:_) -> [ pr ] -- See Note [Only-quals]
([], []) -> [] ]
-- Note [Only-quals]
-- The second alternative returns those names with the same
-- OccName as the one we tried, but live in *qualified* imports
-- e.g. if you have:
--
-- > import qualified Data.Map as Map
-- > foo :: Map
--
-- then we suggest @Map.Map@.
--------------------
unquals_in_scope :: GlobalRdrElt -> [HowInScope]
unquals_in_scope (GRE { gre_name = n, gre_lcl = lcl, gre_imp = is })
| lcl = [ Left (nameSrcSpan n) ]
| otherwise = [ Right ispec
| i <- is, let ispec = is_decl i
, not (is_qual ispec) ]
--------------------
quals_in_scope :: GlobalRdrElt -> [(ModuleName, HowInScope)]
-- Ones for which the qualified version is in scope
quals_in_scope (GRE { gre_name = n, gre_lcl = lcl, gre_imp = is })
| lcl = case nameModule_maybe n of
Nothing -> []
Just m -> [(moduleName m, Left (nameSrcSpan n))]
| otherwise = [ (is_as ispec, Right ispec)
| i <- is, let ispec = is_decl i ]
--------------------
quals_only :: GlobalRdrElt -> [(RdrName, HowInScope)]
-- Ones for which *only* the qualified version is in scope
quals_only (GRE { gre_name = n, gre_imp = is })
= [ (mkRdrQual (is_as ispec) (nameOccName n), Right ispec)
| i <- is, let ispec = is_decl i, is_qual ispec ]
-- | Generate helpful suggestions if a qualified name Mod.foo is not in scope.
importSuggestions :: WhereLooking -> ImportAvails -> RdrName -> SDoc
importSuggestions where_look imports rdr_name
| WL_LocalOnly <- where_look = Outputable.empty
| not (isQual rdr_name || isUnqual rdr_name) = Outputable.empty
| null interesting_imports
, Just name <- mod_name
= hsep
[ text "No module named"
, quotes (ppr name)
, text "is imported."
]
| is_qualified
, null helpful_imports
, [(mod,_)] <- interesting_imports
= hsep
[ text "Module"
, quotes (ppr mod)
, text "does not export"
, quotes (ppr occ_name) <> dot
]
| is_qualified
, null helpful_imports
, mods <- map fst interesting_imports
= hsep
[ text "Neither"
, quotedListWithNor (map ppr mods)
, text "exports"
, quotes (ppr occ_name) <> dot
]
| [(mod,imv)] <- helpful_imports_non_hiding
= fsep
[ text "Perhaps you want to add"
, quotes (ppr occ_name)
, text "to the import list"
, text "in the import of"
, quotes (ppr mod)
, parens (ppr (imv_span imv)) <> dot
]
| not (null helpful_imports_non_hiding)
= fsep
[ text "Perhaps you want to add"
, quotes (ppr occ_name)
, text "to one of these import lists:"
]
$$
nest 2 (vcat
[ quotes (ppr mod) <+> parens (ppr (imv_span imv))
| (mod,imv) <- helpful_imports_non_hiding
])
| [(mod,imv)] <- helpful_imports_hiding
= fsep
[ text "Perhaps you want to remove"
, quotes (ppr occ_name)
, text "from the explicit hiding list"
, text "in the import of"
, quotes (ppr mod)
, parens (ppr (imv_span imv)) <> dot
]
| not (null helpful_imports_hiding)
= fsep
[ text "Perhaps you want to remove"
, quotes (ppr occ_name)
, text "from the hiding clauses"
, text "in one of these imports:"
]
$$
nest 2 (vcat
[ quotes (ppr mod) <+> parens (ppr (imv_span imv))
| (mod,imv) <- helpful_imports_hiding
])
| otherwise
= Outputable.empty
where
is_qualified = isQual rdr_name
(mod_name, occ_name) = case rdr_name of
Unqual occ_name -> (Nothing, occ_name)
Qual mod_name occ_name -> (Just mod_name, occ_name)
_ -> error "importSuggestions: dead code"
-- What import statements provide "Mod" at all
-- or, if this is an unqualified name, are not qualified imports
interesting_imports = [ (mod, imp)
| (mod, mod_imports) <- moduleEnvToList (imp_mods imports)
, Just imp <- return $ pick (importedByUser mod_imports)
]
-- We want to keep only one for each original module; preferably one with an
-- explicit import list (for no particularly good reason)
pick :: [ImportedModsVal] -> Maybe ImportedModsVal
pick = listToMaybe . sortBy (compare `on` prefer) . filter select
where select imv = case mod_name of Just name -> imv_name imv == name
Nothing -> not (imv_qualified imv)
prefer imv = (imv_is_hiding imv, imv_span imv)
-- Which of these would export a 'foo'
-- (all of these are restricted imports, because if they were not, we
-- wouldn't have an out-of-scope error in the first place)
helpful_imports = filter helpful interesting_imports
where helpful (_,imv)
= not . null $ lookupGlobalRdrEnv (imv_all_exports imv) occ_name
-- Which of these do that because of an explicit hiding list resp. an
-- explicit import list
(helpful_imports_hiding, helpful_imports_non_hiding)
= partition (imv_is_hiding . snd) helpful_imports
extensionSuggestions :: RdrName -> SDoc
extensionSuggestions rdrName
| rdrName == mkUnqual varName (fsLit "mdo") ||
rdrName == mkUnqual varName (fsLit "rec")
= text "Perhaps you meant to use RecursiveDo"
| otherwise = Outputable.empty
perhapsForallMsg :: SDoc
perhapsForallMsg
= vcat [ text "Perhaps you intended to use ExplicitForAll or similar flag"
, text "to enable explicit-forall syntax: forall <tvs>. <type>"]