{-# 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 :: String -> SDoc -> SDoc
badIfaceFile String
file SDoc
err
  = forall doc. IsDoc doc => [doc] -> doc
vcat [forall doc. IsLine doc => String -> doc
text String
"Bad interface file:" forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
file,
          Int -> SDoc -> SDoc
nest Int
4 SDoc
err]

hiModuleNameMismatchWarn :: Module -> Module -> SDoc
hiModuleNameMismatchWarn :: GenModule Unit -> GenModule Unit -> SDoc
hiModuleNameMismatchWarn GenModule Unit
requested_mod GenModule Unit
read_mod
 | forall unit. GenModule unit -> unit
moduleUnit GenModule Unit
requested_mod forall a. Eq a => a -> a -> Bool
== forall unit. GenModule unit -> unit
moduleUnit GenModule Unit
read_mod =
    forall doc. IsLine doc => [doc] -> doc
sep [forall doc. IsLine doc => String -> doc
text String
"Interface file contains module" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr GenModule Unit
read_mod) forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
comma,
         forall doc. IsLine doc => String -> doc
text String
"but we were expecting module" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr GenModule Unit
requested_mod),
         forall doc. IsLine doc => [doc] -> doc
sep [forall doc. IsLine doc => String -> doc
text String
"Probable cause: the source code which generated interface file",
             forall doc. IsLine doc => String -> doc
text String
"has an incompatible module name"
            ]
        ]
 | Bool
otherwise =
  -- ToDo: This will fail to have enough qualification when the package IDs
  -- are the same
  PprStyle -> SDoc -> SDoc
withPprStyle (NamePprCtx -> Depth -> PprStyle
mkUserStyle NamePprCtx
alwaysQualify Depth
AllTheWay) forall a b. (a -> b) -> a -> b
$
    -- we want the Modules below to be qualified with package names,
    -- so reset the NamePprCtx setting.
    forall doc. IsLine doc => [doc] -> doc
hsep [ forall doc. IsLine doc => String -> doc
text String
"Something is amiss; requested module "
         , forall a. Outputable a => a -> SDoc
ppr GenModule Unit
requested_mod
         , forall doc. IsLine doc => String -> doc
text String
"differs from name found in the interface file"
         , forall a. Outputable a => a -> SDoc
ppr GenModule Unit
read_mod
         , forall doc. IsLine doc => doc -> doc
parens (forall doc. IsLine doc => String -> doc
text String
"if these names look the same, try again with -dppr-debug")
         ]

homeModError :: InstalledModule -> ModLocation -> SDoc
-- See Note [Home module load error]
homeModError :: InstalledModule -> ModLocation -> SDoc
homeModError InstalledModule
mod ModLocation
location
  = forall doc. IsLine doc => String -> doc
text String
"attempting to use module " forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr InstalledModule
mod)
    forall doc. IsLine doc => doc -> doc -> doc
<> (case ModLocation -> Maybe String
ml_hs_file ModLocation
location of
           Just String
file -> forall doc. IsLine doc => doc
space forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc -> doc
parens (forall doc. IsLine doc => String -> doc
text String
file)
           Maybe String
Nothing   -> forall doc. IsOutput doc => doc
Outputable.empty)
    forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"which is not loaded"


-- -----------------------------------------------------------------------------
-- Error messages

cannotFindInterface :: UnitState -> Maybe HomeUnit -> Profile -> ([FilePath] -> SDoc) -> ModuleName -> InstalledFindResult -> SDoc
cannotFindInterface :: UnitState
-> Maybe HomeUnit
-> Profile
-> ([String] -> SDoc)
-> ModuleName
-> InstalledFindResult
-> SDoc
cannotFindInterface = SDoc
-> SDoc
-> UnitState
-> Maybe HomeUnit
-> Profile
-> ([String] -> SDoc)
-> ModuleName
-> InstalledFindResult
-> SDoc
cantFindInstalledErr (forall doc. IsLine doc => String -> doc
text String
"Failed to load interface for")
                                           (forall doc. IsLine doc => String -> doc
text String
"Ambiguous interface for")

