path: root/compiler/GHC/Iface/Errors.hs

{-# 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.Types
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.Unit.State
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 -> HomeUnit -> Profile -> ([FilePath] -> SDoc) -> ModuleName -> InstalledFindResult -> SDoc
cannotFindInterface = cantFindInstalledErr (text "Failed to load interface for")
                                           (text "Ambiguous interface for")

cantFindInstalledErr
    :: SDoc
    -> SDoc
    -> UnitState
    -> HomeUnit
    -> Profile
    -> ([FilePath] -> SDoc)
    -> ModuleName
    -> InstalledFindResult
    -> SDoc
cantFindInstalledErr cannot_find _ unit_state home_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, not (isHomeUnitId home_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_home_unit 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