never executed always true always false
    1 {-# LANGUAGE GADTs #-}
    2 
    3 module GHC.Driver.Errors.Types (
    4     GhcMessage(..)
    5   , DriverMessage(..), DriverMessages, PsMessage(PsHeaderMessage)
    6   , BuildingCabalPackage(..)
    7   , WarningMessages
    8   , ErrorMessages
    9   , WarnMsg
   10   -- * Constructors
   11   , ghcUnknownMessage
   12   -- * Utility functions
   13   , hoistTcRnMessage
   14   , hoistDsMessage
   15   , checkBuildingCabalPackage
   16   ) where
   17 
   18 import GHC.Prelude
   19 
   20 import Data.Bifunctor
   21 import Data.Typeable
   22 
   23 import GHC.Driver.Session
   24 import GHC.Types.Error
   25 import GHC.Unit.Module
   26 import GHC.Unit.State
   27 
   28 import GHC.Parser.Errors.Types ( PsMessage(PsHeaderMessage) )
   29 import GHC.Tc.Errors.Types     ( TcRnMessage )
   30 import GHC.HsToCore.Errors.Types ( DsMessage )
   31 import GHC.Hs.Extension          (GhcTc)
   32 
   33 import Language.Haskell.Syntax.Decls (RuleDecl)
   34 
   35 -- | A collection of warning messages.
   36 -- /INVARIANT/: Each 'GhcMessage' in the collection should have 'SevWarning' severity.
   37 type WarningMessages = Messages GhcMessage
   38 
   39 -- | A collection of error messages.
   40 -- /INVARIANT/: Each 'GhcMessage' in the collection should have 'SevError' severity.
   41 type ErrorMessages   = Messages GhcMessage
   42 
   43 -- | A single warning message.
   44 -- /INVARIANT/: It must have 'SevWarning' severity.
   45 type WarnMsg         = MsgEnvelope GhcMessage
   46 
   47 
   48 {- Note [GhcMessage]
   49 ~~~~~~~~~~~~~~~~~~~~
   50 
   51 We might need to report diagnostics (error and/or warnings) to the users. The
   52 'GhcMessage' type is the root of the diagnostic hierarchy.
   53 
   54 It's useful to have a separate type constructor for the different stages of
   55 the compilation pipeline. This is not just helpful for tools, as it gives a
   56 clear indication on where the error occurred exactly. Furthermore it increases
   57 the modularity amongst the different components of GHC (i.e. to avoid having
   58 "everything depend on everything else") and allows us to write separate
   59 functions that renders the different kind of messages.
   60 
   61 -}
   62 
   63 -- | The umbrella type that encompasses all the different messages that GHC
   64 -- might output during the different compilation stages. See
   65 -- Note [GhcMessage].
   66 data GhcMessage where
   67   -- | A message from the parsing phase.
   68   GhcPsMessage      :: PsMessage -> GhcMessage
   69   -- | A message from typecheck/renaming phase.
   70   GhcTcRnMessage    :: TcRnMessage -> GhcMessage
   71   -- | A message from the desugaring (HsToCore) phase.
   72   GhcDsMessage      :: DsMessage -> GhcMessage
   73   -- | A message from the driver.
   74   GhcDriverMessage  :: DriverMessage -> GhcMessage
   75 
   76   -- | An \"escape\" hatch which can be used when we don't know the source of
   77   -- the message or if the message is not one of the typed ones. The
   78   -- 'Diagnostic' and 'Typeable' constraints ensure that if we /know/, at
   79   -- pattern-matching time, the originating type, we can attempt a cast and
   80   -- access the fully-structured error. This would be the case for a GHC
   81   -- plugin that offers a domain-specific error type but that doesn't want to
   82   -- place the burden on IDEs/application code to \"know\" it. The
   83   -- 'Diagnostic' constraint ensures that worst case scenario we can still
   84   -- render this into something which can be eventually converted into a
   85   -- 'DecoratedSDoc'.
   86   GhcUnknownMessage :: forall a. (Diagnostic a, Typeable a) => a -> GhcMessage
   87 
   88 -- | Creates a new 'GhcMessage' out of any diagnostic. This function is also
   89 -- provided to ease the integration of #18516 by allowing diagnostics to be
   90 -- wrapped into the general (but structured) 'GhcMessage' type, so that the
   91 -- conversion can happen gradually. This function should not be needed within
   92 -- GHC, as it would typically be used by plugin or library authors (see
   93 -- comment for the 'GhcUnknownMessage' type constructor)
   94 ghcUnknownMessage :: (Diagnostic a, Typeable a) => a -> GhcMessage
   95 ghcUnknownMessage = GhcUnknownMessage
   96 
   97 -- | Abstracts away the frequent pattern where we are calling 'ioMsgMaybe' on
   98 -- the result of 'IO (Messages TcRnMessage, a)'.
   99 hoistTcRnMessage :: Monad m => m (Messages TcRnMessage, a) -> m (Messages GhcMessage, a)
  100 hoistTcRnMessage = fmap (first (fmap GhcTcRnMessage))
  101 
  102 -- | Abstracts away the frequent pattern where we are calling 'ioMsgMaybe' on
  103 -- the result of 'IO (Messages DsMessage, a)'.
  104 hoistDsMessage :: Monad m => m (Messages DsMessage, a) -> m (Messages GhcMessage, a)
  105 hoistDsMessage = fmap (first (fmap GhcDsMessage))
  106 
  107 -- | A collection of driver messages
  108 type DriverMessages = Messages DriverMessage
  109 
  110 -- | A message from the driver.
  111 data DriverMessage where
  112   -- | Simply wraps a generic 'Diagnostic' message @a@.
  113   DriverUnknownMessage :: (Diagnostic a, Typeable a) => a -> DriverMessage
  114   -- | A parse error in parsing a Haskell file header during dependency
  115   -- analysis
  116   DriverPsHeaderMessage :: !PsMessage -> DriverMessage
  117 
  118   {-| DriverMissingHomeModules is a warning (controlled with -Wmissing-home-modules) that
  119       arises when running GHC in --make mode when some modules needed for compilation
  120       are not included on the command line. For example, if A imports B, `ghc --make
  121       A.hs` will cause this warning, while `ghc --make A.hs B.hs` will not.
  122 
  123       Useful for cabal to ensure GHC won't pick up modules listed neither in
  124       'exposed-modules' nor in 'other-modules'.
  125 
  126       Test case: warnings/should_compile/MissingMod
  127 
  128   -}
  129   DriverMissingHomeModules :: [ModuleName] -> !BuildingCabalPackage -> DriverMessage
  130 
  131   {-| DriverUnusedPackages occurs when when package is requested on command line,
  132       but was never needed during compilation. Activated by -Wunused-packages.
  133 
  134      Test cases: warnings/should_compile/UnusedPackages
  135   -}
  136   DriverUnusedPackages :: [PackageArg] -> DriverMessage
  137 
  138   {-| DriverUnnecessarySourceImports (controlled with -Wunused-imports) occurs if there
  139       are {-# SOURCE #-} imports which are not necessary. See 'warnUnnecessarySourceImports'
  140       in 'GHC.Driver.Make'.
  141 
  142      Test cases: warnings/should_compile/T10637
  143   -}
  144   DriverUnnecessarySourceImports :: !ModuleName -> DriverMessage
  145 
  146   {-| DriverDuplicatedModuleDeclaration occurs if a module 'A' is declared in
  147        multiple files.
  148 
  149      Test cases: None.
  150   -}
  151   DriverDuplicatedModuleDeclaration :: !Module -> [FilePath] -> DriverMessage
  152 
  153   {-| DriverModuleNotFound occurs if a module 'A' can't be found.
  154 
  155      Test cases: None.
  156   -}
  157   DriverModuleNotFound :: !ModuleName -> DriverMessage
  158 
  159   {-| DriverFileModuleNameMismatch occurs if a module 'A' is defined in a file with a different name.
  160       The first field is the name written in the source code; the second argument is the name extracted
  161       from the filename.
  162 
  163      Test cases: module/mod178, /driver/bug1677
  164   -}
  165   DriverFileModuleNameMismatch :: !ModuleName -> !ModuleName -> DriverMessage
  166 
  167   {-| DriverUnexpectedSignature occurs when GHC encounters a module 'A' that imports a signature
  168       file which is neither in the 'signatures' section of a '.cabal' file nor in any package in
  169       the home modules.
  170 
  171       Example:
  172 
  173       -- MyStr.hsig is defined, but not added to 'signatures' in the '.cabal' file.
  174       signature MyStr where
  175           data Str
  176 
  177       -- A.hs, which tries to import the signature.
  178       module A where
  179       import MyStr
  180 
  181 
  182      Test cases: driver/T12955
  183   -}
  184   DriverUnexpectedSignature :: !ModuleName -> !BuildingCabalPackage -> GenInstantiations UnitId -> DriverMessage
  185 
  186   {-| DriverFileNotFound occurs when the input file (e.g. given on the command line) can't be found.
  187 
  188      Test cases: None.
  189   -}
  190   DriverFileNotFound :: !FilePath -> DriverMessage
  191 
  192   {-| DriverStaticPointersNotSupported occurs when the 'StaticPointers' extension is used
  193        in an interactive GHCi context.
  194 
  195      Test cases: ghci/scripts/StaticPtr
  196   -}
  197   DriverStaticPointersNotSupported :: DriverMessage
  198 
  199   {-| DriverBackpackModuleNotFound occurs when Backpack can't find a particular module
  200       during its dependency analysis.
  201 
  202      Test cases: -
  203   -}
  204   DriverBackpackModuleNotFound :: !ModuleName -> DriverMessage
  205 
  206   {-| DriverUserDefinedRuleIgnored is a warning that occurs when user-defined rules
  207       are ignored. This typically happens when Safe Haskell.
  208 
  209      Test cases:
  210 
  211        tests/safeHaskell/safeInfered/UnsafeWarn05
  212        tests/safeHaskell/safeInfered/UnsafeWarn06
  213        tests/safeHaskell/safeInfered/UnsafeWarn07
  214        tests/safeHaskell/safeInfered/UnsafeInfered11
  215        tests/safeHaskell/safeLanguage/SafeLang03
  216   -}
  217   DriverUserDefinedRuleIgnored :: !(RuleDecl GhcTc) -> DriverMessage
  218 
  219   {-| DriverMixedSafetyImport is an error that occurs when a module is imported
  220       both as safe and unsafe.
  221 
  222     Test cases:
  223 
  224       tests/safeHaskell/safeInfered/Mixed03
  225       tests/safeHaskell/safeInfered/Mixed02
  226 
  227   -}
  228   DriverMixedSafetyImport :: !ModuleName -> DriverMessage
  229 
  230   {-| DriverCannotLoadInterfaceFile is an error that occurs when we cannot load the interface
  231       file for a particular module. This can happen for example in the context of Safe Haskell,
  232       when we have to load a module to check if it can be safely imported.
  233 
  234     Test cases: None.
  235 
  236   -}
  237   DriverCannotLoadInterfaceFile :: !Module -> DriverMessage
  238 
  239   {-| DriverInferredSafeImport is a warning (controlled by the Opt_WarnSafe flag)
  240       that occurs when a module is inferred safe.
  241 
  242     Test cases: None.
  243 
  244   -}
  245   DriverInferredSafeModule :: !Module -> DriverMessage
  246 
  247   {-| DriverMarkedTrustworthyButInferredSafe is a warning (controlled by the Opt_WarnTrustworthySafe flag)
  248       that occurs when a module is marked trustworthy in SafeHaskell but it has been inferred safe.
  249 
  250     Test cases:
  251       tests/safeHaskell/safeInfered/TrustworthySafe02
  252       tests/safeHaskell/safeInfered/TrustworthySafe03
  253 
  254   -}
  255   DriverMarkedTrustworthyButInferredSafe :: !Module -> DriverMessage
  256 
  257   {-| DriverInferredSafeImport is a warning (controlled by the Opt_WarnInferredSafeImports flag)
  258       that occurs when a safe-inferred module is imported from a safe module.
  259 
  260     Test cases: None.
  261 
  262   -}
  263   DriverInferredSafeImport :: !Module -> DriverMessage
  264 
  265   {-| DriverCannotImportUnsafeModule is an error that occurs when an usafe module
  266       is being imported from a safe one.
  267 
  268     Test cases: None.
  269 
  270   -}
  271   DriverCannotImportUnsafeModule :: !Module -> DriverMessage
  272 
  273   {-| DriverMissingSafeHaskellMode is a warning (controlled by the Opt_WarnMissingSafeHaskellMode flag)
  274       that occurs when a module is using SafeHaskell features but SafeHaskell mode is not enabled.
  275 
  276     Test cases: None.
  277 
  278   -}
  279   DriverMissingSafeHaskellMode :: !Module -> DriverMessage
  280 
  281   {-| DriverPackageNotTrusted is an error that occurs when a package is required to be trusted
  282       but it isn't.
  283 
  284     Test cases:
  285       tests/safeHaskell/check/Check01
  286       tests/safeHaskell/check/Check08
  287       tests/safeHaskell/check/Check06
  288       tests/safeHaskell/check/pkg01/ImpSafeOnly09
  289       tests/safeHaskell/check/pkg01/ImpSafe03
  290       tests/safeHaskell/check/pkg01/ImpSafeOnly07
  291       tests/safeHaskell/check/pkg01/ImpSafeOnly08
  292 
  293   -}
  294   DriverPackageNotTrusted :: !UnitState -> !UnitId -> DriverMessage
  295 
  296   {-| DriverCannotImportFromUntrustedPackage is an error that occurs in the context of
  297       Safe Haskell when trying to import a module coming from an untrusted package.
  298 
  299     Test cases:
  300       tests/safeHaskell/check/Check09
  301       tests/safeHaskell/check/pkg01/ImpSafe01
  302       tests/safeHaskell/check/pkg01/ImpSafe04
  303       tests/safeHaskell/check/pkg01/ImpSafeOnly03
  304       tests/safeHaskell/check/pkg01/ImpSafeOnly05
  305       tests/safeHaskell/flags/SafeFlags17
  306       tests/safeHaskell/flags/SafeFlags22
  307       tests/safeHaskell/flags/SafeFlags23
  308       tests/safeHaskell/ghci/p11
  309       tests/safeHaskell/ghci/p12
  310       tests/safeHaskell/ghci/p17
  311       tests/safeHaskell/ghci/p3
  312       tests/safeHaskell/safeInfered/UnsafeInfered01
  313       tests/safeHaskell/safeInfered/UnsafeInfered02
  314       tests/safeHaskell/safeInfered/UnsafeInfered02
  315       tests/safeHaskell/safeInfered/UnsafeInfered03
  316       tests/safeHaskell/safeInfered/UnsafeInfered05
  317       tests/safeHaskell/safeInfered/UnsafeInfered06
  318       tests/safeHaskell/safeInfered/UnsafeInfered09
  319       tests/safeHaskell/safeInfered/UnsafeInfered10
  320       tests/safeHaskell/safeInfered/UnsafeInfered11
  321       tests/safeHaskell/safeInfered/UnsafeWarn01
  322       tests/safeHaskell/safeInfered/UnsafeWarn03
  323       tests/safeHaskell/safeInfered/UnsafeWarn04
  324       tests/safeHaskell/safeInfered/UnsafeWarn05
  325       tests/safeHaskell/unsafeLibs/BadImport01
  326       tests/safeHaskell/unsafeLibs/BadImport06
  327       tests/safeHaskell/unsafeLibs/BadImport07
  328       tests/safeHaskell/unsafeLibs/BadImport08
  329       tests/safeHaskell/unsafeLibs/BadImport09
  330       tests/safeHaskell/unsafeLibs/Dep05
  331       tests/safeHaskell/unsafeLibs/Dep06
  332       tests/safeHaskell/unsafeLibs/Dep07
  333       tests/safeHaskell/unsafeLibs/Dep08
  334       tests/safeHaskell/unsafeLibs/Dep09
  335       tests/safeHaskell/unsafeLibs/Dep10
  336 
  337   -}
  338   DriverCannotImportFromUntrustedPackage :: !UnitState -> !Module -> DriverMessage
  339 
  340 -- | Pass to a 'DriverMessage' the information whether or not the
  341 -- '-fbuilding-cabal-package' flag is set.
  342 data BuildingCabalPackage
  343   = YesBuildingCabalPackage
  344   | NoBuildingCabalPackage
  345   deriving Eq
  346 
  347 -- | Checks if we are building a cabal package by consulting the 'DynFlags'.
  348 checkBuildingCabalPackage :: DynFlags -> BuildingCabalPackage
  349 checkBuildingCabalPackage dflags =
  350   if gopt Opt_BuildingCabalPackage dflags
  351      then YesBuildingCabalPackage
  352      else NoBuildingCabalPackage