cantFindInstalledErr
    :: SDoc
    -> SDoc
    -> UnitState
    -> Maybe HomeUnit
    -> Profile
    -> ([FilePath] -> SDoc)
    -> ModuleName
    -> InstalledFindResult
    -> SDoc
cantFindInstalledErr :: SDoc
-> SDoc
-> UnitState
-> Maybe HomeUnit
-> Profile
-> ([String] -> SDoc)
-> ModuleName
-> InstalledFindResult
-> SDoc
cantFindInstalledErr SDoc
cannot_find SDoc
_ UnitState
unit_state Maybe HomeUnit
mhome_unit Profile
profile [String] -> SDoc
tried_these ModuleName
mod_name InstalledFindResult
find_result
  = SDoc
cannot_find forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr ModuleName
mod_name)
    forall doc. IsDoc doc => doc -> doc -> doc
$$ SDoc
more_info
  where
    build_tag :: String
build_tag  = Ways -> String
waysBuildTag (Profile -> Ways
profileWays Profile
profile)

    more_info :: SDoc
more_info
      = case InstalledFindResult
find_result of
            InstalledNoPackage UnitId
pkg
                -> forall doc. IsLine doc => String -> doc
text String
"no unit id matching" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr UnitId
pkg) forall doc. IsLine doc => doc -> doc -> doc
<+>
                   forall doc. IsLine doc => String -> doc
text String
"was found" forall doc. IsDoc doc => doc -> doc -> doc
$$ UnitId -> SDoc
looks_like_srcpkgid UnitId
pkg

            InstalledNotFound [String]
files Maybe UnitId
mb_pkg
                | Just UnitId
pkg <- Maybe UnitId
mb_pkg
                , forall u. Maybe (GenHomeUnit u) -> UnitId -> Bool
notHomeUnitId Maybe HomeUnit
mhome_unit UnitId
pkg
                -> UnitId -> [String] -> SDoc
not_found_in_package UnitId
pkg [String]
files

                | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
files
                -> forall doc. IsLine doc => String -> doc
text String
"It is not a module in the current program, or in any known package."

                | Bool
otherwise
                -> [String] -> SDoc
tried_these [String]
files

            InstalledFindResult
_ -> forall a. HasCallStack => String -> a
panic String
"cantFindInstalledErr"

    looks_like_srcpkgid :: UnitId -> SDoc
    looks_like_srcpkgid :: UnitId -> SDoc
looks_like_srcpkgid UnitId
pk
     -- Unsafely coerce a unit id (i.e. an installed package component
     -- identifier) into a PackageId and see if it means anything.
     | (UnitInfo
pkg:[UnitInfo]
pkgs) <- UnitState -> PackageId -> [UnitInfo]
searchPackageId UnitState
unit_state (FastString -> PackageId
PackageId (UnitId -> FastString
unitIdFS UnitId
pk))
     = forall doc. IsLine doc => doc -> doc
parens (forall doc. IsLine doc => String -> doc
text String
"This unit ID looks like the source package ID;" forall doc. IsDoc doc => doc -> doc -> doc
$$
       forall doc. IsLine doc => String -> doc
text String
"the real unit ID is" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall doc. IsLine doc => FastString -> doc
ftext (UnitId -> FastString
unitIdFS (forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> uid
unitId UnitInfo
pkg))) forall doc. IsDoc doc => doc -> doc -> doc
$$
       (if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [UnitInfo]
pkgs then forall doc. IsOutput doc => doc
Outputable.empty
        else forall doc. IsLine doc => String -> doc
text String
"and" forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => Int -> doc
int (forall (t :: * -> *) a. Foldable t => t a -> Int
length [UnitInfo]
pkgs) forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"other candidates"))
     -- Todo: also check if it looks like a package name!
     | Bool
