{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -fno-warn-orphans #-} -- instance Diagnostic {DriverMessage, GhcMessage}

module GHC.Driver.Errors.Ppr (
  -- This module only exports Diagnostic instances.
  ) where

import GHC.Prelude

import GHC.Driver.Errors.Types
import GHC.Driver.Flags
import GHC.Driver.DynFlags
import GHC.HsToCore.Errors.Ppr ()
import GHC.Parser.Errors.Ppr ()
import GHC.Types.Error
import GHC.Types.Error.Codes
import GHC.Unit.Types
import GHC.Utils.Outputable
import GHC.Unit.Module
import GHC.Unit.State
import GHC.Types.Hint
import GHC.Types.SrcLoc
import Data.Version

import Language.Haskell.Syntax.Decls (RuleDecl(..))
import GHC.Tc.Errors.Types (TcRnMessage)
import GHC.HsToCore.Errors.Types (DsMessage)
import GHC.Iface.Errors.Types
import GHC.Tc.Errors.Ppr ()
import GHC.Iface.Errors.Ppr ()

--
-- Suggestions
--

-- | Suggests a list of 'InstantiationSuggestion' for the '.hsig' file to the user.
suggestInstantiatedWith :: ModuleName -> GenInstantiations UnitId -> [InstantiationSuggestion]
suggestInstantiatedWith :: ModuleName -> GenInstantiations UnitId -> [InstantiationSuggestion]
suggestInstantiatedWith ModuleName
pi_mod_name GenInstantiations UnitId
insts =
  [ ModuleName -> Module -> InstantiationSuggestion
InstantiationSuggestion ModuleName
k Module
v | (ModuleName
k,Module
v) <- ((ModuleName
pi_mod_name, ModuleName -> Module
forall u. ModuleName -> GenModule (GenUnit u)
mkHoleModule ModuleName
pi_mod_name) (ModuleName, Module)
-> GenInstantiations UnitId -> GenInstantiations UnitId
forall a. a -> [a] -> [a]
: GenInstantiations UnitId
insts) ]

instance HasDefaultDiagnosticOpts GhcMessageOpts where
  defaultOpts :: GhcMessageOpts
defaultOpts = DiagnosticOpts PsMessage
-> DiagnosticOpts TcRnMessage
-> DiagnosticOpts DsMessage
-> DiagnosticOpts DriverMessage
-> GhcMessageOpts
GhcMessageOpts (forall opts.
HasDefaultDiagnosticOpts (DiagnosticOpts opts) =>
DiagnosticOpts opts
defaultDiagnosticOpts @PsMessage)
                                         (forall opts.
HasDefaultDiagnosticOpts (DiagnosticOpts opts) =>
DiagnosticOpts opts
defaultDiagnosticOpts @TcRnMessage)
                                         (forall opts.
HasDefaultDiagnosticOpts (DiagnosticOpts opts) =>
DiagnosticOpts opts
defaultDiagnosticOpts @DsMessage)
                                         (forall opts.
HasDefaultDiagnosticOpts (DiagnosticOpts opts) =>
DiagnosticOpts opts
defaultDiagnosticOpts @DriverMessage)

instance Diagnostic GhcMessage where
  type DiagnosticOpts GhcMessage = GhcMessageOpts
  diagnosticMessage :: DiagnosticOpts GhcMessage -> GhcMessage -> DecoratedSDoc
diagnosticMessage DiagnosticOpts GhcMessage
opts = \case
    GhcPsMessage PsMessage
m
      -> DiagnosticOpts PsMessage -> PsMessage -> DecoratedSDoc
forall a. Diagnostic a => DiagnosticOpts a -> a -> DecoratedSDoc
diagnosticMessage (GhcMessageOpts -> DiagnosticOpts PsMessage
psMessageOpts DiagnosticOpts GhcMessage
GhcMessageOpts
opts) PsMessage
m
    GhcTcRnMessage TcRnMessage
m
      -> DiagnosticOpts TcRnMessage -> TcRnMessage -> DecoratedSDoc
forall a. Diagnostic a => DiagnosticOpts a -> a -> DecoratedSDoc
diagnosticMessage (GhcMessageOpts -> DiagnosticOpts TcRnMessage
tcMessageOpts DiagnosticOpts GhcMessage
GhcMessageOpts
opts) TcRnMessage
m
    GhcDsMessage DsMessage
m
      -> DiagnosticOpts DsMessage -> DsMessage -> DecoratedSDoc
forall a. Diagnostic a => DiagnosticOpts a -> a -> DecoratedSDoc
diagnosticMessage (GhcMessageOpts -> DiagnosticOpts DsMessage
dsMessageOpts DiagnosticOpts GhcMessage
GhcMessageOpts
opts) DsMessage
m
    GhcDriverMessage DriverMessage
m
      -> DiagnosticOpts DriverMessage -> DriverMessage -> DecoratedSDoc
forall a. Diagnostic a => DiagnosticOpts a -> a -> DecoratedSDoc
diagnosticMessage (GhcMessageOpts -> DiagnosticOpts DriverMessage
driverMessageOpts DiagnosticOpts GhcMessage
GhcMessageOpts
opts) DriverMessage
m
    GhcUnknownMessage (UnknownDiagnostic DiagnosticOpts GhcMessage -> DiagnosticOpts a
f a
m)
      -> DiagnosticOpts a -> a -> DecoratedSDoc
forall a. Diagnostic a => DiagnosticOpts a -> a -> DecoratedSDoc
diagnosticMessage (DiagnosticOpts GhcMessage -> DiagnosticOpts a
f DiagnosticOpts GhcMessage
opts) a
m

  diagnosticReason :: GhcMessage -> DiagnosticReason
diagnosticReason = \case
    GhcPsMessage PsMessage
m
      -> PsMessage -> DiagnosticReason
forall a. Diagnostic a => a -> DiagnosticReason
diagnosticReason PsMessage
m
    GhcTcRnMessage TcRnMessage
m
      -> TcRnMessage -> DiagnosticReason
forall a. Diagnostic a => a -> DiagnosticReason
diagnosticReason TcRnMessage
m
    GhcDsMessage DsMessage
m
      -> DsMessage -> DiagnosticReason
forall a. Diagnostic a => a -> DiagnosticReason
diagnosticReason DsMessage
m
    GhcDriverMessage DriverMessage
m
      -> DriverMessage -> DiagnosticReason
forall a. Diagnostic a => a -> DiagnosticReason
diagnosticReason DriverMessage
m
    GhcUnknownMessage UnknownDiagnostic (DiagnosticOpts GhcMessage)
m
      -> UnknownDiagnostic GhcMessageOpts -> DiagnosticReason
forall a. Diagnostic a => a -> DiagnosticReason
diagnosticReason UnknownDiagnostic (DiagnosticOpts GhcMessage)
UnknownDiagnostic GhcMessageOpts
m

  diagnosticHints :: GhcMessage -> [GhcHint]
diagnosticHints = \case
    GhcPsMessage PsMessage
m
      -> PsMessage -> [GhcHint]
forall a. Diagnostic a => a -> [GhcHint]
diagnosticHints PsMessage
m
    GhcTcRnMessage TcRnMessage
m
      -> TcRnMessage -> [GhcHint]
forall a. Diagnostic a => a -> [GhcHint]
diagnosticHints TcRnMessage
m
    GhcDsMessage DsMessage
m
      -> DsMessage -> [GhcHint]
forall a. Diagnostic a => a -> [GhcHint]
diagnosticHints DsMessage
m
    GhcDriverMessage DriverMessage
m
      -> DriverMessage -> [GhcHint]
forall a. Diagnostic a => a -> [GhcHint]
diagnosticHints DriverMessage
m
    GhcUnknownMessage UnknownDiagnostic (DiagnosticOpts GhcMessage)
m
      -> UnknownDiagnostic GhcMessageOpts -> [GhcHint]
forall a. Diagnostic a => a -> [GhcHint]
diagnosticHints UnknownDiagnostic (DiagnosticOpts GhcMessage)
UnknownDiagnostic GhcMessageOpts
m

  diagnosticCode :: GhcMessage -> Maybe DiagnosticCode
diagnosticCode = GhcMessage -> Maybe DiagnosticCode
forall diag.
(Generic diag, GDiagnosticCode (Rep diag)) =>
diag -> Maybe DiagnosticCode
constructorCode

instance HasDefaultDiagnosticOpts DriverMessageOpts where
  defaultOpts :: DriverMessageOpts
defaultOpts = DiagnosticOpts PsMessage
-> DiagnosticOpts IfaceMessage -> DriverMessageOpts
DriverMessageOpts (forall opts.
HasDefaultDiagnosticOpts (DiagnosticOpts opts) =>
DiagnosticOpts opts
defaultDiagnosticOpts @PsMessage) (forall opts.
HasDefaultDiagnosticOpts (DiagnosticOpts opts) =>
DiagnosticOpts opts
defaultDiagnosticOpts @IfaceMessage)

instance Diagnostic DriverMessage where
  type DiagnosticOpts DriverMessage = DriverMessageOpts
  diagnosticMessage :: DiagnosticOpts DriverMessage -> DriverMessage -> DecoratedSDoc
diagnosticMessage DiagnosticOpts DriverMessage
opts = \case
    DriverUnknownMessage (UnknownDiagnostic DiagnosticOpts DriverMessage -> DiagnosticOpts a
f a
m)
      -> DiagnosticOpts a -> a -> DecoratedSDoc
forall a. Diagnostic a => DiagnosticOpts a -> a -> DecoratedSDoc
diagnosticMessage (DiagnosticOpts DriverMessage -> DiagnosticOpts a
f DiagnosticOpts DriverMessage
opts) a
m
    DriverPsHeaderMessage PsMessage
m
      -> DiagnosticOpts PsMessage -> PsMessage -> DecoratedSDoc
forall a. Diagnostic a => DiagnosticOpts a -> a -> DecoratedSDoc
diagnosticMessage (DriverMessageOpts -> DiagnosticOpts PsMessage
psDiagnosticOpts DiagnosticOpts DriverMessage
DriverMessageOpts
opts) PsMessage
m
    DriverMissingHomeModules UnitId
uid [ModuleName]
missing BuildingCabalPackage
buildingCabalPackage
      -> let msg :: SDoc
msg | BuildingCabalPackage
buildingCabalPackage BuildingCabalPackage -> BuildingCabalPackage -> Bool
forall a. Eq a => a -> a -> Bool
== BuildingCabalPackage
YesBuildingCabalPackage
                 = SDoc -> Int -> SDoc -> SDoc
hang
                     (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"These modules are needed for compilation but not listed in your .cabal file's other-modules for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr UnitId
uid) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
":")
                     Int
