never executed always true always false
    1 {-# LANGUAGE GADTs #-}
    2 {-# LANGUAGE LambdaCase #-}
    3 {-# OPTIONS_GHC -fno-warn-orphans #-} -- instance Diagnostic {DriverMessage, GhcMessage}
    4 
    5 module GHC.Driver.Errors.Ppr where
    6 
    7 import GHC.Prelude
    8 
    9 import GHC.Driver.Errors.Types
   10 import GHC.Driver.Flags
   11 import GHC.Driver.Session
   12 import GHC.HsToCore.Errors.Ppr ()
   13 import GHC.Parser.Errors.Ppr ()
   14 import GHC.Tc.Errors.Ppr ()
   15 import GHC.Types.Error
   16 import GHC.Unit.Types
   17 import GHC.Utils.Outputable
   18 import GHC.Unit.Module
   19 import GHC.Unit.State
   20 import GHC.Types.Hint
   21 import GHC.Types.SrcLoc
   22 
   23 import Language.Haskell.Syntax.Decls (RuleDecl(..))
   24 
   25 --
   26 -- Suggestions
   27 --
   28 
   29 -- | Suggests a list of 'InstantiationSuggestion' for the '.hsig' file to the user.
   30 suggestInstantiatedWith :: ModuleName -> GenInstantiations UnitId -> [InstantiationSuggestion]
   31 suggestInstantiatedWith pi_mod_name insts =
   32   [ InstantiationSuggestion k v | (k,v) <- ((pi_mod_name, mkHoleModule pi_mod_name) : insts) ]
   33 
   34 
   35 instance Diagnostic GhcMessage where
   36   diagnosticMessage = \case
   37     GhcPsMessage m
   38       -> diagnosticMessage m
   39     GhcTcRnMessage m
   40       -> diagnosticMessage m
   41     GhcDsMessage m
   42       -> diagnosticMessage m
   43     GhcDriverMessage m
   44       -> diagnosticMessage m
   45     GhcUnknownMessage m
   46       -> diagnosticMessage m
   47 
   48   diagnosticReason = \case
   49     GhcPsMessage m
   50       -> diagnosticReason m
   51     GhcTcRnMessage m
   52       -> diagnosticReason m
   53     GhcDsMessage m
   54       -> diagnosticReason m
   55     GhcDriverMessage m
   56       -> diagnosticReason m
   57     GhcUnknownMessage m
   58       -> diagnosticReason m
   59 
   60   diagnosticHints = \case
   61     GhcPsMessage m
   62       -> diagnosticHints m
   63     GhcTcRnMessage m
   64       -> diagnosticHints m
   65     GhcDsMessage m
   66       -> diagnosticHints m
   67     GhcDriverMessage m
   68       -> diagnosticHints m
   69     GhcUnknownMessage m
   70       -> diagnosticHints m
   71 
   72 instance Diagnostic DriverMessage where
   73   diagnosticMessage = \case
   74     DriverUnknownMessage m
   75       -> diagnosticMessage m
   76     DriverPsHeaderMessage m
   77       -> diagnosticMessage m
   78     DriverMissingHomeModules missing buildingCabalPackage
   79       -> let msg | buildingCabalPackage == YesBuildingCabalPackage
   80                  = hang
   81                      (text "These modules are needed for compilation but not listed in your .cabal file's other-modules: ")
   82                      4
   83                      (sep (map ppr missing))
   84                  | otherwise
   85                  =
   86                    hang
   87                      (text "Modules are not listed in command line but needed for compilation: ")
   88                      4
   89                      (sep (map ppr missing))
   90          in mkSimpleDecorated msg
   91     DriverUnusedPackages unusedArgs
   92       -> let msg = vcat [ text "The following packages were specified" <+>
   93                           text "via -package or -package-id flags,"
   94                         , text "but were not needed for compilation:"
   95                         , nest 2 (vcat (map (withDash . pprUnusedArg) unusedArgs))
   96                         ]
   97          in mkSimpleDecorated msg
   98          where
   99             withDash :: SDoc -> SDoc
  100             withDash = (<+>) (text "-")
  101 
  102             pprUnusedArg :: PackageArg -> SDoc
  103             pprUnusedArg (PackageArg str) = text str
  104             pprUnusedArg (UnitIdArg uid) = ppr uid
  105     DriverUnnecessarySourceImports mod
  106       -> mkSimpleDecorated (text "{-# SOURCE #-} unnecessary in import of " <+> quotes (ppr mod))
  107     DriverDuplicatedModuleDeclaration mod files
  108       -> mkSimpleDecorated $
  109            text "module" <+> quotes (ppr mod) <+>
  110            text "is defined in multiple files:" <+>
  111            sep (map text files)
  112     DriverModuleNotFound mod
  113       -> mkSimpleDecorated (text "module" <+> quotes (ppr mod) <+> text "cannot be found locally")
  114     DriverFileModuleNameMismatch actual expected
  115       -> mkSimpleDecorated $
  116            text "File name does not match module name:"
  117            $$ text "Saw     :" <+> quotes (ppr actual)
  118            $$ text "Expected:" <+> quotes (ppr expected)
  119 
  120     DriverUnexpectedSignature pi_mod_name _buildingCabalPackage _instantiations
  121       -> mkSimpleDecorated $ text "Unexpected signature:" <+> quotes (ppr pi_mod_name)
  122     DriverFileNotFound hsFilePath
  123       -> mkSimpleDecorated (text "Can't find" <+> text hsFilePath)
  124     DriverStaticPointersNotSupported
  125       -> mkSimpleDecorated (text "StaticPointers is not supported in GHCi interactive expressions.")
  126     DriverBackpackModuleNotFound modname
  127       -> mkSimpleDecorated (text "module" <+> ppr modname <+> text "was not found")
  128     DriverUserDefinedRuleIgnored (HsRule { rd_name = n })
  129       -> mkSimpleDecorated $
  130             text "Rule \"" <> ftext (snd $ unLoc n) <> text "\" ignored" $+$
  131             text "User defined rules are disabled under Safe Haskell"
  132     DriverMixedSafetyImport modName
  133       -> mkSimpleDecorated $
  134            text "Module" <+> ppr modName <+> text ("is imported both as a safe and unsafe import!")
  135     DriverCannotLoadInterfaceFile m
  136       -> mkSimpleDecorated $
  137            text "Can't load the interface file for" <+> ppr m
  138            <> text ", to check that it can be safely imported"
  139     DriverInferredSafeModule m
  140       -> mkSimpleDecorated $
  141            quotes (ppr $ moduleName m) <+> text "has been inferred as safe!"
  142     DriverInferredSafeImport m
  143       -> mkSimpleDecorated $
  144            sep
  145              [ text "Importing Safe-Inferred module "
  146                  <> ppr (moduleName m)
  147                  <> text " from explicitly Safe module"
  148              ]
  149     DriverMarkedTrustworthyButInferredSafe m
  150       -> mkSimpleDecorated $
  151            quotes (ppr $ moduleName m) <+> text "is marked as Trustworthy but has been inferred as safe!"
  152     DriverCannotImportUnsafeModule m
  153       -> mkSimpleDecorated $
  154            sep [ ppr (moduleName m)
  155                    <> text ": Can't be safely imported!"
  156                , text "The module itself isn't safe." ]
  157     DriverMissingSafeHaskellMode modName
  158       -> mkSimpleDecorated $
  159            ppr modName <+> text "is missing Safe Haskell mode"
  160     DriverPackageNotTrusted state pkg
  161       -> mkSimpleDecorated $
  162            pprWithUnitState state
  163              $ text "The package ("
  164                 <> ppr pkg
  165                 <> text ") is required to be trusted but it isn't!"
  166     DriverCannotImportFromUntrustedPackage state m
  167       -> mkSimpleDecorated $
  168            sep [ ppr (moduleName m)
  169                    <> text ": Can't be safely imported!"
  170                , text "The package ("
  171                    <> (pprWithUnitState state $ ppr (moduleUnit m))
  172                    <> text ") the module resides in isn't trusted."
  173                ]
  174 
  175   diagnosticReason = \case
  176     DriverUnknownMessage m
  177       -> diagnosticReason m
  178     DriverPsHeaderMessage {}
  179       -> ErrorWithoutFlag
  180     DriverMissingHomeModules{}
  181       -> WarningWithFlag Opt_WarnMissingHomeModules
  182     DriverUnusedPackages{}
  183       -> WarningWithFlag Opt_WarnUnusedPackages
  184     DriverUnnecessarySourceImports{}
  185       -> WarningWithFlag Opt_WarnUnusedImports
  186     DriverDuplicatedModuleDeclaration{}
  187       -> ErrorWithoutFlag
  188     DriverModuleNotFound{}
  189       -> ErrorWithoutFlag
  190     DriverFileModuleNameMismatch{}
  191       -> ErrorWithoutFlag
  192     DriverUnexpectedSignature{}
  193       -> ErrorWithoutFlag
  194     DriverFileNotFound{}
  195       -> ErrorWithoutFlag
  196     DriverStaticPointersNotSupported
  197       -> WarningWithoutFlag
  198     DriverBackpackModuleNotFound{}
  199       -> ErrorWithoutFlag
  200     DriverUserDefinedRuleIgnored{}
  201       -> WarningWithoutFlag
  202     DriverMixedSafetyImport{}
  203       -> ErrorWithoutFlag
  204     DriverCannotLoadInterfaceFile{}
  205       -> ErrorWithoutFlag
  206     DriverInferredSafeModule{}
  207       -> WarningWithFlag Opt_WarnSafe
  208     DriverMarkedTrustworthyButInferredSafe{}
  209       ->WarningWithFlag Opt_WarnTrustworthySafe
  210     DriverInferredSafeImport{}
  211       -> WarningWithFlag Opt_WarnInferredSafeImports
  212     DriverCannotImportUnsafeModule{}
  213       -> ErrorWithoutFlag
  214     DriverMissingSafeHaskellMode{}
  215       -> WarningWithFlag Opt_WarnMissingSafeHaskellMode
  216     DriverPackageNotTrusted{}
  217       -> ErrorWithoutFlag
  218     DriverCannotImportFromUntrustedPackage{}
  219       -> ErrorWithoutFlag
  220 
  221   diagnosticHints = \case
  222     DriverUnknownMessage m
  223       -> diagnosticHints m
  224     DriverPsHeaderMessage psMsg
  225       -> diagnosticHints psMsg
  226     DriverMissingHomeModules{}
  227       -> noHints
  228     DriverUnusedPackages{}
  229       -> noHints
  230     DriverUnnecessarySourceImports{}
  231       -> noHints
  232     DriverDuplicatedModuleDeclaration{}
  233       -> noHints
  234     DriverModuleNotFound{}
  235       -> noHints
  236     DriverFileModuleNameMismatch{}
  237       -> noHints
  238     DriverUnexpectedSignature pi_mod_name buildingCabalPackage instantiations
  239       -> if buildingCabalPackage == YesBuildingCabalPackage
  240            then [SuggestAddSignatureCabalFile pi_mod_name]
  241            else [SuggestSignatureInstantiations pi_mod_name (suggestInstantiatedWith pi_mod_name instantiations)]
  242     DriverFileNotFound{}
  243       -> noHints
  244     DriverStaticPointersNotSupported
  245       -> noHints
  246     DriverBackpackModuleNotFound{}
  247       -> noHints
  248     DriverUserDefinedRuleIgnored{}
  249       -> noHints
  250     DriverMixedSafetyImport{}
  251       -> noHints
  252     DriverCannotLoadInterfaceFile{}
  253       -> noHints
  254     DriverInferredSafeModule{}
  255       -> noHints
  256     DriverInferredSafeImport{}
  257       -> noHints
  258     DriverCannotImportUnsafeModule{}
  259       -> noHints
  260     DriverMissingSafeHaskellMode{}
  261       -> noHints
  262     DriverPackageNotTrusted{}
  263       -> noHints
  264     DriverMarkedTrustworthyButInferredSafe{}
  265       -> noHints
  266     DriverCannotImportFromUntrustedPackage{}
  267       -> noHints