otherwise = forall doc. IsOutput doc => doc
Outputable.empty

    not_found_in_package :: UnitId -> [String] -> SDoc
not_found_in_package UnitId
pkg [String]
files
       | String
build_tag forall a. Eq a => a -> a -> Bool
/= String
""
       = let
            build :: String
build = if String
build_tag forall a. Eq a => a -> a -> Bool
== String
"p" then String
"profiling"
                                        else String
"\"" forall a. [a] -> [a] -> [a]
++ String
build_tag forall a. [a] -> [a] -> [a]
++ String
"\""
         in
         forall doc. IsLine doc => String -> doc
text String
"Perhaps you haven't installed the " forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
text String
build forall doc. IsLine doc => doc -> doc -> doc
<>
         forall doc. IsLine doc => String -> doc
text String
" libraries for package " forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr UnitId
pkg) forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => Char -> doc
char Char
'?' forall doc. IsDoc doc => doc -> doc -> doc
$$
         [String] -> SDoc
tried_these [String]
files

       | Bool
otherwise
       = forall doc. IsLine doc => String -> doc
text String
"There are files missing in the " forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr UnitId
pkg) forall doc. IsLine doc => doc -> doc -> doc
<>
         forall doc. IsLine doc => String -> doc
text String
" package," forall doc. IsDoc doc => doc -> doc -> doc
$$
         forall doc. IsLine doc => String -> doc
text String
"try running 'ghc-pkg check'." forall doc. IsDoc doc => doc -> doc -> doc
$$
         [String] -> SDoc
tried_these [String]
files

mayShowLocations :: DynFlags -> [FilePath] -> SDoc
mayShowLocations :: DynFlags -> [String] -> SDoc
mayShowLocations DynFlags
dflags [String]
files
    | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
files = forall doc. IsOutput doc => doc
Outputable.empty
    | DynFlags -> Int
verbosity DynFlags
dflags forall a. Ord a => a -> a -> Bool
< Int
3 =
          forall doc. IsLine doc => String -> doc
text String
"Use -v (or `:set -v` in ghci) " forall doc. IsLine doc => doc -> doc -> doc
<>
              forall doc. IsLine doc => String -> doc
text String
"to see a list of the files searched for."
    | Bool
otherwise =
          SDoc -> Int -> SDoc -> SDoc
hang (forall doc. IsLine doc => String -> doc
text String
"Locations searched:") Int
2 forall a b. (a -> b) -> a -> b
$ forall doc. IsDoc doc => [doc] -> doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map forall doc. IsLine doc => String -> doc
text [String]
files)

cannotFindModule :: HscEnv -> ModuleName -> FindResult -> SDoc
cannotFindModule :: HscEnv -> ModuleName -> FindResult -> SDoc
cannotFindModule HscEnv
hsc_env = DynFlags -> UnitEnv -> Profile -> ModuleName -> FindResult -> SDoc
cannotFindModule'
    (HscEnv -> DynFlags
hsc_dflags   HscEnv
hsc_env)
    (HscEnv -> UnitEnv
hsc_unit_env HscEnv
hsc_env)
    (DynFlags -> Profile
targetProfile (HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env))


cannotFindModule' :: DynFlags -> UnitEnv -> Profile -> ModuleName -> FindResult -> SDoc
cannotFindModule' :: DynFlags -> UnitEnv -> Profile -> ModuleName -> FindResult -> SDoc
cannotFindModule' DynFlags
dflags UnitEnv
unit_env Profile
profile ModuleName
mod FindResult
res = UnitState -> SDoc -> SDoc
pprWithUnitState (HasDebugCallStack => UnitEnv -> UnitState
ue_units UnitEnv
unit_env) forall a b. (a -> b) -> a -> b
$
  BuildingCabalPackage
