Cabal/src/Distribution/PackageDescription/Check/Target.hs

   1 -- |
   2 -- Module      :  Distribution.PackageDescription.Check.Target
   3 -- Copyright   :  Lennart Kolmodin 2008, Francesco Ariis 2023
   4 -- License     :  BSD3
   5 --
   6 -- Maintainer  :  cabal-devel@haskell.org
   7 -- Portability :  portable
   8 --
   9 -- Fully-realised target (library, executable, …) checking functions.
  10 module Distribution.PackageDescription.Check.Target
  11   ( checkLibrary
  12   , checkForeignLib
  13   , checkExecutable
  14   , checkTestSuite
  15   , checkBenchmark
  16   ) where
  17
  18 import Distribution.Compat.Prelude
  19 import Prelude ()
  20
  21 import Distribution.CabalSpecVersion
  22 import Distribution.Compat.Lens
  23 import Distribution.Compiler
  24 import Distribution.ModuleName (ModuleName)
  25 import Distribution.Package
  26 import Distribution.PackageDescription
  27 import Distribution.PackageDescription.Check.Common
  28 import Distribution.PackageDescription.Check.Monad
  29 import Distribution.PackageDescription.Check.Paths
  30 import Distribution.Pretty (prettyShow)
  31 import Distribution.Simple.BuildPaths
  32   ( autogenPackageInfoModuleName
  33   , autogenPathsModuleName
  34   )
  35 import Distribution.Simple.Utils hiding (findPackageDesc, notice)
  36 import Distribution.Types.PackageName.Magic
  37 import Distribution.Utils.Path
  38 import Distribution.Version
  39 import Language.Haskell.Extension
  40 import System.FilePath (takeExtension)
  41
  42 import Control.Monad
  43
  44 import qualified Distribution.Types.BuildInfo.Lens as L
  45
  46 checkLibrary
  47   :: Monad m
  48   => Bool -- Is this a sublibrary?
  49   -> [AssocDep] -- “Inherited” dependencies for PVP checks.
  50   -> Library
  51   -> CheckM m ()
  52 checkLibrary
  53   isSub
  54   ads
  55   lib@( Library
  56           libName_
  57           _exposedModules_
  58           reexportedModules_
  59           signatures_
  60           _libExposed_
  61           _libVisibility_
  62           libBuildInfo_
  63         ) = do
  64     checkP
  65       (libName_ == LMainLibName && isSub)
  66       (PackageBuildImpossible UnnamedInternal)
  67     -- TODO: bogus if a required-signature was passed through.
  68     checkP
  69       (null (explicitLibModules lib) && null reexportedModules_)
  70       (PackageDistSuspiciousWarn (NoModulesExposed libName_))
  71     -- TODO parse-caught check, can safely remove.
  72     checkSpecVer
  73       CabalSpecV2_0
  74       (not . null $ signatures_)
  75       (PackageDistInexcusable SignaturesCabal2)
  76     -- autogen/includes checks.
  77     checkP
  78       ( not $
  79           all
  80             (flip elem (explicitLibModules lib))
  81             (libModulesAutogen lib)
  82       )
  83       (PackageBuildImpossible AutogenNotExposed)
  84     -- check that all autogen-includes appear on includes or
  85     -- install-includes.
  86     checkP
  87       ( not $
  88           all
  89             (flip elem (allExplicitIncludes lib) . getSymbolicPath)
  90             (view L.autogenIncludes lib)
  91       )
  92       $ (PackageBuildImpossible AutogenIncludesNotIncluded)
  93
  94     -- § Build infos.
  95     checkBuildInfo
  96       (CETLibrary libName_)
  97       (explicitLibModules lib)
  98       ads
  99       libBuildInfo_
 100
 101     -- Feature checks.
 102     -- check use of reexported-modules sections
 103     checkSpecVer
 104       CabalSpecV1_22
 105       (not . null $ reexportedModules_)
 106       (PackageDistInexcusable CVReexported)
 107     where
 108       allExplicitIncludes :: L.HasBuildInfo a => a -> [FilePath]
 109       allExplicitIncludes x =
 110         map getSymbolicPath (view L.includes x)
 111           ++ map getSymbolicPath (view L.installIncludes x)
 112
 113 checkForeignLib :: Monad m => ForeignLib -> CheckM m ()
 114 checkForeignLib
 115   ( ForeignLib
 116       foreignLibName_
 117       _foreignLibType_
 118       _foreignLibOptions_
 119       foreignLibBuildInfo_
 120       _foreignLibVersionInfo_
 121       _foreignLibVersionLinux_
 122       _foreignLibModDefFile_
 123     ) = do
 124     checkBuildInfo
 125       (CETForeignLibrary foreignLibName_)
 126       []
 127       []
 128       foreignLibBuildInfo_
 129
 130 checkExecutable
 131   :: Monad m
 132   => [AssocDep] -- “Inherited” dependencies for PVP checks.
 133   -> Executable
 134   -> CheckM m ()
 135 checkExecutable
 136   ads
 137   exe@( Executable
 138           exeName_
 139           symbolicModulePath_
 140           _exeScope_
 141           buildInfo_
 142         ) = do
 143     -- Target type/name (exe).
 144     let cet = CETExecutable exeName_
 145         modulePath_ = getSymbolicPath symbolicModulePath_
 146
 147     -- § Exe specific checks
 148     checkP
 149       (null modulePath_)
 150       (PackageBuildImpossible (NoMainIs exeName_))
 151     -- This check does not apply to scripts.
 152     pid <- asksCM (pnPackageId . ccNames)
 153     checkP
 154       ( pid /= fakePackageId
 155           && not (null modulePath_)
 156           && not (fileExtensionSupportedLanguage $ modulePath_)
 157       )
 158       (PackageBuildImpossible NoHsLhsMain)
 159
 160     -- § Features check
 161     checkSpecVer
 162       CabalSpecV1_18
 163       ( fileExtensionSupportedLanguage modulePath_
 164           && takeExtension modulePath_ `notElem` [".hs", ".lhs"]
 165       )
 166       (PackageDistInexcusable MainCCabal1_18)
 167
 168     -- Alas exeModules ad exeModulesAutogen (exported from
 169     -- Distribution.Types.Executable) take `Executable` as a parameter.
 170     checkP
 171       (not $ all (flip elem (exeModules exe)) (exeModulesAutogen exe))
 172       (PackageBuildImpossible $ AutogenNoOther cet)
 173     checkP
 174       ( not $
 175           all
 176             (flip elem (view L.includes exe) . relativeSymbolicPath)
 177             (view L.autogenIncludes exe)
 178       )
 179       (PackageBuildImpossible AutogenIncludesNotIncludedExe)
 180
 181     -- § Build info checks.
 182     checkBuildInfo cet [] ads buildInfo_
 183
 184 checkTestSuite
 185   :: Monad m
 186   => [AssocDep] -- “Inherited” dependencies for PVP checks.
 187   -> TestSuite
 188   -> CheckM m ()
 189 checkTestSuite
 190   ads
 191   ts@( TestSuite
 192         testName_
 193         testInterface_
 194         testBuildInfo_
 195         _testCodeGenerators_
 196       ) = do
 197     -- Target type/name (test).
 198     let cet = CETTest testName_
 199
 200     -- § TS specific checks.
 201     -- TODO caught by the parser, can remove safely
 202     case testInterface_ of
 203       TestSuiteUnsupported tt@(TestTypeUnknown _ _) ->
 204         tellP (PackageBuildWarning $ TestsuiteTypeNotKnown tt)
 205       TestSuiteUnsupported tt ->
 206         tellP (PackageBuildWarning $ TestsuiteNotSupported tt)
 207       _ -> return ()
 208     checkP
 209       mainIsWrongExt
 210       (PackageBuildImpossible NoHsLhsMain)
 211     checkP
 212       ( not $
 213           all
 214             (flip elem (testModules ts))
 215             (testModulesAutogen ts)
 216       )
 217       (PackageBuildImpossible $ AutogenNoOther cet)
 218     checkP
 219       ( not $
 220           all
 221             (flip elem (view L.includes ts) . relativeSymbolicPath)
 222             (view L.autogenIncludes ts)
 223       )
 224       (PackageBuildImpossible AutogenIncludesNotIncludedExe)
 225
 226     -- § Feature checks.
 227     checkSpecVer
 228       CabalSpecV1_18
 229       (mainIsNotHsExt && not mainIsWrongExt)
 230       (PackageDistInexcusable MainCCabal1_18)
 231
 232     -- § Build info checks.
 233     checkBuildInfo cet [] ads testBuildInfo_
 234     where
 235       mainIsWrongExt =
 236         case testInterface_ of
 237           TestSuiteExeV10 _ f -> not (fileExtensionSupportedLanguage $ getSymbolicPath f)
 238           _ -> False
 239
 240       mainIsNotHsExt =
 241         case testInterface_ of
 242           TestSuiteExeV10 _ f -> takeExtension (getSymbolicPath f) `notElem` [".hs", ".lhs"]
 243           _ -> False
 244
 245 checkBenchmark
 246   :: Monad m
 247   => [AssocDep] -- “Inherited” dependencies for PVP checks.
 248   -> Benchmark
 249   -> CheckM m ()
 250 checkBenchmark
 251   ads
 252   bm@( Benchmark
 253         benchmarkName_
 254         benchmarkInterface_
 255         benchmarkBuildInfo_
 256       ) = do
 257     -- Target type/name (benchmark).
 258     let cet = CETBenchmark benchmarkName_
 259
 260     -- § Interface & bm specific tests.
 261     case benchmarkInterface_ of
 262       BenchmarkUnsupported tt@(BenchmarkTypeUnknown _ _) ->
 263         tellP (PackageBuildWarning $ BenchmarkTypeNotKnown tt)
 264       BenchmarkUnsupported tt ->
 265         tellP (PackageBuildWarning $ BenchmarkNotSupported tt)
 266       _ -> return ()
 267     checkP
 268       mainIsWrongExt
 269       (PackageBuildImpossible NoHsLhsMainBench)
 270
 271     checkP
 272       ( not $
 273           all
 274             (flip elem (benchmarkModules bm))
 275             (benchmarkModulesAutogen bm)
 276       )
 277       (PackageBuildImpossible $ AutogenNoOther cet)
 278
 279     checkP
 280       ( not $
 281           all
 282             (flip elem (view L.includes bm) . relativeSymbolicPath)
 283             (view L.autogenIncludes bm)
 284       )
 285       (PackageBuildImpossible AutogenIncludesNotIncludedExe)
 286
 287     -- § BuildInfo checks.
 288     checkBuildInfo cet [] ads benchmarkBuildInfo_
 289     where
 290       -- Cannot abstract with similar function in checkTestSuite,
 291       -- they are different.
 292       mainIsWrongExt =
 293         case benchmarkInterface_ of
 294           BenchmarkExeV10 _ f -> takeExtension (getSymbolicPath f) `notElem` [".hs", ".lhs"]
 295           _ -> False
 296
 297 -- ------------------------------------------------------------
 298 -- Build info
 299 -- ------------------------------------------------------------
 300
 301 -- Check a great deal of things in buildInfo.
 302 -- With 'checkBuildInfo' we cannot follow the usual “pattern match
 303 -- everything” method, for the number of BuildInfo fields (almost 50)
 304 -- but more importantly because accessing options, etc. is done
 305 -- with functions from 'Distribution.Types.BuildInfo' (e.g. 'hcOptions').
 306 -- Duplicating the effort here means risk of diverging definitions for
 307 -- little gain (most likely if a field is added to BI, the relevant
 308 -- function will be tweaked in Distribution.Types.BuildInfo too).
 309 checkBuildInfo
 310   :: Monad m
 311   => CEType -- Name and type of the target.
 312   -> [ModuleName] -- Additional module names which cannot be
 313   -- extracted from BuildInfo (mainly: exposed
 314   -- library modules).
 315   -> [AssocDep] -- Inherited “internal” (main lib, named
 316   -- internal libs) dependencies.
 317   -> BuildInfo
 318   -> CheckM m ()
 319 checkBuildInfo cet ams ads bi = do
 320   -- For the sake of clarity, we split che checks in various
 321   -- (top level) functions, even if we are not actually going
 322   -- deeper in the traversal.
 323
 324   checkBuildInfoOptions (cet2bit cet) bi
 325   checkBuildInfoPathsContent bi
 326   checkBuildInfoPathsWellFormedness bi
 327
 328   sv <- asksCM ccSpecVersion
 329   checkBuildInfoFeatures bi sv
 330
 331   checkAutogenModules ams bi
 332
 333   -- PVP: we check for base and all other deps.
 334   (ids, rds) <-
 335     partitionDeps
 336       ads
 337       [mkUnqualComponentName "base"]
 338       (mergeDependencies $ targetBuildDepends bi)
 339   let ick = const (PackageDistInexcusable BaseNoUpperBounds)
 340       rck = PackageDistSuspiciousWarn . MissingUpperBounds cet
 341   checkPVP ick ids
 342   unless
 343     (isInternalTarget cet)
 344     (checkPVPs rck rds)
 345
 346   -- Custom fields well-formedness (ASCII).
 347   mapM_ checkCustomField (customFieldsBI bi)
 348
 349   -- Content.
 350   mapM_ (checkLocalPathExist "extra-lib-dirs" . getSymbolicPath) (extraLibDirs bi)
 351   mapM_
 352     (checkLocalPathExist "extra-lib-dirs-static" . getSymbolicPath)
 353     (extraLibDirsStatic bi)
 354   mapM_
 355     (checkLocalPathExist "extra-framework-dirs" . getSymbolicPath)
 356     (extraFrameworkDirs bi)
 357   mapM_ (checkLocalPathExist "include-dirs" . getSymbolicPath) (includeDirs bi)
 358   mapM_
 359     (checkLocalPathExist "hs-source-dirs" . getSymbolicPath)
 360     (hsSourceDirs bi)
 361
 362 -- Well formedness of BI contents (no `Haskell2015`, no deprecated
 363 -- extensions etc).
 364 checkBuildInfoPathsContent :: Monad m => BuildInfo -> CheckM m ()
 365 checkBuildInfoPathsContent bi = do
 366   mapM_ checkLang (allLanguages bi)
 367   mapM_ checkExt (allExtensions bi)
 368   mapM_ checkIntDep (targetBuildDepends bi)
 369   df <- asksCM ccDesugar
 370   -- This way we can use the same function for legacy&non exedeps.
 371   let ds = buildToolDepends bi ++ catMaybes (map df $ buildTools bi)
 372   mapM_ checkBTDep ds
 373   where
 374     checkLang :: Monad m => Language -> CheckM m ()
 375     checkLang (UnknownLanguage n) =
 376       tellP (PackageBuildWarning (UnknownLanguages [n]))
 377     checkLang _ = return ()
 378
 379     checkExt :: Monad m => Extension -> CheckM m ()
 380     checkExt (UnknownExtension n)
 381       | n `elem` map prettyShow knownLanguages =
 382           tellP (PackageBuildWarning (LanguagesAsExtension [n]))
 383       | otherwise =
 384           tellP (PackageBuildWarning (UnknownExtensions [n]))
 385     checkExt n = do
 386       let dss = filter (\(a, _) -> a == n) deprecatedExtensions
 387       checkP
 388         (not . null $ dss)
 389         (PackageDistSuspicious $ DeprecatedExtensions dss)
 390
 391     checkIntDep :: Monad m => Dependency -> CheckM m ()
 392     checkIntDep d@(Dependency name vrange _) = do
 393       mpn <-
 394         asksCM
 395           ( packageNameToUnqualComponentName
 396               . pkgName
 397               . pnPackageId
 398               . ccNames
 399           )
 400       lns <- asksCM (pnSubLibs . ccNames)
 401       pVer <- asksCM (pkgVersion . pnPackageId . ccNames)
 402       let allLibNs = mpn : lns
 403       when
 404         ( mpn == packageNameToUnqualComponentName name
 405             -- Make sure it is not a library with the
 406             -- same name from another package.
 407             && packageNameToUnqualComponentName name `elem` allLibNs
 408         )
 409         ( checkP
 410             (not $ pVer `withinRange` vrange)
 411             (PackageBuildImpossible $ ImpossibleInternalDep [d])
 412         )
 413
 414     checkBTDep :: Monad m => ExeDependency -> CheckM m ()
 415     checkBTDep ed@(ExeDependency n name vrange) = do
 416       exns <- asksCM (pnExecs . ccNames)
 417       pVer <- asksCM (pkgVersion . pnPackageId . ccNames)
 418       pNam <- asksCM (pkgName . pnPackageId . ccNames)
 419       checkP
 420         ( n == pNam
 421             && name `notElem` exns -- internal
 422             -- not present
 423         )
 424         (PackageBuildImpossible $ MissingInternalExe [ed])
 425       when
 426         (name `elem` exns)
 427         ( checkP
 428             (not $ pVer `withinRange` vrange)
 429             (PackageBuildImpossible $ ImpossibleInternalExe [ed])
 430         )
 431
 432 -- Paths well-formedness check for BuildInfo.
 433 checkBuildInfoPathsWellFormedness :: Monad m => BuildInfo -> CheckM m ()
 434 checkBuildInfoPathsWellFormedness bi = do
 435   mapM_ (checkPath False "asm-sources" PathKindFile . getSymbolicPath) (asmSources bi)
 436   mapM_ (checkPath False "cmm-sources" PathKindFile . getSymbolicPath) (cmmSources bi)
 437   mapM_ (checkPath False "c-sources" PathKindFile . getSymbolicPath) (cSources bi)
 438   mapM_ (checkPath False "cxx-sources" PathKindFile . getSymbolicPath) (cxxSources bi)
 439   mapM_ (checkPath False "js-sources" PathKindFile . getSymbolicPath) (jsSources bi)
 440   mapM_
 441     (checkPath False "install-includes" PathKindFile . getSymbolicPath)
 442     (installIncludes bi)
 443   mapM_
 444     (checkPath False "hs-source-dirs" PathKindDirectory . getSymbolicPath)
 445     (hsSourceDirs bi)
 446   -- Possibly absolute paths.
 447   mapM_ (checkPath True "includes" PathKindFile . getSymbolicPath) (includes bi)
 448   mapM_
 449     (checkPath True "include-dirs" PathKindDirectory . getSymbolicPath)
 450     (includeDirs bi)
 451   mapM_
 452     (checkPath True "extra-lib-dirs" PathKindDirectory . getSymbolicPath)
 453     (extraLibDirs bi)
 454   mapM_
 455     (checkPath True "extra-lib-dirs-static" PathKindDirectory . getSymbolicPath)
 456     (extraLibDirsStatic bi)
 457   mapM_ checkOptionPath (perCompilerFlavorToList $ options bi)
 458   where
 459     checkOptionPath
 460       :: Monad m
 461       => (CompilerFlavor, [FilePath])
 462       -> CheckM m ()
 463     checkOptionPath (GHC, paths) =
 464       mapM_
 465         ( \path ->
 466             checkP
 467               (isInsideDist path)
 468               (PackageDistInexcusable $ DistPoint Nothing path)
 469         )
 470         paths
 471     checkOptionPath _ = return ()
 472
 473 -- Checks for features that can be present in BuildInfo only with certain
 474 -- CabalSpecVersion.
 475 checkBuildInfoFeatures
 476   :: Monad m
 477   => BuildInfo
 478   -> CabalSpecVersion
 479   -> CheckM m ()
 480 checkBuildInfoFeatures bi sv = do
 481   -- Default language can be used only w/ spec ≥ 1.10
 482   checkSpecVer
 483     CabalSpecV1_10
 484     (isJust $ defaultLanguage bi)
 485     (PackageBuildWarning CVDefaultLanguage)
 486   -- CheckSpecVer sv.
 487   checkDefaultLanguage
 488   -- Check use of 'extra-framework-dirs' field.
 489   checkSpecVer
 490     CabalSpecV1_24
 491     (not . null $ extraFrameworkDirs bi)
 492     (PackageDistSuspiciousWarn CVExtraFrameworkDirs)
 493   -- Check use of default-extensions field don't need to do the
 494   -- equivalent check for other-extensions.
 495   checkSpecVer
 496     CabalSpecV1_10
 497     (not . null $ defaultExtensions bi)
 498     (PackageBuildWarning CVDefaultExtensions)
 499   -- Check use of extensions field
 500   checkP
 501     (sv >= CabalSpecV1_10 && (not . null $ oldExtensions bi))
 502     (PackageBuildWarning CVExtensionsDeprecated)
 503
 504   -- asm-sources, cmm-sources and friends only w/ spec ≥ 1.10
 505   checkCVSources (map getSymbolicPath $ asmSources bi)
 506   checkCVSources (map getSymbolicPath $ cmmSources bi)
 507   checkCVSources (extraBundledLibs bi)
 508   checkCVSources (extraLibFlavours bi)
 509
 510   -- extra-dynamic-library-flavours requires ≥ 3.0
 511   checkSpecVer
 512     CabalSpecV3_0
 513     (not . null $ extraDynLibFlavours bi)
 514     (PackageDistInexcusable $ CVExtraDynamic [extraDynLibFlavours bi])
 515   -- virtual-modules requires ≥ 2.2
 516   checkSpecVer CabalSpecV2_2 (not . null $ virtualModules bi) $
 517     (PackageDistInexcusable CVVirtualModules)
 518   -- Check use of thinning and renaming.
 519   checkSpecVer
 520     CabalSpecV2_0
 521     (not . null $ mixins bi)
 522     (PackageDistInexcusable CVMixins)
 523
 524   checkBuildInfoExtensions bi
 525   where
 526     checkCVSources :: Monad m => [FilePath] -> CheckM m ()
 527     checkCVSources cvs =
 528       checkSpecVer
 529         CabalSpecV3_0
 530         (not . null $ cvs)
 531         (PackageDistInexcusable CVSources)
 532
 533     checkDefaultLanguage :: Monad m => CheckM m ()
 534     checkDefaultLanguage = do
 535       -- < 1.10 has no `default-language` field.
 536       when
 537         (sv >= CabalSpecV1_10 && isNothing (defaultLanguage bi))
 538         -- < 3.4 mandatory, after just a suggestion.
 539         ( if sv < CabalSpecV3_4
 540             then tellP (PackageBuildWarning CVDefaultLanguageComponent)
 541             else tellP (PackageDistInexcusable CVDefaultLanguageComponentSoft)
 542         )
 543
 544 -- Tests for extensions usage which can break Cabal < 1.4.
 545 checkBuildInfoExtensions :: Monad m => BuildInfo -> CheckM m ()
 546 checkBuildInfoExtensions bi = do
 547   let exts = allExtensions bi
 548       extCabal1_2 = nub $ filter (`elem` compatExtensionsExtra) exts
 549       extCabal1_4 = nub $ filter (`notElem` compatExtensions) exts
 550   -- As of Cabal-1.4 we can add new extensions without worrying
 551   -- about breaking old versions of cabal.
 552   checkSpecVer
 553     CabalSpecV1_2
 554     (not . null $ extCabal1_2)
 555     ( PackageDistInexcusable $
 556         CVExtensions CabalSpecV1_2 extCabal1_2
 557     )
 558   checkSpecVer
 559     CabalSpecV1_4
 560     (not . null $ extCabal1_4)
 561     ( PackageDistInexcusable $
 562         CVExtensions CabalSpecV1_4 extCabal1_4
 563     )
 564   where
 565     -- The known extensions in Cabal-1.2.3
 566     compatExtensions :: [Extension]
 567     compatExtensions =
 568       map
 569         EnableExtension
 570         [ OverlappingInstances
 571         , UndecidableInstances
 572         , IncoherentInstances
 573         , RecursiveDo
 574         , ParallelListComp
 575         , MultiParamTypeClasses
 576         , FunctionalDependencies
 577         , Rank2Types
 578         , RankNTypes
 579         , PolymorphicComponents
 580         , ExistentialQuantification
 581         , ScopedTypeVariables
 582         , ImplicitParams
 583         , FlexibleContexts
 584         , FlexibleInstances
 585         , EmptyDataDecls
 586         , CPP
 587         , BangPatterns
 588         , TypeSynonymInstances
 589         , TemplateHaskell
 590         , ForeignFunctionInterface
 591         , Arrows
 592         , Generics
 593         , NamedFieldPuns
 594         , PatternGuards
 595         , GeneralizedNewtypeDeriving
 596         , ExtensibleRecords
 597         , RestrictedTypeSynonyms
 598         , HereDocuments
 599         ]
 600         ++ map
 601           DisableExtension
 602           [MonomorphismRestriction, ImplicitPrelude]
 603         ++ compatExtensionsExtra
 604
 605     -- The extra known extensions in Cabal-1.2.3 vs Cabal-1.1.6
 606     -- (Cabal-1.1.6 came with ghc-6.6. Cabal-1.2 came with ghc-6.8)
 607     compatExtensionsExtra :: [Extension]
 608     compatExtensionsExtra =
 609       map
 610         EnableExtension
 611         [ KindSignatures
 612         , MagicHash
 613         , TypeFamilies
 614         , StandaloneDeriving
 615         , UnicodeSyntax
 616         , PatternSignatures
 617         , UnliftedFFITypes
 618         , LiberalTypeSynonyms
 619         , TypeOperators
 620         , RecordWildCards
 621         , RecordPuns
 622         , DisambiguateRecordFields
 623         , OverloadedStrings
 624         , GADTs
 625         , RelaxedPolyRec
 626         , ExtendedDefaultRules
 627         , UnboxedTuples
 628         , DeriveDataTypeable
 629         , ConstrainedClassMethods
 630         ]
 631         ++ map
 632           DisableExtension
 633           [MonoPatBinds]
 634
 635 -- Autogenerated modules (Paths_, PackageInfo_) checks. We could pass this
 636 -- function something more specific than the whole BuildInfo, but it would be
 637 -- a tuple of [ModuleName] lists, error prone.
 638 checkAutogenModules
 639   :: Monad m
 640   => [ModuleName] -- Additional modules not present
 641   -- in BuildInfo (e.g. exposed library
 642   -- modules).
 643   -> BuildInfo
 644   -> CheckM m ()
 645 checkAutogenModules ams bi = do
 646   pkgId <- asksCM (pnPackageId . ccNames)
 647   let
 648     -- It is an unfortunate reality that autogenPathsModuleName
 649     -- and autogenPackageInfoModuleName work on PackageDescription
 650     -- while not needing it all, but just the `package` bit.
 651     minimalPD = emptyPackageDescription{package = pkgId}
 652     autoPathsName = autogenPathsModuleName minimalPD
 653     autoInfoModuleName = autogenPackageInfoModuleName minimalPD
 654
 655   -- Autogenerated module + some default extension build failure.
 656   autogenCheck autoPathsName CVAutogenPaths
 657   rebindableClashCheck autoPathsName RebindableClashPaths
 658
 659   -- Paths_* module + some default extension build failure.
 660   autogenCheck autoInfoModuleName CVAutogenPackageInfo
 661   rebindableClashCheck autoInfoModuleName RebindableClashPackageInfo
 662
 663   -- PackageInfo_* module + cabal-version < 3.12
 664   -- See Mikolaj’s comments on #9481 on why this has to be
 665   -- PackageBuildImpossible and not merely PackageDistInexcusable.
 666   checkSpecVer
 667     CabalSpecV3_12
 668     (elem autoInfoModuleName allModsForAuto)
 669     (PackageBuildImpossible CVAutogenPackageInfoGuard)
 670   where
 671     allModsForAuto :: [ModuleName]
 672     allModsForAuto = ams ++ otherModules bi
 673
 674     autogenCheck
 675       :: Monad m
 676       => ModuleName
 677       -> CheckExplanation
 678       -> CheckM m ()
 679     autogenCheck name warning = do
 680       sv <- asksCM ccSpecVersion
 681       checkP
 682         ( sv >= CabalSpecV2_0
 683             && elem name allModsForAuto
 684             && notElem name (autogenModules bi)
 685         )
 686         (PackageDistInexcusable warning)
 687
 688     rebindableClashCheck
 689       :: Monad m
 690       => ModuleName
 691       -> CheckExplanation
 692       -> CheckM m ()
 693     rebindableClashCheck name warning = do
 694       checkSpecVer
 695         CabalSpecV2_2
 696         ( ( name `elem` otherModules bi
 697               || name `elem` autogenModules bi
 698           )
 699             && checkExts
 700         )
 701         (PackageBuildImpossible warning)
 702
 703     -- Do we have some peculiar extensions active which would interfere
 704     -- (cabal-version <2.2) with Paths_modules?
 705     checkExts :: Bool
 706     checkExts =
 707       let exts = defaultExtensions bi
 708        in rebind `elem` exts
 709             && (strings `elem` exts || lists `elem` exts)
 710       where
 711         rebind = EnableExtension RebindableSyntax
 712         strings = EnableExtension OverloadedStrings
 713         lists = EnableExtension OverloadedLists
 714
 715 checkLocalPathExist
 716   :: Monad m
 717   => String -- .cabal field where we found the error.
 718   -> FilePath
 719   -> CheckM m ()
 720 checkLocalPathExist title dir =
 721   checkPkg
 722     ( \ops -> do
 723         dn <- not <$> doesDirectoryExist ops dir
 724         let rp = not (isAbsoluteOnAnyPlatform dir)
 725         return (rp && dn)
 726     )
 727     (PackageBuildWarning $ UnknownDirectory title dir)
 728
 729 -- PVP --
 730
 731 -- Sometimes we read (or end up with) “straddle” deps declarations
 732 -- like this:
 733 --
 734 --     build-depends: base > 3, base < 4
 735 --
 736 -- `mergeDependencies` reduces that to base > 3 && < 4, _while_ maintaining
 737 -- dependencies order in the list (better UX).
 738 mergeDependencies :: [Dependency] -> [Dependency]
 739 mergeDependencies [] = []
 740 mergeDependencies l@(d : _) =
 741   let (sames, diffs) = partition ((== depName d) . depName) l
 742       merged =
 743         Dependency
 744           (depPkgName d)
 745           ( foldl intersectVersionRanges anyVersion $
 746               map depVerRange sames
 747           )
 748           (depLibraries d)
 749    in merged : mergeDependencies diffs
 750   where
 751     depName :: Dependency -> String
 752     depName wd = unPackageName . depPkgName $ wd
 753
 754 -- Is this an internal target? We do not perform PVP checks on those,
 755 -- see https://github.com/haskell/cabal/pull/8361#issuecomment-1577547091
 756 isInternalTarget :: CEType -> Bool
 757 isInternalTarget (CETLibrary{}) = False
 758 isInternalTarget (CETForeignLibrary{}) = False
 759 isInternalTarget (CETExecutable{}) = False
 760 isInternalTarget (CETTest{}) = True
 761 isInternalTarget (CETBenchmark{}) = True
 762 isInternalTarget (CETSetup{}) = False
 763
 764 -- ------------------------------------------------------------
 765 -- Options
 766 -- ------------------------------------------------------------
 767
 768 -- Target type for option checking.
 769 data BITarget = BITLib | BITTestBench | BITOther
 770   deriving (Eq, Show)
 771
 772 cet2bit :: CEType -> BITarget
 773 cet2bit (CETLibrary{}) = BITLib
 774 cet2bit (CETForeignLibrary{}) = BITLib
 775 cet2bit (CETExecutable{}) = BITOther
 776 cet2bit (CETTest{}) = BITTestBench
 777 cet2bit (CETBenchmark{}) = BITTestBench
 778 cet2bit CETSetup = BITOther
 779
 780 -- General check on all options (ghc, C, C++, …) for common inaccuracies.
 781 checkBuildInfoOptions :: Monad m => BITarget -> BuildInfo -> CheckM m ()
 782 checkBuildInfoOptions t bi = do
 783   checkGHCOptions "ghc-options" t (hcOptions GHC bi)
 784   checkGHCOptions "ghc-prof-options" t (hcProfOptions GHC bi)
 785   checkGHCOptions "ghc-shared-options" t (hcSharedOptions GHC bi)
 786   let ldOpts = ldOptions bi
 787   checkCLikeOptions LangC "cc-options" (ccOptions bi) ldOpts
 788   checkCLikeOptions LangCPlusPlus "cxx-options" (cxxOptions bi) ldOpts
 789   checkCPPOptions (cppOptions bi)
 790
 791 -- | Checks GHC options for commonly misused or non-portable flags.
 792 checkGHCOptions
 793   :: Monad m
 794   => CabalField -- .cabal field name where we found the error.
 795   -> BITarget -- Target type.
 796   -> [String] -- Options (alas in String form).
 797   -> CheckM m ()
 798 checkGHCOptions title t opts = do
 799   checkGeneral
 800   case t of
 801     BITLib -> sequence_ [checkLib, checkNonTestBench]
 802     BITTestBench -> checkTestBench
 803     BITOther -> checkNonTestBench
 804   where
 805     checkFlags :: Monad m => [String] -> PackageCheck -> CheckM m ()
 806     checkFlags fs ck = checkP (any (`elem` fs) opts) ck
 807
 808     checkFlagsP
 809       :: Monad m
 810       => (String -> Bool)
 811       -> (String -> PackageCheck)
 812       -> CheckM m ()
 813     checkFlagsP p ckc =
 814       case filter p opts of
 815         [] -> return ()
 816         (_ : _) -> tellP (ckc title)
 817
 818     checkGeneral = do
 819       checkFlags
 820         ["-fasm"]
 821         (PackageDistInexcusable $ OptFasm title)
 822       checkFlags
 823         ["-fhpc"]
 824         (PackageDistInexcusable $ OptHpc title)
 825       checkFlags
 826         ["-prof"]
 827         (PackageBuildWarning $ OptProf title)
 828       pid <- asksCM (pnPackageId . ccNames)
 829       -- Scripts add the -o flag in the fake-package.cabal in order to have the
 830       -- executable name match the script name even when there are characters
 831       -- in the script name which are illegal to have as a target name.
 832       unless (pid == fakePackageId) $
 833         checkFlags
 834           ["-o"]
 835           (PackageBuildWarning $ OptO title)
 836       checkFlags
 837         ["-hide-package"]
 838         (PackageBuildWarning $ OptHide title)
 839       checkFlags
 840         ["--make"]
 841         (PackageBuildWarning $ OptMake title)
 842       checkFlags
 843         ["-O", "-O1"]
 844         (PackageDistInexcusable $ OptOOne title)
 845       checkFlags
 846         ["-O2"]
 847         (PackageDistSuspiciousWarn $ OptOTwo title)
 848       checkFlags
 849         ["-split-sections"]
 850         (PackageBuildWarning $ OptSplitSections title)
 851       checkFlags
 852         ["-split-objs"]
 853         (PackageBuildWarning $ OptSplitObjs title)
 854       checkFlags
 855         ["-optl-Wl,-s", "-optl-s"]
 856         (PackageDistInexcusable $ OptWls title)
 857       checkFlags
 858         ["-fglasgow-exts"]
 859         (PackageDistSuspicious $ OptExts title)
 860       let ghcNoRts = rmRtsOpts opts
 861       checkAlternatives
 862         title
 863         "default-extensions"
 864         [ (flag, prettyShow extension)
 865         | flag <- ghcNoRts
 866         , Just extension <- [ghcExtension flag]
 867         ]
 868       checkAlternatives
 869         title
 870         "default-extensions"
 871         [ (flag, extension)
 872         | flag@('-' : 'X' : extension) <- ghcNoRts
 873         ]
 874       checkAlternatives
 875         title
 876         "cpp-options"
 877         ( [(flag, flag) | flag@('-' : 'D' : _) <- ghcNoRts]
 878             ++ [(flag, flag) | flag@('-' : 'U' : _) <- ghcNoRts]
 879         )
 880       checkAlternatives
 881         title
 882         "include-dirs"
 883         [(flag, dir) | flag@('-' : 'I' : dir) <- ghcNoRts]
 884       checkAlternatives
 885         title
 886         "extra-libraries"
 887         [(flag, lib) | flag@('-' : 'l' : lib) <- ghcNoRts]
 888       checkAlternatives
 889         title
 890         "extra-libraries-static"
 891         [(flag, lib) | flag@('-' : 'l' : lib) <- ghcNoRts]
 892       checkAlternatives
 893         title
 894         "extra-lib-dirs"
 895         [(flag, dir) | flag@('-' : 'L' : dir) <- ghcNoRts]
 896       checkAlternatives
 897         title
 898         "extra-lib-dirs-static"
 899         [(flag, dir) | flag@('-' : 'L' : dir) <- ghcNoRts]
 900       checkAlternatives
 901         title
 902         "frameworks"
 903         [ (flag, fmwk)
 904         | (flag@"-framework", fmwk) <-
 905             zip ghcNoRts (safeTail ghcNoRts)
 906         ]
 907       checkAlternatives
 908         title
 909         "extra-framework-dirs"
 910         [ (flag, dir)
 911         | (flag@"-framework-path", dir) <-
 912             zip ghcNoRts (safeTail ghcNoRts)
 913         ]
 914       -- Old `checkDevelopmentOnlyFlagsOptions` section
 915       checkFlags
 916         ["-Werror"]
 917         (PackageDistInexcusable $ WErrorUnneeded title)
 918       checkFlags
 919         ["-fdefer-type-errors"]
 920         (PackageDistInexcusable $ FDeferTypeErrorsUnneeded title)
 921       checkFlags
 922         [ "-fprof-auto"
 923         , "-fprof-auto-top"
 924         , "-fprof-auto-calls"
 925         , "-fprof-cafs"
 926         , "-fno-prof-count-entries"
 927         , "-auto-all"
 928         , "-auto"
 929         , "-caf-all"
 930         ]
 931         (PackageDistSuspicious $ ProfilingUnneeded title)
 932       checkFlagsP
 933         ( \opt ->
 934             "-d" `isPrefixOf` opt
 935               && opt /= "-dynamic"
 936         )
 937         (PackageDistInexcusable . DynamicUnneeded)
 938       checkFlagsP
 939         ( \opt -> case opt of
 940             "-j" -> True
 941             ('-' : 'j' : d : _) -> isDigit d
 942             _ -> False
 943         )
 944         (PackageDistInexcusable . JUnneeded)
 945
 946     checkLib = do
 947       checkP
 948         ("-rtsopts" `elem` opts)
 949         (PackageBuildWarning $ OptRts title)
 950       checkP
 951         (any (\opt -> "-with-rtsopts" `isPrefixOf` opt) opts)
 952         (PackageBuildWarning $ OptWithRts title)
 953
 954     checkTestBench = do
 955       checkFlags
 956         ["-O0", "-Onot"]
 957         (PackageDistSuspiciousWarn $ OptONot title)
 958
 959     checkNonTestBench = do
 960       checkFlags
 961         ["-O0", "-Onot"]
 962         (PackageDistSuspicious $ OptONot title)
 963
 964     ghcExtension ('-' : 'f' : name) = case name of
 965       "allow-overlapping-instances" -> enable OverlappingInstances
 966       "no-allow-overlapping-instances" -> disable OverlappingInstances
 967       "th" -> enable TemplateHaskell
 968       "no-th" -> disable TemplateHaskell
 969       "ffi" -> enable ForeignFunctionInterface
 970       "no-ffi" -> disable ForeignFunctionInterface
 971       "fi" -> enable ForeignFunctionInterface
 972       "no-fi" -> disable ForeignFunctionInterface
 973       "monomorphism-restriction" -> enable MonomorphismRestriction
 974       "no-monomorphism-restriction" -> disable MonomorphismRestriction
 975       "mono-pat-binds" -> enable MonoPatBinds
 976       "no-mono-pat-binds" -> disable MonoPatBinds
 977       "allow-undecidable-instances" -> enable UndecidableInstances
 978       "no-allow-undecidable-instances" -> disable UndecidableInstances
 979       "allow-incoherent-instances" -> enable IncoherentInstances
 980       "no-allow-incoherent-instances" -> disable IncoherentInstances
 981       "arrows" -> enable Arrows
 982       "no-arrows" -> disable Arrows
 983       "generics" -> enable Generics
 984       "no-generics" -> disable Generics
 985       "implicit-prelude" -> enable ImplicitPrelude
 986       "no-implicit-prelude" -> disable ImplicitPrelude
 987       "implicit-params" -> enable ImplicitParams
 988       "no-implicit-params" -> disable ImplicitParams
 989       "bang-patterns" -> enable BangPatterns
 990       "no-bang-patterns" -> disable BangPatterns
 991       "scoped-type-variables" -> enable ScopedTypeVariables
 992       "no-scoped-type-variables" -> disable ScopedTypeVariables
 993       "extended-default-rules" -> enable ExtendedDefaultRules
 994       "no-extended-default-rules" -> disable ExtendedDefaultRules
 995       _ -> Nothing
 996     ghcExtension "-cpp" = enable CPP
 997     ghcExtension _ = Nothing
 998
 999     enable e = Just (EnableExtension e)
