{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE InstanceSigs #-}
module GHC.Iface.Errors.Ppr
( IfaceMessageOpts(..)
, interfaceErrorHints
, interfaceErrorReason
, interfaceErrorDiagnostic
, missingInterfaceErrorHints
, missingInterfaceErrorReason
, missingInterfaceErrorDiagnostic
, readInterfaceErrorDiagnostic
, lookingForHerald
, cantFindErrorX
, mayShowLocations
, pkgHiddenHint
)
where
import GHC.Prelude
import GHC.Types.Error
import GHC.Types.Hint.Ppr ()
import GHC.Types.Error.Codes
import GHC.Types.Name
import GHC.Types.TyThing
import GHC.Unit.State
import GHC.Unit.Module
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Iface.Errors.Types
defaultIfaceMessageOpts :: IfaceMessageOpts
defaultIfaceMessageOpts :: IfaceMessageOpts
defaultIfaceMessageOpts = IfaceMessageOpts { ifaceShowTriedFiles :: Bool
ifaceShowTriedFiles = Bool
False
, ifaceBuildingCabalPackage :: BuildingCabalPackage
ifaceBuildingCabalPackage = BuildingCabalPackage
NoBuildingCabalPackage }
instance HasDefaultDiagnosticOpts IfaceMessageOpts where
defaultOpts :: IfaceMessageOpts
defaultOpts = IfaceMessageOpts
defaultIfaceMessageOpts
instance Diagnostic IfaceMessage where
type DiagnosticOpts IfaceMessage = IfaceMessageOpts
diagnosticMessage :: DiagnosticOpts IfaceMessage -> IfaceMessage -> DecoratedSDoc
diagnosticMessage DiagnosticOpts IfaceMessage
opts IfaceMessage
reason = SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
IfaceMessageOpts -> IfaceMessage -> SDoc
interfaceErrorDiagnostic DiagnosticOpts IfaceMessage
IfaceMessageOpts
opts IfaceMessage
reason
diagnosticReason :: IfaceMessage -> DiagnosticReason
diagnosticReason = IfaceMessage -> DiagnosticReason
interfaceErrorReason
diagnosticHints :: IfaceMessage -> [GhcHint]
diagnosticHints = IfaceMessage -> [GhcHint]
interfaceErrorHints
diagnosticCode :: IfaceMessage -> Maybe DiagnosticCode
diagnosticCode = IfaceMessage -> Maybe DiagnosticCode
forall diag.
(Generic diag, GDiagnosticCode (Rep diag)) =>
diag -> Maybe DiagnosticCode
constructorCode
interfaceErrorHints :: IfaceMessage -> [GhcHint]
interfaceErrorHints :: IfaceMessage -> [GhcHint]
interfaceErrorHints = \ case
Can'tFindInterface MissingInterfaceError
err InterfaceLookingFor
_looking_for ->
MissingInterfaceError -> [GhcHint]
missingInterfaceErrorHints MissingInterfaceError
err
Can'tFindNameInInterface {} ->
[GhcHint]
noHints
CircularImport {} ->
[GhcHint]
noHints
missingInterfaceErrorHints :: MissingInterfaceError -> [GhcHint]
missingInterfaceErrorHints :: MissingInterfaceError -> [GhcHint]
missingInterfaceErrorHints = \case
BadSourceImport {} ->
[GhcHint]
noHints
HomeModError {} ->
[GhcHint]
noHints
DynamicHashMismatchError {} ->
[GhcHint]
noHints
CantFindErr {} ->
[GhcHint]
noHints
BadIfaceFile {} ->
[GhcHint]
noHints
FailedToLoadDynamicInterface {} ->
[GhcHint]
noHints
interfaceErrorReason :: IfaceMessage -> DiagnosticReason
interfaceErrorReason :: IfaceMessage -> DiagnosticReason
interfaceErrorReason (Can'tFindInterface MissingInterfaceError
err InterfaceLookingFor
_)
= MissingInterfaceError -> DiagnosticReason
missingInterfaceErrorReason MissingInterfaceError
err
interfaceErrorReason (Can'tFindNameInInterface {})
= DiagnosticReason
ErrorWithoutFlag
interfaceErrorReason (CircularImport {})
= DiagnosticReason
ErrorWithoutFlag
missingInterfaceErrorReason :: MissingInterfaceError -> DiagnosticReason
missingInterfaceErrorReason :: MissingInterfaceError -> DiagnosticReason
missingInterfaceErrorReason = \ case
BadSourceImport {} ->
DiagnosticReason
ErrorWithoutFlag
HomeModError {} ->
DiagnosticReason
ErrorWithoutFlag
DynamicHashMismatchError {} ->
DiagnosticReason
ErrorWithoutFlag
CantFindErr {} ->
DiagnosticReason
ErrorWithoutFlag
BadIfaceFile {} ->
DiagnosticReason
ErrorWithoutFlag
FailedToLoadDynamicInterface {} ->
DiagnosticReason
ErrorWithoutFlag
prettyCantFindWhat :: FindOrLoad -> FindingModuleOrInterface -> AmbiguousOrMissing -> SDoc
prettyCantFindWhat :: FindOrLoad
-> FindingModuleOrInterface -> AmbiguousOrMissing -> SDoc
prettyCantFindWhat FindOrLoad
Find FindingModuleOrInterface
FindingModule AmbiguousOrMissing
AoM_Missing = FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"Could not find module"
prettyCantFindWhat FindOrLoad
Load FindingModuleOrInterface
FindingModule AmbiguousOrMissing
AoM_Missing = FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"Could not load module"
prettyCantFindWhat FindOrLoad
_ FindingModuleOrInterface
FindingInterface AmbiguousOrMissing
AoM_Missing = FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"Failed to load interface for"
prettyCantFindWhat FindOrLoad
_ FindingModuleOrInterface
FindingModule AmbiguousOrMissing
AoM_Ambiguous = FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"Ambiguous module name"
prettyCantFindWhat FindOrLoad
_ FindingModuleOrInterface
FindingInterface AmbiguousOrMissing
AoM_Ambiguous = FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"Ambiguous interface for"
isAmbiguousInstalledReason :: CantFindInstalledReason -> AmbiguousOrMissing
isAmbiguousInstalledReason :: CantFindInstalledReason -> AmbiguousOrMissing
isAmbiguousInstalledReason (MultiplePackages {}) = AmbiguousOrMissing
AoM_Ambiguous
isAmbiguousInstalledReason CantFindInstalledReason
_ = AmbiguousOrMissing
AoM_Missing
isLoadOrFindReason :: CantFindInstalledReason -> FindOrLoad
isLoadOrFindReason :: CantFindInstalledReason -> FindOrLoad
isLoadOrFindReason NotAModule {} = FindOrLoad
Find
isLoadOrFindReason (GenericMissing [(Unit, Maybe UnitInfo)]
a [Unit]
b [UnusableUnit]
c [FilePath]
_) | [(Unit, Maybe UnitInfo)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Unit, Maybe UnitInfo)]
a Bool -> Bool -> Bool
&& [Unit] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Unit]
b Bool -> Bool -> Bool
&& [UnusableUnit] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [UnusableUnit]
c = FindOrLoad
Find
isLoadOrFindReason (ModuleSuggestion {}) = FindOrLoad
Find
isLoadOrFindReason CantFindInstalledReason
_ = FindOrLoad
Load
data FindOrLoad = Find | Load
data AmbiguousOrMissing = AoM_Ambiguous | AoM_Missing
cantFindError :: IfaceMessageOpts
-> FindingModuleOrInterface
-> CantFindInstalled
-> SDoc
cantFindError :: IfaceMessageOpts
-> FindingModuleOrInterface -> CantFindInstalled -> SDoc
cantFindError IfaceMessageOpts
opts =
(UnitInfo -> SDoc)
-> ([FilePath] -> SDoc)
-> FindingModuleOrInterface
-> CantFindInstalled
-> SDoc
cantFindErrorX
((UnitInfo -> SDoc) -> BuildingCabalPackage -> UnitInfo -> SDoc
pkgHiddenHint (SDoc -> UnitInfo -> SDoc
forall a b. a -> b -> a
const SDoc
forall doc. IsOutput doc => doc
empty) (IfaceMessageOpts -> BuildingCabalPackage
ifaceBuildingCabalPackage IfaceMessageOpts
opts))
(FilePath -> Bool -> [FilePath] -> SDoc
mayShowLocations FilePath
"-v" (IfaceMessageOpts -> Bool
ifaceShowTriedFiles IfaceMessageOpts
opts))
pkgHiddenHint :: (UnitInfo -> SDoc) -> BuildingCabalPackage
-> UnitInfo -> SDoc
pkgHiddenHint :: (UnitInfo -> SDoc) -> BuildingCabalPackage -> UnitInfo -> SDoc
pkgHiddenHint UnitInfo -> SDoc
_hint BuildingCabalPackage
YesBuildingCabalPackage UnitInfo
pkg
= FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"Perhaps you need to add" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
SDoc -> SDoc
quotes (PackageName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (UnitInfo -> PackageName
forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> srcpkgname
unitPackageName UnitInfo
pkg)) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"to the build-depends in your .cabal file."
pkgHiddenHint UnitInfo -> SDoc
hint BuildingCabalPackage
_not_cabal UnitInfo
pkg
= UnitInfo -> SDoc
hint UnitInfo
pkg
mayShowLocations :: String -> Bool -> [FilePath] -> SDoc
mayShowLocations :: FilePath -> Bool -> [FilePath] -> SDoc
mayShowLocations FilePath
option Bool
verbose [FilePath]
files
| [FilePath] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
files = SDoc
forall doc. IsOutput doc => doc
empty
| Bool -> Bool
not Bool
verbose =
FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"Use" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
option SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"to see a list of the files searched for."
| Bool
otherwise =
SDoc -> Int -> SDoc -> SDoc
hang (FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"Locations searched:") Int
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((FilePath -> SDoc) -> [FilePath] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text [FilePath]
files)
cantFindErrorX :: (UnitInfo -> SDoc) -> ([FilePath] -> SDoc) -> FindingModuleOrInterface -> CantFindInstalled -> SDoc
cantFindErrorX :: (UnitInfo -> SDoc)
-> ([FilePath] -> SDoc)
-> FindingModuleOrInterface
-> CantFindInstalled
-> SDoc
cantFindErrorX UnitInfo -> SDoc
pkg_hidden_hint [FilePath] -> SDoc
may_show_locations FindingModuleOrInterface
mod_or_interface (CantFindInstalled ModuleName
mod_name CantFindInstalledReason
cfir) =
let ambig :: AmbiguousOrMissing
ambig = CantFindInstalledReason -> AmbiguousOrMissing
isAmbiguousInstalledReason CantFindInstalledReason
cfir
find_or_load :: FindOrLoad
find_or_load = CantFindInstalledReason -> FindOrLoad
isLoadOrFindReason CantFindInstalledReason
cfir
ppr_what :: SDoc
ppr_what = FindOrLoad
-> FindingModuleOrInterface -> AmbiguousOrMissing -> SDoc
prettyCantFindWhat FindOrLoad
find_or_load FindingModuleOrInterface
mod_or_interface AmbiguousOrMissing
ambig
in
(SDoc
ppr_what SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
mod_name) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
dot) SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
case CantFindInstalledReason
cfir of
NoUnitIdMatching UnitId
pkg [UnitInfo]
cands ->
let looks_like_srcpkgid :: SDoc
looks_like_srcpkgid :: SDoc
looks_like_srcpkgid =
case [UnitInfo]
cands of
(UnitInfo
pkg:[UnitInfo]
pkgs) ->
SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"This unit ID looks like the source package ID;" SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"the real unit ID is" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (FastString -> SDoc
forall doc. IsLine doc => FastString -> doc
ftext (UnitId -> FastString
unitIdFS (UnitInfo -> UnitId
forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> uid
unitId UnitInfo
pkg))) SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
(if [UnitInfo] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [UnitInfo]
pkgs then SDoc
forall doc. IsOutput doc => doc
empty
else FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"and" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Int -> SDoc
forall doc. IsLine doc => Int -> doc
int ([UnitInfo] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [UnitInfo]
pkgs) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"other candidate" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [UnitInfo] -> SDoc
forall a. [a] -> SDoc
plural [UnitInfo]
pkgs))
[] -> SDoc
forall doc. IsOutput doc => doc
empty
in [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [ FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"no unit id matching" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr UnitId
pkg)
, FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"was found"] SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ SDoc
looks_like_srcpkgid
MissingPackageFiles UnitId
pkg [FilePath]
files ->
FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"There are files missing in the " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
quotes (UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr UnitId
pkg) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"package," SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"try running 'ghc-pkg check'." SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
[FilePath] -> SDoc
may_show_locations [FilePath]
files
MissingPackageWayFiles FilePath
build UnitId
pkg [FilePath]
files ->
FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"Perhaps you haven't installed the " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
build SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"libraries for package " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
quotes (UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr UnitId
pkg) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'?' SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
[FilePath] -> SDoc
may_show_locations [FilePath]
files
ModuleSuggestion [ModuleSuggestion]
ms [FilePath]
fps ->
let pp_suggestions :: [ModuleSuggestion] -> SDoc
pp_suggestions :: [ModuleSuggestion] -> SDoc
pp_suggestions [ModuleSuggestion]
sugs
| [ModuleSuggestion] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ModuleSuggestion]
sugs = SDoc
forall doc. IsOutput doc => doc
empty
| Bool
otherwise = SDoc -> Int -> SDoc -> SDoc
hang (FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"Perhaps you meant")
Int
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((ModuleSuggestion -> SDoc) -> [ModuleSuggestion] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map ModuleSuggestion -> SDoc
pp_sugg [ModuleSuggestion]
sugs))
pp_sugg :: ModuleSuggestion -> SDoc
pp_sugg (SuggestVisible ModuleName
m Module
mod ModuleOrigin
o) = ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
m SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ModuleOrigin -> SDoc
provenance ModuleOrigin
o
where provenance :: ModuleOrigin -> SDoc
provenance ModuleOrigin
ModHidden = SDoc
forall doc. IsOutput doc => doc
empty
provenance (ModUnusable UnusableUnit
_) = SDoc
forall doc. IsOutput doc => doc
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
= SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"from" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Unit -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
mod))
| Bool
f Bool -> Bool -> Bool
&& Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
mod ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== ModuleName
m
= SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"from" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Unit -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
mod))
| (UnitInfo
pkg:[UnitInfo]
_) <- [UnitInfo]
res
= SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"from" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Unit -> SDoc
forall a. Outputable a => a -> SDoc
ppr (UnitInfo -> Unit
mkUnit UnitInfo
pkg)
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"reexporting" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
mod)
| Bool
f
= SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"defined via package flags to be"
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
mod)
| Bool
otherwise = SDoc
forall doc. IsOutput doc => doc
empty
pp_sugg (SuggestHidden ModuleName
m Module
mod ModuleOrigin
o) = ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
m SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ModuleOrigin -> SDoc
provenance ModuleOrigin
o
where provenance :: ModuleOrigin -> SDoc
provenance ModuleOrigin
ModHidden = SDoc
forall doc. IsOutput doc => doc
empty
provenance (ModUnusable UnusableUnit
_) = SDoc
forall doc. IsOutput doc => doc
empty
provenance (ModOrigin{ fromOrigUnit :: ModuleOrigin -> Maybe Bool
fromOrigUnit = Maybe Bool
e,
fromHiddenReexport :: ModuleOrigin -> [UnitInfo]
fromHiddenReexport = [UnitInfo]
rhs })
| Just Bool
False <- Maybe Bool
e
= SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"needs flag -package-id"
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Unit -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
mod))
| (UnitInfo
pkg:[UnitInfo]
_) <- [UnitInfo]
rhs
= SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"needs flag -package-id"
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Unit -> SDoc
forall a. Outputable a => a -> SDoc
ppr (UnitInfo -> Unit
mkUnit UnitInfo
pkg))
| Bool
otherwise = SDoc
forall doc. IsOutput doc => doc
empty
in [ModuleSuggestion] -> SDoc
pp_suggestions [ModuleSuggestion]
ms SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ [FilePath] -> SDoc
may_show_locations [FilePath]
fps
CantFindInstalledReason
NotAModule -> FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"It is not a module in the current program, or in any known package."
CouldntFindInFiles [FilePath]
fps -> [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((FilePath -> SDoc) -> [FilePath] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text [FilePath]
fps)
MultiplePackages [(Module, ModuleOrigin)]
mods
| Just [Unit]
pkgs <- Maybe [Unit]
unambiguousPackages
-> [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"it was found in multiple packages:",
[SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep ((Unit -> SDoc) -> [Unit] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map Unit -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Unit]
pkgs)]
| Bool
otherwise
-> [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat (((Module, ModuleOrigin) -> SDoc)
-> [(Module, ModuleOrigin)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (Module, ModuleOrigin) -> SDoc
forall {a}.
(Outputable a, Outputable (GenModule a)) =>
(GenModule a, ModuleOrigin) -> SDoc
pprMod [(Module, ModuleOrigin)]
mods)
where
unambiguousPackages :: Maybe [Unit]
unambiguousPackages = (Maybe [Unit] -> (Module, ModuleOrigin) -> Maybe [Unit])
-> Maybe [Unit] -> [(Module, ModuleOrigin)] -> Maybe [Unit]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Maybe [Unit] -> (Module, ModuleOrigin) -> Maybe [Unit]
forall {a}. Maybe [a] -> (GenModule a, ModuleOrigin) -> Maybe [a]
unambiguousPackage ([Unit] -> Maybe [Unit]
forall a. a -> Maybe a
Just []) [(Module, ModuleOrigin)]
mods
unambiguousPackage :: Maybe [a] -> (GenModule a, ModuleOrigin) -> Maybe [a]
unambiguousPackage (Just [a]
xs) (GenModule a
m, ModOrigin (Just Bool
_) [UnitInfo]
_ [UnitInfo]
_ Bool
_)
= [a] -> Maybe [a]
forall a. a -> Maybe a
Just (GenModule a -> a
forall unit. GenModule unit -> unit
moduleUnit GenModule a
m a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs)
unambiguousPackage Maybe [a]
_ (GenModule a, ModuleOrigin)
_ = Maybe [a]
forall a. Maybe a
Nothing
GenericMissing [(Unit, Maybe UnitInfo)]
pkg_hiddens [Unit]
mod_hiddens [UnusableUnit]
unusables [FilePath]
files ->
[SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat (((Unit, Maybe UnitInfo) -> SDoc)
-> [(Unit, Maybe UnitInfo)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (Unit, Maybe UnitInfo) -> SDoc
pkg_hidden [(Unit, Maybe UnitInfo)]
pkg_hiddens) SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
[SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((Unit -> SDoc) -> [Unit] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map Unit -> SDoc
forall a. Outputable a => a -> SDoc
mod_hidden [Unit]
mod_hiddens) SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
[SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((UnusableUnit -> SDoc) -> [UnusableUnit] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map UnusableUnit -> SDoc
unusable [UnusableUnit]
unusables) SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
[FilePath] -> SDoc
may_show_locations [FilePath]
files
where
pprMod :: (GenModule a, ModuleOrigin) -> SDoc
pprMod (GenModule a
m, ModuleOrigin
o) = FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"it is bound as" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> GenModule a -> SDoc
forall a. Outputable a => a -> SDoc
ppr GenModule a
m SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"by" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> GenModule a -> ModuleOrigin -> SDoc
forall {a}. Outputable a => GenModule a -> ModuleOrigin -> SDoc
pprOrigin GenModule a
m ModuleOrigin
o
pprOrigin :: GenModule a -> ModuleOrigin -> SDoc
pprOrigin GenModule a
_ ModuleOrigin
ModHidden = FilePath -> SDoc
forall a. HasCallStack => FilePath -> a
panic FilePath
"cantFindErr: bound by mod hidden"
pprOrigin GenModule a
_ (ModUnusable UnusableUnit
_) = FilePath -> SDoc
forall a. HasCallStack => FilePath -> a
panic FilePath
"cantFindErr: bound by mod unusable"
pprOrigin GenModule a
m (ModOrigin Maybe Bool
e [UnitInfo]
res [UnitInfo]
_ Bool
f) = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> [SDoc] -> [SDoc]
forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate SDoc
forall doc. IsLine doc => doc
comma (
if Maybe Bool
e Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
then [FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"package" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> a -> SDoc
forall a. Outputable a => a -> SDoc
ppr (GenModule a -> a
forall unit. GenModule unit -> unit
moduleUnit GenModule a
m)]
else [] [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++
(UnitInfo -> SDoc) -> [UnitInfo] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map ((FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"a reexport in package" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>)
(SDoc -> SDoc) -> (UnitInfo -> SDoc) -> UnitInfo -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Unit -> SDoc
forall a. Outputable a => a -> SDoc
ppr(Unit -> SDoc) -> (UnitInfo -> Unit) -> UnitInfo -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
.UnitInfo -> Unit
mkUnit) [UnitInfo]
res [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++
if Bool
f then [FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"a package flag"] else []
)
pkg_hidden :: (Unit, Maybe UnitInfo) -> SDoc
pkg_hidden :: (Unit, Maybe UnitInfo) -> SDoc
pkg_hidden (Unit
uid, Maybe UnitInfo
uif) =
FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"It is a member of the hidden package"
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Unit -> SDoc
forall a. Outputable a => a -> SDoc
ppr Unit
uid)
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
dot SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ SDoc -> (UnitInfo -> SDoc) -> Maybe UnitInfo -> SDoc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SDoc
forall doc. IsOutput doc => doc
empty UnitInfo -> SDoc
pkg_hidden_hint Maybe UnitInfo
uif
mod_hidden :: a -> SDoc
mod_hidden a
pkg =
FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"it is a hidden module in the package" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
pkg)
unusable :: UnusableUnit -> SDoc
unusable (UnusableUnit Unit
unit UnusableUnitReason
reason Bool
reexport)
= FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"It is " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> (if Bool
reexport then FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"reexported from the package"
else FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"a member of the package")
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Unit -> SDoc
forall a. Outputable a => a -> SDoc
ppr Unit
unit)
SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ SDoc -> UnusableUnitReason -> SDoc
pprReason (FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"which is") UnusableUnitReason
reason
interfaceErrorDiagnostic :: IfaceMessageOpts -> IfaceMessage -> SDoc
interfaceErrorDiagnostic :: IfaceMessageOpts -> IfaceMessage -> SDoc
interfaceErrorDiagnostic IfaceMessageOpts
opts = \ case
Can'tFindNameInInterface Name
name [TyThing]
relevant_tyThings ->
Name -> [TyThing] -> SDoc
missingDeclInInterface Name
name [TyThing]
relevant_tyThings
Can'tFindInterface MissingInterfaceError
err InterfaceLookingFor
looking_for ->
SDoc -> Int -> SDoc -> SDoc
hangNotEmpty (InterfaceLookingFor -> SDoc
lookingForHerald InterfaceLookingFor
looking_for) Int
2 (IfaceMessageOpts -> MissingInterfaceError -> SDoc
missingInterfaceErrorDiagnostic IfaceMessageOpts
opts MissingInterfaceError
err)
CircularImport Module
mod ->
FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"Circular imports: module" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
mod)
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"depends on itself"
lookingForHerald :: InterfaceLookingFor -> SDoc
lookingForHerald :: InterfaceLookingFor -> SDoc
lookingForHerald InterfaceLookingFor
looking_for =
case InterfaceLookingFor
looking_for of
LookingForName {} -> SDoc
forall doc. IsOutput doc => doc
empty
LookingForModule {} -> SDoc
forall doc. IsOutput doc => doc
empty
LookingForHiBoot Module
mod ->
FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"Could not find hi-boot interface for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
mod) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon
LookingForSig InstalledModule
sig ->
FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"Could not find interface file for signature" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (InstalledModule -> SDoc
forall a. Outputable a => a -> SDoc
ppr InstalledModule
sig) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon
readInterfaceErrorDiagnostic :: ReadInterfaceError -> SDoc
readInterfaceErrorDiagnostic :: ReadInterfaceError -> SDoc
readInterfaceErrorDiagnostic = \ case
ExceptionOccurred FilePath
fp SomeException
ex ->
SDoc -> Int -> SDoc -> SDoc
hang (FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"Exception when reading interface file " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
fp)
Int
2 (FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text (SomeException -> FilePath
forall e. Exception e => e -> FilePath
showException SomeException
ex))
HiModuleNameMismatchWarn FilePath
_ Module
m1 Module
m2 ->
Module -> Module -> SDoc
hiModuleNameMismatchWarn Module
m1 Module
m2
missingInterfaceErrorDiagnostic :: IfaceMessageOpts -> MissingInterfaceError -> SDoc
missingInterfaceErrorDiagnostic :: IfaceMessageOpts -> MissingInterfaceError -> SDoc
missingInterfaceErrorDiagnostic IfaceMessageOpts
opts MissingInterfaceError
reason =
case MissingInterfaceError
reason of
BadSourceImport Module
m -> Module -> SDoc
badSourceImport Module
m
HomeModError InstalledModule
im ModLocation
ml -> InstalledModule -> ModLocation -> SDoc
homeModError InstalledModule
im ModLocation
ml
DynamicHashMismatchError Module
m ModLocation
ml -> Module -> ModLocation -> SDoc
dynamicHashMismatchError Module
m ModLocation
ml
CantFindErr UnitState
us FindingModuleOrInterface
module_or_interface CantFindInstalled
cfi -> UnitState -> SDoc -> SDoc
pprWithUnitState UnitState
us (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ IfaceMessageOpts
-> FindingModuleOrInterface -> CantFindInstalled -> SDoc
cantFindError IfaceMessageOpts
opts FindingModuleOrInterface
module_or_interface CantFindInstalled
cfi
BadIfaceFile ReadInterfaceError
rie -> ReadInterfaceError -> SDoc
readInterfaceErrorDiagnostic ReadInterfaceError
rie
FailedToLoadDynamicInterface Module
wanted_mod ReadInterfaceError
err ->
SDoc -> Int -> SDoc -> SDoc
hang (FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"Failed to load dynamic interface file for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
wanted_mod SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon)
Int
2 (ReadInterfaceError -> SDoc
readInterfaceErrorDiagnostic ReadInterfaceError
err)
hiModuleNameMismatchWarn :: Module -> Module -> SDoc
hiModuleNameMismatchWarn :: Module -> Module -> SDoc
hiModuleNameMismatchWarn Module
requested_mod Module
read_mod
| Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
requested_mod Unit -> Unit -> Bool
forall a. Eq a => a -> a -> Bool
== Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
read_mod =
[SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"Interface file contains module" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
read_mod) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma,
FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"but we were expecting module" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
requested_mod),
[SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"Probable cause: the source code which generated interface file",
FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"has an incompatible module name"
]
]
| Bool
otherwise =
PprStyle -> SDoc -> SDoc
withPprStyle (NamePprCtx -> Depth -> PprStyle
mkUserStyle NamePprCtx
alwaysQualify Depth
AllTheWay) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
[SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [ FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"Something is amiss; requested module "
, Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
requested_mod
, FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"differs from name found in the interface file"
, Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
read_mod
, SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"if these names look the same, try again with -dppr-debug")
]
dynamicHashMismatchError :: Module -> ModLocation -> SDoc
dynamicHashMismatchError :: Module -> ModLocation -> SDoc
dynamicHashMismatchError Module
wanted_mod ModLocation
loc =
[SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"Dynamic hash doesn't match for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
wanted_mod)
, FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"Normal interface file from" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text (ModLocation -> FilePath
ml_hi_file ModLocation
loc)
, FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"Dynamic interface file from" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text (ModLocation -> FilePath
ml_dyn_hi_file ModLocation
loc)
, FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"You probably need to recompile" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
wanted_mod) ]
homeModError :: InstalledModule -> ModLocation -> SDoc
homeModError :: InstalledModule -> ModLocation -> SDoc
homeModError InstalledModule
mod ModLocation
location
= FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"attempting to use module " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
quotes (InstalledModule -> SDoc
forall a. Outputable a => a -> SDoc
ppr InstalledModule
mod)
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> (case ModLocation -> Maybe FilePath
ml_hs_file ModLocation
location of
Just FilePath
file -> SDoc
forall doc. IsLine doc => doc
space SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
file)
Maybe FilePath
Nothing -> SDoc
forall doc. IsOutput doc => doc
empty)
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"which is not loaded"
missingDeclInInterface :: Name -> [TyThing] -> SDoc
missingDeclInInterface :: Name -> [TyThing] -> SDoc
missingDeclInInterface Name
name [TyThing]
things =
SDoc -> SDoc
forall doc. IsOutput doc => doc -> doc
whenPprDebug (SDoc
found_things SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ SDoc
forall doc. IsOutput doc => doc
empty) SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
SDoc -> Int -> SDoc -> SDoc
hang (FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"Can't find interface-file declaration for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
NameSpace -> SDoc
pprNameSpace (Name -> NameSpace
nameNameSpace Name
name) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name)
Int
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"Probable cause: bug in .hi-boot file, or inconsistent .hi file",
FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"Use -ddump-if-trace to get an idea of which file caused the error"])
where
found_things :: SDoc
found_things =
SDoc -> Int -> SDoc -> SDoc
hang (FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"Found the following declarations in" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr (HasDebugCallStack => Name -> Module
Name -> Module
nameModule Name
name) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon)
Int
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((TyThing -> SDoc) -> [TyThing] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map TyThing -> SDoc
forall a. Outputable a => a -> SDoc
ppr [TyThing]
things))
badSourceImport :: Module -> SDoc
badSourceImport :: Module -> SDoc
badSourceImport Module
mod
= SDoc -> Int -> SDoc -> SDoc
hang (FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"You cannot {-# SOURCE #-} import a module from another package")
Int
2 (FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"but" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
mod) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"is from package"
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Unit -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
mod)))