-> SDoc
-> SDoc
-> UnitEnv
-> Profile
-> ([String] -> SDoc)
-> ModuleName
-> FindResult
-> SDoc
cantFindErr (DynFlags -> BuildingCabalPackage
checkBuildingCabalPackage DynFlags
dflags)
              SDoc
cannotFindMsg
              (forall doc. IsLine doc => String -> doc
text String
"Ambiguous module name")
              UnitEnv
unit_env
              Profile
profile
              (DynFlags -> [String] -> SDoc
mayShowLocations DynFlags
dflags)
              ModuleName
mod
              FindResult
res
  where
    cannotFindMsg :: SDoc
cannotFindMsg =
      case FindResult
res of
        NotFound { fr_mods_hidden :: FindResult -> [Unit]
fr_mods_hidden = [Unit]
hidden_mods
                 , fr_pkgs_hidden :: FindResult -> [Unit]
fr_pkgs_hidden = [Unit]
hidden_pkgs
                 , fr_unusables :: FindResult -> [(Unit, UnusableUnitReason)]
fr_unusables = [(Unit, UnusableUnitReason)]
unusables }
          | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Unit]
hidden_mods Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Unit]
hidden_pkgs Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Unit, UnusableUnitReason)]
unusables)
          -> forall doc. IsLine doc => String -> doc
text String
"Could not load module"
        FindResult
_ -> forall doc. IsLine doc => String -> doc
text String
"Could not find module"

cantFindErr
    :: BuildingCabalPackage -- ^ Using Cabal?
    -> SDoc
    -> SDoc
    -> UnitEnv
    -> Profile
    -> ([FilePath] -> SDoc)
    -> ModuleName
    -> FindResult
    -> SDoc
cantFindErr :: BuildingCabalPackage
-> SDoc
-> SDoc
-> UnitEnv
-> Profile
-> ([String] -> SDoc)
-> ModuleName
-> FindResult
-> SDoc
cantFindErr BuildingCabalPackage
_ SDoc
_ SDoc
multiple_found UnitEnv
_ Profile
_ [String] -> SDoc
_ ModuleName
mod_name (FoundMultiple [(GenModule Unit, ModuleOrigin)]
mods)
  | Just [Unit]
pkgs <- Maybe [Unit]
unambiguousPackages
  = SDoc -> Int -> SDoc -> SDoc
hang (SDoc
multiple_found forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr ModuleName
mod_name) forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
colon) Int
2 (
       forall doc. IsLine doc => [doc] -> doc
sep [forall doc. IsLine doc => String -> doc
text String
"it was found in multiple packages:",
                forall doc. IsLine doc => [doc] -> doc
hsep (forall a b. (a -> b) -> [a] -> [b]
map forall a. Outputable a => a -> SDoc
ppr [Unit]
pkgs) ]
    )
  | Bool
otherwise
  = SDoc -> Int -> SDoc -> SDoc
hang (SDoc
multiple_found forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr ModuleName
mod_name) forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
colon) Int
2 (
       forall doc. IsDoc doc => [doc] -> doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map forall {a}.
(Outputable a, Outputable (GenModule a)) =>
(GenModule a, ModuleOrigin) -> SDoc
pprMod [(GenModule Unit, ModuleOrigin)]
mods)
    )
  where
    unambiguousPackages :: Maybe [Unit]
unambiguousPackages = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall {a}. Maybe [a] -> (GenModule a, ModuleOrigin) -> Maybe [a]
unambiguousPackage (forall a. a -> Maybe a
Just []) [(GenModule Unit, ModuleOrigin)]
mods
    unambiguousPackage :: Maybe [a] -> (GenModule a, ModuleOrigin) -> Maybe [a]
unambiguousPackage (Just [a]
xs) (GenModule a
m, ModOrigin (Just Bool
_) [UnitInfo]
_ [UnitInfo]
_ Bool
_)
        = forall a. a -> Maybe a
