never executed always true always false
    1 
    2 {-# LANGUAGE FlexibleContexts #-}
    3 
    4 module GHC.Iface.Errors
    5   ( badIfaceFile
    6   , hiModuleNameMismatchWarn
    7   , homeModError
    8   , cannotFindInterface
    9   , cantFindInstalledErr
   10   , cannotFindModule
   11   , cantFindErr
   12   -- * Utility functions
   13   , mayShowLocations
   14   ) where
   15 
   16 import GHC.Platform.Profile
   17 import GHC.Platform.Ways
   18 import GHC.Utils.Panic.Plain
   19 import GHC.Driver.Session
   20 import GHC.Driver.Env.Types
   21 import GHC.Driver.Errors.Types
   22 import GHC.Data.Maybe
   23 import GHC.Prelude
   24 import GHC.Unit
   25 import GHC.Unit.Env
   26 import GHC.Unit.Finder.Types
   27 import GHC.Utils.Outputable as Outputable
   28 
   29 
   30 badIfaceFile :: String -> SDoc -> SDoc
   31 badIfaceFile file err
   32   = vcat [text "Bad interface file:" <+> text file,
   33           nest 4 err]
   34 
   35 hiModuleNameMismatchWarn :: Module -> Module -> SDoc
   36 hiModuleNameMismatchWarn requested_mod read_mod
   37  | moduleUnit requested_mod == moduleUnit read_mod =
   38     sep [text "Interface file contains module" <+> quotes (ppr read_mod) <> comma,
   39          text "but we were expecting module" <+> quotes (ppr requested_mod),
   40          sep [text "Probable cause: the source code which generated interface file",
   41              text "has an incompatible module name"
   42             ]
   43         ]
   44  | otherwise =
   45   -- ToDo: This will fail to have enough qualification when the package IDs
   46   -- are the same
   47   withPprStyle (mkUserStyle alwaysQualify AllTheWay) $
   48     -- we want the Modules below to be qualified with package names,
   49     -- so reset the PrintUnqualified setting.
   50     hsep [ text "Something is amiss; requested module "
   51          , ppr requested_mod
   52          , text "differs from name found in the interface file"
   53          , ppr read_mod
   54          , parens (text "if these names look the same, try again with -dppr-debug")
   55          ]
   56 
   57 homeModError :: InstalledModule -> ModLocation -> SDoc
   58 -- See Note [Home module load error]
   59 homeModError mod location
   60   = text "attempting to use module " <> quotes (ppr mod)
   61     <> (case ml_hs_file location of
   62            Just file -> space <> parens (text file)
   63            Nothing   -> Outputable.empty)
   64     <+> text "which is not loaded"
   65 
   66 
   67 -- -----------------------------------------------------------------------------
   68 -- Error messages
   69 
   70 cannotFindInterface :: UnitState -> HomeUnit -> Profile -> ([FilePath] -> SDoc) -> ModuleName -> InstalledFindResult -> SDoc
   71 cannotFindInterface = cantFindInstalledErr (text "Failed to load interface for")
   72                                            (text "Ambiguous interface for")
   73 
   74 cantFindInstalledErr
   75     :: SDoc
   76     -> SDoc
   77     -> UnitState
   78     -> HomeUnit
   79     -> Profile
   80     -> ([FilePath] -> SDoc)
   81     -> ModuleName
   82     -> InstalledFindResult
   83     -> SDoc
   84 cantFindInstalledErr cannot_find _ unit_state home_unit profile tried_these mod_name find_result
   85   = cannot_find <+> quotes (ppr mod_name)
   86     $$ more_info
   87   where
   88     build_tag  = waysBuildTag (profileWays profile)
   89 
   90     more_info
   91       = case find_result of
   92             InstalledNoPackage pkg
   93                 -> text "no unit id matching" <+> quotes (ppr pkg) <+>
   94                    text "was found" $$ looks_like_srcpkgid pkg
   95 
   96             InstalledNotFound files mb_pkg
   97                 | Just pkg <- mb_pkg, not (isHomeUnitId home_unit pkg)
   98                 -> not_found_in_package pkg files
   99 
  100                 | null files
  101                 -> text "It is not a module in the current program, or in any known package."
  102 
  103                 | otherwise
  104                 -> tried_these files
  105 
  106             _ -> panic "cantFindInstalledErr"
  107 
  108     looks_like_srcpkgid :: UnitId -> SDoc
  109     looks_like_srcpkgid pk
  110      -- Unsafely coerce a unit id (i.e. an installed package component
  111      -- identifier) into a PackageId and see if it means anything.
  112      | (pkg:pkgs) <- searchPackageId unit_state (PackageId (unitIdFS pk))
  113      = parens (text "This unit ID looks like the source package ID;" $$
  114        text "the real unit ID is" <+> quotes (ftext (unitIdFS (unitId pkg))) $$
  115        (if null pkgs then Outputable.empty
  116         else text "and" <+> int (length pkgs) <+> text "other candidates"))
  117      -- Todo: also check if it looks like a package name!
  118      | otherwise = Outputable.empty
  119 
  120     not_found_in_package pkg files
  121        | build_tag /= ""
  122        = let
  123             build = if build_tag == "p" then "profiling"
  124                                         else "\"" ++ build_tag ++ "\""
  125          in
  126          text "Perhaps you haven't installed the " <> text build <>
  127          text " libraries for package " <> quotes (ppr pkg) <> char '?' $$
  128          tried_these files
  129 
  130        | otherwise
  131        = text "There are files missing in the " <> quotes (ppr pkg) <>
  132          text " package," $$
  133          text "try running 'ghc-pkg check'." $$
  134          tried_these files
  135 
  136 mayShowLocations :: DynFlags -> [FilePath] -> SDoc
  137 mayShowLocations dflags files
  138     | null files = Outputable.empty
  139     | verbosity dflags < 3 =
  140           text "Use -v (or `:set -v` in ghci) " <>
  141               text "to see a list of the files searched for."
  142     | otherwise =
  143           hang (text "Locations searched:") 2 $ vcat (map text files)
  144 
  145 cannotFindModule :: HscEnv -> ModuleName -> FindResult -> SDoc
  146 cannotFindModule hsc_env = cannotFindModule'
  147     (hsc_dflags   hsc_env)
  148     (hsc_unit_env hsc_env)
  149     (targetProfile (hsc_dflags hsc_env))
  150 
  151 
  152 cannotFindModule' :: DynFlags -> UnitEnv -> Profile -> ModuleName -> FindResult -> SDoc
  153 cannotFindModule' dflags unit_env profile mod res = pprWithUnitState (ue_units unit_env) $
  154   cantFindErr (checkBuildingCabalPackage dflags)
  155               cannotFindMsg
  156               (text "Ambiguous module name")
  157               unit_env
  158               profile
  159               (mayShowLocations dflags)
  160               mod
  161               res
  162   where
  163     cannotFindMsg =
  164       case res of
  165         NotFound { fr_mods_hidden = hidden_mods
  166                  , fr_pkgs_hidden = hidden_pkgs
  167                  , fr_unusables = unusables }
  168           | not (null hidden_mods && null hidden_pkgs && null unusables)
  169           -> text "Could not load module"
  170         _ -> text "Could not find module"
  171 
  172 cantFindErr
  173     :: BuildingCabalPackage -- ^ Using Cabal?
  174     -> SDoc
  175     -> SDoc
  176     -> UnitEnv
  177     -> Profile
  178     -> ([FilePath] -> SDoc)
  179     -> ModuleName
  180     -> FindResult
  181     -> SDoc
  182 cantFindErr _ _ multiple_found _ _ _ mod_name (FoundMultiple mods)
  183   | Just pkgs <- unambiguousPackages
  184   = hang (multiple_found <+> quotes (ppr mod_name) <> colon) 2 (
  185        sep [text "it was found in multiple packages:",
  186                 hsep (map ppr pkgs) ]
  187     )
  188   | otherwise
  189   = hang (multiple_found <+> quotes (ppr mod_name) <> colon) 2 (
  190        vcat (map pprMod mods)
  191     )
  192   where
  193     unambiguousPackages = foldl' unambiguousPackage (Just []) mods
  194     unambiguousPackage (Just xs) (m, ModOrigin (Just _) _ _ _)
  195         = Just (moduleUnit m : xs)
  196     unambiguousPackage _ _ = Nothing
  197 
  198     pprMod (m, o) = text "it is bound as" <+> ppr m <+>
  199                                 text "by" <+> pprOrigin m o
  200     pprOrigin _ ModHidden = panic "cantFindErr: bound by mod hidden"
  201     pprOrigin _ (ModUnusable _) = panic "cantFindErr: bound by mod unusable"
  202     pprOrigin m (ModOrigin e res _ f) = sep $ punctuate comma (
  203       if e == Just True
  204           then [text "package" <+> ppr (moduleUnit m)]
  205           else [] ++
  206       map ((text "a reexport in package" <+>)
  207                 .ppr.mkUnit) res ++
  208       if f then [text "a package flag"] else []
  209       )
  210 
  211 cantFindErr using_cabal cannot_find _ unit_env profile tried_these mod_name find_result
  212   = cannot_find <+> quotes (ppr mod_name)
  213     $$ more_info
  214   where
  215     mhome_unit = ue_home_unit unit_env
  216     more_info
  217       = case find_result of
  218             NoPackage pkg
  219                 -> text "no unit id matching" <+> quotes (ppr pkg) <+>
  220                    text "was found"
  221 
  222             NotFound { fr_paths = files, fr_pkg = mb_pkg
  223                      , fr_mods_hidden = mod_hiddens, fr_pkgs_hidden = pkg_hiddens
  224                      , fr_unusables = unusables, fr_suggestions = suggest }
  225                 | Just pkg <- mb_pkg
  226                 , Nothing <- mhome_unit           -- no home-unit
  227                 -> not_found_in_package pkg files
  228 
  229                 | Just pkg <- mb_pkg
  230                 , Just home_unit <- mhome_unit    -- there is a home-unit but the
  231                 , not (isHomeUnit home_unit pkg)  -- module isn't from it
  232                 -> not_found_in_package pkg files
  233 
  234                 | not (null suggest)
  235                 -> pp_suggestions suggest $$ tried_these files
  236 
  237                 | null files && null mod_hiddens &&
  238                   null pkg_hiddens && null unusables
  239                 -> text "It is not a module in the current program, or in any known package."
  240 
  241                 | otherwise
  242                 -> vcat (map pkg_hidden pkg_hiddens) $$
  243                    vcat (map mod_hidden mod_hiddens) $$
  244                    vcat (map unusable unusables) $$
  245                    tried_these files
  246 
  247             _ -> panic "cantFindErr"
  248 
  249     build_tag = waysBuildTag (profileWays profile)
  250 
  251     not_found_in_package pkg files
  252        | build_tag /= ""
  253        = let
  254             build = if build_tag == "p" then "profiling"
  255                                         else "\"" ++ build_tag ++ "\""
  256          in
  257          text "Perhaps you haven't installed the " <> text build <>
  258          text " libraries for package " <> quotes (ppr pkg) <> char '?' $$
  259          tried_these files
  260 
  261        | otherwise
  262        = text "There are files missing in the " <> quotes (ppr pkg) <>
  263          text " package," $$
  264          text "try running 'ghc-pkg check'." $$
  265          tried_these files
  266 
  267     pkg_hidden :: Unit -> SDoc
  268     pkg_hidden uid =
  269         text "It is a member of the hidden package"
  270         <+> quotes (ppr uid)
  271         --FIXME: we don't really want to show the unit id here we should
  272         -- show the source package id or installed package id if it's ambiguous
  273         <> dot $$ pkg_hidden_hint uid
  274 
  275     pkg_hidden_hint uid
  276      | using_cabal == YesBuildingCabalPackage
  277         = let pkg = expectJust "pkg_hidden" (lookupUnit (ue_units unit_env) uid)
  278            in text "Perhaps you need to add" <+>
  279               quotes (ppr (unitPackageName pkg)) <+>
  280               text "to the build-depends in your .cabal file."
  281      | Just pkg <- lookupUnit (ue_units unit_env) uid
  282          = text "You can run" <+>
  283            quotes (text ":set -package " <> ppr (unitPackageName pkg)) <+>
  284            text "to expose it." $$
  285            text "(Note: this unloads all the modules in the current scope.)"
  286      | otherwise = Outputable.empty
  287 
  288     mod_hidden pkg =
  289         text "it is a hidden module in the package" <+> quotes (ppr pkg)
  290 
  291     unusable (pkg, reason)
  292       = text "It is a member of the package"
  293       <+> quotes (ppr pkg)
  294       $$ pprReason (text "which is") reason
  295 
  296     pp_suggestions :: [ModuleSuggestion] -> SDoc
  297     pp_suggestions sugs
  298       | null sugs = Outputable.empty
  299       | otherwise = hang (text "Perhaps you meant")
  300                        2 (vcat (map pp_sugg sugs))
  301 
  302     -- NB: Prefer the *original* location, and then reexports, and then
  303     -- package flags when making suggestions.  ToDo: if the original package
  304     -- also has a reexport, prefer that one
  305     pp_sugg (SuggestVisible m mod o) = ppr m <+> provenance o
  306       where provenance ModHidden = Outputable.empty
  307             provenance (ModUnusable _) = Outputable.empty
  308             provenance (ModOrigin{ fromOrigUnit = e,
  309                                    fromExposedReexport = res,
  310                                    fromPackageFlag = f })
  311               | Just True <- e
  312                  = parens (text "from" <+> ppr (moduleUnit mod))
  313               | f && moduleName mod == m
  314                  = parens (text "from" <+> ppr (moduleUnit mod))
  315               | (pkg:_) <- res
  316                  = parens (text "from" <+> ppr (mkUnit pkg)
  317                     <> comma <+> text "reexporting" <+> ppr mod)
  318               | f
  319                  = parens (text "defined via package flags to be"
  320                     <+> ppr mod)
  321               | otherwise = Outputable.empty
  322     pp_sugg (SuggestHidden m mod o) = ppr m <+> provenance o
  323       where provenance ModHidden =  Outputable.empty
  324             provenance (ModUnusable _) = Outputable.empty
  325             provenance (ModOrigin{ fromOrigUnit = e,
  326                                    fromHiddenReexport = rhs })
  327               | Just False <- e
  328                  = parens (text "needs flag -package-id"
  329                     <+> ppr (moduleUnit mod))
  330               | (pkg:_) <- rhs
  331                  = parens (text "needs flag -package-id"
  332                     <+> ppr (mkUnit pkg))
  333               | otherwise = Outputable.empty
  334