4
                     ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep ((ModuleName -> SDoc) -> [ModuleName] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr [ModuleName]
missing))
                 | Bool
otherwise
                 =
                   SDoc -> Int -> SDoc -> SDoc
hang
                     (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Modules are not listed in options for"
                        SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr UnitId
uid) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"but needed for compilation:")
                     Int
4
                     ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep ((ModuleName -> SDoc) -> [ModuleName] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr [ModuleName]
missing))
         in SDoc -> DecoratedSDoc
mkSimpleDecorated SDoc
msg
    DriverUnknownHiddenModules UnitId
uid [ModuleName]
missing
      -> let msg :: SDoc
msg = SDoc -> Int -> SDoc -> SDoc
hang
                     (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Modules are listed as hidden in options for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr UnitId
uid) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"but not part of the unit:")
                     Int
4
                     ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep ((ModuleName -> SDoc) -> [ModuleName] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr [ModuleName]
missing))
         in SDoc -> DecoratedSDoc
mkSimpleDecorated SDoc
msg
    DriverUnknownReexportedModules UnitId
uid [ModuleName]
missing
      -> let msg :: SDoc
msg = SDoc -> Int -> SDoc -> SDoc
hang
                     (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Modules are listed as reexported in options for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr UnitId
uid) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"but can't be found in any dependency:")
                     Int