Just (forall unit. GenModule unit -> unit
moduleUnit GenModule a
m forall a. a -> [a] -> [a]
: [a]
xs)
    unambiguousPackage Maybe [a]
_ (GenModule a, ModuleOrigin)
_ = forall a. Maybe a
Nothing

    pprMod :: (GenModule a, ModuleOrigin) -> SDoc
pprMod (GenModule a
m, ModuleOrigin
o) = forall doc. IsLine doc => String -> doc
text String
"it is bound as" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr GenModule a
m forall doc. IsLine doc => doc -> doc -> doc
<+>
                                forall doc. IsLine doc => String -> doc
text String
"by" forall doc. IsLine doc => doc -> doc -> doc
<+> forall {a}. Outputable a => GenModule a -> ModuleOrigin -> SDoc
pprOrigin GenModule a
m ModuleOrigin
o
    pprOrigin :: GenModule a -> ModuleOrigin -> SDoc
pprOrigin GenModule a
_ ModuleOrigin
ModHidden = forall a. HasCallStack => String -> a
panic String
"cantFindErr: bound by mod hidden"
    pprOrigin GenModule a
_ (ModUnusable UnusableUnitReason
_) = forall a. HasCallStack => String -> a
panic String
"cantFindErr: bound by mod unusable"
    pprOrigin GenModule a
m (ModOrigin Maybe Bool
e [UnitInfo]
res [UnitInfo]
_ Bool
f) = forall doc. IsLine doc => [doc] -> doc
sep forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate forall doc. IsLine doc => doc
comma (
      if Maybe Bool
e forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Bool
True
          then [forall doc. IsLine doc => String -> doc
text String
"package" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr (forall unit. GenModule unit -> unit
moduleUnit GenModule a
m)]
          else [] forall a. [a] -> [a] -> [a]
++
      forall a b. (a -> b) -> [a] -> [b]
map ((forall doc. IsLine doc => String -> doc
text String
"a reexport in package" forall doc. IsLine doc => doc -> doc -> doc
<+>)
                forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. Outputable a => a -> SDoc
pprforall b c a. (b -> c) -> (a -> b) -> a -> c
.UnitInfo -> Unit
mkUnit) [UnitInfo]
res forall a. [a] -> [a] -> [a]
++
      if Bool
f then [forall doc. IsLine doc => String -> doc
text String
"a package flag"] else []
      )

cantFindErr BuildingCabalPackage
using_cabal SDoc
cannot_find SDoc
_ UnitEnv
unit_env Profile
profile [String] -> SDoc
tried_these ModuleName
mod_name FindResult
find_result
  = SDoc
cannot_find forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr ModuleName
mod_name)
    forall doc. IsDoc doc => doc -> doc -> doc
$$ SDoc
more_info
  where
    mhome_unit :: Maybe HomeUnit
mhome_unit = UnitEnv -> Maybe HomeUnit
ue_homeUnit UnitEnv
unit_env
    more_info :: SDoc
more_info
      = case FindResult
find_result of
            NoPackage Unit
pkg
                -> forall doc. IsLine doc => String -> doc
text String
"no unit id matching" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Unit
pkg) forall doc. IsLine doc => doc -> doc -> doc
<+>
                   forall doc. IsLine doc => String -> doc
text String
"was found"

            NotFound { fr_paths :: FindResult -> [String]
fr_paths = [String]
files, fr_pkg :: FindResult -> Maybe Unit
fr_pkg = Maybe Unit
mb_pkg
                     , fr_mods_hidden :: FindResult -> [Unit]
fr_mods_hidden = [Unit]
mod_hiddens, fr_pkgs_hidden :: FindResult -> [Unit]
fr_pkgs_hidden = [Unit]
pkg_hiddens
                     , fr_unusables :: FindResult -> [(Unit, UnusableUnitReason)]
fr_unusables = [(Unit, UnusableUnitReason)]
unusables, fr_suggestions :: FindResult -> [ModuleSuggestion]
fr_suggestions = [ModuleSuggestion]
suggest }
                | Just Unit
