{-# LANGUAGE FlexibleContexts #-} module GHC.Iface.Errors ( badIfaceFile , hiModuleNameMismatchWarn , homeModError , cannotFindInterface , cantFindInstalledErr , cannotFindModule , cantFindErr -- * Utility functions , mayShowLocations ) where import GHC.Platform.Profile import GHC.Platform.Ways import GHC.Utils.Panic.Plain import GHC.Driver.Session import GHC.Driver.Env import GHC.Driver.Errors.Types import GHC.Data.Maybe import GHC.Prelude import GHC.Unit import GHC.Unit.Env import GHC.Unit.Finder.Types import GHC.Utils.Outputable as Outputable badIfaceFile :: String -> SDoc -> SDoc badIfaceFile file err = vcat [text "Bad interface file:" <+> text file, nest 4 err] hiModuleNameMismatchWarn :: Module -> Module -> SDoc hiModuleNameMismatchWarn requested_mod read_mod | moduleUnit requested_mod == moduleUnit read_mod = sep [text "Interface file contains module" <+> quotes (ppr read_mod) <> comma, text "but we were expecting module" <+> quotes (ppr requested_mod), sep [text "Probable cause: the source code which generated interface file", text "has an incompatible module name" ] ] | otherwise = -- ToDo: This will fail to have enough qualification when the package IDs -- are the same withPprStyle (mkUserStyle alwaysQualify AllTheWay) $ -- we want the Modules below to be qualified with package names, -- so reset the PrintUnqualified setting. hsep [ text "Something is amiss; requested module " , ppr requested_mod , text "differs from name found in the interface file" , ppr read_mod , parens (text "if these names look the same, try again with -dppr-debug") ] homeModError :: InstalledModule -> ModLocation -> SDoc -- See Note [Home module load error] homeModError mod location = text "attempting to use module " <> quotes (ppr mod) <> (case ml_hs_file location of Just file -> space <> parens (text file) Nothing -> Outputable.empty) <+> text "which is not loaded" -- ----------------------------------------------------------------------------- -- Error messages cannotFindInterface :: UnitState -> Maybe HomeUnit -> Profile -> ([FilePath] -> SDoc) -> ModuleName -> InstalledFindResult -> SDoc cannotFindInterface = cantFindInstalledErr (text "Failed to load interface for") (text "Ambiguous interface for") cantFindInstalledErr :: SDoc -> SDoc -> UnitState -> Maybe HomeUnit -> Profile -> ([FilePath] -> SDoc) -> ModuleName -> InstalledFindResult -> SDoc cantFindInstalledErr cannot_find _ unit_state mhome_unit profile tried_these mod_name find_result = cannot_find <+> quotes (ppr mod_name) $$ more_info where build_tag = waysBuildTag (profileWays profile) more_info = case find_result of InstalledNoPackage pkg -> text "no unit id matching" <+> quotes (ppr pkg) <+> text "was found" $$ looks_like_srcpkgid pkg InstalledNotFound files mb_pkg | Just pkg <- mb_pkg , notHomeUnitId mhome_unit pkg -> not_found_in_package pkg files | null files -> text "It is not a module in the current program, or in any known package." | otherwise -> tried_these files _ -> panic "cantFindInstalledErr" looks_like_srcpkgid :: UnitId -> SDoc looks_like_srcpkgid pk -- Unsafely coerce a unit id (i.e. an installed package component -- identifier) into a PackageId and see if it means anything. | (pkg:pkgs) <- searchPackageId unit_state (PackageId (unitIdFS pk)) = parens (text "This unit ID looks like the source package ID;" $$ text "the real unit ID is" <+> quotes (ftext (unitIdFS (unitId pkg))) $$ (if null pkgs then Outputable.empty else text "and" <+> int (length pkgs) <+> text "other candidates")) -- Todo: also check if it looks like a package name! | otherwise = Outputable.empty not_found_in_package pkg files | build_tag /= "" = let build = if build_tag == "p" then "profiling" else "\"" ++ build_tag ++ "\"" in text "Perhaps you haven't installed the " <> text build <> text " libraries for package " <> quotes (ppr pkg) <> char '?' $$ tried_these files | otherwise = text "There are files missing in the " <> quotes (ppr pkg) <> text " package," $$ text "try running 'ghc-pkg check'." $$ tried_these files mayShowLocations :: DynFlags -> [FilePath] -> SDoc mayShowLocations dflags files | null files = Outputable.empty | verbosity dflags < 3 = text "Use -v (or `:set -v` in ghci) " <> text "to see a list of the files searched for." | otherwise = hang (text "Locations searched:") 2 $ vcat (map text files) cannotFindModule :: HscEnv -> ModuleName -> FindResult -> SDoc cannotFindModule hsc_env = cannotFindModule' (hsc_dflags hsc_env) (hsc_unit_env hsc_env) (targetProfile (hsc_dflags hsc_env)) cannotFindModule' :: DynFlags -> UnitEnv -> Profile -> ModuleName -> FindResult -> SDoc cannotFindModule' dflags unit_env profile mod res = pprWithUnitState (ue_units unit_env) $ cantFindErr (checkBuildingCabalPackage dflags) cannotFindMsg (text "Ambiguous module name") unit_env profile (mayShowLocations dflags) mod res where cannotFindMsg = case res of NotFound { fr_mods_hidden = hidden_mods , fr_pkgs_hidden = hidden_pkgs , fr_unusables = unusables } | not (null hidden_mods && null hidden_pkgs && null unusables) -> text "Could not load module" _ -> text "Could not find module" cantFindErr :: BuildingCabalPackage -- ^ Using Cabal? -> SDoc -> SDoc -> UnitEnv -> Profile -> ([FilePath] -> SDoc) -> ModuleName -> FindResult -> SDoc cantFindErr _ _ multiple_found _ _ _ mod_name (FoundMultiple mods) | Just pkgs <- unambiguousPackages = hang (multiple_found <+> quotes (ppr mod_name) <> colon) 2 ( sep [text "it was found in multiple packages:", hsep (map ppr pkgs) ] ) | otherwise = hang (multiple_found <+> quotes (ppr mod_name) <> colon) 2 ( vcat (map pprMod mods) ) where unambiguousPackages = foldl' unambiguousPackage (Just []) mods unambiguousPackage (Just xs) (m, ModOrigin (Just _) _ _ _) = Just (moduleUnit m : xs) unambiguousPackage _ _ = Nothing pprMod (m, o) = text "it is bound as" <+> ppr m <+> text "by" <+> pprOrigin m o pprOrigin _ ModHidden = panic "cantFindErr: bound by mod hidden" pprOrigin _ (ModUnusable _) = panic "cantFindErr: bound by mod unusable" pprOrigin m (ModOrigin e res _ f) = sep $ punctuate comma ( if e == Just True then [text "package" <+> ppr (moduleUnit m)] else [] ++ map ((text "a reexport in package" <+>) .ppr.mkUnit) res ++ if f then [text "a package flag"] else [] ) cantFindErr using_cabal cannot_find _ unit_env profile tried_these mod_name find_result = cannot_find <+> quotes (ppr mod_name) $$ more_info where mhome_unit = ue_homeUnit unit_env more_info = case find_result of NoPackage pkg -> text "no unit id matching" <+> quotes (ppr pkg) <+> text "was found" NotFound { fr_paths = files, fr_pkg = mb_pkg , fr_mods_hidden = mod_hiddens, fr_pkgs_hidden = pkg_hiddens , fr_unusables = unusables, fr_suggestions = suggest } | Just pkg <- mb_pkg , Nothing <- mhome_unit -- no home-unit -> not_found_in_package pkg files | Just pkg <- mb_pkg , Just home_unit <- mhome_unit -- there is a home-unit but the , not (isHomeUnit home_unit pkg) -- module isn't from it -> not_found_in_package pkg files | not (null suggest) -> pp_suggestions suggest $$ tried_these files | null files && null mod_hiddens && null pkg_hiddens && null unusables -> text "It is not a module in the current program, or in any known package." | otherwise -> vcat (map pkg_hidden pkg_hiddens) $$ vcat (map mod_hidden mod_hiddens) $$ vcat (map unusable unusables) $$ tried_these files _ -> panic "cantFindErr" build_tag = waysBuildTag (profileWays profile) not_found_in_package pkg files | build_tag /= "" = let build = if build_tag == "p" then "profiling" else "\"" ++ build_tag ++ "\"" in text "Perhaps you haven't installed the " <> text build <> text " libraries for package " <> quotes (ppr pkg) <> char '?' $$ tried_these files | otherwise = text "There are files missing in the " <> quotes (ppr pkg) <> text " package," $$ text "try running 'ghc-pkg check'." $$ tried_these files pkg_hidden :: Unit -> SDoc pkg_hidden uid = text "It is a member of the hidden package" <+> quotes (ppr uid) --FIXME: we don't really want to show the unit id here we should -- show the source package id or installed package id if it's ambiguous <> dot $$ pkg_hidden_hint uid pkg_hidden_hint uid | using_cabal == YesBuildingCabalPackage = let pkg = expectJust "pkg_hidden" (lookupUnit (ue_units unit_env) uid) in text "Perhaps you need to add" <+> quotes (ppr (unitPackageName pkg)) <+> text "to the build-depends in your .cabal file." | Just pkg <- lookupUnit (ue_units unit_env) uid = text "You can run" <+> quotes (text ":set -package " <> ppr (unitPackageName pkg)) <+> text "to expose it." $$ text "(Note: this unloads all the modules in the current scope.)" | otherwise = Outputable.empty mod_hidden pkg = text "it is a hidden module in the package" <+> quotes (ppr pkg) unusable (pkg, reason) = text "It is a member of the package" <+> quotes (ppr pkg) $$ pprReason (text "which is") reason pp_suggestions :: [ModuleSuggestion] -> SDoc pp_suggestions sugs | null sugs = Outputable.empty | otherwise = hang (text "Perhaps you meant") 2 (vcat (map pp_sugg sugs)) -- NB: Prefer the *original* location, and then reexports, and then -- package flags when making suggestions. ToDo: if the original package -- also has a reexport, prefer that one pp_sugg (SuggestVisible m mod o) = ppr m <+> provenance o where provenance ModHidden = Outputable.empty provenance (ModUnusable _) = Outputable.empty provenance (ModOrigin{ fromOrigUnit = e, fromExposedReexport = res, fromPackageFlag = f }) | Just True <- e = parens (text "from" <+> ppr (moduleUnit mod)) | f && moduleName mod == m = parens (text "from" <+> ppr (moduleUnit mod)) | (pkg:_) <- res = parens (text "from" <+> ppr (mkUnit pkg) <> comma <+> text "reexporting" <+> ppr mod) | f = parens (text "defined via package flags to be" <+> ppr mod) | otherwise = Outputable.empty pp_sugg (SuggestHidden m mod o) = ppr m <+> provenance o where provenance ModHidden = Outputable.empty provenance (ModUnusable _) = Outputable.empty provenance (ModOrigin{ fromOrigUnit = e, fromHiddenReexport = rhs }) | Just False <- e = parens (text "needs flag -package-id" <+> ppr (moduleUnit mod)) | (pkg:_) <- rhs = parens (text "needs flag -package-id" <+> ppr (mkUnit pkg)) | otherwise = Outputable.empty