4
                     ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep ((ModuleName -> SDoc) -> [ModuleName] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr [ModuleName]
missing))
         in SDoc -> DecoratedSDoc
mkSimpleDecorated SDoc
msg
    DriverUnusedPackages [(UnitId, PackageName, Version, PackageArg)]
unusedArgs
      -> let msg :: SDoc
msg = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The following packages were specified" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                          String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"via -package or -package-id flags,"
                        , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"but were not needed for compilation:"
                        , Int -> SDoc -> SDoc
nest Int
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat (((UnitId, PackageName, Version, PackageArg) -> SDoc)
-> [(UnitId, PackageName, Version, PackageArg)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (SDoc -> SDoc
withDash (SDoc -> SDoc)
-> ((UnitId, PackageName, Version, PackageArg) -> SDoc)
-> (UnitId, PackageName, Version, PackageArg)
-> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnitId, PackageName, Version, PackageArg) -> SDoc
forall {a} {a}. Outputable a => (a, a, Version, PackageArg) -> SDoc
displayOneUnused) [(UnitId, PackageName, Version, PackageArg)]
unusedArgs))
                        ]
         in SDoc -> DecoratedSDoc
mkSimpleDecorated SDoc
msg
         where
            withDash :: SDoc -> SDoc
            withDash :: SDoc -> SDoc