pkg <- Maybe Unit
mb_pkg
                , Maybe HomeUnit
Nothing <- Maybe HomeUnit
mhome_unit           -- no home-unit
                -> Unit -> [String] -> SDoc
not_found_in_package Unit
pkg [String]
files

                | Just Unit
pkg <- Maybe Unit
mb_pkg
                , Just HomeUnit
home_unit <- Maybe HomeUnit
mhome_unit    -- there is a home-unit but the
                , Bool -> Bool
not (HomeUnit -> Unit -> Bool
isHomeUnit HomeUnit
home_unit Unit
pkg)  -- module isn't from it
                -> Unit -> [String] -> SDoc
not_found_in_package Unit
pkg [String]
files

                | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ModuleSuggestion]
suggest)
                -> [ModuleSuggestion] -> SDoc
pp_suggestions [ModuleSuggestion]
suggest forall doc. IsDoc doc => doc -> doc -> doc
$$ [String] -> SDoc
tried_these [String]
files

                | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
files Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Unit]
mod_hiddens Bool -> Bool -> Bool
&&
                  forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Unit]
pkg_hiddens Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Unit, UnusableUnitReason)]
unusables
                -> forall doc. IsLine doc => String -> doc
text String
"It is not a module in the current program, or in any known package."

                | Bool
otherwise
                -> forall doc. IsDoc doc => [doc] -> doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map Unit -> SDoc
pkg_hidden [Unit]
pkg_hiddens) forall doc. IsDoc doc => doc -> doc -> doc
$$
                   forall doc. IsDoc doc => [doc] -> doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map forall a. Outputable a => a -> SDoc
mod_hidden [Unit]
mod_hiddens) forall doc. IsDoc doc => doc -> doc -> doc
$$
                   forall doc. IsDoc doc => [doc] -> doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Outputable a => (a, UnusableUnitReason) -> SDoc
unusable [(Unit, UnusableUnitReason)]
unusables) forall doc. IsDoc doc => doc -> doc -> doc
$$
                   [String] -> SDoc
tried_these [String]
files

            FindResult
_ -> forall a. HasCallStack => String -> a
panic String
"cantFindErr"

    build_tag :: String
build_tag = Ways -> String
waysBuildTag (Profile -> Ways
profileWays Profile
profile)

    not_found_in_package :: Unit -> [String] -> SDoc
not_found_in_package Unit
pkg [String]
files
       | String
build_tag forall a. Eq a => a -> a -> Bool
/= String
""
       = let
            build :: String
build = if String
build_tag forall a. Eq a => a -> a -> Bool
== String
"p" then String
"profiling"
                                        else String
"\"" forall a. [a] -> [a] -> [a]
++ String
build_tag forall a. [a] -> [a] -> [a]
++ String
"\""
         in
         forall doc. IsLine doc => String -> doc
text String
"Perhaps you haven't installed the " forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
text String
build forall doc. IsLine doc => doc -> doc -> doc
<>
         forall doc. IsLine doc => String -> doc
text String
" libraries for package " forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Unit
pkg) forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => Char -> doc
char Char
'?' forall doc. IsDoc doc => doc -> doc -> doc
$$
         [String] -> SDoc
tried_these [String]
files

       | Bool
otherwise
       = forall doc. IsLine doc => String -> doc
text String
"There are files missing in the " forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Unit
pkg) forall doc. IsLine doc => doc -> doc -> doc
<>
         forall doc. IsLine doc => String -> doc
text String
" package," forall doc. IsDoc doc => doc -> doc -> doc
$$
         forall doc. IsLine doc => String -> doc
text String
"try running 'ghc-pkg check'." forall doc. IsDoc doc => doc -> doc -> doc
$$
         [String] -> SDoc
