Cabal/Distribution/PackageDescription/Check.hs

   1 -----------------------------------------------------------------------------
   2 -- |
   3 -- Module      :  Distribution.PackageDescription.Check
   4 -- Copyright   :  Lennart Kolmodin 2008
   5 -- License     :  BSD3
   6 --
   7 -- Maintainer  :  cabal-devel@haskell.org
   8 -- Portability :  portable
   9 --
  10 -- This has code for checking for various problems in packages. There is one
  11 -- set of checks that just looks at a 'PackageDescription' in isolation and
  12 -- another set of checks that also looks at files in the package. Some of the
  13 -- checks are basic sanity checks, others are portability standards that we'd
  14 -- like to encourage. There is a 'PackageCheck' type that distinguishes the
  15 -- different kinds of check so we can see which ones are appropriate to report
  16 -- in different situations. This code gets uses when configuring a package when
  17 -- we consider only basic problems. The higher standard is uses when when
  18 -- preparing a source tarball and by Hackage when uploading new packages. The
  19 -- reason for this is that we want to hold packages that are expected to be
  20 -- distributed to a higher standard than packages that are only ever expected
  21 -- to be used on the author's own environment.
  22
  23 module Distribution.PackageDescription.Check (
  24         -- * Package Checking
  25         PackageCheck(..),
  26         checkPackage,
  27         checkConfiguredPackage,
  28
  29         -- ** Checking package contents
  30         checkPackageFiles,
  31         checkPackageContent,
  32         CheckPackageContentOps(..),
  33         checkPackageFileNames,
  34   ) where
  35
  36 import Distribution.Compat.Prelude
  37 import Prelude ()
  38
  39 import Control.Monad                                 (mapM)
  40 import Data.List                                     (group)
  41 import Distribution.Compat.Lens
  42 import Distribution.Compiler
  43 import Distribution.License
  44 import Distribution.Package
  45 import Distribution.PackageDescription
  46 import Distribution.PackageDescription.Configuration
  47 import Distribution.Pretty                           (prettyShow)
  48 import Distribution.Simple.BuildPaths                (autogenPathsModuleName)
  49 import Distribution.Simple.BuildToolDepends
  50 import Distribution.Simple.CCompiler
  51 import Distribution.Simple.Utils                     hiding (findPackageDesc, notice)
  52 import Distribution.System
  53 import Distribution.Text
  54 import Distribution.Types.ComponentRequestedSpec
  55 import Distribution.Types.CondTree
  56 import Distribution.Types.ExeDependency
  57 import Distribution.Types.UnqualComponentName
  58 import Distribution.Utils.Generic                    (isAscii)
  59 import Distribution.Version
  60 import Language.Haskell.Extension
  61 import System.FilePath
  62        (splitDirectories, splitExtension, splitPath, takeExtension, takeFileName, (<.>), (</>))
  63
  64 import qualified Data.ByteString.Lazy      as BS
  65 import qualified Data.Map                  as Map
  66 import qualified Distribution.Compat.DList as DList
  67 import qualified Distribution.SPDX         as SPDX
  68 import qualified System.Directory          as System
  69
  70 import qualified System.Directory        (getDirectoryContents)
  71 import qualified System.FilePath.Windows as FilePath.Windows (isValid)
  72
  73 import qualified Data.Set as Set
  74
  75 import qualified Distribution.Types.BuildInfo.Lens                 as L
  76 import qualified Distribution.Types.GenericPackageDescription.Lens as L
  77 import qualified Distribution.Types.PackageDescription.Lens        as L
  78
  79 -- | Results of some kind of failed package check.
  80 --
  81 -- There are a range of severities, from merely dubious to totally insane.
  82 -- All of them come with a human readable explanation. In future we may augment
  83 -- them with more machine readable explanations, for example to help an IDE
  84 -- suggest automatic corrections.
  85 --
  86 data PackageCheck =
  87
  88        -- | This package description is no good. There's no way it's going to
  89        -- build sensibly. This should give an error at configure time.
  90        PackageBuildImpossible { explanation :: String }
  91
  92        -- | A problem that is likely to affect building the package, or an
  93        -- issue that we'd like every package author to be aware of, even if
  94        -- the package is never distributed.
  95      | PackageBuildWarning { explanation :: String }
  96
  97        -- | An issue that might not be a problem for the package author but
  98        -- might be annoying or detrimental when the package is distributed to
  99        -- users. We should encourage distributed packages to be free from these
 100        -- issues, but occasionally there are justifiable reasons so we cannot
 101        -- ban them entirely.
 102      | PackageDistSuspicious { explanation :: String }
 103
 104        -- | Like PackageDistSuspicious but will only display warnings
 105        -- rather than causing abnormal exit when you run 'cabal check'.
 106      | PackageDistSuspiciousWarn { explanation :: String }
 107
 108        -- | An issue that is OK in the author's environment but is almost
 109        -- certain to be a portability problem for other environments. We can
 110        -- quite legitimately refuse to publicly distribute packages with these
 111        -- problems.
 112      | PackageDistInexcusable { explanation :: String }
 113   deriving (Eq)
 114
 115 instance Show PackageCheck where
 116     show notice = explanation notice
 117
 118 check :: Bool -> PackageCheck -> Maybe PackageCheck
 119 check False _  = Nothing
 120 check True  pc = Just pc
 121
 122 checkSpecVersion :: PackageDescription -> [Int] -> Bool -> PackageCheck
 123                  -> Maybe PackageCheck
 124 checkSpecVersion pkg specver cond pc
 125   | specVersion pkg >= mkVersion specver  = Nothing
 126   | otherwise                             = check cond pc
 127
 128 -- ------------------------------------------------------------
 129 -- * Standard checks
 130 -- ------------------------------------------------------------
 131
 132 -- | Check for common mistakes and problems in package descriptions.
 133 --
 134 -- This is the standard collection of checks covering all aspects except
 135 -- for checks that require looking at files within the package. For those
 136 -- see 'checkPackageFiles'.
 137 --
 138 -- It requires the 'GenericPackageDescription' and optionally a particular
 139 -- configuration of that package. If you pass 'Nothing' then we just check
 140 -- a version of the generic description using 'flattenPackageDescription'.
 141 --
 142 checkPackage :: GenericPackageDescription
 143              -> Maybe PackageDescription
 144              -> [PackageCheck]
 145 checkPackage gpkg mpkg =
 146      checkConfiguredPackage pkg
 147   ++ checkConditionals gpkg
 148   ++ checkPackageVersions gpkg
 149   ++ checkDevelopmentOnlyFlags gpkg
 150   ++ checkFlagNames gpkg
 151   ++ checkUnusedFlags gpkg
 152   ++ checkUnicodeXFields gpkg
 153   ++ checkPathsModuleExtensions pkg
 154   where
 155     pkg = fromMaybe (flattenPackageDescription gpkg) mpkg
 156
 157 --TODO: make this variant go away
 158 --      we should always know the GenericPackageDescription
 159 checkConfiguredPackage :: PackageDescription -> [PackageCheck]
 160 checkConfiguredPackage pkg =
 161     checkSanity pkg
 162  ++ checkFields pkg
 163  ++ checkLicense pkg
 164  ++ checkSourceRepos pkg
 165  ++ checkGhcOptions pkg
 166  ++ checkCCOptions pkg
 167  ++ checkCPPOptions pkg
 168  ++ checkPaths pkg
 169  ++ checkCabalVersion pkg
 170
 171
 172 -- ------------------------------------------------------------
 173 -- * Basic sanity checks
 174 -- ------------------------------------------------------------
 175
 176 -- | Check that this package description is sane.
 177 --
 178 checkSanity :: PackageDescription -> [PackageCheck]
 179 checkSanity pkg =
 180   catMaybes [
 181
 182     check (null . unPackageName . packageName $ pkg) $
 183       PackageBuildImpossible "No 'name' field."
 184
 185   , check (nullVersion == packageVersion pkg) $
 186       PackageBuildImpossible "No 'version' field."
 187
 188   , check (all ($ pkg) [ null . executables
 189                        , null . testSuites
 190                        , null . benchmarks
 191                        , null . allLibraries
 192                        , null . foreignLibs ]) $
 193       PackageBuildImpossible
 194         "No executables, libraries, tests, or benchmarks found. Nothing to do."
 195
 196   , check (any isNothing (map libName $ subLibraries pkg)) $
 197       PackageBuildImpossible $ "Found one or more unnamed internal libraries. "
 198         ++ "Only the non-internal library can have the same name as the package."
 199
 200   , check (not (null duplicateNames)) $
 201       PackageBuildImpossible $ "Duplicate sections: "
 202         ++ commaSep (map unUnqualComponentName duplicateNames)
 203         ++ ". The name of every library, executable, test suite,"
 204         ++ " and benchmark section in"
 205         ++ " the package must be unique."
 206
 207   -- NB: but it's OK for executables to have the same name!
 208   -- TODO shouldn't need to compare on the string level
 209   , check (any (== display (packageName pkg)) (display <$> subLibNames)) $
 210       PackageBuildImpossible $ "Illegal internal library name "
 211         ++ display (packageName pkg)
 212         ++ ". Internal libraries cannot have the same name as the package."
 213         ++ " Maybe you wanted a non-internal library?"
 214         ++ " If so, rewrite the section stanza"
 215         ++ " from 'library: '" ++ display (packageName pkg) ++ "' to 'library'."
 216   ]
 217   --TODO: check for name clashes case insensitively: windows file systems cannot
 218   --cope.
 219
 220   ++ concatMap (checkLibrary    pkg) (allLibraries pkg)
 221   ++ concatMap (checkExecutable pkg) (executables pkg)
 222   ++ concatMap (checkTestSuite  pkg) (testSuites pkg)
 223   ++ concatMap (checkBenchmark  pkg) (benchmarks pkg)
 224
 225   ++ catMaybes [
 226
 227     check (specVersion pkg > cabalVersion) $
 228       PackageBuildImpossible $
 229            "This package description follows version "
 230         ++ display (specVersion pkg) ++ " of the Cabal specification. This "
 231         ++ "tool only supports up to version " ++ display cabalVersion ++ "."
 232   ]
 233   where
 234     -- The public 'library' gets special dispensation, because it
 235     -- is common practice to export a library and name the executable
 236     -- the same as the package.
 237     subLibNames = catMaybes . map libName $ subLibraries pkg
 238     exeNames = map exeName $ executables pkg
 239     testNames = map testName $ testSuites pkg
 240     bmNames = map benchmarkName $ benchmarks pkg
 241     duplicateNames = dups $ subLibNames ++ exeNames ++ testNames ++ bmNames
 242
 243 checkLibrary :: PackageDescription -> Library -> [PackageCheck]
 244 checkLibrary pkg lib =
 245   catMaybes [
 246
 247     check (not (null moduleDuplicates)) $
 248        PackageBuildImpossible $
 249             "Duplicate modules in library: "
 250          ++ commaSep (map display moduleDuplicates)
 251
 252   -- TODO: This check is bogus if a required-signature was passed through
 253   , check (null (explicitLibModules lib) && null (reexportedModules lib)) $
 254       PackageDistSuspiciousWarn $
 255            "Library " ++ (case libName lib of
 256                             Nothing -> ""
 257                             Just n -> display n
 258                             ) ++ "does not expose any modules"
 259
 260     -- check use of signatures sections
 261   , checkVersion [1,25] (not (null (signatures lib))) $
 262       PackageDistInexcusable $
 263            "To use the 'signatures' field the package needs to specify "
 264         ++ "at least 'cabal-version: 2.0'."
 265
 266     -- check that all autogen-modules appear on other-modules or exposed-modules
 267   , check
 268       (not $ and $ map (flip elem (explicitLibModules lib)) (libModulesAutogen lib)) $
 269       PackageBuildImpossible $
 270            "An 'autogen-module' is neither on 'exposed-modules' or "
 271         ++ "'other-modules'."
 272
 273   ]
 274
 275   where
 276     checkVersion :: [Int] -> Bool -> PackageCheck -> Maybe PackageCheck
 277     checkVersion ver cond pc
 278       | specVersion pkg >= mkVersion ver       = Nothing
 279       | otherwise                              = check cond pc
 280
 281     -- TODO: not sure if this check is always right in Backpack
 282     moduleDuplicates = dups (explicitLibModules lib ++
 283                              map moduleReexportName (reexportedModules lib))
 284
 285 checkExecutable :: PackageDescription -> Executable -> [PackageCheck]
 286 checkExecutable pkg exe =
 287   catMaybes [
 288
 289     check (null (modulePath exe)) $
 290       PackageBuildImpossible $
 291         "No 'main-is' field found for executable " ++ display (exeName exe)
 292
 293   , check (not (null (modulePath exe))
 294        && (not $ fileExtensionSupportedLanguage $ modulePath exe)) $
 295       PackageBuildImpossible $
 296            "The 'main-is' field must specify a '.hs' or '.lhs' file "
 297         ++ "(even if it is generated by a preprocessor), "
 298         ++ "or it may specify a C/C++/obj-C source file."
 299
 300   , checkSpecVersion pkg [1,17]
 301           (fileExtensionSupportedLanguage (modulePath exe)
 302         && takeExtension (modulePath exe) `notElem` [".hs", ".lhs"]) $
 303       PackageDistInexcusable $
 304            "The package uses a C/C++/obj-C source file for the 'main-is' field. "
 305         ++ "To use this feature you must specify 'cabal-version: >= 1.18'."
 306
 307   , check (not (null moduleDuplicates)) $
 308        PackageBuildImpossible $
 309             "Duplicate modules in executable '" ++ display (exeName exe) ++ "': "
 310          ++ commaSep (map display moduleDuplicates)
 311
 312     -- check that all autogen-modules appear on other-modules
 313   , check
 314       (not $ and $ map (flip elem (exeModules exe)) (exeModulesAutogen exe)) $
 315       PackageBuildImpossible $
 316            "On executable '" ++ display (exeName exe) ++ "' an 'autogen-module' is not "
 317         ++ "on 'other-modules'"
 318   ]
 319   where
 320     moduleDuplicates = dups (exeModules exe)
 321
 322 checkTestSuite :: PackageDescription -> TestSuite -> [PackageCheck]
 323 checkTestSuite pkg test =
 324   catMaybes [
 325
 326     case testInterface test of
 327       TestSuiteUnsupported tt@(TestTypeUnknown _ _) -> Just $
 328         PackageBuildWarning $
 329              quote (display tt) ++ " is not a known type of test suite. "
 330           ++ "The known test suite types are: "
 331           ++ commaSep (map display knownTestTypes)
 332
 333       TestSuiteUnsupported tt -> Just $
 334         PackageBuildWarning $
 335              quote (display tt) ++ " is not a supported test suite version. "
 336           ++ "The known test suite types are: "
 337           ++ commaSep (map display knownTestTypes)
 338       _ -> Nothing
 339
 340   , check (not $ null moduleDuplicates) $
 341       PackageBuildImpossible $
 342            "Duplicate modules in test suite '" ++ display (testName test) ++ "': "
 343         ++ commaSep (map display moduleDuplicates)
 344
 345   , check mainIsWrongExt $
 346       PackageBuildImpossible $
 347            "The 'main-is' field must specify a '.hs' or '.lhs' file "
 348         ++ "(even if it is generated by a preprocessor), "
 349         ++ "or it may specify a C/C++/obj-C source file."
 350
 351   , checkSpecVersion pkg [1,17] (mainIsNotHsExt && not mainIsWrongExt) $
 352       PackageDistInexcusable $
 353            "The package uses a C/C++/obj-C source file for the 'main-is' field. "
 354         ++ "To use this feature you must specify 'cabal-version: >= 1.18'."
 355
 356     -- check that all autogen-modules appear on other-modules
 357   , check
 358       (not $ and $ map
 359         (flip elem (testModules test))
 360         (testModulesAutogen test)
 361       ) $
 362       PackageBuildImpossible $
 363            "On test suite '" ++ display (testName test) ++ "' an 'autogen-module' is not "
 364         ++ "on 'other-modules'"
 365   ]
 366   where
 367     moduleDuplicates = dups $ testModules test
 368
 369     mainIsWrongExt = case testInterface test of
 370       TestSuiteExeV10 _ f -> not $ fileExtensionSupportedLanguage f
 371       _                   -> False
 372
 373     mainIsNotHsExt = case testInterface test of
 374       TestSuiteExeV10 _ f -> takeExtension f `notElem` [".hs", ".lhs"]
 375       _                   -> False
 376
 377 checkBenchmark :: PackageDescription -> Benchmark -> [PackageCheck]
 378 checkBenchmark _pkg bm =
 379   catMaybes [
 380
 381     case benchmarkInterface bm of
 382       BenchmarkUnsupported tt@(BenchmarkTypeUnknown _ _) -> Just $
 383         PackageBuildWarning $
 384              quote (display tt) ++ " is not a known type of benchmark. "
 385           ++ "The known benchmark types are: "
 386           ++ commaSep (map display knownBenchmarkTypes)
 387
 388       BenchmarkUnsupported tt -> Just $
 389         PackageBuildWarning $
 390              quote (display tt) ++ " is not a supported benchmark version. "
 391           ++ "The known benchmark types are: "
 392           ++ commaSep (map display knownBenchmarkTypes)
 393       _ -> Nothing
 394
 395   , check (not $ null moduleDuplicates) $
 396       PackageBuildImpossible $
 397            "Duplicate modules in benchmark '" ++ display (benchmarkName bm) ++ "': "
 398         ++ commaSep (map display moduleDuplicates)
 399
 400   , check mainIsWrongExt $
 401       PackageBuildImpossible $
 402            "The 'main-is' field must specify a '.hs' or '.lhs' file "
 403         ++ "(even if it is generated by a preprocessor)."
 404
 405     -- check that all autogen-modules appear on other-modules
 406   , check
 407       (not $ and $ map
 408         (flip elem (benchmarkModules bm))
 409         (benchmarkModulesAutogen bm)
 410       ) $
 411       PackageBuildImpossible $
 412              "On benchmark '" ++ display (benchmarkName bm) ++ "' an 'autogen-module' is "
 413           ++ "not on 'other-modules'"
 414   ]
 415   where
 416     moduleDuplicates = dups $ benchmarkModules bm
 417
 418     mainIsWrongExt = case benchmarkInterface bm of
 419       BenchmarkExeV10 _ f -> takeExtension f `notElem` [".hs", ".lhs"]
 420       _                   -> False
 421
 422 -- ------------------------------------------------------------
 423 -- * Additional pure checks
 424 -- ------------------------------------------------------------
 425
 426 checkFields :: PackageDescription -> [PackageCheck]
 427 checkFields pkg =
 428   catMaybes [
 429
 430     check (not . FilePath.Windows.isValid . display . packageName $ pkg) $
 431       PackageDistInexcusable $
 432            "Unfortunately, the package name '" ++ display (packageName pkg)
 433         ++ "' is one of the reserved system file names on Windows. Many tools "
 434         ++ "need to convert package names to file names so using this name "
 435         ++ "would cause problems."
 436
 437   , check ((isPrefixOf "z-") . display . packageName $ pkg) $
 438       PackageDistInexcusable $
 439            "Package names with the prefix 'z-' are reserved by Cabal and "
 440         ++ "cannot be used."
 441
 442   , check (isNothing (buildTypeRaw pkg) && specVersion pkg < mkVersion [2,1]) $
 443       PackageBuildWarning $
 444            "No 'build-type' specified. If you do not need a custom Setup.hs or "
 445         ++ "./configure script then use 'build-type: Simple'."
 446
 447   , check (isJust (setupBuildInfo pkg) && buildType pkg /= Custom) $
 448       PackageBuildWarning $
 449            "Ignoring the 'custom-setup' section because the 'build-type' is "
 450         ++ "not 'Custom'. Use 'build-type: Custom' if you need to use a "
 451         ++ "custom Setup.hs script."
 452
 453   , check (not (null unknownCompilers)) $
 454       PackageBuildWarning $
 455         "Unknown compiler " ++ commaSep (map quote unknownCompilers)
 456                             ++ " in 'tested-with' field."
 457
 458   , check (not (null unknownLanguages)) $
 459       PackageBuildWarning $
 460         "Unknown languages: " ++ commaSep unknownLanguages
 461
 462   , check (not (null unknownExtensions)) $
 463       PackageBuildWarning $
 464         "Unknown extensions: " ++ commaSep unknownExtensions
 465
 466   , check (not (null languagesUsedAsExtensions)) $
 467       PackageBuildWarning $
 468            "Languages listed as extensions: "
 469         ++ commaSep languagesUsedAsExtensions
 470         ++ ". Languages must be specified in either the 'default-language' "
 471         ++ " or the 'other-languages' field."
 472
 473   , check (not (null ourDeprecatedExtensions)) $
 474       PackageDistSuspicious $
 475            "Deprecated extensions: "
 476         ++ commaSep (map (quote . display . fst) ourDeprecatedExtensions)
 477         ++ ". " ++ unwords
 478              [ "Instead of '" ++ display ext
 479             ++ "' use '" ++ display replacement ++ "'."
 480              | (ext, Just replacement) <- ourDeprecatedExtensions ]
 481
 482   , check (null (category pkg)) $
 483       PackageDistSuspicious "No 'category' field."
 484
 485   , check (null (maintainer pkg)) $
 486       PackageDistSuspicious "No 'maintainer' field."
 487
 488   , check (null (synopsis pkg) && null (description pkg)) $
 489       PackageDistInexcusable "No 'synopsis' or 'description' field."
 490
 491   , check (null (description pkg) && not (null (synopsis pkg))) $
 492       PackageDistSuspicious "No 'description' field."
 493
 494   , check (null (synopsis pkg) && not (null (description pkg))) $
 495       PackageDistSuspicious "No 'synopsis' field."
 496
 497     --TODO: recommend the bug reports URL, author and homepage fields
 498     --TODO: recommend not using the stability field
 499     --TODO: recommend specifying a source repo
 500
 501   , check (length (synopsis pkg) >= 80) $
 502       PackageDistSuspicious
 503         "The 'synopsis' field is rather long (max 80 chars is recommended)."
 504
 505     -- See also https://github.com/haskell/cabal/pull/3479
 506   , check (not (null (description pkg))
 507            && length (description pkg) <= length (synopsis pkg)) $
 508       PackageDistSuspicious $
 509            "The 'description' field should be longer than the 'synopsis' "
 510         ++ "field. "
 511         ++ "It's useful to provide an informative 'description' to allow "
 512         ++ "Haskell programmers who have never heard about your package to "
 513         ++ "understand the purpose of your package. "
 514         ++ "The 'description' field content is typically shown by tooling "
 515         ++ "(e.g. 'cabal info', Haddock, Hackage) below the 'synopsis' which "
 516         ++ "serves as a headline. "
 517         ++ "Please refer to <https://www.haskell.org/"
 518         ++ "cabal/users-guide/developing-packages.html#package-properties>"
 519         ++ " for more details."
 520
 521     -- check use of impossible constraints "tested-with: GHC== 6.10 && ==6.12"
 522   , check (not (null testedWithImpossibleRanges)) $
 523       PackageDistInexcusable $
 524            "Invalid 'tested-with' version range: "
 525         ++ commaSep (map display testedWithImpossibleRanges)
 526         ++ ". To indicate that you have tested a package with multiple "
 527         ++ "different versions of the same compiler use multiple entries, "
 528         ++ "for example 'tested-with: GHC==6.10.4, GHC==6.12.3' and not "
 529         ++ "'tested-with: GHC==6.10.4 && ==6.12.3'."
 530
 531   , check (not (null depInternalLibraryWithExtraVersion)) $
 532       PackageBuildWarning $
 533            "The package has an extraneous version range for a dependency on an "
 534         ++ "internal library: "
 535         ++ commaSep (map display depInternalLibraryWithExtraVersion)
 536         ++ ". This version range includes the current package but isn't needed "
 537         ++ "as the current package's library will always be used."
 538
 539   , check (not (null depInternalLibraryWithImpossibleVersion)) $
 540       PackageBuildImpossible $
 541            "The package has an impossible version range for a dependency on an "
 542         ++ "internal library: "
 543         ++ commaSep (map display depInternalLibraryWithImpossibleVersion)
 544         ++ ". This version range does not include the current package, and must "
 545         ++ "be removed as the current package's library will always be used."
 546
 547   , check (not (null depInternalExecutableWithExtraVersion)) $
 548       PackageBuildWarning $
 549            "The package has an extraneous version range for a dependency on an "
 550         ++ "internal executable: "
 551         ++ commaSep (map display depInternalExecutableWithExtraVersion)
 552         ++ ". This version range includes the current package but isn't needed "
 553         ++ "as the current package's executable will always be used."
 554
 555   , check (not (null depInternalExecutableWithImpossibleVersion)) $
 556       PackageBuildImpossible $
 557            "The package has an impossible version range for a dependency on an "
 558         ++ "internal executable: "
 559         ++ commaSep (map display depInternalExecutableWithImpossibleVersion)
 560         ++ ". This version range does not include the current package, and must "
 561         ++ "be removed as the current package's executable will always be used."
 562
 563   , check (not (null depMissingInternalExecutable)) $
 564       PackageBuildImpossible $
 565            "The package depends on a missing internal executable: "
 566         ++ commaSep (map display depInternalExecutableWithImpossibleVersion)
 567   ]
 568   where
 569     unknownCompilers  = [ name | (OtherCompiler name, _) <- testedWith pkg ]
 570     unknownLanguages  = [ name | bi <- allBuildInfo pkg
 571                                , UnknownLanguage name <- allLanguages bi ]
 572     unknownExtensions = [ name | bi <- allBuildInfo pkg
 573                                , UnknownExtension name <- allExtensions bi
 574                                , name `notElem` map display knownLanguages ]
 575     ourDeprecatedExtensions = nub $ catMaybes
 576       [ find ((==ext) . fst) deprecatedExtensions
 577       | bi <- allBuildInfo pkg
 578       , ext <- allExtensions bi ]
 579     languagesUsedAsExtensions =
 580       [ name | bi <- allBuildInfo pkg
 581              , UnknownExtension name <- allExtensions bi
 582              , name `elem` map display knownLanguages ]
 583
 584     testedWithImpossibleRanges =
 585       [ Dependency (mkPackageName (display compiler)) vr
 586       | (compiler, vr) <- testedWith pkg
 587       , isNoVersion vr ]
 588
 589     internalLibraries =
 590         map (maybe (packageName pkg) (unqualComponentNameToPackageName) . libName)
 591             (allLibraries pkg)
 592
 593     internalExecutables = map exeName $ executables pkg
 594
 595     internalLibDeps =
 596       [ dep
 597       | bi <- allBuildInfo pkg
 598       , dep@(Dependency name _) <- targetBuildDepends bi
 599       , name `elem` internalLibraries
 600       ]
 601
 602     internalExeDeps =
 603       [ dep
 604       | bi <- allBuildInfo pkg
 605       , dep <- getAllToolDependencies pkg bi
 606       , isInternal pkg dep
 607       ]
 608
 609     depInternalLibraryWithExtraVersion =
 610       [ dep
 611       | dep@(Dependency _ versionRange) <- internalLibDeps
 612       , not $ isAnyVersion versionRange
 613       , packageVersion pkg `withinRange` versionRange
 614       ]
 615
 616     depInternalLibraryWithImpossibleVersion =
 617       [ dep
 618       | dep@(Dependency _ versionRange) <- internalLibDeps
 619       , not $ packageVersion pkg `withinRange` versionRange
 620       ]
 621
 622     depInternalExecutableWithExtraVersion =
 623       [ dep
 624       | dep@(ExeDependency _ _ versionRange) <- internalExeDeps
 625       , not $ isAnyVersion versionRange
 626       , packageVersion pkg `withinRange` versionRange
 627       ]
 628
 629     depInternalExecutableWithImpossibleVersion =
 630       [ dep
 631       | dep@(ExeDependency _ _ versionRange) <- internalExeDeps
 632       , not $ packageVersion pkg `withinRange` versionRange
 633       ]
 634
 635     depMissingInternalExecutable =
 636       [ dep
 637       | dep@(ExeDependency _ eName _) <- internalExeDeps
 638       , not $ eName `elem` internalExecutables
 639       ]
 640
 641
 642 checkLicense :: PackageDescription -> [PackageCheck]
 643 checkLicense pkg = case licenseRaw pkg of
 644     Right l -> checkOldLicense pkg l
 645     Left  l -> checkNewLicense pkg l
 646
 647 checkNewLicense :: PackageDescription -> SPDX.License -> [PackageCheck]
 648 checkNewLicense _pkg lic = catMaybes
 649     [ check (lic == SPDX.NONE) $
 650         PackageDistInexcusable
 651             "The 'license' field is missing or is NONE."
 652     ]
 653
 654 checkOldLicense :: PackageDescription -> License -> [PackageCheck]
 655 checkOldLicense pkg lic = catMaybes
 656   [ check (lic == UnspecifiedLicense) $
 657       PackageDistInexcusable
 658         "The 'license' field is missing."
 659
 660   , check (lic == AllRightsReserved) $
 661       PackageDistSuspicious
 662         "The 'license' is AllRightsReserved. Is that really what you want?"
 663
 664   , checkVersion [1,4] (lic `notElem` compatLicenses) $
 665       PackageDistInexcusable $
 666            "Unfortunately the license " ++ quote (prettyShow (license pkg))
 667         ++ " messes up the parser in earlier Cabal versions so you need to "
 668         ++ "specify 'cabal-version: >= 1.4'. Alternatively if you require "
 669         ++ "compatibility with earlier Cabal versions then use 'OtherLicense'."
 670
 671   , case lic of
 672       UnknownLicense l -> Just $
 673         PackageBuildWarning $
 674              quote ("license: " ++ l) ++ " is not a recognised license. The "
 675           ++ "known licenses are: "
 676           ++ commaSep (map display knownLicenses)
 677       _ -> Nothing
 678
 679   , check (lic == BSD4) $
 680       PackageDistSuspicious $
 681            "Using 'license: BSD4' is almost always a misunderstanding. 'BSD4' "
 682         ++ "refers to the old 4-clause BSD license with the advertising "
 683         ++ "clause. 'BSD3' refers the new 3-clause BSD license."
 684
 685   , case unknownLicenseVersion (lic) of
 686       Just knownVersions -> Just $
 687         PackageDistSuspicious $
 688              "'license: " ++ display (lic) ++ "' is not a known "
 689           ++ "version of that license. The known versions are "
 690           ++ commaSep (map display knownVersions)
 691           ++ ". If this is not a mistake and you think it should be a known "
 692           ++ "version then please file a ticket."
 693       _ -> Nothing
 694
 695   , check (lic `notElem` [ AllRightsReserved
 696                                  , UnspecifiedLicense, PublicDomain]
 697            -- AllRightsReserved and PublicDomain are not strictly
 698            -- licenses so don't need license files.
 699         && null (licenseFiles pkg)) $
 700       PackageDistSuspicious "A 'license-file' is not specified."
 701   ]
 702   where
 703     unknownLicenseVersion (GPL  (Just v))
 704       | v `notElem` knownVersions = Just knownVersions
 705       where knownVersions = [ v' | GPL  (Just v') <- knownLicenses ]
 706     unknownLicenseVersion (LGPL (Just v))
 707       | v `notElem` knownVersions = Just knownVersions
 708       where knownVersions = [ v' | LGPL (Just v') <- knownLicenses ]
 709     unknownLicenseVersion (AGPL (Just v))
 710       | v `notElem` knownVersions = Just knownVersions
 711       where knownVersions = [ v' | AGPL (Just v') <- knownLicenses ]
 712     unknownLicenseVersion (Apache  (Just v))
 713       | v `notElem` knownVersions = Just knownVersions
 714       where knownVersions = [ v' | Apache  (Just v') <- knownLicenses ]
 715     unknownLicenseVersion _ = Nothing
 716
 717     checkVersion :: [Int] -> Bool -> PackageCheck -> Maybe PackageCheck
 718     checkVersion ver cond pc
 719       | specVersion pkg >= mkVersion ver       = Nothing
 720       | otherwise                              = check cond pc
 721
 722     compatLicenses = [ GPL Nothing, LGPL Nothing, AGPL Nothing, BSD3, BSD4
 723                      , PublicDomain, AllRightsReserved
 724                      , UnspecifiedLicense, OtherLicense ]
 725
 726 checkSourceRepos :: PackageDescription -> [PackageCheck]
 727 checkSourceRepos pkg =
 728   catMaybes $ concat [[
 729
 730     case repoKind repo of
 731       RepoKindUnknown kind -> Just $ PackageDistInexcusable $
 732         quote kind ++ " is not a recognised kind of source-repository. "
 733                    ++ "The repo kind is usually 'head' or 'this'"
 734       _ -> Nothing
 735
 736   , check (isNothing (repoType repo)) $
 737       PackageDistInexcusable
 738         "The source-repository 'type' is a required field."
 739
 740   , check (isNothing (repoLocation repo)) $
 741       PackageDistInexcusable
 742         "The source-repository 'location' is a required field."
 743
 744   , check (repoType repo == Just CVS && isNothing (repoModule repo)) $
 745       PackageDistInexcusable
 746         "For a CVS source-repository, the 'module' is a required field."
 747
 748   , check (repoKind repo == RepoThis && isNothing (repoTag repo)) $
 749       PackageDistInexcusable $
 750            "For the 'this' kind of source-repository, the 'tag' is a required "
 751         ++ "field. It should specify the tag corresponding to this version "
 752         ++ "or release of the package."
 753
 754   , check (maybe False isAbsoluteOnAnyPlatform (repoSubdir repo)) $
 755       PackageDistInexcusable
 756         "The 'subdir' field of a source-repository must be a relative path."
 757   ]
 758   | repo <- sourceRepos pkg ]
 759
 760 --TODO: check location looks like a URL for some repo types.
 761
 762 checkGhcOptions :: PackageDescription -> [PackageCheck]
 763 checkGhcOptions pkg =
 764   catMaybes [
 765
 766     checkFlags ["-fasm"] $
 767       PackageDistInexcusable $
 768            "'ghc-options: -fasm' is unnecessary and will not work on CPU "
 769         ++ "architectures other than x86, x86-64, ppc or sparc."
 770
 771   , checkFlags ["-fvia-C"] $
 772       PackageDistSuspicious $
 773            "'ghc-options: -fvia-C' is usually unnecessary. If your package "
 774         ++ "needs -via-C for correctness rather than performance then it "
 775         ++ "is using the FFI incorrectly and will probably not work with GHC "
 776         ++ "6.10 or later."
 777
 778   , checkFlags ["-fhpc"] $
 779       PackageDistInexcusable $
 780            "'ghc-options: -fhpc' is not not necessary. Use the configure flag "
 781         ++ " --enable-coverage instead."
 782
 783   , checkFlags ["-prof"] $
 784       PackageBuildWarning $
 785            "'ghc-options: -prof' is not necessary and will lead to problems "
 786         ++ "when used on a library. Use the configure flag "
 787         ++ "--enable-library-profiling and/or --enable-profiling."
 788
 789   , checkFlags ["-o"] $
 790       PackageBuildWarning $
 791            "'ghc-options: -o' is not needed. "
 792         ++ "The output files are named automatically."
 793
 794   , checkFlags ["-hide-package"] $
 795       PackageBuildWarning $
 796       "'ghc-options: -hide-package' is never needed. "
 797       ++ "Cabal hides all packages."
 798
 799   , checkFlags ["--make"] $
 800       PackageBuildWarning $
 801       "'ghc-options: --make' is never needed. Cabal uses this automatically."
 802
 803   , checkFlags ["-main-is"] $
 804       PackageDistSuspicious $
 805       "'ghc-options: -main-is' is not portable."
 806
 807   , checkNonTestAndBenchmarkFlags ["-O0", "-Onot"] $
 808       PackageDistSuspicious $
 809       "'ghc-options: -O0' is not needed. "
 810       ++ "Use the --disable-optimization configure flag."
 811
 812   , checkTestAndBenchmarkFlags ["-O0", "-Onot"] $
 813       PackageDistSuspiciousWarn $
 814       "'ghc-options: -O0' is not needed. "
 815       ++ "Use the --disable-optimization configure flag."
 816
 817   , checkFlags [ "-O", "-O1"] $
 818       PackageDistInexcusable $
 819       "'ghc-options: -O' is not needed. "
 820       ++ "Cabal automatically adds the '-O' flag. "
 821       ++ "Setting it yourself interferes with the --disable-optimization flag."
 822
 823   , checkFlags ["-O2"] $
 824       PackageDistSuspiciousWarn $
 825       "'ghc-options: -O2' is rarely needed. "
 826       ++ "Check that it is giving a real benefit "
 827       ++ "and not just imposing longer compile times on your users."
 828
 829   , checkFlags ["-split-sections"] $
 830       PackageBuildWarning $
 831         "'ghc-options: -split-sections' is not needed. "
 832         ++ "Use the --enable-split-sections configure flag."
 833
 834   , checkFlags ["-split-objs"] $
 835       PackageBuildWarning $
 836         "'ghc-options: -split-objs' is not needed. "
 837         ++ "Use the --enable-split-objs configure flag."
 838
 839   , checkFlags ["-optl-Wl,-s", "-optl-s"] $
 840       PackageDistInexcusable $
 841            "'ghc-options: -optl-Wl,-s' is not needed and is not portable to all"
 842         ++ " operating systems. Cabal 1.4 and later automatically strip"
 843         ++ " executables. Cabal also has a flag --disable-executable-stripping"
 844         ++ " which is necessary when building packages for some Linux"
 845         ++ " distributions and using '-optl-Wl,-s' prevents that from working."
 846
 847   , checkFlags ["-fglasgow-exts"] $
 848       PackageDistSuspicious $
 849         "Instead of 'ghc-options: -fglasgow-exts' it is preferable to use "
 850         ++ "the 'extensions' field."
 851
 852   , check ("-threaded" `elem` lib_ghc_options) $
 853       PackageBuildWarning $
 854            "'ghc-options: -threaded' has no effect for libraries. It should "
 855         ++ "only be used for executables."
 856
 857   , check ("-rtsopts" `elem` lib_ghc_options) $
 858       PackageBuildWarning $
 859            "'ghc-options: -rtsopts' has no effect for libraries. It should "
 860         ++ "only be used for executables."
 861
 862   , check (any (\opt -> "-with-rtsopts" `isPrefixOf` opt) lib_ghc_options) $
 863       PackageBuildWarning $
 864            "'ghc-options: -with-rtsopts' has no effect for libraries. It "
 865         ++ "should only be used for executables."
 866
 867   , checkAlternatives "ghc-options" "extensions"
 868       [ (flag, display extension) | flag <- all_ghc_options
 869                                   , Just extension <- [ghcExtension flag] ]
 870
 871   , checkAlternatives "ghc-options" "extensions"
 872       [ (flag, extension) | flag@('-':'X':extension) <- all_ghc_options ]
 873
 874   , checkAlternatives "ghc-options" "cpp-options" $
 875          [ (flag, flag) | flag@('-':'D':_) <- all_ghc_options ]
 876       ++ [ (flag, flag) | flag@('-':'U':_) <- all_ghc_options ]
 877
 878   , checkAlternatives "ghc-options" "include-dirs"
 879       [ (flag, dir) | flag@('-':'I':dir) <- all_ghc_options ]
 880
 881   , checkAlternatives "ghc-options" "extra-libraries"
 882       [ (flag, lib) | flag@('-':'l':lib) <- all_ghc_options ]
 883
 884   , checkAlternatives "ghc-options" "extra-lib-dirs"
 885       [ (flag, dir) | flag@('-':'L':dir) <- all_ghc_options ]
 886
 887   , checkAlternatives "ghc-options" "frameworks"
 888       [ (flag, fmwk) | (flag@"-framework", fmwk) <-
 889            zip all_ghc_options (safeTail all_ghc_options) ]
 890
 891   , checkAlternatives "ghc-options" "extra-framework-dirs"
 892       [ (flag, dir) | (flag@"-framework-path", dir) <-
 893            zip all_ghc_options (safeTail all_ghc_options) ]
 894   ]
 895
 896   where
 897     all_ghc_options    = concatMap get_ghc_options (allBuildInfo pkg)
 898     lib_ghc_options    = concatMap (get_ghc_options . libBuildInfo)
 899                          (allLibraries pkg)
 900     get_ghc_options bi = hcOptions GHC bi ++ hcProfOptions GHC bi
 901                          ++ hcSharedOptions GHC bi
 902
 903     test_ghc_options      = concatMap (get_ghc_options . testBuildInfo)
 904                             (testSuites pkg)
 905     benchmark_ghc_options = concatMap (get_ghc_options . benchmarkBuildInfo)
 906                             (benchmarks pkg)
 907     test_and_benchmark_ghc_options     = test_ghc_options ++
 908                                          benchmark_ghc_options
 909     non_test_and_benchmark_ghc_options = concatMap get_ghc_options
 910                                          (allBuildInfo (pkg { testSuites = []
 911                                                             , benchmarks = []
 912                                                             }))
 913
 914     checkFlags :: [String] -> PackageCheck -> Maybe PackageCheck
 915     checkFlags flags = check (any (`elem` flags) all_ghc_options)
 916
 917     checkTestAndBenchmarkFlags :: [String] -> PackageCheck -> Maybe PackageCheck
 918     checkTestAndBenchmarkFlags flags = check (any (`elem` flags) test_and_benchmark_ghc_options)
 919
 920     checkNonTestAndBenchmarkFlags :: [String] -> PackageCheck -> Maybe PackageCheck
 921     checkNonTestAndBenchmarkFlags flags = check (any (`elem` flags) non_test_and_benchmark_ghc_options)
 922
 923     ghcExtension ('-':'f':name) = case name of
 924       "allow-overlapping-instances"    -> enable  OverlappingInstances
 925       "no-allow-overlapping-instances" -> disable OverlappingInstances
 926       "th"                             -> enable  TemplateHaskell
 927       "no-th"                          -> disable TemplateHaskell
 928       "ffi"                            -> enable  ForeignFunctionInterface
 929       "no-ffi"                         -> disable ForeignFunctionInterface
 930       "fi"                             -> enable  ForeignFunctionInterface
 931       "no-fi"                          -> disable ForeignFunctionInterface
 932       "monomorphism-restriction"       -> enable  MonomorphismRestriction
 933       "no-monomorphism-restriction"    -> disable MonomorphismRestriction
 934       "mono-pat-binds"                 -> enable  MonoPatBinds
 935       "no-mono-pat-binds"              -> disable MonoPatBinds
 936       "allow-undecidable-instances"    -> enable  UndecidableInstances
 937       "no-allow-undecidable-instances" -> disable UndecidableInstances
 938       "allow-incoherent-instances"     -> enable  IncoherentInstances
 939       "no-allow-incoherent-instances"  -> disable IncoherentInstances
 940       "arrows"                         -> enable  Arrows
 941       "no-arrows"                      -> disable Arrows
 942       "generics"                       -> enable  Generics
 943       "no-generics"                    -> disable Generics
 944       "implicit-prelude"               -> enable  ImplicitPrelude
 945       "no-implicit-prelude"            -> disable ImplicitPrelude
 946       "implicit-params"                -> enable  ImplicitParams
 947       "no-implicit-params"             -> disable ImplicitParams
 948       "bang-patterns"                  -> enable  BangPatterns
 949       "no-bang-patterns"               -> disable BangPatterns
 950       "scoped-type-variables"          -> enable  ScopedTypeVariables
 951       "no-scoped-type-variables"       -> disable ScopedTypeVariables
 952       "extended-default-rules"         -> enable  ExtendedDefaultRules
 953       "no-extended-default-rules"      -> disable ExtendedDefaultRules
 954       _                                -> Nothing
 955     ghcExtension "-cpp"             = enable CPP
 956     ghcExtension _                  = Nothing
 957
 958     enable  e = Just (EnableExtension e)
 959     disable e = Just (DisableExtension e)
 960
 961 checkCCOptions :: PackageDescription -> [PackageCheck]
 962 checkCCOptions pkg =
 963   catMaybes [
 964
 965     checkAlternatives "cc-options" "include-dirs"
 966       [ (flag, dir) | flag@('-':'I':dir) <- all_ccOptions ]
 967
 968   , checkAlternatives "cc-options" "extra-libraries"
 969       [ (flag, lib) | flag@('-':'l':lib) <- all_ccOptions ]
 970
 971   , checkAlternatives "cc-options" "extra-lib-dirs"
 972       [ (flag, dir) | flag@('-':'L':dir) <- all_ccOptions ]
 973
 974   , checkAlternatives "ld-options" "extra-libraries"
 975       [ (flag, lib) | flag@('-':'l':lib) <- all_ldOptions ]
 976
 977   , checkAlternatives "ld-options" "extra-lib-dirs"
 978       [ (flag, dir) | flag@('-':'L':dir) <- all_ldOptions ]
 979
 980   , checkCCFlags [ "-O", "-Os", "-O0", "-O1", "-O2", "-O3" ] $
 981       PackageDistSuspicious $
 982            "'cc-options: -O[n]' is generally not needed. When building with "
 983         ++ " optimisations Cabal automatically adds '-O2' for C code. "
 984         ++ "Setting it yourself interferes with the --disable-optimization "
 985         ++ "flag."
 986   ]
 987
 988   where all_ccOptions = [ opts | bi <- allBuildInfo pkg
 989                               , opts <- ccOptions bi ]
 990         all_ldOptions = [ opts | bi <- allBuildInfo pkg
 991                                , opts <- ldOptions bi ]
 992
 993         checkCCFlags :: [String] -> PackageCheck -> Maybe PackageCheck
 994         checkCCFlags flags = check (any (`elem` flags) all_ccOptions)
 995
 996 checkCPPOptions :: PackageDescription -> [PackageCheck]
 997 checkCPPOptions pkg =
 998   catMaybes [
 999     checkAlternatives "cpp-options" "include-dirs"
1000       [ (flag, dir) | flag@('-':'I':dir) <- all_cppOptions]
1001     ]
1002   where all_cppOptions = [ opts | bi <- allBuildInfo pkg
1003                                 , opts <- cppOptions bi ]
1004
1005 checkAlternatives :: String -> String -> [(String, String)]
1006                   -> Maybe PackageCheck
1007 checkAlternatives badField goodField flags =
1008   check (not (null badFlags)) $
1009     PackageBuildWarning $
1010          "Instead of " ++ quote (badField ++ ": " ++ unwords badFlags)
1011       ++ " use " ++ quote (goodField ++ ": " ++ unwords goodFlags)
1012
1013   where (badFlags, goodFlags) = unzip flags
1014
1015 checkPaths :: PackageDescription -> [PackageCheck]
1016 checkPaths pkg =
1017   [ PackageBuildWarning $
1018          quote (kind ++ ": " ++ path)
1019       ++ " is a relative path outside of the source tree. "
1020       ++ "This will not work when generating a tarball with 'sdist'."
1021   | (path, kind) <- relPaths ++ absPaths
1022   , isOutsideTree path ]
1023   ++
1024   [ PackageDistInexcusable $
1025       quote (kind ++ ": " ++ path) ++ " is an absolute path."
1026   | (path, kind) <- relPaths
1027   , isAbsoluteOnAnyPlatform path ]
1028   ++
1029   [ PackageDistInexcusable $
1030          quote (kind ++ ": " ++ path) ++ " points inside the 'dist' "
1031       ++ "directory. This is not reliable because the location of this "
1032       ++ "directory is configurable by the user (or package manager). In "
1033       ++ "addition the layout of the 'dist' directory is subject to change "
1034       ++ "in future versions of Cabal."
1035   | (path, kind) <- relPaths ++ absPaths
1036   , isInsideDist path ]
1037   ++
1038   [ PackageDistInexcusable $
1039          "The 'ghc-options' contains the path '" ++ path ++ "' which points "
1040       ++ "inside the 'dist' directory. This is not reliable because the "
1041       ++ "location of this directory is configurable by the user (or package "
1042       ++ "manager). In addition the layout of the 'dist' directory is subject "
1043       ++ "to change in future versions of Cabal."
1044   | bi <- allBuildInfo pkg
1045   , (GHC, flags) <- options bi
1046   , path <- flags
1047   , isInsideDist path ]
1048   where
1049     isOutsideTree path = case splitDirectories path of
1050       "..":_     -> True
1051       ".":"..":_ -> True
1052       _          -> False
1053     isInsideDist path = case map lowercase (splitDirectories path) of
1054       "dist"    :_ -> True
1055       ".":"dist":_ -> True
1056       _            -> False
1057     -- paths that must be relative
1058     relPaths =
1059          [ (path, "extra-src-files") | path <- extraSrcFiles pkg ]
1060       ++ [ (path, "extra-tmp-files") | path <- extraTmpFiles pkg ]
1061       ++ [ (path, "extra-doc-files") | path <- extraDocFiles pkg ]
1062       ++ [ (path, "data-files")      | path <- dataFiles     pkg ]
1063       ++ [ (path, "data-dir")        | path <- [dataDir      pkg]]
1064       ++ [ (path, "license-file")    | path <- licenseFiles  pkg ]
1065       ++ concat
1066          [    [ (path, "asm-sources")      | path <- asmSources      bi ]
1067            ++ [ (path, "cmm-sources")      | path <- cmmSources      bi ]
1068            ++ [ (path, "c-sources")        | path <- cSources        bi ]
1069            ++ [ (path, "cxx-sources")      | path <- cxxSources      bi ]
1070            ++ [ (path, "js-sources")       | path <- jsSources       bi ]
1071            ++ [ (path, "install-includes") | path <- installIncludes bi ]
1072            ++ [ (path, "hs-source-dirs")   | path <- hsSourceDirs    bi ]
1073          | bi <- allBuildInfo pkg ]
1074     -- paths that are allowed to be absolute
1075     absPaths = concat
1076       [    [ (path, "includes")         | path <- includes        bi ]
1077         ++ [ (path, "include-dirs")     | path <- includeDirs     bi ]
1078         ++ [ (path, "extra-lib-dirs")   | path <- extraLibDirs    bi ]
1079       | bi <- allBuildInfo pkg ]
1080
1081 --TODO: check sets of paths that would be interpreted differently between Unix
1082 -- and windows, ie case-sensitive or insensitive. Things that might clash, or
1083 -- conversely be distinguished.
1084
1085 --TODO: use the tar path checks on all the above paths
1086
1087 -- | Check that the package declares the version in the @\"cabal-version\"@
1088 -- field correctly.
1089 --
1090 checkCabalVersion :: PackageDescription -> [PackageCheck]
1091 checkCabalVersion pkg =
1092   catMaybes [
1093
1094     -- check syntax of cabal-version field
1095     check (specVersion pkg >= mkVersion [1,10]
1096            && not simpleSpecVersionRangeSyntax) $
1097       PackageBuildWarning $
1098            "Packages relying on Cabal 1.10 or later must only specify a "
1099         ++ "version range of the form 'cabal-version: >= x.y'. Use "
1100         ++ "'cabal-version: >= " ++ display (specVersion pkg) ++ "'."
1101
1102     -- check syntax of cabal-version field
1103   , check (specVersion pkg < mkVersion [1,9]
1104            && not simpleSpecVersionRangeSyntax) $
1105       PackageDistSuspicious $
1106            "It is recommended that the 'cabal-version' field only specify a "
1107         ++ "version range of the form '>= x.y'. Use "
1108         ++ "'cabal-version: >= " ++ display (specVersion pkg) ++ "'. "
1109         ++ "Tools based on Cabal 1.10 and later will ignore upper bounds."
1110
1111     -- check syntax of cabal-version field
1112   , checkVersion [1,12] simpleSpecVersionSyntax $
1113       PackageBuildWarning $
1114            "With Cabal 1.10 or earlier, the 'cabal-version' field must use "
1115         ++ "range syntax rather than a simple version number. Use "
1116         ++ "'cabal-version: >= " ++ display (specVersion pkg) ++ "'."
1117
1118     -- check syntax of cabal-version field
1119   , check (specVersion pkg >= mkVersion [1,12]
1120            && not simpleSpecVersionSyntax) $
1121       (if specVersion pkg >= mkVersion [2,0] then PackageDistSuspicious else PackageDistSuspiciousWarn) $
1122            "Packages relying on Cabal 1.12 or later should specify a "
1123         ++ "specific version of the Cabal spec of the form "
1124         ++ "'cabal-version: x.y'. "
1125         ++ "Use 'cabal-version: " ++ display (specVersion pkg) ++ "'."
1126
1127     -- check use of test suite sections
1128   , checkVersion [1,8] (not (null $ testSuites pkg)) $
1129       PackageDistInexcusable $
1130            "The 'test-suite' section is new in Cabal 1.10. "
1131         ++ "Unfortunately it messes up the parser in older Cabal versions "
1132         ++ "so you must specify at least 'cabal-version: >= 1.8', but note "
1133         ++ "that only Cabal 1.10 and later can actually run such test suites."
1134
1135     -- check use of default-language field
1136     -- note that we do not need to do an equivalent check for the
1137     -- other-language field since that one does not change behaviour
1138   , checkVersion [1,10] (any isJust (buildInfoField defaultLanguage)) $
1139       PackageBuildWarning $
1140            "To use the 'default-language' field the package needs to specify "
1141         ++ "at least 'cabal-version: >= 1.10'."
1142
1143   , check (specVersion pkg >= mkVersion [1,10]
1144            && (any isNothing (buildInfoField defaultLanguage))) $
1145       PackageBuildWarning $
1146            "Packages using 'cabal-version: >= 1.10' must specify the "
1147         ++ "'default-language' field for each component (e.g. Haskell98 or "
1148         ++ "Haskell2010). If a component uses different languages in "
1149         ++ "different modules then list the other ones in the "
1150         ++ "'other-languages' field."
1151
1152   , checkVersion [1,18]
1153     (not . null $ extraDocFiles pkg) $
1154       PackageDistInexcusable $
1155            "To use the 'extra-doc-files' field the package needs to specify "
1156         ++ "at least 'cabal-version: >= 1.18'."
1157
1158   , checkVersion [2,0]
1159     (not (null (subLibraries pkg))) $
1160       PackageDistInexcusable $
1161            "To use multiple 'library' sections or a named library section "
1162         ++ "the package needs to specify at least 'cabal-version: 2.0'."
1163
1164     -- check use of reexported-modules sections
1165   , checkVersion [1,21]
1166     (any (not.null.reexportedModules) (allLibraries pkg)) $
1167       PackageDistInexcusable $
1168            "To use the 'reexported-module' field the package needs to specify "
1169         ++ "at least 'cabal-version: >= 1.22'."
1170
1171     -- check use of thinning and renaming
1172   , checkVersion [1,25] usesBackpackIncludes $
1173       PackageDistInexcusable $
1174            "To use the 'mixins' field the package needs to specify "
1175         ++ "at least 'cabal-version: 2.0'."
1176
1177     -- check use of 'extra-framework-dirs' field
1178   , checkVersion [1,23] (any (not . null) (buildInfoField extraFrameworkDirs)) $
1179       -- Just a warning, because this won't break on old Cabal versions.
1180       PackageDistSuspiciousWarn $
1181            "To use the 'extra-framework-dirs' field the package needs to specify"
1182         ++ " at least 'cabal-version: >= 1.24'."
1183
1184     -- check use of default-extensions field
1185     -- don't need to do the equivalent check for other-extensions
1186   , checkVersion [1,10] (any (not . null) (buildInfoField defaultExtensions)) $
1187       PackageBuildWarning $
1188            "To use the 'default-extensions' field the package needs to specify "
1189         ++ "at least 'cabal-version: >= 1.10'."
1190
1191     -- check use of extensions field
1192   , check (specVersion pkg >= mkVersion [1,10]
1193            && (any (not . null) (buildInfoField oldExtensions))) $
1194       PackageBuildWarning $
1195            "For packages using 'cabal-version: >= 1.10' the 'extensions' "
1196         ++ "field is deprecated. The new 'default-extensions' field lists "
1197         ++ "extensions that are used in all modules in the component, while "
1198         ++ "the 'other-extensions' field lists extensions that are used in "
1199         ++ "some modules, e.g. via the {-# LANGUAGE #-} pragma."
1200
1201     -- check use of "foo (>= 1.0 && < 1.4) || >=1.8 " version-range syntax
1202   , checkVersion [1,8] (not (null versionRangeExpressions)) $
1203       PackageDistInexcusable $
1204            "The package uses full version-range expressions "
1205         ++ "in a 'build-depends' field: "
1206         ++ commaSep (map displayRawDependency versionRangeExpressions)
1207         ++ ". To use this new syntax the package needs to specify at least "
1208         ++ "'cabal-version: >= 1.8'. Alternatively, if broader compatibility "
1209         ++ "is important, then convert to conjunctive normal form, and use "
1210         ++ "multiple 'build-depends:' lines, one conjunct per line."
1211
1212     -- check use of "build-depends: foo == 1.*" syntax
1213   , checkVersion [1,6] (not (null depsUsingWildcardSyntax)) $
1214       PackageDistInexcusable $
1215            "The package uses wildcard syntax in the 'build-depends' field: "
1216         ++ commaSep (map display depsUsingWildcardSyntax)
1217         ++ ". To use this new syntax the package need to specify at least "
1218         ++ "'cabal-version: >= 1.6'. Alternatively, if broader compatibility "
1219         ++ "is important then use: " ++ commaSep
1220            [ display (Dependency name (eliminateWildcardSyntax versionRange))
1221            | Dependency name versionRange <- depsUsingWildcardSyntax ]
1222
1223     -- check use of "build-depends: foo ^>= 1.2.3" syntax
1224   , checkVersion [2,0] (not (null depsUsingMajorBoundSyntax)) $
1225       PackageDistInexcusable $
1226            "The package uses major bounded version syntax in the "
1227         ++ "'build-depends' field: "
1228         ++ commaSep (map display depsUsingMajorBoundSyntax)
1229         ++ ". To use this new syntax the package need to specify at least "
1230         ++ "'cabal-version: 2.0'. Alternatively, if broader compatibility "
1231         ++ "is important then use: " ++ commaSep
1232            [ display (Dependency name (eliminateMajorBoundSyntax versionRange))
1233            | Dependency name versionRange <- depsUsingMajorBoundSyntax ]
1234
1235   , checkVersion [2,1] (any (not . null)
1236                         (concatMap buildInfoField
1237                          [ asmSources
1238                          , cmmSources
1239                          , extraBundledLibs
1240                          , extraLibFlavours ])) $
1241       PackageDistInexcusable $
1242            "The use of 'asm-sources', 'cmm-sources', 'extra-bundled-libraries' "
1243         ++ " and 'extra-library-flavours' requires the package "
1244         ++ " to specify at least 'cabal-version: >= 2.1'."
1245
1246   , checkVersion [2,1] (any (not . null)
1247                         (buildInfoField virtualModules)) $
1248       PackageDistInexcusable $
1249            "The use of 'virtual-modules' requires the package "
1250         ++ " to specify at least 'cabal-version: >= 2.1'."
1251
1252     -- check use of "tested-with: GHC (>= 1.0 && < 1.4) || >=1.8 " syntax
1253   , checkVersion [1,8] (not (null testedWithVersionRangeExpressions)) $
1254       PackageDistInexcusable $
1255            "The package uses full version-range expressions "
1256         ++ "in a 'tested-with' field: "
1257         ++ commaSep (map displayRawDependency testedWithVersionRangeExpressions)
1258         ++ ". To use this new syntax the package needs to specify at least "
1259         ++ "'cabal-version: >= 1.8'."
1260
1261     -- check use of "tested-with: GHC == 6.12.*" syntax
1262   , checkVersion [1,6] (not (null testedWithUsingWildcardSyntax)) $
1263       PackageDistInexcusable $
1264            "The package uses wildcard syntax in the 'tested-with' field: "
1265         ++ commaSep (map display testedWithUsingWildcardSyntax)
1266         ++ ". To use this new syntax the package need to specify at least "
1267         ++ "'cabal-version: >= 1.6'. Alternatively, if broader compatibility "
1268         ++ "is important then use: " ++ commaSep
1269            [ display (Dependency name (eliminateWildcardSyntax versionRange))
1270            | Dependency name versionRange <- testedWithUsingWildcardSyntax ]
1271
1272     -- check use of "data-files: data/*.txt" syntax
1273   , checkVersion [1,6] (not (null dataFilesUsingGlobSyntax)) $
1274       PackageDistInexcusable $
1275            "Using wildcards like "
1276         ++ commaSep (map quote $ take 3 dataFilesUsingGlobSyntax)
1277         ++ " in the 'data-files' field requires 'cabal-version: >= 1.6'. "
1278         ++ "Alternatively if you require compatibility with earlier Cabal "
1279         ++ "versions then list all the files explicitly."
1280
1281     -- check use of "extra-source-files: mk/*.in" syntax
1282   , checkVersion [1,6] (not (null extraSrcFilesUsingGlobSyntax)) $
1283       PackageDistInexcusable $
1284            "Using wildcards like "
1285         ++ commaSep (map quote $ take 3 extraSrcFilesUsingGlobSyntax)
1286         ++ " in the 'extra-source-files' field requires "
1287         ++ "'cabal-version: >= 1.6'. Alternatively if you require "
1288         ++ "compatibility with earlier Cabal versions then list all the files "
1289         ++ "explicitly."
1290
1291     -- check use of "source-repository" section
1292   , checkVersion [1,6] (not (null (sourceRepos pkg))) $
1293       PackageDistInexcusable $
1294            "The 'source-repository' section is new in Cabal 1.6. "
1295         ++ "Unfortunately it messes up the parser in earlier Cabal versions "
1296         ++ "so you need to specify 'cabal-version: >= 1.6'."
1297
1298     -- check for new language extensions
1299   , checkVersion [1,2,3] (not (null mentionedExtensionsThatNeedCabal12)) $
1300       PackageDistInexcusable $
1301            "Unfortunately the language extensions "
1302         ++ commaSep (map (quote . display) mentionedExtensionsThatNeedCabal12)
1303         ++ " break the parser in earlier Cabal versions so you need to "
1304         ++ "specify 'cabal-version: >= 1.2.3'. Alternatively if you require "
1305         ++ "compatibility with earlier Cabal versions then you may be able to "
1306         ++ "use an equivalent compiler-specific flag."
1307
1308   , checkVersion [1,4] (not (null mentionedExtensionsThatNeedCabal14)) $
1309       PackageDistInexcusable $
1310            "Unfortunately the language extensions "
1311         ++ commaSep (map (quote . display) mentionedExtensionsThatNeedCabal14)
1312         ++ " break the parser in earlier Cabal versions so you need to "
1313         ++ "specify 'cabal-version: >= 1.4'. Alternatively if you require "
1314         ++ "compatibility with earlier Cabal versions then you may be able to "
1315         ++ "use an equivalent compiler-specific flag."
1316
1317   , check (specVersion pkg >= mkVersion [1,23]
1318            && isNothing (setupBuildInfo pkg)
1319            && buildType pkg == Custom) $
1320       PackageBuildWarning $
1321            "Packages using 'cabal-version: >= 1.24' with 'build-type: Custom' "
1322         ++ "must use a 'custom-setup' section with a 'setup-depends' field "
1323         ++ "that specifies the dependencies of the Setup.hs script itself. "
1324         ++ "The 'setup-depends' field uses the same syntax as 'build-depends', "
1325         ++ "so a simple example would be 'setup-depends: base, Cabal'."
1326
1327   , check (specVersion pkg < mkVersion [1,23]
1328            && isNothing (setupBuildInfo pkg)
1329            && buildType pkg == Custom) $
1330       PackageDistSuspiciousWarn $
1331            "From version 1.24 cabal supports specifiying explicit dependencies "
1332         ++ "for Custom setup scripts. Consider using cabal-version >= 1.24 and "
1333         ++ "adding a 'custom-setup' section with a 'setup-depends' field "
1334         ++ "that specifies the dependencies of the Setup.hs script itself. "
1335         ++ "The 'setup-depends' field uses the same syntax as 'build-depends', "
1336         ++ "so a simple example would be 'setup-depends: base, Cabal'."
1337
1338   , check (specVersion pkg >= mkVersion [1,25]
1339            && elem (autogenPathsModuleName pkg) allModuleNames
1340            && not (elem (autogenPathsModuleName pkg) allModuleNamesAutogen) ) $
1341       PackageDistInexcusable $
1342            "Packages using 'cabal-version: 2.0' and the autogenerated "
1343         ++ "module Paths_* must include it also on the 'autogen-modules' field "
1344         ++ "besides 'exposed-modules' and 'other-modules'. This specifies that "
1345         ++ "the module does not come with the package and is generated on "
1346         ++ "setup. Modules built with a custom Setup.hs script also go here "
1347         ++ "to ensure that commands like sdist don't fail."
1348
1349   ]
1350   where
1351     -- Perform a check on packages that use a version of the spec less than
1352     -- the version given. This is for cases where a new Cabal version adds
1353     -- a new feature and we want to check that it is not used prior to that
1354     -- version.
1355     checkVersion :: [Int] -> Bool -> PackageCheck -> Maybe PackageCheck
1356     checkVersion ver cond pc
1357       | specVersion pkg >= mkVersion ver       = Nothing
1358       | otherwise                              = check cond pc
1359
1360     buildInfoField field         = map field (allBuildInfo pkg)
1361     dataFilesUsingGlobSyntax     = filter usesGlobSyntax (dataFiles pkg)
1362     extraSrcFilesUsingGlobSyntax = filter usesGlobSyntax (extraSrcFiles pkg)
1363     usesGlobSyntax str = case parseFileGlob str of
1364       Just (FileGlob _ _) -> True
1365       _                   -> False
1366
1367     versionRangeExpressions =
1368         [ dep | dep@(Dependency _ vr) <- allBuildDepends pkg
1369               , usesNewVersionRangeSyntax vr ]
1370
1371     testedWithVersionRangeExpressions =
1372         [ Dependency (mkPackageName (display compiler)) vr
1373         | (compiler, vr) <- testedWith pkg
1374         , usesNewVersionRangeSyntax vr ]
1375
1376     simpleSpecVersionRangeSyntax =
1377         either (const True) (cataVersionRange alg) (specVersionRaw pkg)
1378       where
1379         alg (OrLaterVersionF _) = True
1380         alg _                   = False
1381
1382     -- is the cabal-version field a simple version number, rather than a range
1383     simpleSpecVersionSyntax =
1384       either (const True) (const False) (specVersionRaw pkg)
1385
1386     usesNewVersionRangeSyntax :: VersionRange -> Bool
1387     usesNewVersionRangeSyntax
1388         = (> 2) -- uses the new syntax if depth is more than 2
1389         . cataVersionRange alg
1390       where
1391         alg (UnionVersionRangesF a b) = a + b
1392         alg (IntersectVersionRangesF a b) = a + b
1393         alg (VersionRangeParensF _) = 3
1394         alg _ = 1 :: Int
1395
1396     depsUsingWildcardSyntax = [ dep | dep@(Dependency _ vr) <- allBuildDepends pkg
1397                                     , usesWildcardSyntax vr ]
1398
1399     depsUsingMajorBoundSyntax = [ dep | dep@(Dependency _ vr) <- allBuildDepends pkg
1400                                       , usesMajorBoundSyntax vr ]
1401
1402     usesBackpackIncludes = any (not . null . mixins) (allBuildInfo pkg)
1403
1404     testedWithUsingWildcardSyntax =
1405       [ Dependency (mkPackageName (display compiler)) vr
1406       | (compiler, vr) <- testedWith pkg
1407       , usesWildcardSyntax vr ]
1408
1409     usesWildcardSyntax :: VersionRange -> Bool
1410     usesWildcardSyntax = cataVersionRange alg
1411       where
1412         alg (WildcardVersionF _)          = True
1413         alg (UnionVersionRangesF a b)     = a || b
1414         alg (IntersectVersionRangesF a b) = a || b
1415         alg (VersionRangeParensF a)       = a
1416         alg _                             = False
1417
1418     -- NB: this eliminates both, WildcardVersion and MajorBoundVersion
1419     -- because when WildcardVersion is not support, neither is MajorBoundVersion
1420     eliminateWildcardSyntax = hyloVersionRange embed projectVersionRange
1421       where
1422         embed (WildcardVersionF v) = intersectVersionRanges
1423             (orLaterVersion v) (earlierVersion (wildcardUpperBound v))
1424         embed (MajorBoundVersionF v) = intersectVersionRanges
1425             (orLaterVersion v) (earlierVersion (majorUpperBound v))
1426         embed vr = embedVersionRange vr
1427
1428     usesMajorBoundSyntax :: VersionRange -> Bool
1429     usesMajorBoundSyntax = cataVersionRange alg
1430       where
1431         alg (MajorBoundVersionF _)        = True
1432         alg (UnionVersionRangesF a b)     = a || b
1433         alg (IntersectVersionRangesF a b) = a || b
1434         alg (VersionRangeParensF a)       = a
1435         alg _                             = False
1436
1437     eliminateMajorBoundSyntax = hyloVersionRange embed projectVersionRange
1438       where
1439         embed (MajorBoundVersionF v) = intersectVersionRanges
1440             (orLaterVersion v) (earlierVersion (majorUpperBound v))
1441         embed vr = embedVersionRange vr
1442
1443     mentionedExtensions = [ ext | bi <- allBuildInfo pkg
1444                                 , ext <- allExtensions bi ]
1445     mentionedExtensionsThatNeedCabal12 =
1446       nub (filter (`elem` compatExtensionsExtra) mentionedExtensions)
1447
1448     -- As of Cabal-1.4 we can add new extensions without worrying about
1449     -- breaking old versions of cabal.
1450     mentionedExtensionsThatNeedCabal14 =
1451       nub (filter (`notElem` compatExtensions) mentionedExtensions)
1452
1453     -- The known extensions in Cabal-1.2.3
1454     compatExtensions =
1455       map EnableExtension
1456       [ OverlappingInstances, UndecidableInstances, IncoherentInstances
1457       , RecursiveDo, ParallelListComp, MultiParamTypeClasses
1458       , FunctionalDependencies, Rank2Types
1459       , RankNTypes, PolymorphicComponents, ExistentialQuantification
1460       , ScopedTypeVariables, ImplicitParams, FlexibleContexts
1461       , FlexibleInstances, EmptyDataDecls, CPP, BangPatterns
1462       , TypeSynonymInstances, TemplateHaskell, ForeignFunctionInterface
1463       , Arrows, Generics, NamedFieldPuns, PatternGuards
1464       , GeneralizedNewtypeDeriving, ExtensibleRecords, RestrictedTypeSynonyms
1465       , HereDocuments] ++
1466       map DisableExtension
1467       [MonomorphismRestriction, ImplicitPrelude] ++
1468       compatExtensionsExtra
1469
1470     -- The extra known extensions in Cabal-1.2.3 vs Cabal-1.1.6
1471     -- (Cabal-1.1.6 came with ghc-6.6. Cabal-1.2 came with ghc-6.8)
1472     compatExtensionsExtra =
1473       map EnableExtension
1474       [ KindSignatures, MagicHash, TypeFamilies, StandaloneDeriving
1475       , UnicodeSyntax, PatternSignatures, UnliftedFFITypes, LiberalTypeSynonyms
1476       , TypeOperators, RecordWildCards, RecordPuns, DisambiguateRecordFields
1477       , OverloadedStrings, GADTs, RelaxedPolyRec
1478       , ExtendedDefaultRules, UnboxedTuples, DeriveDataTypeable
1479       , ConstrainedClassMethods
1480       ] ++
1481       map DisableExtension
1482       [MonoPatBinds]
1483
1484     allModuleNames =
1485          (case library pkg of
1486            Nothing -> []
1487            (Just lib) -> explicitLibModules lib
1488          )
1489       ++ concatMap otherModules (allBuildInfo pkg)
1490
1491     allModuleNamesAutogen = concatMap autogenModules (allBuildInfo pkg)
1492
1493 displayRawDependency :: Dependency -> String
1494 displayRawDependency (Dependency pkg vr) =
1495   display pkg ++ " " ++ display vr
1496
1497
1498 -- ------------------------------------------------------------
1499 -- * Checks on the GenericPackageDescription
1500 -- ------------------------------------------------------------
1501
1502 -- | Check the build-depends fields for any weirdness or bad practise.
1503 --
1504 checkPackageVersions :: GenericPackageDescription -> [PackageCheck]
1505 checkPackageVersions pkg =
1506   catMaybes [
1507
1508     -- Check that the version of base is bounded above.
1509     -- For example this bans "build-depends: base >= 3".
1510     -- It should probably be "build-depends: base >= 3 && < 4"
1511     -- which is the same as  "build-depends: base == 3.*"
1512     check (not (boundedAbove baseDependency)) $
1513       PackageDistInexcusable $
1514            "The dependency 'build-depends: base' does not specify an upper "
1515         ++ "bound on the version number. Each major release of the 'base' "
1516         ++ "package changes the API in various ways and most packages will "
1517         ++ "need some changes to compile with it. The recommended practise "
1518         ++ "is to specify an upper bound on the version of the 'base' "
1519         ++ "package. This ensures your package will continue to build when a "
1520         ++ "new major version of the 'base' package is released. If you are "
1521         ++ "not sure what upper bound to use then use the next  major "
1522         ++ "version. For example if you have tested your package with 'base' "
1523         ++ "version 4.5 and 4.6 then use 'build-depends: base >= 4.5 && < 4.7'."
1524
1525   ]
1526   where
1527     -- TODO: What we really want to do is test if there exists any
1528     -- configuration in which the base version is unbounded above.
1529     -- However that's a bit tricky because there are many possible
1530     -- configurations. As a cheap easy and safe approximation we will
1531     -- pick a single "typical" configuration and check if that has an
1532     -- open upper bound. To get a typical configuration we finalise
1533     -- using no package index and the current platform.
1534     finalised = finalizePD
1535                               mempty defaultComponentRequestedSpec (const True)
1536                               buildPlatform
1537                               (unknownCompilerInfo
1538                                 (CompilerId buildCompilerFlavor nullVersion)
1539                                 NoAbiTag)
1540                               [] pkg
1541     baseDependency = case finalised of
1542       Right (pkg', _) | not (null baseDeps) ->
1543           foldr intersectVersionRanges anyVersion baseDeps
1544         where
1545           baseDeps =
1546             [ vr | Dependency pname vr <- allBuildDepends pkg'
1547                  , pname == mkPackageName "base" ]
1548
1549       -- Just in case finalizePD fails for any reason,
1550       -- or if the package doesn't depend on the base package at all,
1551       -- then we will just skip the check, since boundedAbove noVersion = True
1552       _          -> noVersion
1553
1554     boundedAbove :: VersionRange -> Bool
1555     boundedAbove vr = case asVersionIntervals vr of
1556       []        -> True -- this is the inconsistent version range.
1557       intervals -> case last intervals of
1558         (_,   UpperBound _ _) -> True
1559         (_, NoUpperBound    ) -> False
1560
1561
1562 checkConditionals :: GenericPackageDescription -> [PackageCheck]
1563 checkConditionals pkg =
1564   catMaybes [
1565
1566     check (not $ null unknownOSs) $
1567       PackageDistInexcusable $
1568            "Unknown operating system name "
1569         ++ commaSep (map quote unknownOSs)
1570
1571   , check (not $ null unknownArches) $
1572       PackageDistInexcusable $
1573            "Unknown architecture name "
1574         ++ commaSep (map quote unknownArches)
1575
1576   , check (not $ null unknownImpls) $
1577       PackageDistInexcusable $
1578            "Unknown compiler name "
1579         ++ commaSep (map quote unknownImpls)
1580   ]
1581   where
1582     unknownOSs    = [ os   | OS   (OtherOS os)           <- conditions ]
1583     unknownArches = [ arch | Arch (OtherArch arch)       <- conditions ]
1584     unknownImpls  = [ impl | Impl (OtherCompiler impl) _ <- conditions ]
1585     conditions = concatMap fvs (maybeToList (condLibrary pkg))
1586               ++ concatMap (fvs . snd) (condSubLibraries pkg)
1587               ++ concatMap (fvs . snd) (condForeignLibs pkg)
1588               ++ concatMap (fvs . snd) (condExecutables pkg)
1589               ++ concatMap (fvs . snd) (condTestSuites pkg)
1590               ++ concatMap (fvs . snd) (condBenchmarks pkg)
1591     fvs (CondNode _ _ ifs) = concatMap compfv ifs -- free variables
1592     compfv (CondBranch c ct mct) = condfv c ++ fvs ct ++ maybe [] fvs mct
1593     condfv c = case c of
1594       Var v      -> [v]
1595       Lit _      -> []
1596       CNot c1    -> condfv c1
1597       COr  c1 c2 -> condfv c1 ++ condfv c2
1598       CAnd c1 c2 -> condfv c1 ++ condfv c2
1599
1600 checkFlagNames :: GenericPackageDescription -> [PackageCheck]
1601 checkFlagNames gpd
1602     | null invalidFlagNames = []
1603     | otherwise             = [ PackageDistInexcusable
1604         $ "Suspicious flag names: " ++ unwords invalidFlagNames ++ ". "
1605         ++ "To avoid ambiguity in command line interfaces, flag shouldn't "
1606         ++ "start with a dash. Also for better compatibility, flag names "
1607         ++ "shouldn't contain non-ascii characters."
1608         ]
1609   where
1610     invalidFlagNames =
1611         [ fn
1612         | flag <- genPackageFlags gpd
1613         , let fn = unFlagName (flagName flag)
1614         , invalidFlagName fn
1615         ]
1616     -- starts with dash
1617     invalidFlagName ('-':_) = True
1618     -- mon ascii letter
1619     invalidFlagName cs = any (not . isAscii) cs
1620
1621 checkUnusedFlags :: GenericPackageDescription -> [PackageCheck]
1622 checkUnusedFlags gpd
1623     | declared == used = []
1624     | otherwise        = [ PackageDistSuspicious
1625         $ "Declared and used flag sets differ: "
1626         ++ s declared ++ " /= " ++ s used ++ ". "
1627         ]
1628   where
1629     s :: Set.Set FlagName -> String
1630     s = commaSep . map unFlagName . Set.toList
1631
1632     declared :: Set.Set FlagName
1633     declared = toSetOf (L.genPackageFlags . traverse . L.flagName) gpd
1634
1635     used :: Set.Set FlagName
1636     used = mconcat
1637         [ toSetOf (L.condLibrary      . traverse      . traverseCondTreeV . L._Flag) gpd
1638         , toSetOf (L.condSubLibraries . traverse . _2 . traverseCondTreeV . L._Flag) gpd
1639         , toSetOf (L.condForeignLibs  . traverse . _2 . traverseCondTreeV . L._Flag) gpd
1640         , toSetOf (L.condExecutables  . traverse . _2 . traverseCondTreeV . L._Flag) gpd
1641         , toSetOf (L.condTestSuites   . traverse . _2 . traverseCondTreeV . L._Flag) gpd
1642         , toSetOf (L.condBenchmarks   . traverse . _2 . traverseCondTreeV . L._Flag) gpd
1643         ]
1644
1645 checkUnicodeXFields :: GenericPackageDescription -> [PackageCheck]
1646 checkUnicodeXFields gpd
1647     | null nonAsciiXFields = []
1648     | otherwise            = [ PackageDistInexcusable
1649         $ "Non ascii custom fields: " ++ unwords nonAsciiXFields ++ ". "
1650         ++ "For better compatibility, custom field names "
1651         ++ "shouldn't contain non-ascii characters."
1652         ]
1653   where
1654     nonAsciiXFields :: [String]
1655     nonAsciiXFields = [ n | (n, _) <- xfields, any (not . isAscii) n ]
1656
1657     xfields :: [(String,String)]
1658     xfields = DList.runDList $ mconcat
1659         [ toDListOf (L.packageDescription . L.customFieldsPD . traverse) gpd
1660         , toDListOf (L.traverseBuildInfos . L.customFieldsBI . traverse) gpd
1661         ]
1662
1663 -- | cabal-version <2.2 + Paths_module + default-extensions: doesn't build.
1664 checkPathsModuleExtensions :: PackageDescription -> [PackageCheck]
1665 checkPathsModuleExtensions pd
1666     | specVersion pd >= mkVersion [2,1] = []
1667     | any checkBI (allBuildInfo pd) || any checkLib (allLibraries pd)
1668         = return $ PackageBuildImpossible $ unwords
1669             [ "The package uses RebindableSyntax with OverloadedStrings or OverloadedLists"
1670             , "in default-extensions, and also Paths_ autogen module."
1671             , "That configuration is known to cause compile failures with Cabal < 2.2."
1672             , "To use these default-extensions with Paths_ autogen module"
1673             , "specify at least 'cabal-version: 2.2'."
1674             ]
1675     | otherwise = []
1676   where
1677     mn = autogenPathsModuleName pd
1678
1679     checkLib :: Library -> Bool
1680     checkLib l = mn `elem` exposedModules l && checkExts (l ^. L.defaultExtensions)
1681
1682     checkBI :: BuildInfo -> Bool
1683     checkBI bi =
1684         (mn `elem` otherModules bi || mn `elem` autogenModules bi) &&
1685         checkExts (bi ^. L.defaultExtensions)
1686
1687     checkExts exts = rebind `elem` exts && (strings `elem` exts || lists `elem` exts)
1688       where
1689         rebind  = EnableExtension RebindableSyntax
1690         strings = EnableExtension OverloadedStrings
1691         lists   = EnableExtension OverloadedLists
1692
1693 checkDevelopmentOnlyFlagsBuildInfo :: BuildInfo -> [PackageCheck]
1694 checkDevelopmentOnlyFlagsBuildInfo bi =
1695   catMaybes [
1696
1697     check has_WerrorWall $
1698       PackageDistInexcusable $
1699            "'ghc-options: -Wall -Werror' makes the package very easy to "
1700         ++ "break with future GHC versions because new GHC versions often "
1701         ++ "add new warnings. Use just 'ghc-options: -Wall' instead."
1702         ++ extraExplanation
1703
1704   , check (not has_WerrorWall && has_Werror) $
1705       PackageDistInexcusable $
1706            "'ghc-options: -Werror' makes the package easy to "
1707         ++ "break with future GHC versions because new GHC versions often "
1708         ++ "add new warnings. "
1709         ++ extraExplanation
1710
1711   , checkFlags ["-fdefer-type-errors"] $
1712       PackageDistInexcusable $
1713            "'ghc-options: -fdefer-type-errors' is fine during development but "
1714         ++ "is not appropriate for a distributed package. "
1715         ++ extraExplanation
1716
1717     -- -dynamic is not a debug flag
1718   , check (any (\opt -> "-d" `isPrefixOf` opt && opt /= "-dynamic")
1719            ghc_options) $
1720       PackageDistInexcusable $
1721            "'ghc-options: -d*' debug flags are not appropriate "
1722         ++ "for a distributed package. "
1723         ++ extraExplanation
1724
1725   , checkFlags ["-fprof-auto", "-fprof-auto-top", "-fprof-auto-calls",
1726                "-fprof-cafs", "-fno-prof-count-entries",
1727                "-auto-all", "-auto", "-caf-all"] $
1728       PackageDistSuspicious $
1729            "'ghc-options/ghc-prof-options: -fprof*' profiling flags are typically not "
1730         ++ "appropriate for a distributed library package. These flags are "
1731         ++ "useful to profile this package, but when profiling other packages "
1732         ++ "that use this one these flags clutter the profile output with "
1733         ++ "excessive detail. If you think other packages really want to see "
1734         ++ "cost centres from this package then use '-fprof-auto-exported' "
1735         ++ "which puts cost centres only on exported functions. "
1736         ++ extraExplanation
1737   ]
1738   where
1739     extraExplanation =
1740          " Alternatively, if you want to use this, make it conditional based "
1741       ++ "on a Cabal configuration flag (with 'manual: True' and 'default: "
1742       ++ "False') and enable that flag during development."
1743
1744     has_WerrorWall   = has_Werror && ( has_Wall || has_W )
1745     has_Werror       = "-Werror" `elem` ghc_options
1746     has_Wall         = "-Wall"   `elem` ghc_options
1747     has_W            = "-W"      `elem` ghc_options
1748     ghc_options      = hcOptions GHC bi ++ hcProfOptions GHC bi
1749                        ++ hcSharedOptions GHC bi
1750
1751     checkFlags :: [String] -> PackageCheck -> Maybe PackageCheck
1752     checkFlags flags = check (any (`elem` flags) ghc_options)
1753
1754 checkDevelopmentOnlyFlags :: GenericPackageDescription -> [PackageCheck]
1755 checkDevelopmentOnlyFlags pkg =
1756     concatMap checkDevelopmentOnlyFlagsBuildInfo
1757               [ bi
1758               | (conditions, bi) <- allConditionalBuildInfo
1759               , not (any guardedByManualFlag conditions) ]
1760   where
1761     guardedByManualFlag = definitelyFalse
1762
1763     -- We've basically got three-values logic here: True, False or unknown
1764     -- hence this pattern to propagate the unknown cases properly.
1765     definitelyFalse (Var (Flag n)) = maybe False not (Map.lookup n manualFlags)
1766     definitelyFalse (Var _)        = False
1767     definitelyFalse (Lit  b)       = not b
1768     definitelyFalse (CNot c)       = definitelyTrue c
1769     definitelyFalse (COr  c1 c2)   = definitelyFalse c1 && definitelyFalse c2
1770     definitelyFalse (CAnd c1 c2)   = definitelyFalse c1 || definitelyFalse c2
1771
1772     definitelyTrue (Var (Flag n)) = fromMaybe False (Map.lookup n manualFlags)
1773     definitelyTrue (Var _)        = False
1774     definitelyTrue (Lit  b)       = b
1775     definitelyTrue (CNot c)       = definitelyFalse c
1776     definitelyTrue (COr  c1 c2)   = definitelyTrue c1 || definitelyTrue c2
1777     definitelyTrue (CAnd c1 c2)   = definitelyTrue c1 && definitelyTrue c2
1778
1779     manualFlags = Map.fromList
1780                     [ (flagName flag, flagDefault flag)
1781                     | flag <- genPackageFlags pkg
1782                     , flagManual flag ]
1783
1784     allConditionalBuildInfo :: [([Condition ConfVar], BuildInfo)]
1785     allConditionalBuildInfo =
1786         concatMap (collectCondTreePaths libBuildInfo)
1787                   (maybeToList (condLibrary pkg))
1788
1789      ++ concatMap (collectCondTreePaths libBuildInfo . snd)
1790                   (condSubLibraries pkg)
1791
1792      ++ concatMap (collectCondTreePaths buildInfo . snd)
1793                   (condExecutables pkg)
1794
1795      ++ concatMap (collectCondTreePaths testBuildInfo . snd)
1796                   (condTestSuites pkg)
1797
1798      ++ concatMap (collectCondTreePaths benchmarkBuildInfo . snd)
1799                   (condBenchmarks pkg)
1800
1801     -- get all the leaf BuildInfo, paired up with the path (in the tree sense)
1802     -- of if-conditions that guard it
1803     collectCondTreePaths :: (a -> b)
1804                          -> CondTree v c a
1805                          -> [([Condition v], b)]
1806     collectCondTreePaths mapData = go []
1807       where
1808         go conditions condNode =
1809             -- the data at this level in the tree:
1810             (reverse conditions, mapData (condTreeData condNode))
1811
1812           : concat
1813             [ go (condition:conditions) ifThen
1814             | (CondBranch condition ifThen _) <- condTreeComponents condNode ]
1815
1816          ++ concat
1817             [ go (condition:conditions) elseThen
1818             | (CondBranch condition _ (Just elseThen)) <- condTreeComponents condNode ]
1819
1820
1821 -- ------------------------------------------------------------
1822 -- * Checks involving files in the package
1823 -- ------------------------------------------------------------
1824
1825 -- | Sanity check things that requires IO. It looks at the files in the
1826 -- package and expects to find the package unpacked in at the given file path.
1827 --
1828 checkPackageFiles :: PackageDescription -> FilePath -> NoCallStackIO [PackageCheck]
1829 checkPackageFiles pkg root = checkPackageContent checkFilesIO pkg
1830   where
1831     checkFilesIO = CheckPackageContentOps {
1832       doesFileExist        = System.doesFileExist                  . relative,
1833       doesDirectoryExist   = System.doesDirectoryExist             . relative,
1834       getDirectoryContents = System.Directory.getDirectoryContents . relative,
1835       getFileContents      = BS.readFile
1836     }
1837     relative path = root </> path
1838
1839 -- | A record of operations needed to check the contents of packages.
1840 -- Used by 'checkPackageContent'.
1841 --
1842 data CheckPackageContentOps m = CheckPackageContentOps {
1843     doesFileExist        :: FilePath -> m Bool,
1844     doesDirectoryExist   :: FilePath -> m Bool,
1845     getDirectoryContents :: FilePath -> m [FilePath],
1846     getFileContents      :: FilePath -> m BS.ByteString
1847   }
1848
1849 -- | Sanity check things that requires looking at files in the package.
1850 -- This is a generalised version of 'checkPackageFiles' that can work in any
1851 -- monad for which you can provide 'CheckPackageContentOps' operations.
1852 --
1853 -- The point of this extra generality is to allow doing checks in some virtual
1854 -- file system, for example a tarball in memory.
1855 --
1856 checkPackageContent :: Monad m => CheckPackageContentOps m
1857                     -> PackageDescription
1858                     -> m [PackageCheck]
1859 checkPackageContent ops pkg = do
1860   cabalBomError   <- checkCabalFileBOM    ops
1861   cabalNameError  <- checkCabalFileName   ops pkg
1862   licenseErrors   <- checkLicensesExist   ops pkg
1863   setupError      <- checkSetupExists     ops pkg
1864   configureError  <- checkConfigureExists ops pkg
1865   localPathErrors <- checkLocalPathsExist ops pkg
1866   vcsLocation     <- checkMissingVcsInfo  ops pkg
1867
1868   return $ licenseErrors
1869         ++ catMaybes [cabalBomError, cabalNameError, setupError, configureError]
1870         ++ localPathErrors
1871         ++ vcsLocation
1872
1873 checkCabalFileBOM :: Monad m => CheckPackageContentOps m
1874                   -> m (Maybe PackageCheck)
1875 checkCabalFileBOM ops = do
1876   epdfile <- findPackageDesc ops
1877   case epdfile of
1878     -- MASSIVE HACK.  If the Cabal file doesn't exist, that is
1879     -- a very strange situation to be in, because the driver code
1880     -- in 'Distribution.Setup' ought to have noticed already!
1881     -- But this can be an issue, see #3552 and also when
1882     -- --cabal-file is specified.  So if you can't find the file,
1883     -- just don't bother with this check.
1884     Left _       -> return $ Nothing
1885     Right pdfile -> (flip check pc . BS.isPrefixOf bomUtf8)
1886                     `liftM` (getFileContents ops pdfile)
1887       where pc = PackageDistInexcusable $
1888                  pdfile ++ " starts with an Unicode byte order mark (BOM)."
1889                  ++ " This may cause problems with older cabal versions."
1890
1891   where
1892     bomUtf8 :: BS.ByteString
1893     bomUtf8 = BS.pack [0xef,0xbb,0xbf] -- U+FEFF encoded as UTF8
1894
1895 checkCabalFileName :: Monad m => CheckPackageContentOps m
1896                  -> PackageDescription
1897                  -> m (Maybe PackageCheck)
1898 checkCabalFileName ops pkg = do
1899   -- findPackageDesc already takes care to detect missing/multiple
1900   -- .cabal files; we don't include this check in 'findPackageDesc' in
1901   -- order not to short-cut other checks which call 'findPackageDesc'
1902   epdfile <- findPackageDesc ops
1903   case epdfile of
1904     -- see "MASSIVE HACK" note in 'checkCabalFileBOM'
1905     Left _       -> return Nothing
1906     Right pdfile
1907       | takeFileName pdfile == expectedCabalname -> return Nothing
1908       | otherwise -> return $ Just $ PackageDistInexcusable $
1909                  "The filename " ++ pdfile ++ " does not match package name " ++
1910                  "(expected: " ++ expectedCabalname ++ ")"
1911   where
1912     pkgname = unPackageName . packageName $ pkg
1913     expectedCabalname = pkgname <.> "cabal"
1914
1915
1916 -- |Find a package description file in the given directory.  Looks for
1917 -- @.cabal@ files.  Like 'Distribution.Simple.Utils.findPackageDesc',
1918 -- but generalized over monads.
1919 findPackageDesc :: Monad m => CheckPackageContentOps m
1920                  -> m (Either PackageCheck FilePath) -- ^<pkgname>.cabal
1921 findPackageDesc ops
1922  = do let dir = "."
1923       files <- getDirectoryContents ops dir
1924       -- to make sure we do not mistake a ~/.cabal/ dir for a <pkgname>.cabal
1925       -- file we filter to exclude dirs and null base file names:
1926       cabalFiles <- filterM (doesFileExist ops)
1927                        [ dir </> file
1928                        | file <- files
1929                        , let (name, ext) = splitExtension file
1930                        , not (null name) && ext == ".cabal" ]
1931       case cabalFiles of
1932         []          -> return (Left $ PackageBuildImpossible noDesc)
1933         [cabalFile] -> return (Right cabalFile)
1934         multiple    -> return (Left $ PackageBuildImpossible
1935                                $ multiDesc multiple)
1936
1937   where
1938     noDesc :: String
1939     noDesc = "No cabal file found.\n"
1940              ++ "Please create a package description file <pkgname>.cabal"
1941
1942     multiDesc :: [String] -> String
1943     multiDesc l = "Multiple cabal files found while checking.\n"
1944                   ++ "Please use only one of: "
1945                   ++ intercalate ", " l
1946
1947 checkLicensesExist :: Monad m => CheckPackageContentOps m
1948                    -> PackageDescription
1949                    -> m [PackageCheck]
1950 checkLicensesExist ops pkg = do
1951     exists <- mapM (doesFileExist ops) (licenseFiles pkg)
1952     return
1953       [ PackageBuildWarning $
1954            "The '" ++ fieldname ++ "' field refers to the file "
1955         ++ quote file ++ " which does not exist."
1956       | (file, False) <- zip (licenseFiles pkg) exists ]
1957   where
1958     fieldname | length (licenseFiles pkg) == 1 = "license-file"
1959               | otherwise                      = "license-files"
1960
1961 checkSetupExists :: Monad m => CheckPackageContentOps m
1962                  -> PackageDescription
1963                  -> m (Maybe PackageCheck)
1964 checkSetupExists ops pkg = do
1965   let simpleBuild = buildType pkg == Simple
1966   hsexists  <- doesFileExist ops "Setup.hs"
1967   lhsexists <- doesFileExist ops "Setup.lhs"
1968   return $ check (not simpleBuild && not hsexists && not lhsexists) $
1969     PackageDistInexcusable $
1970       "The package is missing a Setup.hs or Setup.lhs script."
1971
1972 checkConfigureExists :: Monad m => CheckPackageContentOps m
1973                      -> PackageDescription
1974                      -> m (Maybe PackageCheck)
1975 checkConfigureExists ops pd
1976   | buildType pd == Configure = do
1977       exists <- doesFileExist ops "configure"
1978       return $ check (not exists) $
1979         PackageBuildWarning $
1980           "The 'build-type' is 'Configure' but there is no 'configure' script. "
1981           ++ "You probably need to run 'autoreconf -i' to generate it."
1982   | otherwise = return Nothing
1983
1984 checkLocalPathsExist :: Monad m => CheckPackageContentOps m
1985                      -> PackageDescription
1986                      -> m [PackageCheck]
1987 checkLocalPathsExist ops pkg = do
1988   let dirs = [ (dir, kind)
1989              | bi <- allBuildInfo pkg
1990              , (dir, kind) <-
1991                   [ (dir, "extra-lib-dirs") | dir <- extraLibDirs bi ]
1992                ++ [ (dir, "extra-framework-dirs")
1993                   | dir <- extraFrameworkDirs  bi ]
1994                ++ [ (dir, "include-dirs")   | dir <- includeDirs  bi ]
1995                ++ [ (dir, "hs-source-dirs") | dir <- hsSourceDirs bi ]
1996              , isRelativeOnAnyPlatform dir ]
1997   missing <- filterM (liftM not . doesDirectoryExist ops . fst) dirs
1998   return [ PackageBuildWarning {
1999              explanation = quote (kind ++ ": " ++ dir)
2000                         ++ " directory does not exist."
2001            }
2002          | (dir, kind) <- missing ]
2003
2004 checkMissingVcsInfo :: Monad m => CheckPackageContentOps m
2005                     -> PackageDescription
2006                     -> m [PackageCheck]
2007 checkMissingVcsInfo ops pkg | null (sourceRepos pkg) = do
2008     vcsInUse <- liftM or $ mapM (doesDirectoryExist ops) repoDirnames
2009     if vcsInUse
2010       then return [ PackageDistSuspicious message ]
2011       else return []
2012   where
2013     repoDirnames = [ dirname | repo    <- knownRepoTypes
2014                              , dirname <- repoTypeDirname repo ]
2015     message  = "When distributing packages it is encouraged to specify source "
2016             ++ "control information in the .cabal file using one or more "
2017             ++ "'source-repository' sections. See the Cabal user guide for "
2018             ++ "details."
2019
2020 checkMissingVcsInfo _ _ = return []
2021
2022 repoTypeDirname :: RepoType -> [FilePath]
2023 repoTypeDirname Darcs      = ["_darcs"]
2024 repoTypeDirname Git        = [".git"]
2025 repoTypeDirname SVN        = [".svn"]
2026 repoTypeDirname CVS        = ["CVS"]
2027 repoTypeDirname Mercurial  = [".hg"]
2028 repoTypeDirname GnuArch    = [".arch-params"]
2029 repoTypeDirname Bazaar     = [".bzr"]
2030 repoTypeDirname Monotone   = ["_MTN"]
2031 repoTypeDirname _          = []
2032
2033
2034 -- ------------------------------------------------------------
2035 -- * Checks involving files in the package
2036 -- ------------------------------------------------------------
2037
2038 -- | Check the names of all files in a package for portability problems. This
2039 -- should be done for example when creating or validating a package tarball.
2040 --
2041 checkPackageFileNames :: [FilePath] -> [PackageCheck]
2042 checkPackageFileNames files =
2043      (take 1 . mapMaybe checkWindowsPath $ files)
2044   ++ (take 1 . mapMaybe checkTarPath     $ files)
2045       -- If we get any of these checks triggering then we're likely to get
2046       -- many, and that's probably not helpful, so return at most one.
2047
2048 checkWindowsPath :: FilePath -> Maybe PackageCheck
2049 checkWindowsPath path =
2050   check (not $ FilePath.Windows.isValid path') $
2051     PackageDistInexcusable $
2052          "Unfortunately, the file " ++ quote path ++ " is not a valid file "
2053       ++ "name on Windows which would cause portability problems for this "
2054       ++ "package. Windows file names cannot contain any of the characters "
2055       ++ "\":*?<>|\" and there are a few reserved names including \"aux\", "
2056       ++ "\"nul\", \"con\", \"prn\", \"com1-9\", \"lpt1-9\" and \"clock$\"."
2057   where
2058     path' = ".\\" ++ path
2059     -- force a relative name to catch invalid file names like "f:oo" which
2060     -- otherwise parse as file "oo" in the current directory on the 'f' drive.
2061
2062 -- | Check a file name is valid for the portable POSIX tar format.
2063 --
2064 -- The POSIX tar format has a restriction on the length of file names. It is
2065 -- unfortunately not a simple restriction like a maximum length. The exact
2066 -- restriction is that either the whole path be 100 characters or less, or it
2067 -- be possible to split the path on a directory separator such that the first
2068 -- part is 155 characters or less and the second part 100 characters or less.
2069 --
2070 checkTarPath :: FilePath -> Maybe PackageCheck
2071 checkTarPath path
2072   | length path > 255   = Just longPath
2073   | otherwise = case pack nameMax (reverse (splitPath path)) of
2074     Left err           -> Just err
2075     Right []           -> Nothing
2076     Right (h:rest) -> case pack prefixMax remainder of
2077       Left err         -> Just err
2078       Right []         -> Nothing
2079       Right (_:_)      -> Just noSplit
2080      where
2081         -- drop the '/' between the name and prefix:
2082         remainder = init h : rest
2083
2084   where
2085     nameMax, prefixMax :: Int
2086     nameMax   = 100
2087     prefixMax = 155
2088
2089     pack _   []     = Left emptyName
2090     pack maxLen (c:cs)
2091       | n > maxLen  = Left longName
2092       | otherwise   = Right (pack' maxLen n cs)
2093       where n = length c
2094
2095     pack' maxLen n (c:cs)
2096       | n' <= maxLen = pack' maxLen n' cs
2097       where n' = n + length c
2098     pack' _     _ cs = cs
2099
2100     longPath = PackageDistInexcusable $
2101          "The following file name is too long to store in a portable POSIX "
2102       ++ "format tar archive. The maximum length is 255 ASCII characters.\n"
2103       ++ "The file in question is:\n  " ++ path
2104     longName = PackageDistInexcusable $
2105          "The following file name is too long to store in a portable POSIX "
2106       ++ "format tar archive. The maximum length for the name part (including "
2107       ++ "extension) is 100 ASCII characters. The maximum length for any "
2108       ++ "individual directory component is 155.\n"
2109       ++ "The file in question is:\n  " ++ path
2110     noSplit = PackageDistInexcusable $
2111          "The following file name is too long to store in a portable POSIX "
2112       ++ "format tar archive. While the total length is less than 255 ASCII "
2113       ++ "characters, there are unfortunately further restrictions. It has to "
2114       ++ "be possible to split the file path on a directory separator into "
2115       ++ "two parts such that the first part fits in 155 characters or less "
2116       ++ "and the second part fits in 100 characters or less. Basically you "
2117       ++ "have to make the file name or directory names shorter, or you could "
2118       ++ "split a long directory name into nested subdirectories with shorter "
2119       ++ "names.\nThe file in question is:\n  " ++ path
2120     emptyName = PackageDistInexcusable $
2121          "Encountered a file with an empty name, something is very wrong! "
2122       ++ "Files with an empty name cannot be stored in a tar archive or in "
2123       ++ "standard file systems."
2124
2125 -- ------------------------------------------------------------
2126 -- * Utils
2127 -- ------------------------------------------------------------
2128
2129 quote :: String -> String
2130 quote s = "'" ++ s ++ "'"
2131
2132 commaSep :: [String] -> String
2133 commaSep = intercalate ", "
2134
2135 dups :: Ord a => [a] -> [a]
2136 dups xs = [ x | (x:_:_) <- group (sort xs) ]
2137
2138 fileExtensionSupportedLanguage :: FilePath -> Bool
2139 fileExtensionSupportedLanguage path =
2140     isHaskell || isC
2141   where
2142     extension = takeExtension path
2143     isHaskell = extension `elem` [".hs", ".lhs"]
2144     isC       = isJust (filenameCDialect extension)