withDash = SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
(<+>) (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"-")

            displayOneUnused :: (a, a, Version, PackageArg) -> SDoc
displayOneUnused (a
_uid, a
pn , Version
v, PackageArg
f) =
              a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
pn SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"-"  SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> SDoc
forall doc. IsLine doc => String -> doc
text (Version -> String
showVersion Version
v)
                     SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (PackageArg -> SDoc
suffix PackageArg
f)

            suffix :: PackageArg -> SDoc
suffix PackageArg
f = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"exposed by flag" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> PackageArg -> SDoc
pprUnusedArg PackageArg
f

            pprUnusedArg :: PackageArg -> SDoc
            pprUnusedArg :: PackageArg -> SDoc
pprUnusedArg (PackageArg String
str) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"-package" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
str
            pprUnusedArg (UnitIdArg Unit
uid) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"-package-id" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Unit -> SDoc
forall a. Outputable a => a -> SDoc
ppr Unit
uid

    DriverUnnecessarySourceImports ModuleName
mod
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"{-# SOURCE #-} unnecessary in import of " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
mod))
    DriverDuplicatedModuleDeclaration Module
mod [String]
files
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"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
<+>
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is defined in multiple files:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
           [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep ((String -> SDoc) -> [String] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map String -> SDoc
forall doc. IsLine doc => String -> doc
text [String]
files)
    DriverModuleNotFound ModuleName
mod
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"module" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
mod) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"cannot be found locally")
    DriverFileModuleNameMismatch ModuleName
actual ModuleName
expected
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"File name does not match module name:"
           SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Saw     :" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
actual)
           SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Expected:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
expected)

    DriverUnexpectedSignature ModuleName
pi_mod_name BuildingCabalPackage
_buildingCabalPackage GenInstantiations UnitId
_instantiations
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Unexpected signature:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
pi_mod_name)
    DriverFileNotFound String
hsFilePath
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Can't find" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
hsFilePath)
    DriverMessage
DriverStaticPointersNotSupported
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"StaticPointers is not supported in GHCi interactive expressions.")
    DriverBackpackModuleNotFound ModuleName
modname
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"module" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
modname SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"was not found")
    DriverUserDefinedRuleIgnored (HsRule { rd_name :: forall pass. RuleDecl pass -> XRec pass FastString
rd_name = XRec GhcTc FastString
n })
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
            String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Rule \"" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> FastString -> SDoc