tried_these [String]
files

    pkg_hidden :: Unit -> SDoc
    pkg_hidden :: Unit -> SDoc
pkg_hidden Unit
uid =
        forall doc. IsLine doc => String -> doc
text String
"It is a member of the hidden package"
        forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Unit
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
        forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
dot forall doc. IsDoc doc => doc -> doc -> doc
$$ Unit -> SDoc
pkg_hidden_hint Unit
uid

    pkg_hidden_hint :: Unit -> SDoc
pkg_hidden_hint Unit
uid
     | BuildingCabalPackage
using_cabal forall a. Eq a => a -> a -> Bool
== BuildingCabalPackage
YesBuildingCabalPackage
        = let pkg :: UnitInfo
pkg = forall a. HasCallStack => String -> Maybe a -> a
expectJust String
"pkg_hidden" (UnitState -> Unit -> Maybe UnitInfo
lookupUnit (HasDebugCallStack => UnitEnv -> UnitState
ue_units UnitEnv
unit_env) Unit
uid)
           in forall doc. IsLine doc => String -> doc
text String
"Perhaps you need to add" forall doc. IsLine doc => doc -> doc -> doc
<+>
              SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr (forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> srcpkgname
unitPackageName UnitInfo
pkg)) forall doc. IsLine doc => doc -> doc -> doc
<+>
              forall doc. IsLine doc => String -> doc
text String
"to the build-depends in your .cabal file."
     | Just UnitInfo
pkg <- UnitState -> Unit -> Maybe UnitInfo
lookupUnit (HasDebugCallStack => UnitEnv -> UnitState
ue_units UnitEnv
unit_env) Unit
uid
         = forall doc. IsLine doc => String -> doc
text String
"You can run" forall doc. IsLine doc => doc -> doc -> doc
<+>
           SDoc -> SDoc
quotes (forall doc. IsLine doc => String -> doc
text String
":set -package " forall doc. IsLine doc => doc -> doc -> doc
<> forall a. Outputable a => a -> SDoc
ppr (forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> srcpkgname
unitPackageName UnitInfo
pkg)) forall doc. IsLine doc => doc -> doc -> doc
<+>
           forall doc. IsLine doc => String -> doc
text String
"to expose it." forall doc. IsDoc doc => doc -> doc -> doc
$$
           forall doc. IsLine doc => String -> doc
text String
"(Note: this unloads all the modules in the current scope.)"
     | Bool
otherwise = forall doc. IsOutput doc => doc
Outputable.empty

    mod_hidden :: a -> SDoc
mod_hidden a
pkg =
        forall doc. IsLine doc => String -> doc
text String
"it is a hidden module in the package" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr a
pkg)

    unusable :: (a, UnusableUnitReason) -> SDoc
unusable (a
pkg, UnusableUnitReason
reason)
      = forall doc. IsLine doc => String -> doc
text String
"It is a member of the package"
      forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr a
pkg)
      forall doc. IsDoc doc => doc -> doc -> doc
$$ SDoc -> UnusableUnitReason -> SDoc
pprReason (forall doc. IsLine doc => String -> doc
text String
"which is") UnusableUnitReason
reason

    pp_suggestions :: [ModuleSuggestion] -> SDoc
    pp_suggestions :: [ModuleSuggestion] -> SDoc
pp_suggestions [ModuleSuggestion]
sugs
      | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ModuleSuggestion]
sugs = forall doc. IsOutput doc => doc
Outputable.empty
      | Bool
otherwise = SDoc -> Int -> SDoc -> SDoc
hang (forall doc. IsLine doc => String -> doc
text String
"Perhaps you meant")
                       Int
