Cabal/src/Distribution/PackageDescription/Check.hs

   1 {-# LANGUAGE LambdaCase #-}
   2
   3 -----------------------------------------------------------------------------
   4
   5 -- |
   6 -- Module      :  Distribution.PackageDescription.Check
   7 -- Copyright   :  Lennart Kolmodin 2008
   8 -- License     :  BSD3
   9 --
  10 -- Maintainer  :  cabal-devel@haskell.org
  11 -- Portability :  portable
  12 --
  13 -- This has code for checking for various problems in packages. There is one
  14 -- set of checks that just looks at a 'PackageDescription' in isolation and
  15 -- another set of checks that also looks at files in the package. Some of the
  16 -- checks are basic sanity checks, others are portability standards that we'd
  17 -- like to encourage. There is a 'PackageCheck' type that distinguishes the
  18 -- different kinds of checks so we can see which ones are appropriate to report
  19 -- in different situations. This code gets used when configuring a package when
  20 -- we consider only basic problems. The higher standard is used when
  21 -- preparing a source tarball and by Hackage when uploading new packages. The
  22 -- reason for this is that we want to hold packages that are expected to be
  23 -- distributed to a higher standard than packages that are only ever expected
  24 -- to be used on the author's own environment.
  25 module Distribution.PackageDescription.Check
  26   ( -- * Package Checking
  27     CheckExplanation (..)
  28   , PackageCheck (..)
  29   , checkPackage
  30   , checkConfiguredPackage
  31   , wrapParseWarning
  32   , ppPackageCheck
  33   , isHackageDistError
  34
  35     -- ** Checking package contents
  36   , checkPackageFiles
  37   , checkPackageContent
  38   , CheckPackageContentOps (..)
  39   , checkPackageFileNames
  40   ) where
  41
  42 import Data.Foldable (foldrM)
  43 import Distribution.Compat.Prelude
  44 import Prelude ()
  45
  46 import Data.List (delete, group)
  47 import Distribution.CabalSpecVersion
  48 import Distribution.Compat.Lens
  49 import Distribution.Compiler
  50 import Distribution.License
  51 import Distribution.ModuleName (ModuleName)
  52 import Distribution.Package
  53 import Distribution.PackageDescription
  54 import Distribution.PackageDescription.Configuration
  55 import Distribution.Parsec.Warning (PWarning, showPWarning)
  56 import Distribution.Pretty (prettyShow)
  57 import Distribution.Simple.BuildPaths (autogenPackageInfoModuleName, autogenPathsModuleName)
  58 import Distribution.Simple.BuildToolDepends
  59 import Distribution.Simple.CCompiler
  60 import Distribution.Simple.Glob
  61 import Distribution.Simple.Utils hiding (findPackageDesc, notice)
  62 import Distribution.System
  63 import Distribution.Types.ComponentRequestedSpec
  64 import Distribution.Types.PackageName.Magic
  65 import Distribution.Utils.Generic (isAscii)
  66 import Distribution.Utils.Path
  67 import Distribution.Verbosity
  68 import Distribution.Version
  69 import Language.Haskell.Extension
  70 import System.FilePath
  71   ( makeRelative
  72   , normalise
  73   , splitDirectories
  74   , splitExtension
  75   , splitPath
  76   , takeExtension
  77   , takeFileName
  78   , (<.>)
  79   , (</>)
  80   )
  81
  82 import qualified Control.Monad as CM
  83 import qualified Data.ByteString.Lazy as BS
  84 import qualified Data.Map as Map
  85 import qualified Distribution.Compat.DList as DList
  86 import qualified Distribution.SPDX as SPDX
  87 import qualified System.Directory as System
  88
  89 import qualified System.Directory (getDirectoryContents)
  90 import qualified System.FilePath.Windows as FilePath.Windows (isValid)
  91
  92 import qualified Data.Set as Set
  93 import qualified Distribution.Utils.ShortText as ShortText
  94
  95 import qualified Distribution.Types.BuildInfo.Lens as L
  96 import qualified Distribution.Types.GenericPackageDescription.Lens as L
  97 import qualified Distribution.Types.PackageDescription.Lens as L
  98
  99 -- $setup
 100 -- >>> import Control.Arrow ((&&&))
 101
 102 -- ------------------------------------------------------------
 103
 104 -- * Warning messages
 105
 106 -- ------------------------------------------------------------
 107
 108 -- | Which stanza does `CheckExplanation` refer to?
 109 data CEType = CETLibrary | CETExecutable | CETTest | CETBenchmark
 110   deriving (Eq, Ord, Show)
 111
 112 -- | Pretty printing `CEType`.
 113 ppCE :: CEType -> String
 114 ppCE CETLibrary = "library"
 115 ppCE CETExecutable = "executable"
 116 ppCE CETTest = "test suite"
 117 ppCE CETBenchmark = "benchmark"
 118
 119 -- | Which field does `CheckExplanation` refer to?
 120 data CEField
 121   = CEFCategory
 122   | CEFMaintainer
 123   | CEFSynopsis
 124   | CEFDescription
 125   | CEFSynOrDesc
 126   deriving (Eq, Ord, Show)
 127
 128 -- | Pretty printing `CEField`.
 129 ppCEField :: CEField -> String
 130 ppCEField CEFCategory = "category"
 131 ppCEField CEFMaintainer = "maintainer"
 132 ppCEField CEFSynopsis = "synopsis"
 133 ppCEField CEFDescription = "description"
 134 ppCEField CEFSynOrDesc = "synopsis' or 'description"
 135
 136 -- | Explanations of 'PackageCheck`'s errors/warnings.
 137 data CheckExplanation
 138   = ParseWarning FilePath PWarning
 139   | NoNameField
 140   | NoVersionField
 141   | NoTarget
 142   | UnnamedInternal
 143   | DuplicateSections [UnqualComponentName]
 144   | IllegalLibraryName PackageDescription
 145   | NoModulesExposed Library
 146   | SignaturesCabal2
 147   | AutogenNotExposed
 148   | AutogenIncludesNotIncluded
 149   | NoMainIs Executable
 150   | NoHsLhsMain
 151   | MainCCabal1_18
 152   | AutogenNoOther CEType UnqualComponentName
 153   | AutogenIncludesNotIncludedExe
 154   | TestsuiteTypeNotKnown TestType
 155   | TestsuiteNotSupported TestType
 156   | BenchmarkTypeNotKnown BenchmarkType
 157   | BenchmarkNotSupported BenchmarkType
 158   | NoHsLhsMainBench
 159   | InvalidNameWin PackageDescription
 160   | ZPrefix
 161   | NoBuildType
 162   | NoCustomSetup
 163   | UnknownCompilers [String]
 164   | UnknownLanguages [String]
 165   | UnknownExtensions [String]
 166   | LanguagesAsExtension [String]
 167   | DeprecatedExtensions [(Extension, Maybe Extension)]
 168   | MissingField CEField
 169   | SynopsisTooLong
 170   | ShortDesc
 171   | InvalidTestWith [Dependency]
 172   | ImpossibleInternalDep [Dependency]
 173   | ImpossibleInternalExe [ExeDependency]
 174   | MissingInternalExe [ExeDependency]
 175   | NONELicense
 176   | NoLicense
 177   | AllRightsReservedLicense
 178   | LicenseMessParse PackageDescription
 179   | UnrecognisedLicense String
 180   | UncommonBSD4
 181   | UnknownLicenseVersion License [Version]
 182   | NoLicenseFile
 183   | UnrecognisedSourceRepo String
 184   | MissingType
 185   | MissingLocation
 186   | MissingModule
 187   | MissingTag
 188   | SubdirRelPath
 189   | SubdirGoodRelPath String
 190   | OptFasm String
 191   | OptViaC String
 192   | OptHpc String
 193   | OptProf String
 194   | OptO String
 195   | OptHide String
 196   | OptMake String
 197   | OptONot String
 198   | OptOOne String
 199   | OptOTwo String
 200   | OptSplitSections String
 201   | OptSplitObjs String
 202   | OptWls String
 203   | OptExts String
 204   | OptRts String
 205   | OptWithRts String
 206   | COptONumber String String
 207   | COptCPP String
 208   | OptAlternatives String String [(String, String)]
 209   | RelativeOutside String FilePath
 210   | AbsolutePath String FilePath
 211   | BadRelativePAth String FilePath String
 212   | DistPoint (Maybe String) FilePath
 213   | GlobSyntaxError String String
 214   | RecursiveGlobInRoot String FilePath
 215   | InvalidOnWin [FilePath]
 216   | FilePathTooLong FilePath
 217   | FilePathNameTooLong FilePath
 218   | FilePathSplitTooLong FilePath
 219   | FilePathEmpty
 220   | CVTestSuite
 221   | CVDefaultLanguage
 222   | CVDefaultLanguageComponent
 223   | CVExtraDocFiles
 224   | CVMultiLib
 225   | CVReexported
 226   | CVMixins
 227   | CVExtraFrameworkDirs
 228   | CVDefaultExtensions
 229   | CVExtensionsDeprecated
 230   | CVSources
 231   | CVExtraDynamic [[String]]
 232   | CVVirtualModules
 233   | CVSourceRepository
 234   | CVExtensions CabalSpecVersion [Extension]
 235   | CVCustomSetup
 236   | CVExpliticDepsCustomSetup
 237   | CVAutogenPaths
 238   | CVAutogenPackageInfo
 239   | GlobNoMatch String String
 240   | GlobExactMatch String String FilePath
 241   | GlobNoDir String String FilePath
 242   | UnknownOS [String]
 243   | UnknownArch [String]
 244   | UnknownCompiler [String]
 245   | BaseNoUpperBounds
 246   | MissingUpperBounds [PackageName]
 247   | SuspiciousFlagName [String]
 248   | DeclaredUsedFlags (Set FlagName) (Set FlagName)
 249   | NonASCIICustomField [String]
 250   | RebindableClashPaths
 251   | RebindableClashPackageInfo
 252   | WErrorUnneeded String
 253   | JUnneeded String
 254   | FDeferTypeErrorsUnneeded String
 255   | DynamicUnneeded String
 256   | ProfilingUnneeded String
 257   | UpperBoundSetup String
 258   | DuplicateModule String [ModuleName]
 259   | PotentialDupModule String [ModuleName]
 260   | BOMStart FilePath
 261   | NotPackageName FilePath String
 262   | NoDesc
 263   | MultiDesc [String]
 264   | UnknownFile String (SymbolicPath PackageDir LicenseFile)
 265   | MissingSetupFile
 266   | MissingConfigureScript
 267   | UnknownDirectory String FilePath
 268   | MissingSourceControl
 269   | MissingExpectedDocFiles Bool [FilePath]
 270   | WrongFieldForExpectedDocFiles Bool String [FilePath]
 271   deriving (Eq, Ord, Show)
 272
 273 -- | Wraps `ParseWarning` into `PackageCheck`.
 274 wrapParseWarning :: FilePath -> PWarning -> PackageCheck
 275 wrapParseWarning fp pw = PackageDistSuspicious (ParseWarning fp pw)
 276
 277 -- TODO: as Jul 2022 there is no severity indication attached PWarnType.
 278 --       Once that is added, we can output something more appropriate
 279 --       than PackageDistSuspicious for every parse warning.
 280 --       (see: Cabal-syntax/src/Distribution/Parsec/Warning.hs)
 281
 282 -- | Pretty printing `CheckExplanation`.
 283 ppExplanation :: CheckExplanation -> String
 284 ppExplanation (ParseWarning fp pp) = showPWarning fp pp
 285 ppExplanation NoNameField = "No 'name' field."
 286 ppExplanation NoVersionField = "No 'version' field."
 287 ppExplanation NoTarget =
 288   "No executables, libraries, tests, or benchmarks found. Nothing to do."
 289 ppExplanation UnnamedInternal =
 290   "Found one or more unnamed internal libraries. Only the non-internal"
 291     ++ " library can have the same name as the package."
 292 ppExplanation (DuplicateSections duplicateNames) =
 293   "Duplicate sections: "
 294     ++ commaSep (map unUnqualComponentName duplicateNames)
 295     ++ ". The name of every library, executable, test suite,"
 296     ++ " and benchmark section in the package must be unique."
 297 ppExplanation (IllegalLibraryName pkg) =
 298   "Illegal internal library name "
 299     ++ prettyShow (packageName pkg)
 300     ++ ". Internal libraries cannot have the same name as the package."
 301     ++ " Maybe you wanted a non-internal library?"
 302     ++ " If so, rewrite the section stanza"
 303     ++ " from 'library: '"
 304     ++ prettyShow (packageName pkg)
 305     ++ "' to 'library'."
 306 ppExplanation (NoModulesExposed lib) =
 307   showLibraryName (libName lib) ++ " does not expose any modules"
 308 ppExplanation SignaturesCabal2 =
 309   "To use the 'signatures' field the package needs to specify "
 310     ++ "at least 'cabal-version: 2.0'."
 311 ppExplanation AutogenNotExposed =
 312   "An 'autogen-module' is neither on 'exposed-modules' nor 'other-modules'."
 313 ppExplanation AutogenIncludesNotIncluded =
 314   "An include in 'autogen-includes' is neither in 'includes' or "
 315     ++ "'install-includes'."
 316 ppExplanation (NoMainIs exe) =
 317   "No 'main-is' field found for executable " ++ prettyShow (exeName exe)
 318 ppExplanation NoHsLhsMain =
 319   "The 'main-is' field must specify a '.hs' or '.lhs' file "
 320     ++ "(even if it is generated by a preprocessor), "
 321     ++ "or it may specify a C/C++/obj-C source file."
 322 ppExplanation MainCCabal1_18 =
 323   "The package uses a C/C++/obj-C source file for the 'main-is' field. "
 324     ++ "To use this feature you need to specify 'cabal-version: 1.18' or"
 325     ++ " higher."
 326 ppExplanation (AutogenNoOther ct ucn) =
 327   "On "
 328     ++ ppCE ct
 329     ++ " '"
 330     ++ prettyShow ucn
 331     ++ "' an 'autogen-module'"
 332     ++ " is not on 'other-modules'"
 333 ppExplanation AutogenIncludesNotIncludedExe =
 334   "An include in 'autogen-includes' is not in 'includes'."
 335 ppExplanation (TestsuiteTypeNotKnown tt) =
 336   quote (prettyShow tt)
 337     ++ " is not a known type of test suite. "
 338     ++ "Either remove the 'type' field or use a known type. "
 339     ++ "The known test suite types are: "
 340     ++ commaSep (map prettyShow knownTestTypes)
 341 ppExplanation (TestsuiteNotSupported tt) =
 342   quote (prettyShow tt)
 343     ++ " is not a supported test suite version. "
 344     ++ "Either remove the 'type' field or use a known type. "
 345     ++ "The known test suite types are: "
 346     ++ commaSep (map prettyShow knownTestTypes)
 347 ppExplanation (BenchmarkTypeNotKnown tt) =
 348   quote (prettyShow tt)
 349     ++ " is not a known type of benchmark. "
 350     ++ "Either remove the 'type' field or use a known type. "
 351     ++ "The known benchmark types are: "
 352     ++ commaSep (map prettyShow knownBenchmarkTypes)
 353 ppExplanation (BenchmarkNotSupported tt) =
 354   quote (prettyShow tt)
 355     ++ " is not a supported benchmark version. "
 356     ++ "Either remove the 'type' field or use a known type. "
 357     ++ "The known benchmark types are: "
 358     ++ commaSep (map prettyShow knownBenchmarkTypes)
 359 ppExplanation NoHsLhsMainBench =
 360   "The 'main-is' field must specify a '.hs' or '.lhs' file "
 361     ++ "(even if it is generated by a preprocessor)."
 362 ppExplanation (InvalidNameWin pkg) =
 363   "The package name '"
 364     ++ prettyShow (packageName pkg)
 365     ++ "' is "
 366     ++ "invalid on Windows. Many tools need to convert package names to "
 367     ++ "file names so using this name would cause problems."
 368 ppExplanation ZPrefix =
 369   "Package names with the prefix 'z-' are reserved by Cabal and "
 370     ++ "cannot be used."
 371 ppExplanation NoBuildType =
 372   "No 'build-type' specified. If you do not need a custom Setup.hs or "
 373     ++ "./configure script then use 'build-type: Simple'."
 374 ppExplanation NoCustomSetup =
 375   "Ignoring the 'custom-setup' section because the 'build-type' is "
 376     ++ "not 'Custom'. Use 'build-type: Custom' if you need to use a "
 377     ++ "custom Setup.hs script."
 378 ppExplanation (UnknownCompilers unknownCompilers) =
 379   "Unknown compiler "
 380     ++ commaSep (map quote unknownCompilers)
 381     ++ " in 'tested-with' field."
 382 ppExplanation (UnknownLanguages unknownLanguages) =
 383   "Unknown languages: " ++ commaSep unknownLanguages
 384 ppExplanation (UnknownExtensions unknownExtensions) =
 385   "Unknown extensions: " ++ commaSep unknownExtensions
 386 ppExplanation (LanguagesAsExtension languagesUsedAsExtensions) =
 387   "Languages listed as extensions: "
 388     ++ commaSep languagesUsedAsExtensions
 389     ++ ". Languages must be specified in either the 'default-language' "
 390     ++ " or the 'other-languages' field."
 391 ppExplanation (DeprecatedExtensions ourDeprecatedExtensions) =
 392   "Deprecated extensions: "
 393     ++ commaSep (map (quote . prettyShow . fst) ourDeprecatedExtensions)
 394     ++ ". "
 395     ++ unwords
 396       [ "Instead of '"
 397         ++ prettyShow ext
 398         ++ "' use '"
 399         ++ prettyShow replacement
 400         ++ "'."
 401       | (ext, Just replacement) <- ourDeprecatedExtensions
 402       ]
 403 ppExplanation (MissingField cef) =
 404   "No '" ++ ppCEField cef ++ "' field."
 405 ppExplanation SynopsisTooLong =
 406   "The 'synopsis' field is rather long (max 80 chars is recommended)."
 407 ppExplanation ShortDesc =
 408   "The 'description' field should be longer than the 'synopsis' field. "
 409     ++ "It's useful to provide an informative 'description' to allow "
 410     ++ "Haskell programmers who have never heard about your package to "
 411     ++ "understand the purpose of your package. "
 412     ++ "The 'description' field content is typically shown by tooling "
 413     ++ "(e.g. 'cabal info', Haddock, Hackage) below the 'synopsis' which "
 414     ++ "serves as a headline. "
 415     ++ "Please refer to <https://cabal.readthedocs.io/en/stable/"
 416     ++ "cabal-package.html#package-properties> for more details."
 417 ppExplanation (InvalidTestWith testedWithImpossibleRanges) =
 418   "Invalid 'tested-with' version range: "
 419     ++ commaSep (map prettyShow testedWithImpossibleRanges)
 420     ++ ". To indicate that you have tested a package with multiple "
 421     ++ "different versions of the same compiler use multiple entries, "
 422     ++ "for example 'tested-with: GHC==6.10.4, GHC==6.12.3' and not "
 423     ++ "'tested-with: GHC==6.10.4 && ==6.12.3'."
 424 ppExplanation (ImpossibleInternalDep depInternalLibWithImpossibleVersion) =
 425   "The package has an impossible version range for a dependency on an "
 426     ++ "internal library: "
 427     ++ commaSep (map prettyShow depInternalLibWithImpossibleVersion)
 428     ++ ". This version range does not include the current package, and must "
 429     ++ "be removed as the current package's library will always be used."
 430 ppExplanation (ImpossibleInternalExe depInternalExecWithImpossibleVersion) =
 431   "The package has an impossible version range for a dependency on an "
 432     ++ "internal executable: "
 433     ++ commaSep (map prettyShow depInternalExecWithImpossibleVersion)
 434     ++ ". This version range does not include the current package, and must "
 435     ++ "be removed as the current package's executable will always be used."
 436 ppExplanation (MissingInternalExe depInternalExeWithImpossibleVersion) =
 437   "The package depends on a missing internal executable: "
 438     ++ commaSep (map prettyShow depInternalExeWithImpossibleVersion)
 439 ppExplanation NONELicense = "The 'license' field is missing or is NONE."
 440 ppExplanation NoLicense = "The 'license' field is missing."
 441 ppExplanation AllRightsReservedLicense =
 442   "The 'license' is AllRightsReserved. Is that really what you want?"
 443 ppExplanation (LicenseMessParse pkg) =
 444   "Unfortunately the license "
 445     ++ quote (prettyShow (license pkg))
 446     ++ " messes up the parser in earlier Cabal versions so you need to "
 447     ++ "specify 'cabal-version: >= 1.4'. Alternatively if you require "
 448     ++ "compatibility with earlier Cabal versions then use 'OtherLicense'."
 449 ppExplanation (UnrecognisedLicense l) =
 450   quote ("license: " ++ l)
 451     ++ " is not a recognised license. The "
 452     ++ "known licenses are: "
 453     ++ commaSep (map prettyShow knownLicenses)
 454 ppExplanation UncommonBSD4 =
 455   "Using 'license: BSD4' is almost always a misunderstanding. 'BSD4' "
 456     ++ "refers to the old 4-clause BSD license with the advertising "
 457     ++ "clause. 'BSD3' refers the new 3-clause BSD license."
 458 ppExplanation (UnknownLicenseVersion lic known) =
 459   "'license: "
 460     ++ prettyShow lic
 461     ++ "' is not a known "
 462     ++ "version of that license. The known versions are "
 463     ++ commaSep (map prettyShow known)
 464     ++ ". If this is not a mistake and you think it should be a known "
 465     ++ "version then please file a ticket."
 466 ppExplanation NoLicenseFile = "A 'license-file' is not specified."
 467 ppExplanation (UnrecognisedSourceRepo kind) =
 468   quote kind
 469     ++ " is not a recognised kind of source-repository. "
 470     ++ "The repo kind is usually 'head' or 'this'"
 471 ppExplanation MissingType =
 472   "The source-repository 'type' is a required field."
 473 ppExplanation MissingLocation =
 474   "The source-repository 'location' is a required field."
 475 ppExplanation MissingModule =
 476   "For a CVS source-repository, the 'module' is a required field."
 477 ppExplanation MissingTag =
 478   "For the 'this' kind of source-repository, the 'tag' is a required "
 479     ++ "field. It should specify the tag corresponding to this version "
 480     ++ "or release of the package."
 481 ppExplanation SubdirRelPath =
 482   "The 'subdir' field of a source-repository must be a relative path."
 483 ppExplanation (SubdirGoodRelPath err) =
 484   "The 'subdir' field of a source-repository is not a good relative path: "
 485     ++ show err
 486 ppExplanation (OptFasm fieldName) =
 487   "'"
 488     ++ fieldName
 489     ++ ": -fasm' is unnecessary and will not work on CPU "
 490     ++ "architectures other than x86, x86-64, ppc or sparc."
 491 ppExplanation (OptViaC fieldName) =
 492   "'"
 493     ++ fieldName
 494     ++ ": -fvia-C' is usually unnecessary. If your package "
 495     ++ "needs -via-C for correctness rather than performance then it "
 496     ++ "is using the FFI incorrectly and will probably not work with GHC "
 497     ++ "6.10 or later."
 498 ppExplanation (OptHpc fieldName) =
 499   "'"
 500     ++ fieldName
 501     ++ ": -fhpc' is not necessary. Use the configure flag "
 502     ++ " --enable-coverage instead."
 503 ppExplanation (OptProf fieldName) =
 504   "'"
 505     ++ fieldName
 506     ++ ": -prof' is not necessary and will lead to problems "
 507     ++ "when used on a library. Use the configure flag "
 508     ++ "--enable-library-profiling and/or --enable-profiling."
 509 ppExplanation (OptO fieldName) =
 510   "'"
 511     ++ fieldName
 512     ++ ": -o' is not needed. "
 513     ++ "The output files are named automatically."
 514 ppExplanation (OptHide fieldName) =
 515   "'"
 516     ++ fieldName
 517     ++ ": -hide-package' is never needed. "
 518     ++ "Cabal hides all packages."
 519 ppExplanation (OptMake fieldName) =
 520   "'"
 521     ++ fieldName
 522     ++ ": --make' is never needed. Cabal uses this automatically."
 523 ppExplanation (OptONot fieldName) =
 524   "'"
 525     ++ fieldName
 526     ++ ": -O0' is not needed. "
 527     ++ "Use the --disable-optimization configure flag."
 528 ppExplanation (OptOOne fieldName) =
 529   "'"
 530     ++ fieldName
 531     ++ ": -O' is not needed. "
 532     ++ "Cabal automatically adds the '-O' flag. "
 533     ++ "Setting it yourself interferes with the --disable-optimization flag."
 534 ppExplanation (OptOTwo fieldName) =
 535   "'"
 536     ++ fieldName
 537     ++ ": -O2' is rarely needed. "
 538     ++ "Check that it is giving a real benefit "
 539     ++ "and not just imposing longer compile times on your users."
 540 ppExplanation (OptSplitSections fieldName) =
 541   "'"
 542     ++ fieldName
 543     ++ ": -split-sections' is not needed. "
 544     ++ "Use the --enable-split-sections configure flag."
 545 ppExplanation (OptSplitObjs fieldName) =
 546   "'"
 547     ++ fieldName
 548     ++ ": -split-objs' is not needed. "
 549     ++ "Use the --enable-split-objs configure flag."
 550 ppExplanation (OptWls fieldName) =
 551   "'"
 552     ++ fieldName
 553     ++ ": -optl-Wl,-s' is not needed and is not portable to"
 554     ++ " all operating systems. Cabal 1.4 and later automatically strip"
 555     ++ " executables. Cabal also has a flag --disable-executable-stripping"
 556     ++ " which is necessary when building packages for some Linux"
 557     ++ " distributions and using '-optl-Wl,-s' prevents that from working."
 558 ppExplanation (OptExts fieldName) =
 559   "Instead of '"
 560     ++ fieldName
 561     ++ ": -fglasgow-exts' it is preferable to use "
 562     ++ "the 'extensions' field."
 563 ppExplanation (OptRts fieldName) =
 564   "'"
 565     ++ fieldName
 566     ++ ": -rtsopts' has no effect for libraries. It should "
 567     ++ "only be used for executables."
 568 ppExplanation (OptWithRts fieldName) =
 569   "'"
 570     ++ fieldName
 571     ++ ": -with-rtsopts' has no effect for libraries. It "
 572     ++ "should only be used for executables."
 573 ppExplanation (COptONumber prefix label) =
 574   "'"
 575     ++ prefix
 576     ++ ": -O[n]' is generally not needed. When building with "
 577     ++ " optimisations Cabal automatically adds '-O2' for "
 578     ++ label
 579     ++ " code. Setting it yourself interferes with the"
 580     ++ " --disable-optimization flag."
 581 ppExplanation (COptCPP opt) =
 582   "'cpp-options: " ++ opt ++ "' is not a portable C-preprocessor flag."
 583 ppExplanation (OptAlternatives badField goodField flags) =
 584   "Instead of "
 585     ++ quote (badField ++ ": " ++ unwords badFlags)
 586     ++ " use "
 587     ++ quote (goodField ++ ": " ++ unwords goodFlags)
 588   where
 589     (badFlags, goodFlags) = unzip flags
 590 ppExplanation (RelativeOutside field path) =
 591   quote (field ++ ": " ++ path)
 592     ++ " is a relative path outside of the source tree. "
 593     ++ "This will not work when generating a tarball with 'sdist'."
 594 ppExplanation (AbsolutePath field path) =
 595   quote (field ++ ": " ++ path)
 596     ++ " specifies an absolute path, but the "
 597     ++ quote field
 598     ++ " field must use relative paths."
 599 ppExplanation (BadRelativePAth field path err) =
 600   quote (field ++ ": " ++ path)
 601     ++ " is not a good relative path: "
 602     ++ show err
 603 ppExplanation (DistPoint mfield path) =
 604   incipit
 605     ++ " points inside the 'dist' "
 606     ++ "directory. This is not reliable because the location of this "
 607     ++ "directory is configurable by the user (or package manager). In "
 608     ++ "addition the layout of the 'dist' directory is subject to change "
 609     ++ "in future versions of Cabal."
 610   where
 611     -- mfiled Nothing -> the path is inside `ghc-options`
 612     incipit =
 613       maybe
 614         ("'ghc-options' path " ++ quote path)
 615         (\field -> quote (field ++ ": " ++ path))
 616         mfield
 617 ppExplanation (GlobSyntaxError field expl) =
 618   "In the '" ++ field ++ "' field: " ++ expl
 619 ppExplanation (RecursiveGlobInRoot field glob) =
 620   "In the '"
 621     ++ field
 622     ++ "': glob '"
 623     ++ glob
 624     ++ "' starts at project root directory, this might "
 625     ++ "include `.git/`, ``dist-newstyle/``, or other large directories!"
 626 ppExplanation (InvalidOnWin paths) =
 627   "The "
 628     ++ quotes paths
 629     ++ " invalid on Windows, which "
 630     ++ "would cause portability problems for this package. Windows file "
 631     ++ "names cannot contain any of the characters \":*?<>|\" and there "
 632     ++ "a few reserved names including \"aux\", \"nul\", \"con\", "
 633     ++ "\"prn\", \"com1-9\", \"lpt1-9\" and \"clock$\"."
 634   where
 635     quotes [failed] = "path " ++ quote failed ++ " is"
 636     quotes failed =
 637       "paths "
 638         ++ intercalate ", " (map quote failed)
 639         ++ " are"
 640 ppExplanation (FilePathTooLong path) =
 641   "The following file name is too long to store in a portable POSIX "
 642     ++ "format tar archive. The maximum length is 255 ASCII characters.\n"
 643     ++ "The file in question is:\n  "
 644     ++ path
 645 ppExplanation (FilePathNameTooLong path) =
 646   "The following file name is too long to store in a portable POSIX "
 647     ++ "format tar archive. The maximum length for the name part (including "
 648     ++ "extension) is 100 ASCII characters. The maximum length for any "
 649     ++ "individual directory component is 155.\n"
 650     ++ "The file in question is:\n  "
 651     ++ path
 652 ppExplanation (FilePathSplitTooLong path) =
 653   "The following file name is too long to store in a portable POSIX "
 654     ++ "format tar archive. While the total length is less than 255 ASCII "
 655     ++ "characters, there are unfortunately further restrictions. It has to "
 656     ++ "be possible to split the file path on a directory separator into "
 657     ++ "two parts such that the first part fits in 155 characters or less "
 658     ++ "and the second part fits in 100 characters or less. Basically you "
 659     ++ "have to make the file name or directory names shorter, or you could "
 660     ++ "split a long directory name into nested subdirectories with shorter "
 661     ++ "names.\nThe file in question is:\n  "
 662     ++ path
 663 ppExplanation FilePathEmpty =
 664   "Encountered a file with an empty name, something is very wrong! "
 665     ++ "Files with an empty name cannot be stored in a tar archive or in "
 666     ++ "standard file systems."
 667 ppExplanation CVTestSuite =
 668   "The 'test-suite' section is new in Cabal 1.10. "
 669     ++ "Unfortunately it messes up the parser in older Cabal versions "
 670     ++ "so you must specify at least 'cabal-version: >= 1.8', but note "
 671     ++ "that only Cabal 1.10 and later can actually run such test suites."
 672 ppExplanation CVDefaultLanguage =
 673   "To use the 'default-language' field the package needs to specify "
 674     ++ "at least 'cabal-version: >= 1.10'."
 675 ppExplanation CVDefaultLanguageComponent =
 676   "Packages using 'cabal-version: >= 1.10' and before 'cabal-version: 3.4' "
 677     ++ "must specify the 'default-language' field for each component (e.g. "
 678     ++ "Haskell98 or Haskell2010). If a component uses different languages "
 679     ++ "in different modules then list the other ones in the "
 680     ++ "'other-languages' field."
 681 ppExplanation CVExtraDocFiles =
 682   "To use the 'extra-doc-files' field the package needs to specify "
 683     ++ "'cabal-version: 1.18' or higher."
 684 ppExplanation CVMultiLib =
 685   "To use multiple 'library' sections or a named library section "
 686     ++ "the package needs to specify at least 'cabal-version: 2.0'."
 687 ppExplanation CVReexported =
 688   "To use the 'reexported-module' field the package needs to specify "
 689     ++ "'cabal-version: 1.22' or higher."
 690 ppExplanation CVMixins =
 691   "To use the 'mixins' field the package needs to specify "
 692     ++ "at least 'cabal-version: 2.0'."
 693 ppExplanation CVExtraFrameworkDirs =
 694   "To use the 'extra-framework-dirs' field the package needs to specify"
 695     ++ " 'cabal-version: 1.24' or higher."
 696 ppExplanation CVDefaultExtensions =
 697   "To use the 'default-extensions' field the package needs to specify "
 698     ++ "at least 'cabal-version: >= 1.10'."
 699 ppExplanation CVExtensionsDeprecated =
 700   "For packages using 'cabal-version: >= 1.10' the 'extensions' "
 701     ++ "field is deprecated. The new 'default-extensions' field lists "
 702     ++ "extensions that are used in all modules in the component, while "
 703     ++ "the 'other-extensions' field lists extensions that are used in "
 704     ++ "some modules, e.g. via the {-# LANGUAGE #-} pragma."
 705 ppExplanation CVSources =
 706   "The use of 'asm-sources', 'cmm-sources', 'extra-bundled-libraries' "
 707     ++ " and 'extra-library-flavours' requires the package "
 708     ++ " to specify at least 'cabal-version: 3.0'."
 709 ppExplanation (CVExtraDynamic flavs) =
 710   "The use of 'extra-dynamic-library-flavours' requires the package "
 711     ++ " to specify at least 'cabal-version: 3.0'. The flavours are: "
 712     ++ commaSep (concat flavs)
 713 ppExplanation CVVirtualModules =
 714   "The use of 'virtual-modules' requires the package "
 715     ++ " to specify at least 'cabal-version: 2.2'."
 716 ppExplanation CVSourceRepository =
 717   "The 'source-repository' section is new in Cabal 1.6. "
 718     ++ "Unfortunately it messes up the parser in earlier Cabal versions "
 719     ++ "so you need to specify 'cabal-version: >= 1.6'."
 720 ppExplanation (CVExtensions version extCab12) =
 721   "Unfortunately the language extensions "
 722     ++ commaSep (map (quote . prettyShow) extCab12)
 723     ++ " break the parser in earlier Cabal versions so you need to "
 724     ++ "specify 'cabal-version: >= "
 725     ++ showCabalSpecVersion version
 726     ++ "'. Alternatively if you require compatibility with earlier "
 727     ++ "Cabal versions then you may be able to use an equivalent "
 728     ++ "compiler-specific flag."
 729 ppExplanation CVCustomSetup =
 730   "Packages using 'cabal-version: 1.24' or higher with 'build-type: Custom' "
 731     ++ "must use a 'custom-setup' section with a 'setup-depends' field "
 732     ++ "that specifies the dependencies of the Setup.hs script itself. "
 733     ++ "The 'setup-depends' field uses the same syntax as 'build-depends', "
 734     ++ "so a simple example would be 'setup-depends: base, Cabal'."
 735 ppExplanation CVExpliticDepsCustomSetup =
 736   "From version 1.24 cabal supports specifying explicit dependencies "
 737     ++ "for Custom setup scripts. Consider using 'cabal-version: 1.24' or "
 738     ++ "higher and adding a 'custom-setup' section with a 'setup-depends' "
 739     ++ "field that specifies the dependencies of the Setup.hs script "
 740     ++ "itself. The 'setup-depends' field uses the same syntax as "
 741     ++ "'build-depends', so a simple example would be 'setup-depends: base, "
 742     ++ "Cabal'."
 743 ppExplanation CVAutogenPaths =
 744   "Packages using 'cabal-version: 2.0' and the autogenerated "
 745     ++ "module Paths_* must include it also on the 'autogen-modules' field "
 746     ++ "besides 'exposed-modules' and 'other-modules'. This specifies that "
 747     ++ "the module does not come with the package and is generated on "
 748     ++ "setup. Modules built with a custom Setup.hs script also go here "
 749     ++ "to ensure that commands like sdist don't fail."
 750 ppExplanation CVAutogenPackageInfo =
 751   "Packages using 'cabal-version: 2.0' and the autogenerated "
 752     ++ "module PackageInfo_* must include it in 'autogen-modules' as well as"
 753     ++ " 'exposed-modules' and 'other-modules'. This specifies that "
 754     ++ "the module does not come with the package and is generated on "
 755     ++ "setup. Modules built with a custom Setup.hs script also go here "
 756     ++ "to ensure that commands like sdist don't fail."
 757 ppExplanation (GlobNoMatch field glob) =
 758   "In '"
 759     ++ field
 760     ++ "': the pattern '"
 761     ++ glob
 762     ++ "' does not"
 763     ++ " match any files."
 764 ppExplanation (GlobExactMatch field glob file) =
 765   "In '"
 766     ++ field
 767     ++ "': the pattern '"
 768     ++ glob
 769     ++ "' does not"
 770     ++ " match the file '"
 771     ++ file
 772     ++ "' because the extensions do not"
 773     ++ " exactly match (e.g., foo.en.html does not exactly match *.html)."
 774     ++ " To enable looser suffix-only matching, set 'cabal-version: 2.4' or"
 775     ++ " higher."
 776 ppExplanation (GlobNoDir field glob dir) =
 777   "In '"
 778     ++ field
 779     ++ "': the pattern '"
 780     ++ glob
 781     ++ "' attempts to"
 782     ++ " match files in the directory '"
 783     ++ dir
 784     ++ "', but there is no"
 785     ++ " directory by that name."
 786 ppExplanation (UnknownOS unknownOSs) =
 787   "Unknown operating system name " ++ commaSep (map quote unknownOSs)
 788 ppExplanation (UnknownArch unknownArches) =
 789   "Unknown architecture name " ++ commaSep (map quote unknownArches)
 790 ppExplanation (UnknownCompiler unknownImpls) =
 791   "Unknown compiler name " ++ commaSep (map quote unknownImpls)
 792 ppExplanation (MissingUpperBounds names) =
 793   let separator = "\n  - "
 794    in "These packages miss upper bounds:"
 795         ++ separator
 796         ++ (intercalate separator (unPackageName <$> names))
 797         ++ "\n"
 798         ++ "Please add them, using `cabal gen-bounds` for suggestions."
 799         ++ " For more information see: "
 800         ++ " https://pvp.haskell.org/"
 801 ppExplanation BaseNoUpperBounds =
 802   "The dependency 'build-depends: base' does not specify an upper "
 803     ++ "bound on the version number. Each major release of the 'base' "
 804     ++ "package changes the API in various ways and most packages will "
 805     ++ "need some changes to compile with it. The recommended practice "
 806     ++ "is to specify an upper bound on the version of the 'base' "
 807     ++ "package. This ensures your package will continue to build when a "
 808     ++ "new major version of the 'base' package is released. If you are "
 809     ++ "not sure what upper bound to use then use the next  major "
 810     ++ "version. For example if you have tested your package with 'base' "
 811     ++ "version 4.5 and 4.6 then use 'build-depends: base >= 4.5 && < 4.7'."
 812 ppExplanation (SuspiciousFlagName invalidFlagNames) =
 813   "Suspicious flag names: "
 814     ++ unwords invalidFlagNames
 815     ++ ". "
 816     ++ "To avoid ambiguity in command line interfaces, flag shouldn't "
 817     ++ "start with a dash. Also for better compatibility, flag names "
 818     ++ "shouldn't contain non-ascii characters."
 819 ppExplanation (DeclaredUsedFlags declared used) =
 820   "Declared and used flag sets differ: "
 821     ++ s declared
 822     ++ " /= "
 823     ++ s used
 824     ++ ". "
 825   where
 826     s :: Set.Set FlagName -> String
 827     s = commaSep . map unFlagName . Set.toList
 828 ppExplanation (NonASCIICustomField nonAsciiXFields) =
 829   "Non ascii custom fields: "
 830     ++ unwords nonAsciiXFields
 831     ++ ". "
 832     ++ "For better compatibility, custom field names "
 833     ++ "shouldn't contain non-ascii characters."
 834 ppExplanation RebindableClashPaths =
 835   "Packages using RebindableSyntax with OverloadedStrings or"
 836     ++ " OverloadedLists in default-extensions, in conjunction with the"
 837     ++ " autogenerated module Paths_*, are known to cause compile failures"
 838     ++ " with Cabal < 2.2. To use these default-extensions with a Paths_*"
 839     ++ " autogen module, specify at least 'cabal-version: 2.2'."
 840 ppExplanation RebindableClashPackageInfo =
 841   "Packages using RebindableSyntax with OverloadedStrings or"
 842     ++ " OverloadedLists in default-extensions, in conjunction with the"
 843     ++ " autogenerated module PackageInfo_*, are known to cause compile failures"
 844     ++ " with Cabal < 2.2. To use these default-extensions with a PackageInfo_*"
 845     ++ " autogen module, specify at least 'cabal-version: 2.2'."
 846 ppExplanation (WErrorUnneeded fieldName) =
 847   addConditionalExp $
 848     "'"
 849       ++ fieldName
 850       ++ ": -Werror' makes the package easy to "
 851       ++ "break with future GHC versions because new GHC versions often "
 852       ++ "add new warnings."
 853 ppExplanation (JUnneeded fieldName) =
 854   addConditionalExp $
 855     "'"
 856       ++ fieldName
 857       ++ ": -j[N]' can make sense for specific user's setup,"
 858       ++ " but it is not appropriate for a distributed package."
 859 ppExplanation (FDeferTypeErrorsUnneeded fieldName) =
 860   addConditionalExp $
 861     "'"
 862       ++ fieldName
 863       ++ ": -fdefer-type-errors' is fine during development "
 864       ++ "but is not appropriate for a distributed package."
 865 ppExplanation (DynamicUnneeded fieldName) =
 866   addConditionalExp $
 867     "'"
 868       ++ fieldName
 869       ++ ": -d*' debug flags are not appropriate "
 870       ++ "for a distributed package."
 871 ppExplanation (ProfilingUnneeded fieldName) =
 872   addConditionalExp $
 873     "'"
 874       ++ fieldName
 875       ++ ": -fprof*' profiling flags are typically not "
 876       ++ "appropriate for a distributed library package. These flags are "
 877       ++ "useful to profile this package, but when profiling other packages "
 878       ++ "that use this one these flags clutter the profile output with "
 879       ++ "excessive detail. If you think other packages really want to see "
 880       ++ "cost centres from this package then use '-fprof-auto-exported' "
 881       ++ "which puts cost centres only on exported functions."
 882 ppExplanation (UpperBoundSetup nm) =
 883   "The dependency 'setup-depends: '"
 884     ++ nm
 885     ++ "' does not specify an "
 886     ++ "upper bound on the version number. Each major release of the "
 887     ++ "'"
 888     ++ nm
 889     ++ "' package changes the API in various ways and most "
 890     ++ "packages will need some changes to compile with it. If you are "
 891     ++ "not sure what upper bound to use then use the next major "
 892     ++ "version."
 893 ppExplanation (DuplicateModule s dupLibsLax) =
 894   "Duplicate modules in "
 895     ++ s
 896     ++ ": "
 897     ++ commaSep (map prettyShow dupLibsLax)
 898 ppExplanation (PotentialDupModule s dupLibsStrict) =
 899   "Potential duplicate modules (subject to conditionals) in "
 900     ++ s
 901     ++ ": "
 902     ++ commaSep (map prettyShow dupLibsStrict)
 903 ppExplanation (BOMStart pdfile) =
 904   pdfile
 905     ++ " starts with an Unicode byte order mark (BOM)."
 906     ++ " This may cause problems with older cabal versions."
 907 ppExplanation (NotPackageName pdfile expectedCabalname) =
 908   "The filename "
 909     ++ quote pdfile
 910     ++ " does not match package name "
 911     ++ "(expected: "
 912     ++ quote expectedCabalname
 913     ++ ")"
 914 ppExplanation NoDesc =
 915   "No cabal file found.\n"
 916     ++ "Please create a package description file <pkgname>.cabal"
 917 ppExplanation (MultiDesc multiple) =
 918   "Multiple cabal files found while checking.\n"
 919     ++ "Please use only one of: "
 920     ++ intercalate ", " multiple
 921 ppExplanation (UnknownFile fieldname file) =
 922   "The '"
 923     ++ fieldname
 924     ++ "' field refers to the file "
 925     ++ quote (getSymbolicPath file)
 926     ++ " which does not exist."
 927 ppExplanation MissingSetupFile =
 928   "The package is missing a Setup.hs or Setup.lhs script."
 929 ppExplanation MissingConfigureScript =
 930   "The 'build-type' is 'Configure' but there is no 'configure' script. "
 931     ++ "You probably need to run 'autoreconf -i' to generate it."
 932 ppExplanation (UnknownDirectory kind dir) =
 933   quote (kind ++ ": " ++ dir)
 934     ++ " specifies a directory which does not exist."
 935 ppExplanation MissingSourceControl =
 936   "When distributing packages it is encouraged to specify source "
 937     ++ "control information in the .cabal file using one or more "
 938     ++ "'source-repository' sections. See the Cabal user guide for "
 939     ++ "details."
 940 ppExplanation (MissingExpectedDocFiles extraDocFileSupport paths) =
 941   "Please consider including the "
 942     ++ quotes paths
 943     ++ " in the '"
 944     ++ targetField
 945     ++ "' section of the .cabal file "
 946     ++ "if it contains useful information for users of the package."
 947   where
 948     quotes [p] = "file " ++ quote p
 949     quotes ps = "files " ++ intercalate ", " (map quote ps)
 950     targetField =
 951       if extraDocFileSupport
 952         then "extra-doc-files"
 953         else "extra-source-files"
 954 ppExplanation (WrongFieldForExpectedDocFiles extraDocFileSupport field paths) =
 955   "Please consider moving the "
 956     ++ quotes paths
 957     ++ " from the '"
 958     ++ field
 959     ++ "' section of the .cabal file "
 960     ++ "to the section '"
 961     ++ targetField
 962     ++ "'."
 963   where
 964     quotes [p] = "file " ++ quote p
 965     quotes ps = "files " ++ intercalate ", " (map quote ps)
 966     targetField =
 967       if extraDocFileSupport
 968         then "extra-doc-files"
 969         else "extra-source-files"
 970
 971 -- | Results of some kind of failed package check.
 972 --
 973 -- There are a range of severities, from merely dubious to totally insane.
 974 -- All of them come with a human readable explanation. In future we may augment
 975 -- them with more machine readable explanations, for example to help an IDE
 976 -- suggest automatic corrections.
 977 data PackageCheck
 978   = -- | This package description is no good. There's no way it's going to
 979     -- build sensibly. This should give an error at configure time.
 980     PackageBuildImpossible {explanation :: CheckExplanation}
 981   | -- | A problem that is likely to affect building the package, or an
 982     -- issue that we'd like every package author to be aware of, even if
 983     -- the package is never distributed.
 984     PackageBuildWarning {explanation :: CheckExplanation}
 985   | -- | An issue that might not be a problem for the package author but
 986     -- might be annoying or detrimental when the package is distributed to
 987     -- users. We should encourage distributed packages to be free from these
 988     -- issues, but occasionally there are justifiable reasons so we cannot
 989     -- ban them entirely.
 990     PackageDistSuspicious {explanation :: CheckExplanation}
 991   | -- | Like PackageDistSuspicious but will only display warnings
 992     -- rather than causing abnormal exit when you run 'cabal check'.
 993     PackageDistSuspiciousWarn {explanation :: CheckExplanation}
 994   | -- | An issue that is OK in the author's environment but is almost
 995     -- certain to be a portability problem for other environments. We can
 996     -- quite legitimately refuse to publicly distribute packages with these
 997     -- problems.
 998     PackageDistInexcusable {explanation :: CheckExplanation}
 999   deriving (Eq, Ord)
1000
1001 -- | Would Hackage refuse a package because of this error?
1002 isHackageDistError :: PackageCheck -> Bool
1003 isHackageDistError = \case
1004   (PackageBuildImpossible{}) -> True
1005   (PackageBuildWarning{}) -> True
1006   (PackageDistInexcusable{}) -> True
1007   (PackageDistSuspicious{}) -> False
1008   (PackageDistSuspiciousWarn{}) -> False
1009
1010 -- | Pretty printing 'PackageCheck'.
1011 ppPackageCheck :: PackageCheck -> String
1012 ppPackageCheck e = ppExplanation (explanation e)
1013
1014 instance Show PackageCheck where
1015   show notice = ppPackageCheck notice
1016
1017 check :: Bool -> PackageCheck -> Maybe PackageCheck
1018 check False _ = Nothing
1019 check True pc = Just pc
1020
1021 checkSpecVersion
1022   :: PackageDescription
1023   -> CabalSpecVersion
1024   -> Bool
1025   -> PackageCheck
1026   -> Maybe PackageCheck
1027 checkSpecVersion pkg specver cond pc
1028   | specVersion pkg >= specver = Nothing
1029   | otherwise = check cond pc
1030
1031 -- ------------------------------------------------------------
1032
1033 -- * Standard checks
1034
1035 -- ------------------------------------------------------------
1036
1037 -- | Check for common mistakes and problems in package descriptions.
1038 --
1039 -- This is the standard collection of checks covering all aspects except
1040 -- for checks that require looking at files within the package. For those
1041 -- see 'checkPackageFiles'.
1042 --
1043 -- It requires the 'GenericPackageDescription' and optionally a particular
1044 -- configuration of that package. If you pass 'Nothing' then we just check
1045 -- a version of the generic description using 'flattenPackageDescription'.
1046 checkPackage
1047   :: GenericPackageDescription
1048   -> Maybe PackageDescription
1049   -> [PackageCheck]
1050 checkPackage gpkg mpkg =
1051   checkConfiguredPackage pkg
1052     ++ checkConditionals gpkg
1053     ++ checkPackageVersions gpkg
1054     ++ checkDevelopmentOnlyFlags gpkg
1055     ++ checkFlagNames gpkg
1056     ++ checkUnusedFlags gpkg
1057     ++ checkUnicodeXFields gpkg
1058     ++ checkPathsModuleExtensions pkg
1059     ++ checkPackageInfoModuleExtensions pkg
1060     ++ checkSetupVersions gpkg
1061     ++ checkDuplicateModules gpkg
1062   where
1063     pkg = fromMaybe (flattenPackageDescription gpkg) mpkg
1064
1065 -- TODO: make this variant go away
1066 --      we should always know the GenericPackageDescription
1067 checkConfiguredPackage :: PackageDescription -> [PackageCheck]
1068 checkConfiguredPackage pkg =
1069   checkSanity pkg
1070     ++ checkFields pkg
1071     ++ checkLicense pkg
1072     ++ checkSourceRepos pkg
1073     ++ checkAllGhcOptions pkg
1074     ++ checkCCOptions pkg
1075     ++ checkCxxOptions pkg
1076     ++ checkCPPOptions pkg
1077     ++ checkPaths pkg
1078     ++ checkCabalVersion pkg
1079
1080 -- ------------------------------------------------------------
1081
1082 -- * Basic sanity checks
1083
1084 -- ------------------------------------------------------------
1085
1086 -- | Check that this package description is sane.
1087 checkSanity :: PackageDescription -> [PackageCheck]
1088 checkSanity pkg =
1089   catMaybes
1090     [ check (null . unPackageName . packageName $ pkg) $
1091         PackageBuildImpossible NoNameField
1092     , check (nullVersion == packageVersion pkg) $
1093         PackageBuildImpossible NoVersionField
1094     , check
1095         ( all
1096             ($ pkg)
1097             [ null . executables
1098             , null . testSuites
1099             , null . benchmarks
1100             , null . allLibraries
1101             , null . foreignLibs
1102             ]
1103         )
1104         $ PackageBuildImpossible NoTarget
1105     , check (any (== LMainLibName) (map libName $ subLibraries pkg)) $
1106         PackageBuildImpossible UnnamedInternal
1107     , check (not (null duplicateNames)) $
1108         PackageBuildImpossible (DuplicateSections duplicateNames)
1109     , -- NB: but it's OK for executables to have the same name!
1110       -- TODO shouldn't need to compare on the string level
1111       check
1112         ( any
1113             (== prettyShow (packageName pkg))
1114             (prettyShow <$> subLibNames)
1115         )
1116         $ PackageBuildImpossible (IllegalLibraryName pkg)
1117     ]
1118     -- TODO: check for name clashes case insensitively: windows file systems cannot
1119     -- cope.
1120
1121     ++ concatMap (checkLibrary pkg) (allLibraries pkg)
1122     ++ concatMap (checkExecutable pkg) (executables pkg)
1123     ++ concatMap (checkTestSuite pkg) (testSuites pkg)
1124     ++ concatMap (checkBenchmark pkg) (benchmarks pkg)
1125   where
1126     -- The public 'library' gets special dispensation, because it
1127     -- is common practice to export a library and name the executable
1128     -- the same as the package.
1129     subLibNames = mapMaybe (libraryNameString . libName) $ subLibraries pkg
1130     exeNames = map exeName $ executables pkg
1131     testNames = map testName $ testSuites pkg
1132     bmNames = map benchmarkName $ benchmarks pkg
1133     duplicateNames = dups $ subLibNames ++ exeNames ++ testNames ++ bmNames
1134
1135 checkLibrary :: PackageDescription -> Library -> [PackageCheck]
1136 checkLibrary pkg lib =
1137   catMaybes
1138     [ -- TODO: This check is bogus if a required-signature was passed through
1139       check (null (explicitLibModules lib) && null (reexportedModules lib)) $
1140         PackageDistSuspiciousWarn (NoModulesExposed lib)
1141     , -- check use of signatures sections
1142       checkVersion CabalSpecV2_0 (not (null (signatures lib))) $
1143         PackageDistInexcusable SignaturesCabal2
1144     , -- check that all autogen-modules appear on other-modules or exposed-modules
1145       check
1146         (not $ and $ map (flip elem (explicitLibModules lib)) (libModulesAutogen lib))
1147         $ PackageBuildImpossible AutogenNotExposed
1148     , -- check that all autogen-includes appear on includes or install-includes
1149       check
1150         (not $ and $ map (flip elem (allExplicitIncludes lib)) (view L.autogenIncludes lib))
1151         $ PackageBuildImpossible AutogenIncludesNotIncluded
1152     ]
1153   where
1154     checkVersion :: CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
1155     checkVersion ver cond pc
1156       | specVersion pkg >= ver = Nothing
1157       | otherwise = check cond pc
1158
1159 allExplicitIncludes :: L.HasBuildInfo a => a -> [FilePath]
1160 allExplicitIncludes x = view L.includes x ++ view L.installIncludes x
1161
1162 checkExecutable :: PackageDescription -> Executable -> [PackageCheck]
1163 checkExecutable pkg exe =
1164   catMaybes
1165     [ check (null (modulePath exe)) $
1166         PackageBuildImpossible (NoMainIs exe)
1167     , -- This check does not apply to scripts.
1168       check
1169         ( package pkg /= fakePackageId
1170             && not (null (modulePath exe))
1171             && not (fileExtensionSupportedLanguage $ modulePath exe)
1172         )
1173         $ PackageBuildImpossible NoHsLhsMain
1174     , checkSpecVersion
1175         pkg
1176         CabalSpecV1_18
1177         ( fileExtensionSupportedLanguage (modulePath exe)
1178             && takeExtension (modulePath exe) `notElem` [".hs", ".lhs"]
1179         )
1180         $ PackageDistInexcusable MainCCabal1_18
1181     , -- check that all autogen-modules appear on other-modules
1182       check
1183         (not $ and $ map (flip elem (exeModules exe)) (exeModulesAutogen exe))
1184         $ PackageBuildImpossible (AutogenNoOther CETExecutable (exeName exe))
1185     , -- check that all autogen-includes appear on includes
1186       check
1187         (not $ and $ map (flip elem (view L.includes exe)) (view L.autogenIncludes exe))
1188         $ PackageBuildImpossible AutogenIncludesNotIncludedExe
1189     ]
1190
1191 checkTestSuite :: PackageDescription -> TestSuite -> [PackageCheck]
1192 checkTestSuite pkg test =
1193   catMaybes
1194     [ case testInterface test of
1195         TestSuiteUnsupported tt@(TestTypeUnknown _ _) ->
1196           Just $
1197             PackageBuildWarning (TestsuiteTypeNotKnown tt)
1198         TestSuiteUnsupported tt ->
1199           Just $
1200             PackageBuildWarning (TestsuiteNotSupported tt)
1201         _ -> Nothing
1202     , check mainIsWrongExt $
1203         PackageBuildImpossible NoHsLhsMain
1204     , checkSpecVersion pkg CabalSpecV1_18 (mainIsNotHsExt && not mainIsWrongExt) $
1205         PackageDistInexcusable MainCCabal1_18
1206     , -- check that all autogen-modules appear on other-modules
1207       check
1208         (not $ and $ map (flip elem (testModules test)) (testModulesAutogen test))
1209         $ PackageBuildImpossible (AutogenNoOther CETTest (testName test))
1210     , -- check that all autogen-includes appear on includes
1211       check
1212         (not $ and $ map (flip elem (view L.includes test)) (view L.autogenIncludes test))
1213         $ PackageBuildImpossible AutogenIncludesNotIncludedExe
1214     ]
1215   where
1216     mainIsWrongExt = case testInterface test of
1217       TestSuiteExeV10 _ f -> not $ fileExtensionSupportedLanguage f
1218       _ -> False
1219
1220     mainIsNotHsExt = case testInterface test of
1221       TestSuiteExeV10 _ f -> takeExtension f `notElem` [".hs", ".lhs"]
1222       _ -> False
1223
1224 checkBenchmark :: PackageDescription -> Benchmark -> [PackageCheck]
1225 checkBenchmark _pkg bm =
1226   catMaybes
1227     [ case benchmarkInterface bm of
1228         BenchmarkUnsupported tt@(BenchmarkTypeUnknown _ _) ->
1229           Just $
1230             PackageBuildWarning (BenchmarkTypeNotKnown tt)
1231         BenchmarkUnsupported tt ->
1232           Just $
1233             PackageBuildWarning (BenchmarkNotSupported tt)
1234         _ -> Nothing
1235     , check mainIsWrongExt $
1236         PackageBuildImpossible NoHsLhsMainBench
1237     , -- check that all autogen-modules appear on other-modules
1238       check
1239         (not $ and $ map (flip elem (benchmarkModules bm)) (benchmarkModulesAutogen bm))
1240         $ PackageBuildImpossible (AutogenNoOther CETBenchmark (benchmarkName bm))
1241     , -- check that all autogen-includes appear on includes
1242       check
1243         (not $ and $ map (flip elem (view L.includes bm)) (view L.autogenIncludes bm))
1244         $ PackageBuildImpossible AutogenIncludesNotIncludedExe
1245     ]
1246   where
1247     mainIsWrongExt = case benchmarkInterface bm of
1248       BenchmarkExeV10 _ f -> takeExtension f `notElem` [".hs", ".lhs"]
1249       _ -> False
1250
1251 -- ------------------------------------------------------------
1252
1253 -- * Additional pure checks
1254
1255 -- ------------------------------------------------------------
1256
1257 checkFields :: PackageDescription -> [PackageCheck]
1258 checkFields pkg =
1259   catMaybes
1260     [ check (not . FilePath.Windows.isValid . prettyShow . packageName $ pkg) $
1261         PackageDistInexcusable (InvalidNameWin pkg)
1262     , check (isPrefixOf "z-" . prettyShow . packageName $ pkg) $
1263         PackageDistInexcusable ZPrefix
1264     , check (isNothing (buildTypeRaw pkg) && specVersion pkg < CabalSpecV2_2) $
1265         PackageBuildWarning NoBuildType
1266     , check (isJust (setupBuildInfo pkg) && buildType pkg /= Custom) $
1267         PackageBuildWarning NoCustomSetup
1268     , check (not (null unknownCompilers)) $
1269         PackageBuildWarning (UnknownCompilers unknownCompilers)
1270     , check (not (null unknownLanguages)) $
1271         PackageBuildWarning (UnknownLanguages unknownLanguages)
1272     , check (not (null unknownExtensions)) $
1273         PackageBuildWarning (UnknownExtensions unknownExtensions)
1274     , check (not (null languagesUsedAsExtensions)) $
1275         PackageBuildWarning (LanguagesAsExtension languagesUsedAsExtensions)
1276     , check (not (null ourDeprecatedExtensions)) $
1277         PackageDistSuspicious (DeprecatedExtensions ourDeprecatedExtensions)
1278     , check (ShortText.null (category pkg)) $
1279         PackageDistSuspicious (MissingField CEFCategory)
1280     , check (ShortText.null (maintainer pkg)) $
1281         PackageDistSuspicious (MissingField CEFMaintainer)
1282     , check (ShortText.null (synopsis pkg) && ShortText.null (description pkg)) $
1283         PackageDistInexcusable (MissingField CEFSynOrDesc)
1284     , check (ShortText.null (description pkg) && not (ShortText.null (synopsis pkg))) $
1285         PackageDistSuspicious (MissingField CEFDescription)
1286     , check (ShortText.null (synopsis pkg) && not (ShortText.null (description pkg))) $
1287         PackageDistSuspicious (MissingField CEFSynopsis)
1288     , -- TODO: recommend the bug reports URL, author and homepage fields
1289       -- TODO: recommend not using the stability field
1290       -- TODO: recommend specifying a source repo
1291
1292       check (ShortText.length (synopsis pkg) > 80) $
1293         PackageDistSuspicious SynopsisTooLong
1294     , -- See also https://github.com/haskell/cabal/pull/3479
1295       check
1296         ( not (ShortText.null (description pkg))
1297             && ShortText.length (description pkg) <= ShortText.length (synopsis pkg)
1298         )
1299         $ PackageDistSuspicious ShortDesc
1300     , -- check use of impossible constraints "tested-with: GHC== 6.10 && ==6.12"
1301       check (not (null testedWithImpossibleRanges)) $
1302         PackageDistInexcusable (InvalidTestWith testedWithImpossibleRanges)
1303     , -- for more details on why the following was commented out,
1304       -- check https://github.com/haskell/cabal/pull/7470#issuecomment-875878507
1305       -- , check (not (null depInternalLibraryWithExtraVersion)) $
1306       --     PackageBuildWarning $
1307       --          "The package has an extraneous version range for a dependency on an "
1308       --       ++ "internal library: "
1309       --       ++ commaSep (map prettyShow depInternalLibraryWithExtraVersion)
1310       --       ++ ". This version range includes the current package but isn't needed "
1311       --       ++ "as the current package's library will always be used."
1312
1313       check (not (null depInternalLibraryWithImpossibleVersion)) $
1314         PackageBuildImpossible
1315           (ImpossibleInternalDep depInternalLibraryWithImpossibleVersion)
1316     , -- , check (not (null depInternalExecutableWithExtraVersion)) $
1317       --     PackageBuildWarning $
1318       --          "The package has an extraneous version range for a dependency on an "
1319       --       ++ "internal executable: "
1320       --       ++ commaSep (map prettyShow depInternalExecutableWithExtraVersion)
1321       --       ++ ". This version range includes the current package but isn't needed "
1322       --       ++ "as the current package's executable will always be used."
1323
1324       check (not (null depInternalExecutableWithImpossibleVersion)) $
1325         PackageBuildImpossible
1326           (ImpossibleInternalExe depInternalExecutableWithImpossibleVersion)
1327     , check (not (null depMissingInternalExecutable)) $
1328         PackageBuildImpossible (MissingInternalExe depMissingInternalExecutable)
1329     ]
1330   where
1331     unknownCompilers = [name | (OtherCompiler name, _) <- testedWith pkg]
1332     unknownLanguages =
1333       [ name | bi <- allBuildInfo pkg, UnknownLanguage name <- allLanguages bi
1334       ]
1335     unknownExtensions =
1336       [ name | bi <- allBuildInfo pkg, UnknownExtension name <- allExtensions bi, name `notElem` map prettyShow knownLanguages
1337       ]
1338     ourDeprecatedExtensions =
1339       nub $
1340         catMaybes
1341           [ find ((== ext) . fst) deprecatedExtensions
1342           | bi <- allBuildInfo pkg
1343           , ext <- allExtensions bi
1344           ]
1345     languagesUsedAsExtensions =
1346       [ name | bi <- allBuildInfo pkg, UnknownExtension name <- allExtensions bi, name `elem` map prettyShow knownLanguages
1347       ]
1348
1349     testedWithImpossibleRanges =
1350       [ Dependency (mkPackageName (prettyShow compiler)) vr mainLibSet
1351       | (compiler, vr) <- testedWith pkg
1352       , isNoVersion vr
1353       ]
1354
1355     internalExecutables = map exeName $ executables pkg
1356
1357     internalLibDeps =
1358       [ dep
1359       | bi <- allBuildInfo pkg
1360       , dep@(Dependency name _ _) <- targetBuildDepends bi
1361       , name == packageName pkg
1362       ]
1363
1364     internalExeDeps =
1365       [ dep
1366       | bi <- allBuildInfo pkg
1367       , dep <- getAllToolDependencies pkg bi
1368       , isInternal pkg dep
1369       ]
1370
1371     -- depInternalLibraryWithExtraVersion =
1372     --   [ dep
1373     --   | dep@(Dependency _ versionRange _) <- internalLibDeps
1374     --   , not $ isAnyVersion versionRange
1375     --   , packageVersion pkg `withinRange` versionRange
1376     --   ]
1377
1378     depInternalLibraryWithImpossibleVersion =
1379       [ dep
1380       | dep@(Dependency _ versionRange _) <- internalLibDeps
1381       , not $ packageVersion pkg `withinRange` versionRange
1382       ]
1383
1384     -- depInternalExecutableWithExtraVersion =
1385     --   [ dep
1386     --   | dep@(ExeDependency _ _ versionRange) <- internalExeDeps
1387     --   , not $ isAnyVersion versionRange
1388     --   , packageVersion pkg `withinRange` versionRange
1389     --   ]
1390
1391     depInternalExecutableWithImpossibleVersion =
1392       [ dep
1393       | dep@(ExeDependency _ _ versionRange) <- internalExeDeps
1394       , not $ packageVersion pkg `withinRange` versionRange
1395       ]
1396
1397     depMissingInternalExecutable =
1398       [ dep
1399       | dep@(ExeDependency _ eName _) <- internalExeDeps
1400       , not $ eName `elem` internalExecutables
1401       ]
1402
1403 checkLicense :: PackageDescription -> [PackageCheck]
1404 checkLicense pkg = case licenseRaw pkg of
1405   Right l -> checkOldLicense pkg l
1406   Left l -> checkNewLicense pkg l
1407
1408 checkNewLicense :: PackageDescription -> SPDX.License -> [PackageCheck]
1409 checkNewLicense _pkg lic =
1410   catMaybes
1411     [ check (lic == SPDX.NONE) $
1412         PackageDistInexcusable NONELicense
1413     ]
1414
1415 checkOldLicense :: PackageDescription -> License -> [PackageCheck]
1416 checkOldLicense pkg lic =
1417   catMaybes
1418     [ check (lic == UnspecifiedLicense) $
1419         PackageDistInexcusable NoLicense
1420     , check (lic == AllRightsReserved) $
1421         PackageDistSuspicious AllRightsReservedLicense
1422     , checkVersion CabalSpecV1_4 (lic `notElem` compatLicenses) $
1423         PackageDistInexcusable (LicenseMessParse pkg)
1424     , case lic of
1425         UnknownLicense l -> Just $ PackageBuildWarning (UnrecognisedLicense l)
1426         _ -> Nothing
1427     , check (lic == BSD4) $
1428         PackageDistSuspicious UncommonBSD4
1429     , case unknownLicenseVersion lic of
1430         Just knownVersions ->
1431           Just $
1432             PackageDistSuspicious (UnknownLicenseVersion lic knownVersions)
1433         _ -> Nothing
1434     , check
1435         ( lic
1436             `notElem` [ AllRightsReserved
1437                       , UnspecifiedLicense
1438                       , PublicDomain
1439                       ]
1440             -- AllRightsReserved and PublicDomain are not strictly
1441             -- licenses so don't need license files.
1442             && null (licenseFiles pkg)
1443         )
1444         $ PackageDistSuspicious NoLicenseFile
1445     ]
1446   where
1447     unknownLicenseVersion (GPL (Just v))
1448       | v `notElem` knownVersions = Just knownVersions
1449       where
1450         knownVersions = [v' | GPL (Just v') <- knownLicenses]
1451     unknownLicenseVersion (LGPL (Just v))
1452       | v `notElem` knownVersions = Just knownVersions
1453       where
1454         knownVersions = [v' | LGPL (Just v') <- knownLicenses]
1455     unknownLicenseVersion (AGPL (Just v))
1456       | v `notElem` knownVersions = Just knownVersions
1457       where
1458         knownVersions = [v' | AGPL (Just v') <- knownLicenses]
1459     unknownLicenseVersion (Apache (Just v))
1460       | v `notElem` knownVersions = Just knownVersions
1461       where
1462         knownVersions = [v' | Apache (Just v') <- knownLicenses]
1463     unknownLicenseVersion _ = Nothing
1464
1465     checkVersion :: CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
1466     checkVersion ver cond pc
1467       | specVersion pkg >= ver = Nothing
1468       | otherwise = check cond pc
1469
1470     compatLicenses =
1471       [ GPL Nothing
1472       , LGPL Nothing
1473       , AGPL Nothing
1474       , BSD3
1475       , BSD4
1476       , PublicDomain
1477       , AllRightsReserved
1478       , UnspecifiedLicense
1479       , OtherLicense
1480       ]
1481
1482 checkSourceRepos :: PackageDescription -> [PackageCheck]
1483 checkSourceRepos pkg =
1484   catMaybes $
1485     concat
1486       [ [ case repoKind repo of
1487             RepoKindUnknown kind ->
1488               Just $
1489                 PackageDistInexcusable $
1490                   UnrecognisedSourceRepo kind
1491             _ -> Nothing
1492         , check (isNothing (repoType repo)) $
1493             PackageDistInexcusable MissingType
1494         , check (isNothing (repoLocation repo)) $
1495             PackageDistInexcusable MissingLocation
1496         , check (repoType repo == Just (KnownRepoType CVS) && isNothing (repoModule repo)) $
1497             PackageDistInexcusable MissingModule
1498         , check (repoKind repo == RepoThis && isNothing (repoTag repo)) $
1499             PackageDistInexcusable MissingTag
1500         , check (maybe False isAbsoluteOnAnyPlatform (repoSubdir repo)) $
1501             PackageDistInexcusable SubdirRelPath
1502         , do
1503             subdir <- repoSubdir repo
1504             err <- isGoodRelativeDirectoryPath subdir
1505             return $ PackageDistInexcusable (SubdirGoodRelPath err)
1506         ]
1507       | repo <- sourceRepos pkg
1508       ]
1509
1510 -- TODO: check location looks like a URL for some repo types.
1511
1512 -- | Checks GHC options from all ghc-*-options fields in the given
1513 -- PackageDescription and reports commonly misused or non-portable flags
1514 checkAllGhcOptions :: PackageDescription -> [PackageCheck]
1515 checkAllGhcOptions pkg =
1516   checkGhcOptions "ghc-options" (hcOptions GHC) pkg
1517     ++ checkGhcOptions "ghc-prof-options" (hcProfOptions GHC) pkg
1518     ++ checkGhcOptions "ghc-shared-options" (hcSharedOptions GHC) pkg
1519
1520 -- | Extracts GHC options belonging to the given field from the given
1521 -- PackageDescription using given function and checks them for commonly misused
1522 -- or non-portable flags
1523 checkGhcOptions :: String -> (BuildInfo -> [String]) -> PackageDescription -> [PackageCheck]
1524 checkGhcOptions fieldName getOptions pkg =
1525   catMaybes
1526     [ checkFlags ["-fasm"] $
1527         PackageDistInexcusable (OptFasm fieldName)
1528     , checkFlags ["-fvia-C"] $
1529         PackageDistSuspicious (OptViaC fieldName)
1530     , checkFlags ["-fhpc"] $
1531         PackageDistInexcusable (OptHpc fieldName)
1532     , checkFlags ["-prof"] $
1533         PackageBuildWarning (OptProf fieldName)
1534     , unlessScript . checkFlags ["-o"] $
1535         PackageBuildWarning (OptO fieldName)
1536     , checkFlags ["-hide-package"] $
1537         PackageBuildWarning (OptHide fieldName)
1538     , checkFlags ["--make"] $
1539         PackageBuildWarning (OptMake fieldName)
1540     , checkNonTestAndBenchmarkFlags ["-O0", "-Onot"] $
1541         PackageDistSuspicious (OptONot fieldName)
1542     , checkTestAndBenchmarkFlags ["-O0", "-Onot"] $
1543         PackageDistSuspiciousWarn (OptONot fieldName)
1544     , checkFlags ["-O", "-O1"] $
1545         PackageDistInexcusable (OptOOne fieldName)
1546     , checkFlags ["-O2"] $
1547         PackageDistSuspiciousWarn (OptOTwo fieldName)
1548     , checkFlags ["-split-sections"] $
1549         PackageBuildWarning (OptSplitSections fieldName)
1550     , checkFlags ["-split-objs"] $
1551         PackageBuildWarning (OptSplitObjs fieldName)
1552     , checkFlags ["-optl-Wl,-s", "-optl-s"] $
1553         PackageDistInexcusable (OptWls fieldName)
1554     , checkFlags ["-fglasgow-exts"] $
1555         PackageDistSuspicious (OptExts fieldName)
1556     , check ("-rtsopts" `elem` lib_ghc_options) $
1557         PackageBuildWarning (OptRts fieldName)
1558     , check (any (\opt -> "-with-rtsopts" `isPrefixOf` opt) lib_ghc_options) $
1559         PackageBuildWarning (OptWithRts fieldName)
1560     , checkAlternatives
1561         fieldName
1562         "extensions"
1563         [ (flag, prettyShow extension) | flag <- ghc_options_no_rtsopts, Just extension <- [ghcExtension flag]
1564         ]
1565     , checkAlternatives
1566         fieldName
1567         "extensions"
1568         [(flag, extension) | flag@('-' : 'X' : extension) <- ghc_options_no_rtsopts]
1569     , checkAlternatives fieldName "cpp-options" $
1570         [(flag, flag) | flag@('-' : 'D' : _) <- ghc_options_no_rtsopts]
1571           ++ [(flag, flag) | flag@('-' : 'U' : _) <- ghc_options_no_rtsopts]
1572     , checkAlternatives
1573         fieldName
1574         "include-dirs"
1575         [(flag, dir) | flag@('-' : 'I' : dir) <- ghc_options_no_rtsopts]
1576     , checkAlternatives
1577         fieldName
1578         "extra-libraries"
1579         [(flag, lib) | flag@('-' : 'l' : lib) <- ghc_options_no_rtsopts]
1580     , checkAlternatives
1581         fieldName
1582         "extra-libraries-static"
1583         [(flag, lib) | flag@('-' : 'l' : lib) <- ghc_options_no_rtsopts]
1584     , checkAlternatives
1585         fieldName
1586         "extra-lib-dirs"
1587         [(flag, dir) | flag@('-' : 'L' : dir) <- ghc_options_no_rtsopts]
1588     , checkAlternatives
1589         fieldName
1590         "extra-lib-dirs-static"
1591         [(flag, dir) | flag@('-' : 'L' : dir) <- ghc_options_no_rtsopts]
1592     , checkAlternatives
1593         fieldName
1594         "frameworks"
1595         [ (flag, fmwk)
1596         | (flag@"-framework", fmwk) <-
1597             zip ghc_options_no_rtsopts (safeTail ghc_options_no_rtsopts)
1598         ]
1599     , checkAlternatives
1600         fieldName
1601         "extra-framework-dirs"
1602         [ (flag, dir)
1603         | (flag@"-framework-path", dir) <-
1604             zip ghc_options_no_rtsopts (safeTail ghc_options_no_rtsopts)
1605         ]
1606     ]
1607   where
1608     all_ghc_options = concatMap getOptions (allBuildInfo pkg)
1609     ghc_options_no_rtsopts = rmRtsOpts all_ghc_options
1610     lib_ghc_options =
1611       concatMap
1612         (getOptions . libBuildInfo)
1613         (allLibraries pkg)
1614     test_ghc_options =
1615       concatMap
1616         (getOptions . testBuildInfo)
1617         (testSuites pkg)
1618     benchmark_ghc_options =
1619       concatMap
1620         (getOptions . benchmarkBuildInfo)
1621         (benchmarks pkg)
1622     test_and_benchmark_ghc_options =
1623       test_ghc_options
1624         ++ benchmark_ghc_options
1625     non_test_and_benchmark_ghc_options =
1626       concatMap
1627         getOptions
1628         ( allBuildInfo
1629             ( pkg
1630                 { testSuites = []
1631                 , benchmarks = []
1632                 }
1633             )
1634         )
1635
1636     checkFlags :: [String] -> PackageCheck -> Maybe PackageCheck
1637     checkFlags flags = check (any (`elem` flags) all_ghc_options)
1638
1639     unlessScript :: Maybe PackageCheck -> Maybe PackageCheck
1640     unlessScript pc
1641       | packageId pkg == fakePackageId = Nothing
1642       | otherwise = pc
1643
1644     checkTestAndBenchmarkFlags :: [String] -> PackageCheck -> Maybe PackageCheck
1645     checkTestAndBenchmarkFlags flags = check (any (`elem` flags) test_and_benchmark_ghc_options)
1646
1647     checkNonTestAndBenchmarkFlags :: [String] -> PackageCheck -> Maybe PackageCheck
1648     checkNonTestAndBenchmarkFlags flags = check (any (`elem` flags) non_test_and_benchmark_ghc_options)
1649
1650     ghcExtension ('-' : 'f' : name) = case name of
1651       "allow-overlapping-instances" -> enable OverlappingInstances
1652       "no-allow-overlapping-instances" -> disable OverlappingInstances
1653       "th" -> enable TemplateHaskell
1654       "no-th" -> disable TemplateHaskell
1655       "ffi" -> enable ForeignFunctionInterface
1656       "no-ffi" -> disable ForeignFunctionInterface
1657       "fi" -> enable ForeignFunctionInterface
1658       "no-fi" -> disable ForeignFunctionInterface
1659       "monomorphism-restriction" -> enable MonomorphismRestriction
1660       "no-monomorphism-restriction" -> disable MonomorphismRestriction
1661       "mono-pat-binds" -> enable MonoPatBinds
1662       "no-mono-pat-binds" -> disable MonoPatBinds
1663       "allow-undecidable-instances" -> enable UndecidableInstances
1664       "no-allow-undecidable-instances" -> disable UndecidableInstances
1665       "allow-incoherent-instances" -> enable IncoherentInstances
1666       "no-allow-incoherent-instances" -> disable IncoherentInstances
1667       "arrows" -> enable Arrows
1668       "no-arrows" -> disable Arrows
1669       "generics" -> enable Generics
1670       "no-generics" -> disable Generics
1671       "implicit-prelude" -> enable ImplicitPrelude
1672       "no-implicit-prelude" -> disable ImplicitPrelude
1673       "implicit-params" -> enable ImplicitParams
1674       "no-implicit-params" -> disable ImplicitParams
1675       "bang-patterns" -> enable BangPatterns
1676       "no-bang-patterns" -> disable BangPatterns
1677       "scoped-type-variables" -> enable ScopedTypeVariables
1678       "no-scoped-type-variables" -> disable ScopedTypeVariables
1679       "extended-default-rules" -> enable ExtendedDefaultRules
1680       "no-extended-default-rules" -> disable ExtendedDefaultRules
1681       _ -> Nothing
1682     ghcExtension "-cpp" = enable CPP
1683     ghcExtension _ = Nothing
1684
1685     enable e = Just (EnableExtension e)
1686     disable e = Just (DisableExtension e)
1687
1688     rmRtsOpts :: [String] -> [String]
1689     rmRtsOpts ("-with-rtsopts" : _ : xs) = rmRtsOpts xs
1690     rmRtsOpts (x : xs) = x : rmRtsOpts xs
1691     rmRtsOpts [] = []
1692
1693 checkCCOptions :: PackageDescription -> [PackageCheck]
1694 checkCCOptions = checkCLikeOptions "C" "cc-options" ccOptions
1695
1696 checkCxxOptions :: PackageDescription -> [PackageCheck]
1697 checkCxxOptions = checkCLikeOptions "C++" "cxx-options" cxxOptions
1698
1699 checkCLikeOptions :: String -> String -> (BuildInfo -> [String]) -> PackageDescription -> [PackageCheck]
1700 checkCLikeOptions label prefix accessor pkg =
1701   catMaybes
1702     [ checkAlternatives
1703         prefix
1704         "include-dirs"
1705         [(flag, dir) | flag@('-' : 'I' : dir) <- all_cLikeOptions]
1706     , checkAlternatives
1707         prefix
1708         "extra-libraries"
1709         [(flag, lib) | flag@('-' : 'l' : lib) <- all_cLikeOptions]
1710     , checkAlternatives
1711         prefix
1712         "extra-lib-dirs"
1713         [(flag, dir) | flag@('-' : 'L' : dir) <- all_cLikeOptions]
1714     , checkAlternatives
1715         "ld-options"
1716         "extra-libraries"
1717         [(flag, lib) | flag@('-' : 'l' : lib) <- all_ldOptions]
1718     , checkAlternatives
1719         "ld-options"
1720         "extra-lib-dirs"
1721         [(flag, dir) | flag@('-' : 'L' : dir) <- all_ldOptions]
1722     , checkCCFlags ["-O", "-Os", "-O0", "-O1", "-O2", "-O3"] $
1723         PackageDistSuspicious (COptONumber prefix label)
1724     ]
1725   where
1726     all_cLikeOptions =
1727       [ opts | bi <- allBuildInfo pkg, opts <- accessor bi
1728       ]
1729     all_ldOptions =
1730       [ opts | bi <- allBuildInfo pkg, opts <- ldOptions bi
1731       ]
1732
1733     checkCCFlags :: [String] -> PackageCheck -> Maybe PackageCheck
1734     checkCCFlags flags = check (any (`elem` flags) all_cLikeOptions)
1735
1736 checkCPPOptions :: PackageDescription -> [PackageCheck]
1737 checkCPPOptions pkg =
1738   catMaybes
1739     [ checkAlternatives
1740         "cpp-options"
1741         "include-dirs"
1742         [(flag, dir) | flag@('-' : 'I' : dir) <- all_cppOptions]
1743     ]
1744     ++ [ PackageBuildWarning (COptCPP opt)
1745        | opt <- all_cppOptions
1746        , -- "-I" is handled above, we allow only -DNEWSTUFF and -UOLDSTUFF
1747        not $ any (`isPrefixOf` opt) ["-D", "-U", "-I"]
1748        ]
1749   where
1750     all_cppOptions = [opts | bi <- allBuildInfo pkg, opts <- cppOptions bi]
1751
1752 checkAlternatives
1753   :: String
1754   -> String
1755   -> [(String, String)]
1756   -> Maybe PackageCheck
1757 checkAlternatives badField goodField flags =
1758   check (not (null badFlags)) $
1759     PackageBuildWarning (OptAlternatives badField goodField flags)
1760   where
1761     (badFlags, _) = unzip flags
1762
1763 data PathKind
1764   = PathKindFile
1765   | PathKindDirectory
1766   | PathKindGlob
1767   deriving (Eq)
1768
1769 checkPaths :: PackageDescription -> [PackageCheck]
1770 checkPaths pkg =
1771   checkPackageFileNamesWithGlob
1772     [ (kind == PathKindGlob, path)
1773     | (path, _, kind) <- relPaths ++ absPaths
1774     ]
1775     ++ [ PackageBuildWarning (RelativeOutside field path)
1776        | (path, field, _) <- relPaths ++ absPaths
1777        , isOutsideTree path
1778        ]
1779     ++ [ PackageDistInexcusable (AbsolutePath field path)
1780        | (path, field, _) <- relPaths
1781        , isAbsoluteOnAnyPlatform path
1782        ]
1783     ++ [ PackageDistInexcusable (BadRelativePAth field path err)
1784        | (path, field, kind) <- relPaths
1785        , -- these are not paths, but globs...
1786        err <- maybeToList $ case kind of
1787         PathKindFile -> isGoodRelativeFilePath path
1788         PathKindGlob -> isGoodRelativeGlob path
1789         PathKindDirectory -> isGoodRelativeDirectoryPath path
1790        ]
1791     ++ [ PackageDistInexcusable $ DistPoint (Just field) path
1792        | (path, field, _) <- relPaths ++ absPaths
1793        , isInsideDist path
1794        ]
1795     ++ [ PackageDistInexcusable (DistPoint Nothing path)
1796        | bi <- allBuildInfo pkg
1797        , (GHC, flags) <- perCompilerFlavorToList $ options bi
1798        , path <- flags
1799        , isInsideDist path
1800        ]
1801     ++ [ PackageDistInexcusable $
1802         GlobSyntaxError "data-files" (explainGlobSyntaxError pat err)
1803        | (Left err, pat) <- zip globsDataFiles $ dataFiles pkg
1804        ]
1805     ++ [ PackageDistInexcusable
1806         (GlobSyntaxError "extra-source-files" (explainGlobSyntaxError pat err))
1807        | (Left err, pat) <- zip globsExtraSrcFiles $ extraSrcFiles pkg
1808        ]
1809     ++ [ PackageDistInexcusable $
1810         GlobSyntaxError "extra-doc-files" (explainGlobSyntaxError pat err)
1811        | (Left err, pat) <- zip globsExtraDocFiles $ extraDocFiles pkg
1812        ]
1813     ++ [ PackageDistSuspiciousWarn $
1814         RecursiveGlobInRoot "data-files" pat
1815        | (Right glob, pat) <- zip globsDataFiles $ dataFiles pkg
1816        , isRecursiveInRoot glob
1817        ]
1818     ++ [ PackageDistSuspiciousWarn $
1819         RecursiveGlobInRoot "extra-source-files" pat
1820        | (Right glob, pat) <- zip globsExtraSrcFiles $ extraSrcFiles pkg
1821        , isRecursiveInRoot glob
1822        ]
1823     ++ [ PackageDistSuspiciousWarn $
1824         RecursiveGlobInRoot "extra-doc-files" pat
1825        | (Right glob, pat) <- zip globsExtraDocFiles $ extraDocFiles pkg
1826        , isRecursiveInRoot glob
1827        ]
1828   where
1829     isOutsideTree path = case splitDirectories path of
1830       ".." : _ -> True
1831       "." : ".." : _ -> True
1832       _ -> False
1833     isInsideDist path = case map lowercase (splitDirectories path) of
1834       "dist" : _ -> True
1835       "." : "dist" : _ -> True
1836       _ -> False
1837
1838     -- paths that must be relative
1839     relPaths :: [(FilePath, String, PathKind)]
1840     relPaths =
1841       [(path, "extra-source-files", PathKindGlob) | path <- extraSrcFiles pkg]
1842         ++ [(path, "extra-tmp-files", PathKindFile) | path <- extraTmpFiles pkg]
1843         ++ [(path, "extra-doc-files", PathKindGlob) | path <- extraDocFiles pkg]
1844         ++ [(path, "data-files", PathKindGlob) | path <- dataFiles pkg]
1845         ++ [(path, "data-dir", PathKindDirectory) | path <- [dataDir pkg]]
1846         ++ [(path, "license-file", PathKindFile) | path <- map getSymbolicPath $ licenseFiles pkg]
1847         ++ concat
1848           [ [(path, "asm-sources", PathKindFile) | path <- asmSources bi]
1849             ++ [(path, "cmm-sources", PathKindFile) | path <- cmmSources bi]
1850             ++ [(path, "c-sources", PathKindFile) | path <- cSources bi]
1851             ++ [(path, "cxx-sources", PathKindFile) | path <- cxxSources bi]
1852             ++ [(path, "js-sources", PathKindFile) | path <- jsSources bi]
1853             ++ [(path, "install-includes", PathKindFile) | path <- installIncludes bi]
1854             ++ [(path, "hs-source-dirs", PathKindDirectory) | path <- map getSymbolicPath $ hsSourceDirs bi]
1855           | bi <- allBuildInfo pkg
1856           ]
1857
1858     -- paths that are allowed to be absolute
1859     absPaths :: [(FilePath, String, PathKind)]
1860     absPaths =
1861       concat
1862         [ [(path, "includes", PathKindFile) | path <- includes bi]
1863           ++ [(path, "include-dirs", PathKindDirectory) | path <- includeDirs bi]
1864           ++ [(path, "extra-lib-dirs", PathKindDirectory) | path <- extraLibDirs bi]
1865           ++ [(path, "extra-lib-dirs-static", PathKindDirectory) | path <- extraLibDirsStatic bi]
1866         | bi <- allBuildInfo pkg
1867         ]
1868     globsDataFiles :: [Either GlobSyntaxError Glob]
1869     globsDataFiles = parseFileGlob (specVersion pkg) <$> dataFiles pkg
1870     globsExtraSrcFiles :: [Either GlobSyntaxError Glob]
1871     globsExtraSrcFiles = parseFileGlob (specVersion pkg) <$> extraSrcFiles pkg
1872     globsExtraDocFiles :: [Either GlobSyntaxError Glob]
1873     globsExtraDocFiles = parseFileGlob (specVersion pkg) <$> extraDocFiles pkg
1874
1875 -- TODO: check sets of paths that would be interpreted differently between Unix
1876 -- and windows, ie case-sensitive or insensitive. Things that might clash, or
1877 -- conversely be distinguished.
1878
1879 -- TODO: use the tar path checks on all the above paths
1880
1881 -- | Check that the package declares the version in the @\"cabal-version\"@
1882 -- field correctly.
1883 checkCabalVersion :: PackageDescription -> [PackageCheck]
1884 checkCabalVersion pkg =
1885   catMaybes
1886     [ -- check use of test suite sections
1887       checkVersion CabalSpecV1_8 (not (null $ testSuites pkg)) $
1888         PackageDistInexcusable CVTestSuite
1889     , -- check use of default-language field
1890       -- note that we do not need to do an equivalent check for the
1891       -- other-language field since that one does not change behaviour
1892       checkVersion CabalSpecV1_10 (any isJust (buildInfoField defaultLanguage)) $
1893         PackageBuildWarning CVDefaultLanguage
1894     , check
1895         ( specVersion pkg >= CabalSpecV1_10
1896             && specVersion pkg < CabalSpecV3_4
1897             && any isNothing (buildInfoField defaultLanguage)
1898         )
1899         $ PackageBuildWarning CVDefaultLanguageComponent
1900     , checkVersion
1901         CabalSpecV1_18
1902         (not . null $ extraDocFiles pkg)
1903         $ PackageDistInexcusable CVExtraDocFiles
1904     , checkVersion
1905         CabalSpecV2_0
1906         (not (null (subLibraries pkg)))
1907         $ PackageDistInexcusable CVMultiLib
1908     , -- check use of reexported-modules sections
1909       checkVersion
1910         CabalSpecV1_22
1911         (any (not . null . reexportedModules) (allLibraries pkg))
1912         $ PackageDistInexcusable CVReexported
1913     , -- check use of thinning and renaming
1914       checkVersion CabalSpecV2_0 usesBackpackIncludes $
1915         PackageDistInexcusable CVMixins
1916     , -- check use of 'extra-framework-dirs' field
1917       checkVersion CabalSpecV1_24 (any (not . null) (buildInfoField extraFrameworkDirs)) $
1918         -- Just a warning, because this won't break on old Cabal versions.
1919         PackageDistSuspiciousWarn CVExtraFrameworkDirs
1920     , -- check use of default-extensions field
1921       -- don't need to do the equivalent check for other-extensions
1922       checkVersion CabalSpecV1_10 (any (not . null) (buildInfoField defaultExtensions)) $
1923         PackageBuildWarning CVDefaultExtensions
1924     , -- check use of extensions field
1925       check
1926         ( specVersion pkg >= CabalSpecV1_10
1927             && any (not . null) (buildInfoField oldExtensions)
1928         )
1929         $ PackageBuildWarning CVExtensionsDeprecated
1930     , checkVersion
1931         CabalSpecV3_0
1932         ( any
1933             (not . null)
1934             ( concatMap
1935                 buildInfoField
1936                 [ asmSources
1937                 , cmmSources
1938                 , extraBundledLibs
1939                 , extraLibFlavours
1940                 ]
1941             )
1942         )
1943         $ PackageDistInexcusable CVSources
1944     , checkVersion CabalSpecV3_0 (any (not . null) $ buildInfoField extraDynLibFlavours) $
1945         PackageDistInexcusable
1946           (CVExtraDynamic $ buildInfoField extraDynLibFlavours)
1947     , checkVersion
1948         CabalSpecV2_2
1949         ( any
1950             (not . null)
1951             (buildInfoField virtualModules)
1952         )
1953         $ PackageDistInexcusable CVVirtualModules
1954     , -- check use of "source-repository" section
1955       checkVersion CabalSpecV1_6 (not (null (sourceRepos pkg))) $
1956         PackageDistInexcusable CVSourceRepository
1957     , -- check for new language extensions
1958       checkVersion CabalSpecV1_2 (not (null mentionedExtensionsThatNeedCabal12)) $
1959         PackageDistInexcusable
1960           (CVExtensions CabalSpecV1_2 mentionedExtensionsThatNeedCabal12)
1961     , checkVersion CabalSpecV1_4 (not (null mentionedExtensionsThatNeedCabal14)) $
1962         PackageDistInexcusable
1963           (CVExtensions CabalSpecV1_4 mentionedExtensionsThatNeedCabal14)
1964     , check
1965         ( specVersion pkg >= CabalSpecV1_24
1966             && isNothing (setupBuildInfo pkg)
1967             && buildType pkg == Custom
1968         )
1969         $ PackageBuildWarning CVCustomSetup
1970     , check
1971         ( specVersion pkg < CabalSpecV1_24
1972             && isNothing (setupBuildInfo pkg)
1973             && buildType pkg == Custom
1974         )
1975         $ PackageDistSuspiciousWarn CVExpliticDepsCustomSetup
1976     , check
1977         ( specVersion pkg >= CabalSpecV2_0
1978             && elem (autogenPathsModuleName pkg) allModuleNames
1979             && not (elem (autogenPathsModuleName pkg) allModuleNamesAutogen)
1980         )
1981         $ PackageDistInexcusable CVAutogenPaths
1982     , check
1983         ( specVersion pkg >= CabalSpecV2_0
1984             && elem (autogenPackageInfoModuleName pkg) allModuleNames
1985             && not (elem (autogenPackageInfoModuleName pkg) allModuleNamesAutogen)
1986         )
1987         $ PackageDistInexcusable CVAutogenPackageInfo
1988     ]
1989   where
1990     -- Perform a check on packages that use a version of the spec less than
1991     -- the version given. This is for cases where a new Cabal version adds
1992     -- a new feature and we want to check that it is not used prior to that
1993     -- version.
1994     checkVersion :: CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
1995     checkVersion ver cond pc
1996       | specVersion pkg >= ver = Nothing
1997       | otherwise = check cond pc
1998
1999     buildInfoField field = map field (allBuildInfo pkg)
2000
2001     usesBackpackIncludes = any (not . null . mixins) (allBuildInfo pkg)
2002
2003     mentionedExtensions =
2004       [ ext | bi <- allBuildInfo pkg, ext <- allExtensions bi
2005       ]
2006     mentionedExtensionsThatNeedCabal12 =
2007       nub (filter (`elem` compatExtensionsExtra) mentionedExtensions)
2008
2009     -- As of Cabal-1.4 we can add new extensions without worrying about
2010     -- breaking old versions of cabal.
2011     mentionedExtensionsThatNeedCabal14 =
2012       nub (filter (`notElem` compatExtensions) mentionedExtensions)
2013
2014     -- The known extensions in Cabal-1.2.3
2015     compatExtensions =
2016       map
2017         EnableExtension
2018         [ OverlappingInstances
2019         , UndecidableInstances
2020         , IncoherentInstances
2021         , RecursiveDo
2022         , ParallelListComp
2023         , MultiParamTypeClasses
2024         , FunctionalDependencies
2025         , Rank2Types
2026         , RankNTypes
2027         , PolymorphicComponents
2028         , ExistentialQuantification
2029         , ScopedTypeVariables
2030         , ImplicitParams
2031         , FlexibleContexts
2032         , FlexibleInstances
2033         , EmptyDataDecls
2034         , CPP
2035         , BangPatterns
2036         , TypeSynonymInstances
2037         , TemplateHaskell
2038         , ForeignFunctionInterface
2039         , Arrows
2040         , Generics
2041         , NamedFieldPuns
2042         , PatternGuards
2043         , GeneralizedNewtypeDeriving
2044         , ExtensibleRecords
2045         , RestrictedTypeSynonyms
2046         , HereDocuments
2047         ]
2048         ++ map
2049           DisableExtension
2050           [MonomorphismRestriction, ImplicitPrelude]
2051         ++ compatExtensionsExtra
2052
2053     -- The extra known extensions in Cabal-1.2.3 vs Cabal-1.1.6
2054     -- (Cabal-1.1.6 came with ghc-6.6. Cabal-1.2 came with ghc-6.8)
2055     compatExtensionsExtra =
2056       map
2057         EnableExtension
2058         [ KindSignatures
2059         , MagicHash
2060         , TypeFamilies
2061         , StandaloneDeriving
2062         , UnicodeSyntax
2063         , PatternSignatures
2064         , UnliftedFFITypes
2065         , LiberalTypeSynonyms
2066         , TypeOperators
2067         , RecordWildCards
2068         , RecordPuns
2069         , DisambiguateRecordFields
2070         , OverloadedStrings
2071         , GADTs
2072         , RelaxedPolyRec
2073         , ExtendedDefaultRules
2074         , UnboxedTuples
2075         , DeriveDataTypeable
2076         , ConstrainedClassMethods
2077         ]
2078         ++ map
2079           DisableExtension
2080           [MonoPatBinds]
2081
2082     allModuleNames =
2083       ( case library pkg of
2084           Nothing -> []
2085           (Just lib) -> explicitLibModules lib
2086       )
2087         ++ concatMap otherModules (allBuildInfo pkg)
2088
2089     allModuleNamesAutogen = concatMap autogenModules (allBuildInfo pkg)
2090
2091 -- ------------------------------------------------------------
2092
2093 -- * Checks on the GenericPackageDescription
2094
2095 -- ------------------------------------------------------------
2096
2097 -- | Check the build-depends fields for any weirdness or bad practice.
2098 checkPackageVersions :: GenericPackageDescription -> [PackageCheck]
2099 checkPackageVersions pkg =
2100   -- if others is empty,
2101   -- the error will still fire but listing no dependencies.
2102   -- so we have to check
2103   if length others > 0
2104     then PackageDistSuspiciousWarn (MissingUpperBounds others) : baseErrors
2105     else baseErrors
2106   where
2107     baseErrors = PackageDistInexcusable BaseNoUpperBounds <$ bases
2108     deps = toDependencyVersionsMap allNonInternalBuildDepends pkg
2109     -- base gets special treatment (it's more critical)
2110     (bases, others) =
2111       partition (("base" ==) . unPackageName) $
2112         [ name
2113         | (name, vr) <- Map.toList deps
2114         , not (hasUpperBound vr)
2115         ]
2116
2117     -- Get the combined build-depends entries of all components.
2118     allNonInternalBuildDepends :: PackageDescription -> [Dependency]
2119     allNonInternalBuildDepends = targetBuildDepends CM.<=< allNonInternalBuildInfo
2120
2121     allNonInternalBuildInfo :: PackageDescription -> [BuildInfo]
2122     allNonInternalBuildInfo pkg_descr =
2123       [bi | lib <- allLibraries pkg_descr, let bi = libBuildInfo lib]
2124         ++ [bi | flib <- foreignLibs pkg_descr, let bi = foreignLibBuildInfo flib]
2125         ++ [bi | exe <- executables pkg_descr, let bi = buildInfo exe]
2126
2127 checkConditionals :: GenericPackageDescription -> [PackageCheck]
2128 checkConditionals pkg =
2129   catMaybes
2130     [ check (not $ null unknownOSs) $
2131         PackageDistInexcusable (UnknownOS unknownOSs)
2132     , check (not $ null unknownArches) $
2133         PackageDistInexcusable (UnknownArch unknownArches)
2134     , check (not $ null unknownImpls) $
2135         PackageDistInexcusable (UnknownCompiler unknownImpls)
2136     ]
2137   where
2138     unknownOSs = [os | OS (OtherOS os) <- conditions]
2139     unknownArches = [arch | Arch (OtherArch arch) <- conditions]
2140     unknownImpls = [impl | Impl (OtherCompiler impl) _ <- conditions]
2141     conditions =
2142       concatMap fvs (maybeToList (condLibrary pkg))
2143         ++ concatMap (fvs . snd) (condSubLibraries pkg)
2144         ++ concatMap (fvs . snd) (condForeignLibs pkg)
2145         ++ concatMap (fvs . snd) (condExecutables pkg)
2146         ++ concatMap (fvs . snd) (condTestSuites pkg)
2147         ++ concatMap (fvs . snd) (condBenchmarks pkg)
2148     fvs (CondNode _ _ ifs) = concatMap compfv ifs -- free variables
2149     compfv (CondBranch c ct mct) = condfv c ++ fvs ct ++ maybe [] fvs mct
2150     condfv c = case c of
2151       Var v -> [v]
2152       Lit _ -> []
2153       CNot c1 -> condfv c1
2154       COr c1 c2 -> condfv c1 ++ condfv c2
2155       CAnd c1 c2 -> condfv c1 ++ condfv c2
2156
2157 checkFlagNames :: GenericPackageDescription -> [PackageCheck]
2158 checkFlagNames gpd
2159   | null invalidFlagNames = []
2160   | otherwise =
2161       [PackageDistInexcusable (SuspiciousFlagName invalidFlagNames)]
2162   where
2163     invalidFlagNames =
2164       [ fn
2165       | flag <- genPackageFlags gpd
2166       , let fn = unFlagName (flagName flag)
2167       , invalidFlagName fn
2168       ]
2169     -- starts with dash
2170     invalidFlagName ('-' : _) = True
2171     -- mon ascii letter
2172     invalidFlagName cs = any (not . isAscii) cs
2173
2174 checkUnusedFlags :: GenericPackageDescription -> [PackageCheck]
2175 checkUnusedFlags gpd
2176   | declared == used = []
2177   | otherwise =
2178       [PackageDistSuspicious (DeclaredUsedFlags declared used)]
2179   where
2180     declared :: Set.Set FlagName
2181     declared = toSetOf (L.genPackageFlags . traverse . L.flagName) gpd
2182
2183     used :: Set.Set FlagName
2184     used =
2185       mconcat
2186         [ toSetOf (L.condLibrary . traverse . traverseCondTreeV . L._PackageFlag) gpd
2187         , toSetOf (L.condSubLibraries . traverse . _2 . traverseCondTreeV . L._PackageFlag) gpd
2188         , toSetOf (L.condForeignLibs . traverse . _2 . traverseCondTreeV . L._PackageFlag) gpd
2189         , toSetOf (L.condExecutables . traverse . _2 . traverseCondTreeV . L._PackageFlag) gpd
2190         , toSetOf (L.condTestSuites . traverse . _2 . traverseCondTreeV . L._PackageFlag) gpd
2191         , toSetOf (L.condBenchmarks . traverse . _2 . traverseCondTreeV . L._PackageFlag) gpd
2192         ]
2193
2194 checkUnicodeXFields :: GenericPackageDescription -> [PackageCheck]
2195 checkUnicodeXFields gpd
2196   | null nonAsciiXFields = []
2197   | otherwise =
2198       [PackageDistInexcusable (NonASCIICustomField nonAsciiXFields)]
2199   where
2200     nonAsciiXFields :: [String]
2201     nonAsciiXFields = [n | (n, _) <- xfields, any (not . isAscii) n]
2202
2203     xfields :: [(String, String)]
2204     xfields =
2205       DList.runDList $
2206         mconcat
2207           [ toDListOf (L.packageDescription . L.customFieldsPD . traverse) gpd
2208           , toDListOf (L.traverseBuildInfos . L.customFieldsBI . traverse) gpd
2209           ]
2210
2211 -- | cabal-version <2.2 + Paths_module + default-extensions: doesn't build.
2212 checkPathsModuleExtensions :: PackageDescription -> [PackageCheck]
2213 checkPathsModuleExtensions = checkAutogenModuleExtensions autogenPathsModuleName RebindableClashPaths
2214
2215 -- | cabal-version <2.2 + PackageInfo_module + default-extensions: doesn't build.
2216 checkPackageInfoModuleExtensions :: PackageDescription -> [PackageCheck]
2217 checkPackageInfoModuleExtensions = checkAutogenModuleExtensions autogenPackageInfoModuleName RebindableClashPackageInfo
2218
2219 -- | cabal-version <2.2 + *_module + default-extensions: doesn't build.
2220 checkAutogenModuleExtensions
2221   :: (PackageDescription -> ModuleName)
2222   -> CheckExplanation
2223   -> PackageDescription
2224   -> [PackageCheck]
2225 checkAutogenModuleExtensions autogenModuleName rebindableClashExplanation pd
2226   | specVersion pd >= CabalSpecV2_2 = []
2227   | any checkBI (allBuildInfo pd) || any checkLib (allLibraries pd) =
2228       return (PackageBuildImpossible rebindableClashExplanation)
2229   | otherwise = []
2230   where
2231     mn = autogenModuleName pd
2232
2233     checkLib :: Library -> Bool
2234     checkLib l = mn `elem` exposedModules l && checkExts (l ^. L.defaultExtensions)
2235
2236     checkBI :: BuildInfo -> Bool
2237     checkBI bi =
2238       (mn `elem` otherModules bi || mn `elem` autogenModules bi)
2239         && checkExts (bi ^. L.defaultExtensions)
2240
2241     checkExts exts = rebind `elem` exts && (strings `elem` exts || lists `elem` exts)
2242       where
2243         rebind = EnableExtension RebindableSyntax
2244         strings = EnableExtension OverloadedStrings
2245         lists = EnableExtension OverloadedLists
2246
2247 -- | Checks GHC options from all ghc-*-options fields from the given BuildInfo
2248 -- and reports flags that are OK during development process, but are
2249 -- unacceptable in a distributed package
2250 checkDevelopmentOnlyFlagsBuildInfo :: BuildInfo -> [PackageCheck]
2251 checkDevelopmentOnlyFlagsBuildInfo bi =
2252   checkDevelopmentOnlyFlagsOptions "ghc-options" (hcOptions GHC bi)
2253     ++ checkDevelopmentOnlyFlagsOptions "ghc-prof-options" (hcProfOptions GHC bi)
2254     ++ checkDevelopmentOnlyFlagsOptions "ghc-shared-options" (hcSharedOptions GHC bi)
2255
2256 -- | Checks the given list of flags belonging to the given field and reports
2257 -- flags that are OK during development process, but are unacceptable in a
2258 -- distributed package
2259 checkDevelopmentOnlyFlagsOptions :: String -> [String] -> [PackageCheck]
2260 checkDevelopmentOnlyFlagsOptions fieldName ghcOptions =
2261   catMaybes
2262     [ check has_Werror $
2263         PackageDistInexcusable (WErrorUnneeded fieldName)
2264     , check has_J $
2265         PackageDistInexcusable (JUnneeded fieldName)
2266     , checkFlags ["-fdefer-type-errors"] $
2267         PackageDistInexcusable (FDeferTypeErrorsUnneeded fieldName)
2268     , -- -dynamic is not a debug flag
2269       check
2270         ( any
2271             (\opt -> "-d" `isPrefixOf` opt && opt /= "-dynamic")
2272             ghcOptions
2273         )
2274         $ PackageDistInexcusable (DynamicUnneeded fieldName)
2275     , checkFlags
2276         [ "-fprof-auto"
2277         , "-fprof-auto-top"
2278         , "-fprof-auto-calls"
2279         , "-fprof-cafs"
2280         , "-fno-prof-count-entries"
2281         , "-auto-all"
2282         , "-auto"
2283         , "-caf-all"
2284         ]
2285         $ PackageDistSuspicious (ProfilingUnneeded fieldName)
2286     ]
2287   where
2288     has_Werror = "-Werror" `elem` ghcOptions
2289     has_J =
2290       any
2291         ( \o -> case o of
2292             "-j" -> True
2293             ('-' : 'j' : d : _) -> isDigit d
2294             _ -> False
2295         )
2296         ghcOptions
2297     checkFlags :: [String] -> PackageCheck -> Maybe PackageCheck
2298     checkFlags flags = check (any (`elem` flags) ghcOptions)
2299
2300 checkDevelopmentOnlyFlags :: GenericPackageDescription -> [PackageCheck]
2301 checkDevelopmentOnlyFlags pkg =
2302   concatMap
2303     checkDevelopmentOnlyFlagsBuildInfo
2304     [ bi
2305     | (conditions, bi) <- allConditionalBuildInfo
2306     , not (any guardedByManualFlag conditions)
2307     ]
2308   where
2309     guardedByManualFlag = definitelyFalse
2310
2311     -- We've basically got three-values logic here: True, False or unknown
2312     -- hence this pattern to propagate the unknown cases properly.
2313     definitelyFalse (Var (PackageFlag n)) = maybe False not (Map.lookup n manualFlags)
2314     definitelyFalse (Var _) = False
2315     definitelyFalse (Lit b) = not b
2316     definitelyFalse (CNot c) = definitelyTrue c
2317     definitelyFalse (COr c1 c2) = definitelyFalse c1 && definitelyFalse c2
2318     definitelyFalse (CAnd c1 c2) = definitelyFalse c1 || definitelyFalse c2
2319
2320     definitelyTrue (Var (PackageFlag n)) = fromMaybe False (Map.lookup n manualFlags)
2321     definitelyTrue (Var _) = False
2322     definitelyTrue (Lit b) = b
2323     definitelyTrue (CNot c) = definitelyFalse c
2324     definitelyTrue (COr c1 c2) = definitelyTrue c1 || definitelyTrue c2
2325     definitelyTrue (CAnd c1 c2) = definitelyTrue c1 && definitelyTrue c2
2326
2327     manualFlags =
2328       Map.fromList
2329         [ (flagName flag, flagDefault flag)
2330         | flag <- genPackageFlags pkg
2331         , flagManual flag
2332         ]
2333
2334     allConditionalBuildInfo :: [([Condition ConfVar], BuildInfo)]
2335     allConditionalBuildInfo =
2336       concatMap
2337         (collectCondTreePaths libBuildInfo)
2338         (maybeToList (condLibrary pkg))
2339         ++ concatMap
2340           (collectCondTreePaths libBuildInfo . snd)
2341           (condSubLibraries pkg)
2342         ++ concatMap
2343           (collectCondTreePaths buildInfo . snd)
2344           (condExecutables pkg)
2345         ++ concatMap
2346           (collectCondTreePaths testBuildInfo . snd)
2347           (condTestSuites pkg)
2348         ++ concatMap
2349           (collectCondTreePaths benchmarkBuildInfo . snd)
2350           (condBenchmarks pkg)
2351
2352     -- get all the leaf BuildInfo, paired up with the path (in the tree sense)
2353     -- of if-conditions that guard it
2354     collectCondTreePaths
2355       :: (a -> b)
2356       -> CondTree v c a
2357       -> [([Condition v], b)]
2358     collectCondTreePaths mapData = go []
2359       where
2360         go conditions condNode =
2361           -- the data at this level in the tree:
2362           (reverse conditions, mapData (condTreeData condNode))
2363             : concat
2364               [ go (condition : conditions) ifThen
2365               | (CondBranch condition ifThen _) <- condTreeComponents condNode
2366               ]
2367             ++ concat
2368               [ go (condition : conditions) elseThen
2369               | (CondBranch condition _ (Just elseThen)) <- condTreeComponents condNode
2370               ]
2371
2372 -- ------------------------------------------------------------
2373
2374 -- * Checks involving files in the package
2375
2376 -- ------------------------------------------------------------
2377
2378 -- | Sanity check things that requires IO. It looks at the files in the
2379 -- package and expects to find the package unpacked in at the given file path.
2380 checkPackageFiles :: Verbosity -> PackageDescription -> FilePath -> IO [PackageCheck]
2381 checkPackageFiles verbosity pkg root = do
2382   contentChecks <- checkPackageContent checkFilesIO pkg
2383   preDistributionChecks <- checkPackageFilesPreDistribution verbosity pkg root
2384   -- Sort because different platforms will provide files from
2385   -- `getDirectoryContents` in different orders, and we'd like to be
2386   -- stable for test output.
2387   return (sort contentChecks ++ sort preDistributionChecks)
2388   where
2389     checkFilesIO =
2390       CheckPackageContentOps
2391         { doesFileExist = System.doesFileExist . relative
2392         , doesDirectoryExist = System.doesDirectoryExist . relative
2393         , getDirectoryContents = System.Directory.getDirectoryContents . relative
2394         , getFileContents = BS.readFile . relative
2395         }
2396     relative path = root </> path
2397
2398 -- | A record of operations needed to check the contents of packages.
2399 -- Used by 'checkPackageContent'.
2400 data CheckPackageContentOps m = CheckPackageContentOps
2401   { doesFileExist :: FilePath -> m Bool
2402   , doesDirectoryExist :: FilePath -> m Bool
2403   , getDirectoryContents :: FilePath -> m [FilePath]
2404   , getFileContents :: FilePath -> m BS.ByteString
2405   }
2406
2407 -- | Sanity check things that requires looking at files in the package.
2408 -- This is a generalised version of 'checkPackageFiles' that can work in any
2409 -- monad for which you can provide 'CheckPackageContentOps' operations.
2410 --
2411 -- The point of this extra generality is to allow doing checks in some virtual
2412 -- file system, for example a tarball in memory.
2413 checkPackageContent
2414   :: (Monad m, Applicative m)
2415   => CheckPackageContentOps m
2416   -> PackageDescription
2417   -> m [PackageCheck]
2418 checkPackageContent ops pkg = do
2419   cabalBomError <- checkCabalFileBOM ops
2420   cabalNameError <- checkCabalFileName ops pkg
2421   licenseErrors <- checkLicensesExist ops pkg
2422   setupError <- checkSetupExists ops pkg
2423   configureError <- checkConfigureExists ops pkg
2424   localPathErrors <- checkLocalPathsExist ops pkg
2425   vcsLocation <- checkMissingVcsInfo ops pkg
2426
2427   return $
2428     licenseErrors
2429       ++ catMaybes [cabalBomError, cabalNameError, setupError, configureError]
2430       ++ localPathErrors
2431       ++ vcsLocation
2432
2433 checkCabalFileBOM
2434   :: Monad m
2435   => CheckPackageContentOps m
2436   -> m (Maybe PackageCheck)
2437 checkCabalFileBOM ops = do
2438   epdfile <- findPackageDesc ops
2439   case epdfile of
2440     -- MASSIVE HACK.  If the Cabal file doesn't exist, that is
2441     -- a very strange situation to be in, because the driver code
2442     -- in 'Distribution.Setup' ought to have noticed already!
2443     -- But this can be an issue, see #3552 and also when
2444     -- --cabal-file is specified.  So if you can't find the file,
2445     -- just don't bother with this check.
2446     Left _ -> return Nothing
2447     Right pdfile ->
2448       (flip check pc . BS.isPrefixOf bomUtf8)
2449         `liftM` getFileContents ops pdfile
2450       where
2451         pc = PackageDistInexcusable (BOMStart pdfile)
2452   where
2453     bomUtf8 :: BS.ByteString
2454     bomUtf8 = BS.pack [0xef, 0xbb, 0xbf] -- U+FEFF encoded as UTF8
2455
2456 checkCabalFileName
2457   :: Monad m
2458   => CheckPackageContentOps m
2459   -> PackageDescription
2460   -> m (Maybe PackageCheck)
2461 checkCabalFileName ops pkg = do
2462   -- findPackageDesc already takes care to detect missing/multiple
2463   -- .cabal files; we don't include this check in 'findPackageDesc' in
2464   -- order not to short-cut other checks which call 'findPackageDesc'
2465   epdfile <- findPackageDesc ops
2466   case epdfile of
2467     -- see "MASSIVE HACK" note in 'checkCabalFileBOM'
2468     Left _ -> return Nothing
2469     Right pdfile
2470       | takeFileName pdfile == expectedCabalname -> return Nothing
2471       | otherwise ->
2472           return $
2473             Just $
2474               PackageDistInexcusable
2475                 (NotPackageName pdfile expectedCabalname)
2476   where
2477     pkgname = unPackageName . packageName $ pkg
2478     expectedCabalname = pkgname <.> "cabal"
2479
2480 -- | Find a package description file in the given directory.  Looks for
2481 --  @.cabal@ files.  Like 'Distribution.Simple.Utils.findPackageDesc',
2482 --  but generalized over monads.
2483 findPackageDesc
2484   :: Monad m
2485   => CheckPackageContentOps m
2486   -> m (Either PackageCheck FilePath)
2487   -- ^ <pkgname>.cabal
2488 findPackageDesc ops =
2489   do
2490     let dir = "."
2491     files <- getDirectoryContents ops dir
2492     -- to make sure we do not mistake a ~/.cabal/ dir for a <pkgname>.cabal
2493     -- file we filter to exclude dirs and null base file names:
2494     cabalFiles <-
2495       filterM
2496         (doesFileExist ops)
2497         [ dir </> file
2498         | file <- files
2499         , let (name, ext) = splitExtension file
2500         , not (null name) && ext == ".cabal"
2501         ]
2502     case cabalFiles of
2503       [] -> return (Left $ PackageBuildImpossible NoDesc)
2504       [cabalFile] -> return (Right cabalFile)
2505       multiple ->
2506         return
2507           ( Left $
2508               PackageBuildImpossible
2509                 (MultiDesc multiple)
2510           )
2511
2512 checkLicensesExist
2513   :: (Monad m, Applicative m)
2514   => CheckPackageContentOps m
2515   -> PackageDescription
2516   -> m [PackageCheck]
2517 checkLicensesExist ops pkg = do
2518   exists <- traverse (doesFileExist ops . getSymbolicPath) (licenseFiles pkg)
2519   return
2520     [ PackageBuildWarning (UnknownFile fieldname file)
2521     | (file, False) <- zip (licenseFiles pkg) exists
2522     ]
2523   where
2524     fieldname
2525       | length (licenseFiles pkg) == 1 = "license-file"
2526       | otherwise = "license-files"
2527
2528 checkSetupExists
2529   :: Monad m
2530   => CheckPackageContentOps m
2531   -> PackageDescription
2532   -> m (Maybe PackageCheck)
2533 checkSetupExists ops pkg = do
2534   let simpleBuild = buildType pkg == Simple
2535   hsexists <- doesFileExist ops "Setup.hs"
2536   lhsexists <- doesFileExist ops "Setup.lhs"
2537   return $
2538     check (not simpleBuild && not hsexists && not lhsexists) $
2539       PackageDistInexcusable MissingSetupFile
2540
2541 checkConfigureExists
2542   :: Monad m
2543   => CheckPackageContentOps m
2544   -> PackageDescription
2545   -> m (Maybe PackageCheck)
2546 checkConfigureExists ops pd
2547   | buildType pd == Configure = do
2548       exists <- doesFileExist ops "configure"
2549       return $
2550         check (not exists) $
2551           PackageBuildWarning MissingConfigureScript
2552   | otherwise = return Nothing
2553
2554 checkLocalPathsExist
2555   :: Monad m
2556   => CheckPackageContentOps m
2557   -> PackageDescription
2558   -> m [PackageCheck]
2559 checkLocalPathsExist ops pkg = do
2560   let dirs =
2561         [ (dir, kind)
2562         | bi <- allBuildInfo pkg
2563         , (dir, kind) <-
2564             [(dir, "extra-lib-dirs") | dir <- extraLibDirs bi]
2565               ++ [(dir, "extra-lib-dirs-static") | dir <- extraLibDirsStatic bi]
2566               ++ [ (dir, "extra-framework-dirs")
2567                  | dir <- extraFrameworkDirs bi
2568                  ]
2569               ++ [(dir, "include-dirs") | dir <- includeDirs bi]
2570               ++ [(getSymbolicPath dir, "hs-source-dirs") | dir <- hsSourceDirs bi]
2571         , isRelativeOnAnyPlatform dir
2572         ]
2573   missing <- filterM (liftM not . doesDirectoryExist ops . fst) dirs
2574   return
2575     [ PackageBuildWarning (UnknownDirectory kind dir)
2576     | (dir, kind) <- missing
2577     ]
2578
2579 checkMissingVcsInfo
2580   :: (Monad m, Applicative m)
2581   => CheckPackageContentOps m
2582   -> PackageDescription
2583   -> m [PackageCheck]
2584 checkMissingVcsInfo ops pkg | null (sourceRepos pkg) = do
2585   vcsInUse <- liftM or $ traverse (doesDirectoryExist ops) repoDirnames
2586   if vcsInUse
2587     then return [PackageDistSuspicious MissingSourceControl]
2588     else return []
2589   where
2590     repoDirnames =
2591       [ dirname | repo <- knownRepoTypes, dirname <- repoTypeDirname repo
2592       ]
2593 checkMissingVcsInfo _ _ = return []
2594
2595 repoTypeDirname :: KnownRepoType -> [FilePath]
2596 repoTypeDirname Darcs = ["_darcs"]
2597 repoTypeDirname Git = [".git"]
2598 repoTypeDirname SVN = [".svn"]
2599 repoTypeDirname CVS = ["CVS"]
2600 repoTypeDirname Mercurial = [".hg"]
2601 repoTypeDirname GnuArch = [".arch-params"]
2602 repoTypeDirname Bazaar = [".bzr"]
2603 repoTypeDirname Monotone = ["_MTN"]
2604 repoTypeDirname Pijul = [".pijul"]
2605
2606 -- ------------------------------------------------------------
2607
2608 -- * Checks involving files in the package
2609
2610 -- ------------------------------------------------------------
2611
2612 -- | Check the names of all files in a package for portability problems. This
2613 -- should be done for example when creating or validating a package tarball.
2614 checkPackageFileNames :: [FilePath] -> [PackageCheck]
2615 checkPackageFileNames = checkPackageFileNamesWithGlob . zip (repeat True)
2616
2617 checkPackageFileNamesWithGlob :: [(Bool, FilePath)] -> [PackageCheck]
2618 checkPackageFileNamesWithGlob files =
2619   catMaybes $
2620     checkWindowsPaths files
2621       : [ checkTarPath file
2622         | (_, file) <- files
2623         ]
2624
2625 checkWindowsPaths :: [(Bool, FilePath)] -> Maybe PackageCheck
2626 checkWindowsPaths paths =
2627   case filter (not . FilePath.Windows.isValid . escape) paths of
2628     [] -> Nothing
2629     ps ->
2630       Just $
2631         PackageDistInexcusable (InvalidOnWin $ map snd ps)
2632   where
2633     -- force a relative name to catch invalid file names like "f:oo" which
2634     -- otherwise parse as file "oo" in the current directory on the 'f' drive.
2635     escape (isGlob, path) =
2636       (".\\" ++)
2637       -- glob paths will be expanded before being dereferenced, so asterisks
2638       -- shouldn't count against them.
2639       $
2640         map (\c -> if c == '*' && isGlob then 'x' else c) path
2641
2642 -- | Check a file name is valid for the portable POSIX tar format.
2643 --
2644 -- The POSIX tar format has a restriction on the length of file names. It is
2645 -- unfortunately not a simple restriction like a maximum length. The exact
2646 -- restriction is that either the whole path be 100 characters or less, or it
2647 -- be possible to split the path on a directory separator such that the first
2648 -- part is 155 characters or less and the second part 100 characters or less.
2649 checkTarPath :: FilePath -> Maybe PackageCheck
2650 checkTarPath path
2651   | length path > 255 = Just longPath
2652   | otherwise = case pack nameMax (reverse (splitPath path)) of
2653       Left err -> Just err
2654       Right [] -> Nothing
2655       Right (h : rest) -> case pack prefixMax remainder of
2656         Left err -> Just err
2657         Right [] -> Nothing
2658         Right (_ : _) -> Just noSplit
2659         where
2660           -- drop the '/' between the name and prefix:
2661           remainder = safeInit h : rest
2662   where
2663     nameMax, prefixMax :: Int
2664     nameMax = 100
2665     prefixMax = 155
2666
2667     pack _ [] = Left emptyName
2668     pack maxLen (c : cs)
2669       | n > maxLen = Left longName
2670       | otherwise = Right (pack' maxLen n cs)
2671       where
2672         n = length c
2673
2674     pack' maxLen n (c : cs)
2675       | n' <= maxLen = pack' maxLen n' cs
2676       where
2677         n' = n + length c
2678     pack' _ _ cs = cs
2679
2680     longPath = PackageDistInexcusable (FilePathTooLong path)
2681     longName = PackageDistInexcusable (FilePathNameTooLong path)
2682     noSplit = PackageDistInexcusable (FilePathSplitTooLong path)
2683     emptyName = PackageDistInexcusable FilePathEmpty
2684
2685 -- --------------------------------------------------------------
2686
2687 -- * Checks for missing content and other pre-distribution checks
2688
2689 -- --------------------------------------------------------------
2690
2691 -- | Similar to 'checkPackageContent', 'checkPackageFilesPreDistribution'
2692 -- inspects the files included in the package, but is primarily looking for
2693 -- files in the working tree that may have been missed or other similar
2694 -- problems that can only be detected pre-distribution.
2695 --
2696 -- Because Hackage necessarily checks the uploaded tarball, it is too late to
2697 -- check these on the server; these checks only make sense in the development
2698 -- and package-creation environment. Hence we can use IO, rather than needing
2699 -- to pass a 'CheckPackageContentOps' dictionary around.
2700 checkPackageFilesPreDistribution :: Verbosity -> PackageDescription -> FilePath -> IO [PackageCheck]
2701 -- Note: this really shouldn't return any 'Inexcusable' warnings,
2702 -- because that will make us say that Hackage would reject the package.
2703 -- But, because Hackage doesn't run these tests, that will be a lie!
2704 checkPackageFilesPreDistribution = checkGlobFiles
2705
2706 -- | Discover problems with the package's wildcards.
2707 checkGlobFiles
2708   :: Verbosity
2709   -> PackageDescription
2710   -> FilePath
2711   -> IO [PackageCheck]
2712 checkGlobFiles verbosity pkg root = do
2713   -- Get the desirable doc files from package’s directory
2714   rootContents <- System.Directory.getDirectoryContents root
2715   docFiles0 <-
2716     filterM
2717       System.doesFileExist
2718       [ file
2719       | file <- rootContents
2720       , isDesirableExtraDocFile desirableDocFiles file
2721       ]
2722   -- Check the globs
2723   (warnings, unlisted) <- foldrM checkGlob ([], docFiles0) allGlobs
2724
2725   return $
2726     if null unlisted
2727       then -- No missing desirable file
2728         warnings
2729       else -- Some missing desirable files
2730
2731         warnings
2732           ++ let unlisted' = (root </>) <$> unlisted
2733               in [ PackageDistSuspiciousWarn
2734                     (MissingExpectedDocFiles extraDocFilesSupport unlisted')
2735                  ]
2736   where
2737     -- `extra-doc-files` is supported only from version 1.18
2738     extraDocFilesSupport = specVersion pkg >= CabalSpecV1_18
2739     adjustedDataDir = if null (dataDir pkg) then root else root </> dataDir pkg
2740     -- Cabal fields with globs
2741     allGlobs :: [(String, Bool, FilePath, FilePath)]
2742     allGlobs =
2743       concat
2744         [ (,,,) "extra-source-files" (not extraDocFilesSupport) root
2745             <$> extraSrcFiles pkg
2746         , (,,,) "extra-doc-files" True root <$> extraDocFiles pkg
2747         , (,,,) "data-files" False adjustedDataDir <$> dataFiles pkg
2748         ]
2749
2750     -- For each field with globs (see allGlobs), look for:
2751     -- • errors (missing directory, no match)
2752     -- • omitted documentation files (changelog)
2753     checkGlob
2754       :: (String, Bool, FilePath, FilePath)
2755       -> ([PackageCheck], [FilePath])
2756       -> IO ([PackageCheck], [FilePath])
2757     checkGlob (field, isDocField, dir, glob) acc@(warnings, docFiles1) =
2758       -- Note: we just skip over parse errors here; they're reported elsewhere.
2759       case parseFileGlob (specVersion pkg) glob of
2760         Left _ -> return acc
2761         Right parsedGlob -> do
2762           results <- runDirFileGlob verbosity (root </> dir) parsedGlob
2763           let acc0 = (warnings, True, docFiles1, [])
2764           return $ case foldr checkGlobResult acc0 results of
2765             (individualWarn, noMatchesWarn, docFiles1', wrongPaths) ->
2766               let wrongFieldWarnings =
2767                     [ PackageDistSuspiciousWarn
2768                       ( WrongFieldForExpectedDocFiles
2769                           extraDocFilesSupport
2770                           field
2771                           wrongPaths
2772                       )
2773                     | not (null wrongPaths)
2774                     ]
2775                in ( if noMatchesWarn
2776                       then
2777                         [PackageDistSuspiciousWarn (GlobNoMatch field glob)]
2778                           ++ individualWarn
2779                           ++ wrongFieldWarnings
2780                       else individualWarn ++ wrongFieldWarnings
2781                   , docFiles1'
2782                   )
2783           where
2784             checkGlobResult
2785               :: GlobResult FilePath
2786               -> ([PackageCheck], Bool, [FilePath], [FilePath])
2787               -> ([PackageCheck], Bool, [FilePath], [FilePath])
2788             checkGlobResult result (ws, noMatchesWarn, docFiles2, wrongPaths) =
2789               let noMatchesWarn' =
2790                     noMatchesWarn
2791                       && not (suppressesNoMatchesWarning result)
2792                in case getWarning field glob result of
2793                     -- No match: add warning and do no further check
2794                     Left w ->
2795                       ( w : ws
2796                       , noMatchesWarn'
2797                       , docFiles2
2798                       , wrongPaths
2799                       )
2800                     -- Match: check doc files
2801                     Right path ->
2802                       let path' = makeRelative root (normalise path)
2803                           (docFiles2', wrongPaths') =
2804                             checkDoc
2805                               isDocField
2806                               path'
2807                               docFiles2
2808                               wrongPaths
2809                        in ( ws
2810                           , noMatchesWarn'
2811                           , docFiles2'
2812                           , wrongPaths'
2813                           )
2814
2815     -- Check whether a path is a desirable doc: if so, check if it is in the
2816     -- field "extra-doc-files".
2817     checkDoc
2818       :: Bool -- Is it "extra-doc-files" ?
2819       -> FilePath -- Path to test
2820       -> [FilePath] -- Pending doc files to check
2821       -> [FilePath] -- Previous wrong paths
2822       -> ([FilePath], [FilePath]) -- Updated paths
2823     checkDoc isDocField path docFiles wrongFieldPaths =
2824       if path `elem` docFiles
2825         then -- Found desirable doc file
2826
2827           ( delete path docFiles
2828           , if isDocField then wrongFieldPaths else path : wrongFieldPaths
2829           )
2830         else -- Not a desirable doc file
2831
2832           ( docFiles
2833           , wrongFieldPaths
2834           )
2835
2836     -- Predicate for desirable documentation file on Hackage server
2837     isDesirableExtraDocFile :: ([FilePath], [FilePath]) -> FilePath -> Bool
2838     isDesirableExtraDocFile (basenames, extensions) path =
2839       basename `elem` basenames && ext `elem` extensions
2840       where
2841         (basename, ext) = splitExtension (map toLower path)
2842
2843     -- Changelog patterns (basenames & extensions)
2844     -- Source: hackage-server/src/Distribution/Server/Packages/ChangeLog.hs
2845     desirableChangeLog =
2846       [ "news"
2847       , "changelog"
2848       , "change_log"
2849       , "changes"
2850       ]
2851     desirableChangeLogExtensions = ["", ".txt", ".md", ".markdown", ".rst"]
2852     -- [TODO] Check readme. Observations:
2853     --        • Readme is not necessary if package description is good.
2854     --        • Some readmes exists only for repository browsing.
2855     --        • There is currently no reliable way to check what a good
2856     --          description is; there will be complains if the criterion is
2857     --          based on the length or number of words (can of worms).
2858     -- -- Readme patterns
2859     -- -- Source: hackage-server/src/Distribution/Server/Packages/Readme.hs
2860     -- desirableReadme = ["readme"]
2861     desirableDocFiles = (desirableChangeLog, desirableChangeLogExtensions)
2862
2863     -- If there's a missing directory in play, since our globs don't
2864     -- (currently) support disjunction, that will always mean there are no
2865     -- matches. The no matches error in this case is strictly less informative
2866     -- than the missing directory error, so sit on it.
2867     suppressesNoMatchesWarning (GlobMatch _) = True
2868     suppressesNoMatchesWarning (GlobWarnMultiDot _) = False
2869     suppressesNoMatchesWarning (GlobMissingDirectory _) = True
2870
2871     getWarning
2872       :: String
2873       -> FilePath
2874       -> GlobResult FilePath
2875       -> Either PackageCheck FilePath
2876     getWarning _ _ (GlobMatch path) =
2877       Right path
2878     -- Before Cabal 2.4, the extensions of globs had to match the file
2879     -- exactly. This has been relaxed in 2.4 to allow matching only the
2880     -- suffix. This warning detects when pre-2.4 package descriptions are
2881     -- omitting files purely because of the stricter check.
2882     getWarning field glob (GlobWarnMultiDot file) =
2883       Left (PackageDistSuspiciousWarn (GlobExactMatch field glob file))
2884     getWarning field glob (GlobMissingDirectory dir) =
2885       Left (PackageDistSuspiciousWarn (GlobNoDir field glob dir))
2886
2887 -- | Check that setup dependencies, have proper bounds.
2888 -- In particular, @base@ and @Cabal@ upper bounds are mandatory.
2889 checkSetupVersions :: GenericPackageDescription -> [PackageCheck]
2890 checkSetupVersions pkg =
2891   [ emitError nameStr
2892   | (name, vr) <- Map.toList deps
2893   , not (hasUpperBound vr)
2894   , let nameStr = unPackageName name
2895   , nameStr `elem` criticalPkgs
2896   ]
2897   where
2898     criticalPkgs = ["Cabal", "base"]
2899     deps = toDependencyVersionsMap (foldMap setupDepends . setupBuildInfo) pkg
2900     emitError nm =
2901       PackageDistInexcusable (UpperBoundSetup nm)
2902
2903 checkDuplicateModules :: GenericPackageDescription -> [PackageCheck]
2904 checkDuplicateModules pkg =
2905   concatMap checkLib (maybe id (:) (condLibrary pkg) . map snd $ condSubLibraries pkg)
2906     ++ concatMap checkExe (map snd $ condExecutables pkg)
2907     ++ concatMap checkTest (map snd $ condTestSuites pkg)
2908     ++ concatMap checkBench (map snd $ condBenchmarks pkg)
2909   where
2910     -- the duplicate modules check is has not been thoroughly vetted for backpack
2911     checkLib = checkDups "library" (\l -> explicitLibModules l ++ map moduleReexportName (reexportedModules l))
2912     checkExe = checkDups "executable" exeModules
2913     checkTest = checkDups "test suite" testModules
2914     checkBench = checkDups "benchmark" benchmarkModules
2915     checkDups s getModules t =
2916       let sumPair (x, x') (y, y') = (x + x' :: Int, y + y' :: Int)
2917           mergePair (x, x') (y, y') = (x + x', max y y')
2918           maxPair (x, x') (y, y') = (max x x', max y y')
2919           libMap =
2920             foldCondTree
2921               Map.empty
2922               (\(_, v) -> Map.fromListWith sumPair . map (\x -> (x, (1, 1))) $ getModules v)
2923               (Map.unionWith mergePair) -- if a module may occur in nonexclusive branches count it twice strictly and once loosely.
2924               (Map.unionWith maxPair) -- a module occurs the max of times it might appear in exclusive branches
2925               t
2926           dupLibsStrict = Map.keys $ Map.filter ((> 1) . fst) libMap
2927           dupLibsLax = Map.keys $ Map.filter ((> 1) . snd) libMap
2928        in if not (null dupLibsLax)
2929             then
2930               [ PackageBuildImpossible
2931                   (DuplicateModule s dupLibsLax)
2932               ]
2933             else
2934               if not (null dupLibsStrict)
2935                 then
2936                   [ PackageDistSuspicious
2937                       (PotentialDupModule s dupLibsStrict)
2938                   ]
2939                 else []
2940
2941 -- ------------------------------------------------------------
2942
2943 -- * Utils
2944
2945 -- ------------------------------------------------------------
2946
2947 toDependencyVersionsMap :: (PackageDescription -> [Dependency]) -> GenericPackageDescription -> Map PackageName VersionRange
2948 toDependencyVersionsMap selectDependencies pkg = case typicalPkg pkg of
2949   Right (pkgs', _) ->
2950     let
2951       self :: PackageName
2952       self = pkgName $ package pkgs'
2953      in
2954       Map.fromListWith intersectVersionRanges $
2955         [ (pname, vr)
2956         | Dependency pname vr _ <- selectDependencies pkgs'
2957         , pname /= self
2958         ]
2959   -- Just in case finalizePD fails for any reason,
2960   -- or if the package doesn't depend on the base package at all,
2961   -- no deps is no checks.
2962   _ -> Map.empty
2963
2964 quote :: String -> String
2965 quote s = "'" ++ s ++ "'"
2966
2967 commaSep :: [String] -> String
2968 commaSep = intercalate ", "
2969
2970 dups :: Ord a => [a] -> [a]
2971 dups xs = [x | (x : _ : _) <- group (sort xs)]
2972
2973 fileExtensionSupportedLanguage :: FilePath -> Bool
2974 fileExtensionSupportedLanguage path =
2975   isHaskell || isC
2976   where
2977     extension = takeExtension path
2978     isHaskell = extension `elem` [".hs", ".lhs"]
2979     isC = isJust (filenameCDialect extension)
2980
2981 -- | Whether a path is a good relative path.  We aren't worried about perfect
2982 -- cross-platform compatibility here; this function just checks the paths in
2983 -- the (local) @.cabal@ file, while only Hackage needs the portability.
2984 --
2985 -- >>> let test fp = putStrLn $ show (isGoodRelativeDirectoryPath fp) ++ "; " ++ show (isGoodRelativeFilePath fp)
2986 --
2987 -- Note that "foo./bar.hs" would be invalid on Windows.
2988 --
2989 -- >>> traverse_ test ["foo/bar/quu", "a/b.hs", "foo./bar.hs"]
2990 -- Nothing; Nothing
2991 -- Nothing; Nothing
2992 -- Nothing; Nothing
2993 --
2994 -- Trailing slash is not allowed for files, for directories it is ok.
2995 --
2996 -- >>> test "foo/"
2997 -- Nothing; Just "trailing slash"
2998 --
2999 -- Leading @./@ is fine, but @.@ and @./@ are not valid files.
3000 --
3001 -- >>> traverse_ test [".", "./", "./foo/bar"]
3002 -- Nothing; Just "trailing dot segment"
3003 -- Nothing; Just "trailing slash"
3004 -- Nothing; Nothing
3005 --
3006 -- Lastly, not good file nor directory cases:
3007 --
3008 -- >>> traverse_ test ["", "/tmp/src", "foo//bar", "foo/.", "foo/./bar", "foo/../bar"]
3009 -- Just "empty path"; Just "empty path"
3010 -- Just "posix absolute path"; Just "posix absolute path"
3011 -- Just "empty path segment"; Just "empty path segment"
3012 -- Just "trailing same directory segment: ."; Just "trailing same directory segment: ."
3013 -- Just "same directory segment: ."; Just "same directory segment: ."
3014 -- Just "parent directory segment: .."; Just "parent directory segment: .."
3015 --
3016 -- For the last case, 'isGoodRelativeGlob' doesn't warn:
3017 --
3018 -- >>> traverse_ (print . isGoodRelativeGlob) ["foo/../bar"]
3019 -- Just "parent directory segment: .."
3020 isGoodRelativeFilePath :: FilePath -> Maybe String
3021 isGoodRelativeFilePath = state0
3022   where
3023     -- initial state
3024     state0 [] = Just "empty path"
3025     state0 (c : cs)
3026       | c == '.' = state1 cs
3027       | c == '/' = Just "posix absolute path"
3028       | otherwise = state5 cs
3029
3030     -- after initial .
3031     state1 [] = Just "trailing dot segment"
3032     state1 (c : cs)
3033       | c == '.' = state4 cs
3034       | c == '/' = state2 cs
3035       | otherwise = state5 cs
3036
3037     -- after ./ or after / between segments
3038     state2 [] = Just "trailing slash"
3039     state2 (c : cs)
3040       | c == '.' = state3 cs
3041       | c == '/' = Just "empty path segment"
3042       | otherwise = state5 cs
3043
3044     -- after non-first segment's .
3045     state3 [] = Just "trailing same directory segment: ."
3046     state3 (c : cs)
3047       | c == '.' = state4 cs
3048       | c == '/' = Just "same directory segment: ."
3049       | otherwise = state5 cs
3050
3051     -- after ..
3052     state4 [] = Just "trailing parent directory segment: .."
3053     state4 (c : cs)
3054       | c == '.' = state5 cs
3055       | c == '/' = Just "parent directory segment: .."
3056       | otherwise = state5 cs
3057
3058     -- in a segment which is ok.
3059     state5 [] = Nothing
3060     state5 (c : cs)
3061       | c == '.' = state5 cs
3062       | c == '/' = state2 cs
3063       | otherwise = state5 cs
3064
3065 -- | See 'isGoodRelativeFilePath'.
3066 --
3067 -- This is barebones function. We check whether the glob is a valid file
3068 -- by replacing stars @*@ with @x@ses.
3069 isGoodRelativeGlob :: FilePath -> Maybe String
3070 isGoodRelativeGlob = isGoodRelativeFilePath . map f
3071   where
3072     f '*' = 'x'
3073     f c = c
3074
3075 -- | See 'isGoodRelativeFilePath'.
3076 isGoodRelativeDirectoryPath :: FilePath -> Maybe String
3077 isGoodRelativeDirectoryPath = state0
3078   where
3079     -- initial state
3080     state0 [] = Just "empty path"
3081     state0 (c : cs)
3082       | c == '.' = state5 cs
3083       | c == '/' = Just "posix absolute path"
3084       | otherwise = state4 cs
3085
3086     -- after initial ./ or after / between segments
3087     state1 [] = Nothing
3088     state1 (c : cs)
3089       | c == '.' = state2 cs
3090       | c == '/' = Just "empty path segment"
3091       | otherwise = state4 cs
3092
3093     -- after non-first setgment's .
3094     state2 [] = Just "trailing same directory segment: ."
3095     state2 (c : cs)
3096       | c == '.' = state3 cs
3097       | c == '/' = Just "same directory segment: ."
3098       | otherwise = state4 cs
3099
3100     -- after ..
3101     state3 [] = Just "trailing parent directory segment: .."
3102     state3 (c : cs)
3103       | c == '.' = state4 cs
3104       | c == '/' = Just "parent directory segment: .."
3105       | otherwise = state4 cs
3106
3107     -- in a segment which is ok.
3108     state4 [] = Nothing
3109     state4 (c : cs)
3110       | c == '.' = state4 cs
3111       | c == '/' = state1 cs
3112       | otherwise = state4 cs
3113
3114     -- after initial .
3115     state5 [] = Nothing -- "."
3116     state5 (c : cs)
3117       | c == '.' = state3 cs
3118       | c == '/' = state1 cs
3119       | otherwise = state4 cs
3120
3121 -- [Note: Good relative paths]
3122 --
3123 -- Using @kleene@ we can define an extended regex:
3124 --
3125 -- @
3126 -- import Algebra.Lattice
3127 -- import Kleene
3128 -- import Kleene.ERE (ERE (..), intersections)
3129 --
3130 -- data C = CDot | CSlash | CChar
3131 --   deriving (Eq, Ord, Enum, Bounded, Show)
3132 --
3133 -- reservedR :: ERE C
3134 -- reservedR = notChar CSlash
3135 --
3136 -- pathPieceR :: ERE C
3137 -- pathPieceR = intersections
3138 --     [ plus reservedR
3139 --     , ERENot (string [CDot])
3140 --     , ERENot (string [CDot,CDot])
3141 --     ]
3142 --
3143 -- filePathR :: ERE C
3144 -- filePathR = optional (string [CDot, CSlash]) <> pathPieceR <> star (char CSlash <> pathPieceR)
3145 --
3146 -- dirPathR :: ERE C
3147 -- dirPathR = (char CDot \/ filePathR) <> optional (char CSlash)
3148 --
3149 -- plus :: ERE C -> ERE C
3150 -- plus r = r <> star r
3151 --
3152 -- optional :: ERE C -> ERE C
3153 -- optional r = mempty \/ r
3154 -- @
3155 --
3156 -- Results in following state machine for @filePathR@
3157 --
3158 -- @
3159 -- 0 -> \x -> if
3160 --     | x <= CDot           -> 1
3161 --     | otherwise           -> 5
3162 -- 1 -> \x -> if
3163 --     | x <= CDot           -> 4
3164 --     | x <= CSlash         -> 2
3165 --     | otherwise           -> 5
3166 -- 2 -> \x -> if
3167 --     | x <= CDot           -> 3
3168 --     | otherwise           -> 5
3169 -- 3 -> \x -> if
3170 --     | x <= CDot           -> 4
3171 --     | otherwise           -> 5
3172 -- 4 -> \x -> if
3173 --     | x <= CDot           -> 5
3174 --     | otherwise           -> 5
3175 -- 5+ -> \x -> if
3176 --     | x <= CDot           -> 5
3177 --     | x <= CSlash         -> 2
3178 --     | otherwise           -> 5
3179 -- @
3180 --
3181 -- and @dirPathR@:
3182 --
3183 -- @
3184 -- 0 -> \x -> if
3185 --     | x <= CDot           -> 5
3186 --     | otherwise           -> 4
3187 -- 1+ -> \x -> if
3188 --     | x <= CDot           -> 2
3189 --     | otherwise           -> 4
3190 -- 2 -> \x -> if
3191 --     | x <= CDot           -> 3
3192 --     | otherwise           -> 4
3193 -- 3 -> \x -> if
3194 --     | x <= CDot           -> 4
3195 --     | otherwise           -> 4
3196 -- 4+ -> \x -> if
3197 --     | x <= CDot           -> 4
3198 --     | x <= CSlash         -> 1
3199 --     | otherwise           -> 4
3200 -- 5+ -> \x -> if
3201 --     | x <= CDot           -> 3
3202 --     | x <= CSlash         -> 1
3203 --     | otherwise           -> 4
3204 -- @
3205
3206 --
3207 -- TODO: What we really want to do is test if there exists any
3208 -- configuration in which the base version is unbounded above.
3209 -- However that's a bit tricky because there are many possible
3210 -- configurations. As a cheap easy and safe approximation we will
3211 -- pick a single "typical" configuration and check if that has an
3212 -- open upper bound. To get a typical configuration we finalise
3213 -- using no package index and the current platform.
3214 typicalPkg
3215   :: GenericPackageDescription
3216   -> Either [Dependency] (PackageDescription, FlagAssignment)
3217 typicalPkg =
3218   finalizePD
3219     mempty
3220     defaultComponentRequestedSpec
3221     (const True)
3222     buildPlatform
3223     ( unknownCompilerInfo
3224         (CompilerId buildCompilerFlavor nullVersion)
3225         NoAbiTag
3226     )
3227     []
3228
3229 addConditionalExp :: String -> String
3230 addConditionalExp expl =
3231   expl
3232     ++ " Alternatively, if you want to use this, make it conditional based "
3233     ++ "on a Cabal configuration flag (with 'manual: True' and 'default: "
3234     ++ "False') and enable that flag during development."