1000     disable e = Just (DisableExtension e)
1001
1002     rmRtsOpts :: [String] -> [String]
1003     rmRtsOpts ("-with-rtsopts" : _ : xs) = rmRtsOpts xs
1004     rmRtsOpts (x : xs) = x : rmRtsOpts xs
1005     rmRtsOpts [] = []
1006
1007 checkCLikeOptions
1008   :: Monad m
1009   => WarnLang -- Language we are warning about (C or C++).
1010   -> CabalField -- Field where we found the error.
1011   -> [String] -- Options in string form.
1012   -> [String] -- Link options in String form.
1013   -> CheckM m ()
1014 checkCLikeOptions label prefix opts ldOpts = do
1015   checkAlternatives
1016     prefix
1017     "include-dirs"
1018     [(flag, dir) | flag@('-' : 'I' : dir) <- opts]
1019   checkAlternatives
1020     prefix
1021     "extra-libraries"
1022     [(flag, lib) | flag@('-' : 'l' : lib) <- opts]
1023   checkAlternatives
1024     prefix
1025     "extra-lib-dirs"
1026     [(flag, dir) | flag@('-' : 'L' : dir) <- opts]
1027
1028   checkAlternatives
1029     "ld-options"
1030     "extra-libraries"
1031     [(flag, lib) | flag@('-' : 'l' : lib) <- ldOpts]
1032   checkAlternatives
1033     "ld-options"
1034     "extra-lib-dirs"
1035     [(flag, dir) | flag@('-' : 'L' : dir) <- ldOpts]
1036
1037   checkP
1038     (any (`elem` ["-O", "-Os", "-O0", "-O1", "-O2", "-O3"]) opts)
1039     (PackageDistSuspicious $ COptONumber prefix label)
1040
1041 checkAlternatives
1042   :: Monad m
1043   => CabalField -- Wrong field.
1044   -> CabalField -- Appropriate field.
1045   -> [(String, String)] -- List of good and bad flags.
1046   -> CheckM m ()
1047 checkAlternatives badField goodField flags = do
1048   let (badFlags, _) = unzip flags
1049   checkP
1050     (not $ null badFlags)
1051     (PackageBuildWarning $ OptAlternatives badField goodField flags)
1052
1053 checkCPPOptions
1054   :: Monad m
1055   => [String] -- Options in String form.
1056   -> CheckM m ()
1057 checkCPPOptions opts = do
1058   checkAlternatives
1059     "cpp-options"
1060     "include-dirs"
1061     [(flag, dir) | flag@('-' : 'I' : dir) <- opts]
1062   mapM_
1063     ( \opt ->
1064         checkP
1065           (not $ any (`isPrefixOf` opt) ["-D", "-U", "-I"])
1066           (PackageBuildWarning (COptCPP opt))
1067     )
1068     opts