2 (forall doc. IsDoc doc => [doc] -> doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map ModuleSuggestion -> SDoc
pp_sugg [ModuleSuggestion]
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 :: ModuleSuggestion -> SDoc
pp_sugg (SuggestVisible ModuleName
m GenModule Unit
mod ModuleOrigin
o) = forall a. Outputable a => a -> SDoc
ppr ModuleName
m forall doc. IsLine doc => doc -> doc -> doc
<+> ModuleOrigin -> SDoc
provenance ModuleOrigin
o
      where provenance :: ModuleOrigin -> SDoc
provenance ModuleOrigin
ModHidden = forall doc. IsOutput doc => doc
Outputable.empty
            provenance (ModUnusable UnusableUnitReason
_) = forall doc. IsOutput doc => doc
Outputable.empty
            provenance (ModOrigin{ fromOrigUnit :: ModuleOrigin -> Maybe Bool
fromOrigUnit = Maybe Bool
e,
                                   fromExposedReexport :: ModuleOrigin -> [UnitInfo]
fromExposedReexport = [UnitInfo]
res,
                                   fromPackageFlag :: ModuleOrigin -> Bool
fromPackageFlag = Bool
f })
              | Just Bool
True <- Maybe Bool
e
                 = forall doc. IsLine doc => doc -> doc
parens (forall doc. IsLine doc => String -> doc
text String
"from" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr (forall unit. GenModule unit -> unit
moduleUnit GenModule Unit
mod))
              | Bool
f Bool -> Bool -> Bool
&& forall unit. GenModule unit -> ModuleName
moduleName GenModule Unit
mod forall a. Eq a => a -> a -> Bool
== ModuleName
m
                 = forall doc. IsLine doc => doc -> doc
parens (forall doc. IsLine doc => String -> doc
text String
"from" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr (forall unit. GenModule unit -> unit
moduleUnit GenModule Unit
mod))
              | (UnitInfo
pkg:[UnitInfo]
_) <- [UnitInfo]
res
                 = forall doc. IsLine doc => doc -> doc
parens (forall doc. IsLine doc => String -> doc
text String
"from" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr (UnitInfo -> Unit
mkUnit UnitInfo
pkg)
                    forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
comma forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"reexporting" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr GenModule Unit
mod)
              | Bool
f
                 = forall doc. IsLine doc => doc -> doc
parens (forall doc. IsLine doc => String -> doc
text String
"defined via package flags to be"
                    forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr GenModule Unit
mod)
              | Bool
otherwise = forall doc. IsOutput doc => doc
Outputable.empty
    pp_sugg (SuggestHidden ModuleName
m GenModule Unit
mod ModuleOrigin
o) = forall a. Outputable a => a -> SDoc
ppr ModuleName
m forall doc. IsLine doc => doc -> doc -> doc
<+> ModuleOrigin -> SDoc
provenance ModuleOrigin
o
      where provenance :: ModuleOrigin -> SDoc
provenance ModuleOrigin
ModHidden =  forall doc. IsOutput doc => doc
Outputable.empty
            provenance (ModUnusable UnusableUnitReason
_) = forall doc. IsOutput doc => doc
Outputable.empty
            provenance (ModOrigin{ fromOrigUnit :: ModuleOrigin -> Maybe Bool
fromOrigUnit = Maybe Bool
e,
                                   fromHiddenReexport :: ModuleOrigin -> [UnitInfo]
fromHiddenReexport = [UnitInfo]
rhs })
              | Just Bool
False <- Maybe Bool
e
                 = forall doc. IsLine doc => doc -> doc
parens (forall doc. IsLine doc => String -> doc
text String
"needs flag -package-id"
                    forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr (forall unit. GenModule unit -> unit
moduleUnit GenModule Unit
mod))
              | (UnitInfo
pkg:[UnitInfo]
_) <- [UnitInfo]
rhs
                 = forall doc. IsLine doc => doc -> doc
parens (forall doc. IsLine doc => String -> doc
text String
"needs flag -package-id"
                    forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr (UnitInfo -> Unit
mkUnit UnitInfo
pkg))
              | Bool
otherwise = forall doc. IsOutput doc => doc
Outputable.empty