diff options
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/GHC/Driver/Flags.hs | 180 | ||||
| -rw-r--r-- | compiler/GHC/Driver/Session.hs | 3 | ||||
| -rw-r--r-- | compiler/GHC/Rename/Names.hs | 108 |
3 files changed, 163 insertions, 128 deletions
diff --git a/compiler/GHC/Driver/Flags.hs b/compiler/GHC/Driver/Flags.hs index 97039cbcf8..19f730ed19 100644 --- a/compiler/GHC/Driver/Flags.hs +++ b/compiler/GHC/Driver/Flags.hs @@ -534,6 +534,7 @@ data WarningFlag = | Opt_WarnAmbiguousFields -- Since 9.2 | Opt_WarnImplicitLift -- Since 9.2 | Opt_WarnMissingKindSignatures -- Since 9.2 + | Opt_WarnMissingExportedPatternSynonymSignatures -- since 9.2 deriving (Eq, Show, Enum) -- | Return the names of a WarningFlag @@ -542,95 +543,96 @@ data WarningFlag = -- the "preferred one" that will be displayed in warning messages. warnFlagNames :: WarningFlag -> NonEmpty String warnFlagNames wflag = case wflag of - Opt_WarnAlternativeLayoutRuleTransitional -> "alternative-layout-rule-transitional" :| [] - Opt_WarnAmbiguousFields -> "ambiguous-fields" :| [] - Opt_WarnAutoOrphans -> "auto-orphans" :| [] - Opt_WarnCPPUndef -> "cpp-undef" :| [] - Opt_WarnUnbangedStrictPatterns -> "unbanged-strict-patterns" :| [] - Opt_WarnDeferredTypeErrors -> "deferred-type-errors" :| [] - Opt_WarnDeferredOutOfScopeVariables -> "deferred-out-of-scope-variables" :| [] - Opt_WarnWarningsDeprecations -> "deprecations" :| ["warnings-deprecations"] - Opt_WarnDeprecatedFlags -> "deprecated-flags" :| [] - Opt_WarnDerivingDefaults -> "deriving-defaults" :| [] - Opt_WarnDerivingTypeable -> "deriving-typeable" :| [] - Opt_WarnDodgyExports -> "dodgy-exports" :| [] - Opt_WarnDodgyForeignImports -> "dodgy-foreign-imports" :| [] - Opt_WarnDodgyImports -> "dodgy-imports" :| [] - Opt_WarnEmptyEnumerations -> "empty-enumerations" :| [] - Opt_WarnDuplicateConstraints -> "duplicate-constraints" :| [] - Opt_WarnRedundantConstraints -> "redundant-constraints" :| [] - Opt_WarnDuplicateExports -> "duplicate-exports" :| [] - Opt_WarnHiShadows -> "hi-shadowing" :| [] - Opt_WarnInaccessibleCode -> "inaccessible-code" :| [] - Opt_WarnImplicitPrelude -> "implicit-prelude" :| [] - Opt_WarnImplicitKindVars -> "implicit-kind-vars" :| [] - Opt_WarnIncompletePatterns -> "incomplete-patterns" :| [] - Opt_WarnIncompletePatternsRecUpd -> "incomplete-record-updates" :| [] - Opt_WarnIncompleteUniPatterns -> "incomplete-uni-patterns" :| [] - Opt_WarnInlineRuleShadowing -> "inline-rule-shadowing" :| [] - Opt_WarnIdentities -> "identities" :| [] - Opt_WarnMissingFields -> "missing-fields" :| [] - Opt_WarnMissingImportList -> "missing-import-lists" :| [] - Opt_WarnMissingExportList -> "missing-export-lists" :| [] - Opt_WarnMissingLocalSignatures -> "missing-local-signatures" :| [] - Opt_WarnMissingMethods -> "missing-methods" :| [] - Opt_WarnMissingMonadFailInstances -> "missing-monadfail-instances" :| [] - Opt_WarnSemigroup -> "semigroup" :| [] - Opt_WarnMissingSignatures -> "missing-signatures" :| [] - Opt_WarnMissingKindSignatures -> "missing-kind-signatures" :| [] - Opt_WarnMissingExportedSignatures -> "missing-exported-signatures" :| [] - Opt_WarnMonomorphism -> "monomorphism-restriction" :| [] - Opt_WarnNameShadowing -> "name-shadowing" :| [] - Opt_WarnNonCanonicalMonadInstances -> "noncanonical-monad-instances" :| [] - Opt_WarnNonCanonicalMonadFailInstances -> "noncanonical-monadfail-instances" :| [] - Opt_WarnNonCanonicalMonoidInstances -> "noncanonical-monoid-instances" :| [] - Opt_WarnOrphans -> "orphans" :| [] - Opt_WarnOverflowedLiterals -> "overflowed-literals" :| [] - Opt_WarnOverlappingPatterns -> "overlapping-patterns" :| [] - Opt_WarnMissedSpecs -> "missed-specialisations" :| ["missed-specializations"] - Opt_WarnAllMissedSpecs -> "all-missed-specialisations" :| ["all-missed-specializations"] - Opt_WarnSafe -> "safe" :| [] - Opt_WarnTrustworthySafe -> "trustworthy-safe" :| [] - Opt_WarnInferredSafeImports -> "inferred-safe-imports" :| [] - Opt_WarnMissingSafeHaskellMode -> "missing-safe-haskell-mode" :| [] - Opt_WarnTabs -> "tabs" :| [] - Opt_WarnTypeDefaults -> "type-defaults" :| [] - Opt_WarnTypedHoles -> "typed-holes" :| [] - Opt_WarnPartialTypeSignatures -> "partial-type-signatures" :| [] - Opt_WarnUnrecognisedPragmas -> "unrecognised-pragmas" :| [] - Opt_WarnUnsafe -> "unsafe" :| [] - Opt_WarnUnsupportedCallingConventions -> "unsupported-calling-conventions" :| [] - Opt_WarnUnsupportedLlvmVersion -> "unsupported-llvm-version" :| [] - Opt_WarnMissedExtraSharedLib -> "missed-extra-shared-lib" :| [] - Opt_WarnUntickedPromotedConstructors -> "unticked-promoted-constructors" :| [] - Opt_WarnUnusedDoBind -> "unused-do-bind" :| [] - Opt_WarnUnusedForalls -> "unused-foralls" :| [] - Opt_WarnUnusedImports -> "unused-imports" :| [] - Opt_WarnUnusedLocalBinds -> "unused-local-binds" :| [] - Opt_WarnUnusedMatches -> "unused-matches" :| [] - Opt_WarnUnusedPatternBinds -> "unused-pattern-binds" :| [] - Opt_WarnUnusedTopBinds -> "unused-top-binds" :| [] - Opt_WarnUnusedTypePatterns -> "unused-type-patterns" :| [] - Opt_WarnUnusedRecordWildcards -> "unused-record-wildcards" :| [] - Opt_WarnRedundantBangPatterns -> "redundant-bang-patterns" :| [] - Opt_WarnRedundantRecordWildcards -> "redundant-record-wildcards" :| [] - Opt_WarnWrongDoBind -> "wrong-do-bind" :| [] - Opt_WarnMissingPatternSynonymSignatures -> "missing-pattern-synonym-signatures" :| [] - Opt_WarnMissingDerivingStrategies -> "missing-deriving-strategies" :| [] - Opt_WarnSimplifiableClassConstraints -> "simplifiable-class-constraints" :| [] - Opt_WarnMissingHomeModules -> "missing-home-modules" :| [] - Opt_WarnUnrecognisedWarningFlags -> "unrecognised-warning-flags" :| [] - Opt_WarnStarBinder -> "star-binder" :| [] - Opt_WarnStarIsType -> "star-is-type" :| [] - Opt_WarnSpaceAfterBang -> "missing-space-after-bang" :| [] - Opt_WarnPartialFields -> "partial-fields" :| [] - Opt_WarnPrepositiveQualifiedModule -> "prepositive-qualified-module" :| [] - Opt_WarnUnusedPackages -> "unused-packages" :| [] - Opt_WarnCompatUnqualifiedImports -> "compat-unqualified-imports" :| [] - Opt_WarnInvalidHaddock -> "invalid-haddock" :| [] - Opt_WarnOperatorWhitespaceExtConflict -> "operator-whitespace-ext-conflict" :| [] - Opt_WarnOperatorWhitespace -> "operator-whitespace" :| [] - Opt_WarnImplicitLift -> "implicit-lift" :| [] + Opt_WarnAlternativeLayoutRuleTransitional -> "alternative-layout-rule-transitional" :| [] + Opt_WarnAmbiguousFields -> "ambiguous-fields" :| [] + Opt_WarnAutoOrphans -> "auto-orphans" :| [] + Opt_WarnCPPUndef -> "cpp-undef" :| [] + Opt_WarnUnbangedStrictPatterns -> "unbanged-strict-patterns" :| [] + Opt_WarnDeferredTypeErrors -> "deferred-type-errors" :| [] + Opt_WarnDeferredOutOfScopeVariables -> "deferred-out-of-scope-variables" :| [] + Opt_WarnWarningsDeprecations -> "deprecations" :| ["warnings-deprecations"] + Opt_WarnDeprecatedFlags -> "deprecated-flags" :| [] + Opt_WarnDerivingDefaults -> "deriving-defaults" :| [] + Opt_WarnDerivingTypeable -> "deriving-typeable" :| [] + Opt_WarnDodgyExports -> "dodgy-exports" :| [] + Opt_WarnDodgyForeignImports -> "dodgy-foreign-imports" :| [] + Opt_WarnDodgyImports -> "dodgy-imports" :| [] + Opt_WarnEmptyEnumerations -> "empty-enumerations" :| [] + Opt_WarnDuplicateConstraints -> "duplicate-constraints" :| [] + Opt_WarnRedundantConstraints -> "redundant-constraints" :| [] + Opt_WarnDuplicateExports -> "duplicate-exports" :| [] + Opt_WarnHiShadows -> "hi-shadowing" :| [] + Opt_WarnInaccessibleCode -> "inaccessible-code" :| [] + Opt_WarnImplicitPrelude -> "implicit-prelude" :| [] + Opt_WarnImplicitKindVars -> "implicit-kind-vars" :| [] + Opt_WarnIncompletePatterns -> "incomplete-patterns" :| [] + Opt_WarnIncompletePatternsRecUpd -> "incomplete-record-updates" :| [] + Opt_WarnIncompleteUniPatterns -> "incomplete-uni-patterns" :| [] + Opt_WarnInlineRuleShadowing -> "inline-rule-shadowing" :| [] + Opt_WarnIdentities -> "identities" :| [] + Opt_WarnMissingFields -> "missing-fields" :| [] + Opt_WarnMissingImportList -> "missing-import-lists" :| [] + Opt_WarnMissingExportList -> "missing-export-lists" :| [] + Opt_WarnMissingLocalSignatures -> "missing-local-signatures" :| [] + Opt_WarnMissingMethods -> "missing-methods" :| [] + Opt_WarnMissingMonadFailInstances -> "missing-monadfail-instances" :| [] + Opt_WarnSemigroup -> "semigroup" :| [] + Opt_WarnMissingSignatures -> "missing-signatures" :| [] + Opt_WarnMissingKindSignatures -> "missing-kind-signatures" :| [] + Opt_WarnMissingExportedSignatures -> "missing-exported-signatures" :| [] + Opt_WarnMonomorphism -> "monomorphism-restriction" :| [] + Opt_WarnNameShadowing -> "name-shadowing" :| [] + Opt_WarnNonCanonicalMonadInstances -> "noncanonical-monad-instances" :| [] + Opt_WarnNonCanonicalMonadFailInstances -> "noncanonical-monadfail-instances" :| [] + Opt_WarnNonCanonicalMonoidInstances -> "noncanonical-monoid-instances" :| [] + Opt_WarnOrphans -> "orphans" :| [] + Opt_WarnOverflowedLiterals -> "overflowed-literals" :| [] + Opt_WarnOverlappingPatterns -> "overlapping-patterns" :| [] + Opt_WarnMissedSpecs -> "missed-specialisations" :| ["missed-specializations"] + Opt_WarnAllMissedSpecs -> "all-missed-specialisations" :| ["all-missed-specializations"] + Opt_WarnSafe -> "safe" :| [] + Opt_WarnTrustworthySafe -> "trustworthy-safe" :| [] + Opt_WarnInferredSafeImports -> "inferred-safe-imports" :| [] + Opt_WarnMissingSafeHaskellMode -> "missing-safe-haskell-mode" :| [] + Opt_WarnTabs -> "tabs" :| [] + Opt_WarnTypeDefaults -> "type-defaults" :| [] + Opt_WarnTypedHoles -> "typed-holes" :| [] + Opt_WarnPartialTypeSignatures -> "partial-type-signatures" :| [] + Opt_WarnUnrecognisedPragmas -> "unrecognised-pragmas" :| [] + Opt_WarnUnsafe -> "unsafe" :| [] + Opt_WarnUnsupportedCallingConventions -> "unsupported-calling-conventions" :| [] + Opt_WarnUnsupportedLlvmVersion -> "unsupported-llvm-version" :| [] + Opt_WarnMissedExtraSharedLib -> "missed-extra-shared-lib" :| [] + Opt_WarnUntickedPromotedConstructors -> "unticked-promoted-constructors" :| [] + Opt_WarnUnusedDoBind -> "unused-do-bind" :| [] + Opt_WarnUnusedForalls -> "unused-foralls" :| [] + Opt_WarnUnusedImports -> "unused-imports" :| [] + Opt_WarnUnusedLocalBinds -> "unused-local-binds" :| [] + Opt_WarnUnusedMatches -> "unused-matches" :| [] + Opt_WarnUnusedPatternBinds -> "unused-pattern-binds" :| [] + Opt_WarnUnusedTopBinds -> "unused-top-binds" :| [] + Opt_WarnUnusedTypePatterns -> "unused-type-patterns" :| [] + Opt_WarnUnusedRecordWildcards -> "unused-record-wildcards" :| [] + Opt_WarnRedundantBangPatterns -> "redundant-bang-patterns" :| [] + Opt_WarnRedundantRecordWildcards -> "redundant-record-wildcards" :| [] + Opt_WarnWrongDoBind -> "wrong-do-bind" :| [] + Opt_WarnMissingPatternSynonymSignatures -> "missing-pattern-synonym-signatures" :| [] + Opt_WarnMissingDerivingStrategies -> "missing-deriving-strategies" :| [] + Opt_WarnSimplifiableClassConstraints -> "simplifiable-class-constraints" :| [] + Opt_WarnMissingHomeModules -> "missing-home-modules" :| [] + Opt_WarnUnrecognisedWarningFlags -> "unrecognised-warning-flags" :| [] + Opt_WarnStarBinder -> "star-binder" :| [] + Opt_WarnStarIsType -> "star-is-type" :| [] + Opt_WarnSpaceAfterBang -> "missing-space-after-bang" :| [] + Opt_WarnPartialFields -> "partial-fields" :| [] + Opt_WarnPrepositiveQualifiedModule -> "prepositive-qualified-module" :| [] + Opt_WarnUnusedPackages -> "unused-packages" :| [] + Opt_WarnCompatUnqualifiedImports -> "compat-unqualified-imports" :| [] + Opt_WarnInvalidHaddock -> "invalid-haddock" :| [] + Opt_WarnOperatorWhitespaceExtConflict -> "operator-whitespace-ext-conflict" :| [] + Opt_WarnOperatorWhitespace -> "operator-whitespace" :| [] + Opt_WarnImplicitLift -> "implicit-lift" :| [] + Opt_WarnMissingExportedPatternSynonymSignatures -> "missing-exported-pattern-synonym-signatures" :| [] -- ----------------------------------------------------------------------------- -- Standard sets of warning options diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs index 4e570f1b3e..f6095677e4 100644 --- a/compiler/GHC/Driver/Session.hs +++ b/compiler/GHC/Driver/Session.hs @@ -3243,7 +3243,8 @@ wWarningFlagsDeps = mconcat [ warnSpec Opt_WarnInvalidHaddock, warnSpec Opt_WarnOperatorWhitespaceExtConflict, warnSpec Opt_WarnOperatorWhitespace, - warnSpec Opt_WarnImplicitLift + warnSpec Opt_WarnImplicitLift, + warnSpec Opt_WarnMissingExportedPatternSynonymSignatures ] -- | These @-\<blah\>@ flags can all be reversed with @-no-\<blah\>@ diff --git a/compiler/GHC/Rename/Names.hs b/compiler/GHC/Rename/Names.hs index ee545b9132..fa19bdc600 100644 --- a/compiler/GHC/Rename/Names.hs +++ b/compiler/GHC/Rename/Names.hs @@ -1482,6 +1482,28 @@ reportUnusedNames gbl_env hsc_src * * ********************************************************************* -} +{- +Note [Missing signatures] +~~~~~~~~~~~~~~~~~~~~~~~~~ +There are four warning flags in play: + + * -Wmissing-exported-signatures + Warn about any exported top-level function/value without a type signature. + Does not include pattern synonyms. + + * -Wmissing-signatures + Warn about any top-level function/value without a type signature. Does not + include pattern synonyms. Takes priority over -Wmissing-exported-signatures. + + * -Wmissing-exported-pattern-synonym-signatures + Warn about any exported pattern synonym without a type signature. + + * -Wmissing-pattern-synonym-signatures + Warn about any pattern synonym without a type signature. Takes priority over + -Wmissing-exported-pattern-synonym-signatures. + +-} + -- | Warn the user about top level binders that lack type signatures. -- Called /after/ type inference, so that we can report the -- inferred type of the function @@ -1495,46 +1517,56 @@ warnMissingSignatures gbl_env -- Warn about missing signatures -- Do this only when we have a type to offer - ; warn_missing_sigs <- woptM Opt_WarnMissingSignatures - ; warn_only_exported <- woptM Opt_WarnMissingExportedSignatures - ; warn_pat_syns <- woptM Opt_WarnMissingPatternSynonymSignatures + ; warn_binds <- woptM Opt_WarnMissingSignatures + ; warn_exported_binds <- woptM Opt_WarnMissingExportedSignatures + ; warn_pat_syns <- woptM Opt_WarnMissingPatternSynonymSignatures + ; warn_exported_pat_syns <- woptM Opt_WarnMissingExportedPatternSynonymSignatures + -- See Note [Missing signatures] ; let add_sig_warns - | warn_missing_sigs = add_warns Opt_WarnMissingSignatures - | warn_only_exported = add_warns Opt_WarnMissingExportedSignatures - | warn_pat_syns = add_warns Opt_WarnMissingPatternSynonymSignatures - | otherwise = return () - - add_warns flag - = when (warn_missing_sigs || warn_only_exported) - (mapM_ add_bind_warn binds) >> - when (warn_missing_sigs || warn_pat_syns) - (mapM_ add_pat_syn_warn pat_syns) - where - add_pat_syn_warn p - = add_warn name $ - hang (text "Pattern synonym with no type signature:") - 2 (text "pattern" <+> pprPrefixName name <+> dcolon <+> pp_ty) - where - name = patSynName p - pp_ty = pprPatSynType p - - add_bind_warn :: Id -> IOEnv (Env TcGblEnv TcLclEnv) () - add_bind_warn id - = do { env <- tcInitTidyEnv -- Why not use emptyTidyEnv? - ; let name = idName id - (_, ty) = tidyOpenType env (idType id) - ty_msg = pprSigmaType ty - ; add_warn name $ - hang (text "Top-level binding with no type signature:") - 2 (pprPrefixName name <+> dcolon <+> ty_msg) } - - add_warn name msg - = when (name `elemNameSet` sig_ns && export_check name) - (addDiagnosticAt (WarningWithFlag flag) (getSrcSpan name) msg) - - export_check name - = warn_missing_sigs || not warn_only_exported || name `elemNameSet` exports + = when (warn_pat_syns || warn_exported_pat_syns) + (mapM_ add_pat_syn_warn pat_syns) >> + when (warn_binds || warn_exported_binds) + (mapM_ add_bind_warn binds) + + add_pat_syn_warn p + = when export_check $ + add_warn name flag $ + hang (text "Pattern synonym with no type signature:") + 2 (text "pattern" <+> pprPrefixName name <+> dcolon <+> pp_ty) + where + name = patSynName p + pp_ty = pprPatSynType p + export_check = warn_pat_syns || name `elemNameSet` exports + flag | warn_pat_syns + = Opt_WarnMissingPatternSynonymSignatures + | otherwise + = Opt_WarnMissingExportedPatternSynonymSignatures + + add_bind_warn :: Id -> IOEnv (Env TcGblEnv TcLclEnv) () + add_bind_warn id + = do { env <- tcInitTidyEnv -- Why not use emptyTidyEnv? + ; let (_, ty) = tidyOpenType env (idType id) + ty_msg = pprSigmaType ty + + ; when export_check $ + add_warn name flag $ + hang (text "Top-level binding with no type signature:") + 2 (pprPrefixName name <+> dcolon <+> ty_msg) } + where + name = idName id + export_check = warn_binds || name `elemNameSet` exports + flag | warn_binds + = Opt_WarnMissingSignatures + | otherwise + = Opt_WarnMissingExportedSignatures + + add_warn name flag msg + = when not_ghc_generated + (addDiagnosticAt (WarningWithFlag flag) (getSrcSpan name) msg) + where + not_ghc_generated + = name `elemNameSet` sig_ns ; add_sig_warns } |