forall doc. IsLine doc => FastString -> doc
ftext (GenLocated EpAnnCO FastString -> FastString
forall l e. GenLocated l e -> e
unLoc XRec GhcTc FastString
GenLocated EpAnnCO FastString
n) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"\" ignored" SDoc -> SDoc -> SDoc
$+$
            String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Defining user rules is disabled under Safe Haskell"
    DriverMixedSafetyImport ModuleName
modName
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Module" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
modName SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text (String
"is imported both as a safe and unsafe import!")
    DriverCannotLoadInterfaceFile Module
m
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Can't load the interface file for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
m
           SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
", to check that it can be safely imported"
    DriverInferredSafeModule Module
m
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> SDoc
quotes (ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (ModuleName -> SDoc) -> ModuleName -> SDoc
forall a b. (a -> b) -> a -> b
$ Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
m) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"has been inferred as safe!"
    DriverInferredSafeImport Module
m
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep
             [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Importing Safe-Inferred module "
                 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
m)
                 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
" from explicitly Safe module"
             ]
    DriverMarkedTrustworthyButInferredSafe Module
m
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> SDoc
quotes (ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (ModuleName -> SDoc) -> ModuleName -> SDoc
forall a b. (a -> b) -> a -> b
$ Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
m) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is marked as Trustworthy but has been inferred as safe!"
    DriverCannotImportUnsafeModule Module
m
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
m)
                   SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
": Can't be safely imported!"
               , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The module itself isn't safe." ]
    DriverMissingSafeHaskellMode Module
modName
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
modName SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is missing Safe Haskell mode"
    DriverPackageNotTrusted UnitState
state UnitId
pkg
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           UnitState -> SDoc -> SDoc
pprWithUnitState UnitState
state
             (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The package ("
                SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr UnitId
pkg
                SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
") is required to be trusted but it isn't!"
    DriverCannotImportFromUntrustedPackage UnitState
state Module
m
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
m)
                   SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
": Can't be safely imported!"
               , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The package ("
                   SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> (UnitState -> SDoc -> SDoc
pprWithUnitState UnitState
state (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ Unit -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
m))
                   SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
") the module resides in isn't trusted."
               ]
    DriverRedirectedNoMain ModuleName
mod_name
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ (String -> SDoc
forall doc. IsLine doc => String -> doc
text
                       (String
"Output was redirected with -o, " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                       String
"but no output will be generated.") SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
                       (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"There is no module named" 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
<> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"."))
    DriverHomePackagesNotClosed [UnitId]
needed_unit_ids
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ([String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Home units are not closed."
                                  , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"It is necessary to also load the following units:" ]
                                  [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++ (UnitId -> SDoc) -> [UnitId] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (\UnitId
uid -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"-" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr UnitId
uid) [UnitId]
needed_unit_ids)
    DriverInterfaceError IfaceMessage
reason -> DiagnosticOpts IfaceMessage -> IfaceMessage -> DecoratedSDoc
forall a. Diagnostic a => DiagnosticOpts a -> a -> DecoratedSDoc
diagnosticMessage (DriverMessageOpts -> DiagnosticOpts IfaceMessage
ifaceDiagnosticOpts DiagnosticOpts DriverMessage
DriverMessageOpts
opts) IfaceMessage
reason

    DriverInconsistentDynFlags String
msg
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
msg
    DriverSafeHaskellIgnoredExtension Extension
ext
      -> let arg :: SDoc
arg = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"-X" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Extension -> SDoc
forall a. Outputable a => a -> SDoc
ppr Extension
ext
         in SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ SDoc
arg SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is not allowed in Safe Haskell; ignoring" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
arg
    DriverMessage
DriverPackageTrustIgnored
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"-fpackage-trust ignored; must be specified with a Safe Haskell flag"

    DriverUnrecognisedFlag String
arg
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text (String -> SDoc) -> String -> SDoc
forall a b. (a -> b) -> a -> b
$ String
"unrecognised warning flag: -" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
arg
    DriverDeprecatedFlag String
arg String
msg
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text (String -> SDoc) -> String -> SDoc
forall a b. (a -> b) -> a -> b
$ String
arg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is deprecated: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg

  diagnosticReason :: DriverMessage -> DiagnosticReason
diagnosticReason = \case
    DriverUnknownMessage UnknownDiagnostic (DiagnosticOpts DriverMessage)
m
      -> UnknownDiagnostic DriverMessageOpts -> DiagnosticReason
forall a. Diagnostic a => a -> DiagnosticReason
diagnosticReason UnknownDiagnostic (DiagnosticOpts DriverMessage)
UnknownDiagnostic DriverMessageOpts
m
    DriverPsHeaderMessage {}
      -> DiagnosticReason
ErrorWithoutFlag
    DriverMissingHomeModules{}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnMissingHomeModules
    DriverUnknownHiddenModules {}
      -> DiagnosticReason
ErrorWithoutFlag
    DriverUnknownReexportedModules {}
      -> DiagnosticReason
ErrorWithoutFlag
    DriverUnusedPackages{}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnUnusedPackages
    DriverUnnecessarySourceImports{}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnUnusedImports
    DriverDuplicatedModuleDeclaration{}
      -> DiagnosticReason
ErrorWithoutFlag
    DriverModuleNotFound{}
      -> DiagnosticReason
ErrorWithoutFlag
    DriverFileModuleNameMismatch{}
      -> DiagnosticReason
ErrorWithoutFlag
    DriverUnexpectedSignature{}
      -> DiagnosticReason
ErrorWithoutFlag
    DriverFileNotFound{}
      -> DiagnosticReason
ErrorWithoutFlag
    DriverMessage
DriverStaticPointersNotSupported
      -> DiagnosticReason
WarningWithoutFlag
    DriverBackpackModuleNotFound{}
      -> DiagnosticReason
ErrorWithoutFlag
    DriverUserDefinedRuleIgnored{}
      -> DiagnosticReason
WarningWithoutFlag
    DriverMixedSafetyImport{}
      -> DiagnosticReason
ErrorWithoutFlag
    DriverCannotLoadInterfaceFile{}
      -> DiagnosticReason
ErrorWithoutFlag
    DriverInferredSafeModule{}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnSafe
    DriverMarkedTrustworthyButInferredSafe{}
      ->WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnTrustworthySafe
    DriverInferredSafeImport{}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnInferredSafeImports
    DriverCannotImportUnsafeModule{}
      -> DiagnosticReason
ErrorWithoutFlag
    DriverMissingSafeHaskellMode{}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnMissingSafeHaskellMode
    DriverPackageNotTrusted{}
      -> DiagnosticReason
ErrorWithoutFlag
    DriverCannotImportFromUntrustedPackage{}
      -> DiagnosticReason
ErrorWithoutFlag
    DriverRedirectedNoMain {}
      -> DiagnosticReason
ErrorWithoutFlag
    DriverHomePackagesNotClosed {}
      -> DiagnosticReason
ErrorWithoutFlag
    DriverInterfaceError IfaceMessage
reason -> IfaceMessage -> DiagnosticReason
forall a. Diagnostic a => a -> DiagnosticReason
diagnosticReason IfaceMessage
reason
    DriverInconsistentDynFlags {}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnInconsistentFlags
    DriverSafeHaskellIgnoredExtension {}
      -> DiagnosticReason
WarningWithoutFlag
    DriverPackageTrustIgnored {}
      -> DiagnosticReason
WarningWithoutFlag
    DriverUnrecognisedFlag {}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnUnrecognisedWarningFlags
    DriverDeprecatedFlag {}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnDeprecatedFlags

  diagnosticHints :: DriverMessage -> [GhcHint]
diagnosticHints = \case
    DriverUnknownMessage UnknownDiagnostic (DiagnosticOpts DriverMessage)
m
      -> UnknownDiagnostic DriverMessageOpts -> [GhcHint]
forall a. Diagnostic a => a -> [GhcHint]
diagnosticHints UnknownDiagnostic (DiagnosticOpts DriverMessage)
UnknownDiagnostic DriverMessageOpts
m
    DriverPsHeaderMessage PsMessage
psMsg
      -> PsMessage -> [GhcHint]
forall a. Diagnostic a => a -> [GhcHint]
diagnosticHints PsMessage
psMsg
    DriverMissingHomeModules{}
      -> [GhcHint]
noHints
    DriverUnknownHiddenModules {}
      -> [GhcHint]
noHints
    DriverUnknownReexportedModules {}
      -> [GhcHint]
noHints
    DriverUnusedPackages{}
      -> [GhcHint]
noHints
    DriverUnnecessarySourceImports{}
      -> [GhcHint]
noHints
    DriverDuplicatedModuleDeclaration{}
      -> [GhcHint]
noHints
    DriverModuleNotFound{}
      -> [GhcHint]
noHints
    DriverFileModuleNameMismatch{}
      -> [GhcHint]
noHints
    DriverUnexpectedSignature ModuleName
pi_mod_name BuildingCabalPackage
buildingCabalPackage GenInstantiations UnitId
instantiations
      -> if BuildingCabalPackage
buildingCabalPackage BuildingCabalPackage -> BuildingCabalPackage -> Bool
forall a. Eq a => a -> a -> Bool
== BuildingCabalPackage
YesBuildingCabalPackage
           then [ModuleName -> GhcHint
SuggestAddSignatureCabalFile ModuleName
pi_mod_name]
           else [ModuleName -> [InstantiationSuggestion] -> GhcHint
SuggestSignatureInstantiations ModuleName
pi_mod_name (ModuleName -> GenInstantiations UnitId -> [InstantiationSuggestion]
suggestInstantiatedWith ModuleName
pi_mod_name GenInstantiations UnitId
instantiations)]
    DriverFileNotFound{}
      -> [GhcHint]
noHints
    DriverMessage
DriverStaticPointersNotSupported
      -> [GhcHint]
noHints
    DriverBackpackModuleNotFound{}
      -> [GhcHint]
noHints
    DriverUserDefinedRuleIgnored{}
      -> [GhcHint]
noHints
    DriverMixedSafetyImport{}
      -> [GhcHint]
noHints
    DriverCannotLoadInterfaceFile{}
      -> [GhcHint]
noHints
    DriverInferredSafeModule{}
      -> [GhcHint]
noHints
    DriverInferredSafeImport{}
      -> [GhcHint]
noHints
    DriverCannotImportUnsafeModule{}
      -> [GhcHint]
noHints
    DriverMissingSafeHaskellMode{}
      -> [GhcHint]
noHints
    DriverPackageNotTrusted{}
      -> [GhcHint]
noHints
    DriverMarkedTrustworthyButInferredSafe{}
      -> [GhcHint]
noHints
    DriverCannotImportFromUntrustedPackage{}
      -> [GhcHint]
noHints
    DriverRedirectedNoMain {}
      -> [GhcHint]
noHints
    DriverHomePackagesNotClosed {}
      -> [GhcHint]
noHints
    DriverInterfaceError IfaceMessage
reason -> IfaceMessage -> [GhcHint]
forall a. Diagnostic a => a -> [GhcHint]
diagnosticHints IfaceMessage
reason
    DriverInconsistentDynFlags {}
      -> [GhcHint]
noHints
    DriverSafeHaskellIgnoredExtension {}
      -> [GhcHint]
noHints
    DriverPackageTrustIgnored {}
      -> [GhcHint]
noHints
    DriverUnrecognisedFlag {}
      -> [GhcHint]
noHints
    DriverDeprecatedFlag {}
      -> [GhcHint]
noHints

  diagnosticCode :: DriverMessage -> Maybe DiagnosticCode
diagnosticCode = DriverMessage -> Maybe DiagnosticCode
forall diag.
(Generic diag, GDiagnosticCode (Rep diag)) =>
diag -> Maybe DiagnosticCode
constructorCode