Simplify -Werror warning
[cabal.git] / Cabal / src / Distribution / PackageDescription / Check.hs
blobb1ac65bc4f12861afc2020e3e4bd46989284936f
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 checks so we can see which ones are appropriate to report
16 -- in different situations. This code gets used when configuring a package when
17 -- we consider only basic problems. The higher standard is used 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.
23 module Distribution.PackageDescription.Check (
24 -- * Package Checking
25 PackageCheck(..),
26 checkPackage,
27 checkConfiguredPackage,
29 -- ** Checking package contents
30 checkPackageFiles,
31 checkPackageContent,
32 CheckPackageContentOps(..),
33 checkPackageFileNames,
34 ) where
36 import Distribution.Compat.Prelude
37 import Prelude ()
39 import Data.List (group)
40 import Distribution.CabalSpecVersion
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.Glob
52 import Distribution.Simple.Utils hiding (findPackageDesc, notice)
53 import Distribution.System
54 import Distribution.Types.ComponentRequestedSpec
55 import Distribution.Types.PackageName.Magic
56 import Distribution.Utils.Generic (isAscii)
57 import Distribution.Verbosity
58 import Distribution.Version
59 import Distribution.Utils.Path
60 import Language.Haskell.Extension
61 import System.FilePath
62 (splitDirectories, splitExtension, splitPath, takeExtension, takeFileName, (<.>), (</>))
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
70 import qualified System.Directory (getDirectoryContents)
71 import qualified System.FilePath.Windows as FilePath.Windows (isValid)
73 import qualified Data.Set as Set
74 import qualified Distribution.Utils.ShortText as ShortText
76 import qualified Distribution.Types.BuildInfo.Lens as L
77 import qualified Distribution.Types.GenericPackageDescription.Lens as L
78 import qualified Distribution.Types.PackageDescription.Lens as L
80 -- $setup
81 -- >>> import Control.Arrow ((&&&))
83 -- | Results of some kind of failed package check.
85 -- There are a range of severities, from merely dubious to totally insane.
86 -- All of them come with a human readable explanation. In future we may augment
87 -- them with more machine readable explanations, for example to help an IDE
88 -- suggest automatic corrections.
90 data PackageCheck =
92 -- | This package description is no good. There's no way it's going to
93 -- build sensibly. This should give an error at configure time.
94 PackageBuildImpossible { explanation :: String }
96 -- | A problem that is likely to affect building the package, or an
97 -- issue that we'd like every package author to be aware of, even if
98 -- the package is never distributed.
99 | PackageBuildWarning { explanation :: String }
101 -- | An issue that might not be a problem for the package author but
102 -- might be annoying or detrimental when the package is distributed to
103 -- users. We should encourage distributed packages to be free from these
104 -- issues, but occasionally there are justifiable reasons so we cannot
105 -- ban them entirely.
106 | PackageDistSuspicious { explanation :: String }
108 -- | Like PackageDistSuspicious but will only display warnings
109 -- rather than causing abnormal exit when you run 'cabal check'.
110 | PackageDistSuspiciousWarn { explanation :: String }
112 -- | An issue that is OK in the author's environment but is almost
113 -- certain to be a portability problem for other environments. We can
114 -- quite legitimately refuse to publicly distribute packages with these
115 -- problems.
116 | PackageDistInexcusable { explanation :: String }
117 deriving (Eq, Ord)
119 instance Show PackageCheck where
120 show notice = explanation notice
122 check :: Bool -> PackageCheck -> Maybe PackageCheck
123 check False _ = Nothing
124 check True pc = Just pc
126 checkSpecVersion :: PackageDescription -> CabalSpecVersion -> Bool -> PackageCheck
127 -> Maybe PackageCheck
128 checkSpecVersion pkg specver cond pc
129 | specVersion pkg >= specver = Nothing
130 | otherwise = check cond pc
132 -- ------------------------------------------------------------
133 -- * Standard checks
134 -- ------------------------------------------------------------
136 -- | Check for common mistakes and problems in package descriptions.
138 -- This is the standard collection of checks covering all aspects except
139 -- for checks that require looking at files within the package. For those
140 -- see 'checkPackageFiles'.
142 -- It requires the 'GenericPackageDescription' and optionally a particular
143 -- configuration of that package. If you pass 'Nothing' then we just check
144 -- a version of the generic description using 'flattenPackageDescription'.
146 checkPackage :: GenericPackageDescription
147 -> Maybe PackageDescription
148 -> [PackageCheck]
149 checkPackage gpkg mpkg =
150 checkConfiguredPackage pkg
151 ++ checkConditionals gpkg
152 ++ checkPackageVersions gpkg
153 ++ checkDevelopmentOnlyFlags gpkg
154 ++ checkFlagNames gpkg
155 ++ checkUnusedFlags gpkg
156 ++ checkUnicodeXFields gpkg
157 ++ checkPathsModuleExtensions pkg
158 ++ checkSetupVersions gpkg
159 ++ checkDuplicateModules gpkg
160 where
161 pkg = fromMaybe (flattenPackageDescription gpkg) mpkg
163 --TODO: make this variant go away
164 -- we should always know the GenericPackageDescription
165 checkConfiguredPackage :: PackageDescription -> [PackageCheck]
166 checkConfiguredPackage pkg =
167 checkSanity pkg
168 ++ checkFields pkg
169 ++ checkLicense pkg
170 ++ checkSourceRepos pkg
171 ++ checkAllGhcOptions pkg
172 ++ checkCCOptions pkg
173 ++ checkCxxOptions pkg
174 ++ checkCPPOptions pkg
175 ++ checkPaths pkg
176 ++ checkCabalVersion pkg
179 -- ------------------------------------------------------------
180 -- * Basic sanity checks
181 -- ------------------------------------------------------------
183 -- | Check that this package description is sane.
185 checkSanity :: PackageDescription -> [PackageCheck]
186 checkSanity pkg =
187 catMaybes [
189 check (null . unPackageName . packageName $ pkg) $
190 PackageBuildImpossible "No 'name' field."
192 , check (nullVersion == packageVersion pkg) $
193 PackageBuildImpossible "No 'version' field."
195 , check (all ($ pkg) [ null . executables
196 , null . testSuites
197 , null . benchmarks
198 , null . allLibraries
199 , null . foreignLibs ]) $
200 PackageBuildImpossible
201 "No executables, libraries, tests, or benchmarks found. Nothing to do."
203 , check (any (== LMainLibName) (map libName $ subLibraries pkg)) $
204 PackageBuildImpossible $ "Found one or more unnamed internal libraries. "
205 ++ "Only the non-internal library can have the same name as the package."
207 , check (not (null duplicateNames)) $
208 PackageBuildImpossible $ "Duplicate sections: "
209 ++ commaSep (map unUnqualComponentName duplicateNames)
210 ++ ". The name of every library, executable, test suite,"
211 ++ " and benchmark section in"
212 ++ " the package must be unique."
214 -- NB: but it's OK for executables to have the same name!
215 -- TODO shouldn't need to compare on the string level
216 , check (any (== prettyShow (packageName pkg)) (prettyShow <$> subLibNames)) $
217 PackageBuildImpossible $ "Illegal internal library name "
218 ++ prettyShow (packageName pkg)
219 ++ ". Internal libraries cannot have the same name as the package."
220 ++ " Maybe you wanted a non-internal library?"
221 ++ " If so, rewrite the section stanza"
222 ++ " from 'library: '" ++ prettyShow (packageName pkg) ++ "' to 'library'."
224 --TODO: check for name clashes case insensitively: windows file systems cannot
225 --cope.
227 ++ concatMap (checkLibrary pkg) (allLibraries pkg)
228 ++ concatMap (checkExecutable pkg) (executables pkg)
229 ++ concatMap (checkTestSuite pkg) (testSuites pkg)
230 ++ concatMap (checkBenchmark pkg) (benchmarks pkg)
232 where
233 -- The public 'library' gets special dispensation, because it
234 -- is common practice to export a library and name the executable
235 -- the same as the package.
236 subLibNames = mapMaybe (libraryNameString . libName) $ subLibraries pkg
237 exeNames = map exeName $ executables pkg
238 testNames = map testName $ testSuites pkg
239 bmNames = map benchmarkName $ benchmarks pkg
240 duplicateNames = dups $ subLibNames ++ exeNames ++ testNames ++ bmNames
242 checkLibrary :: PackageDescription -> Library -> [PackageCheck]
243 checkLibrary pkg lib =
244 catMaybes [
246 -- TODO: This check is bogus if a required-signature was passed through
247 check (null (explicitLibModules lib) && null (reexportedModules lib)) $
248 PackageDistSuspiciousWarn $
249 showLibraryName (libName lib) ++ " does not expose any modules"
251 -- check use of signatures sections
252 , checkVersion CabalSpecV2_0 (not (null (signatures lib))) $
253 PackageDistInexcusable $
254 "To use the 'signatures' field the package needs to specify "
255 ++ "at least 'cabal-version: 2.0'."
257 -- check that all autogen-modules appear on other-modules or exposed-modules
258 , check
259 (not $ and $ map (flip elem (explicitLibModules lib)) (libModulesAutogen lib)) $
260 PackageBuildImpossible $
261 "An 'autogen-module' is neither on 'exposed-modules' or "
262 ++ "'other-modules'."
264 -- check that all autogen-includes appear on includes or install-includes
265 , check
266 (not $ and $ map (flip elem (allExplicitIncludes lib)) (view L.autogenIncludes lib)) $
267 PackageBuildImpossible $
268 "An include in 'autogen-includes' is neither in 'includes' or "
269 ++ "'install-includes'."
272 where
273 checkVersion :: CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
274 checkVersion ver cond pc
275 | specVersion pkg >= ver = Nothing
276 | otherwise = check cond pc
278 allExplicitIncludes :: L.HasBuildInfo a => a -> [FilePath]
279 allExplicitIncludes x = view L.includes x ++ view L.installIncludes x
281 checkExecutable :: PackageDescription -> Executable -> [PackageCheck]
282 checkExecutable pkg exe =
283 catMaybes [
285 check (null (modulePath exe)) $
286 PackageBuildImpossible $
287 "No 'main-is' field found for executable " ++ prettyShow (exeName exe)
288 -- This check does not apply to scripts.
289 , check (package pkg /= fakePackageId
290 && not (null (modulePath exe))
291 && (not $ fileExtensionSupportedLanguage $ modulePath exe)) $
292 PackageBuildImpossible $
293 "The 'main-is' field must specify a '.hs' or '.lhs' file "
294 ++ "(even if it is generated by a preprocessor), "
295 ++ "or it may specify a C/C++/obj-C source file."
297 , checkSpecVersion pkg CabalSpecV1_18
298 (fileExtensionSupportedLanguage (modulePath exe)
299 && takeExtension (modulePath exe) `notElem` [".hs", ".lhs"]) $
300 PackageDistInexcusable $
301 "The package uses a C/C++/obj-C source file for the 'main-is' field. "
302 ++ "To use this feature you need to specify 'cabal-version: 1.18' or higher."
304 -- check that all autogen-modules appear on other-modules
305 , check
306 (not $ and $ map (flip elem (exeModules exe)) (exeModulesAutogen exe)) $
307 PackageBuildImpossible $
308 "On executable '" ++ prettyShow (exeName exe) ++ "' an 'autogen-module' is not "
309 ++ "on 'other-modules'"
311 -- check that all autogen-includes appear on includes
312 , check
313 (not $ and $ map (flip elem (view L.includes exe)) (view L.autogenIncludes exe)) $
314 PackageBuildImpossible "An include in 'autogen-includes' is not in 'includes'."
317 checkTestSuite :: PackageDescription -> TestSuite -> [PackageCheck]
318 checkTestSuite pkg test =
319 catMaybes [
321 case testInterface test of
322 TestSuiteUnsupported tt@(TestTypeUnknown _ _) -> Just $
323 PackageBuildWarning $
324 quote (prettyShow tt) ++ " is not a known type of test suite. "
325 ++ "Either remove the 'type' field or use a known type. "
326 ++ "The known test suite types are: "
327 ++ commaSep (map prettyShow knownTestTypes)
329 TestSuiteUnsupported tt -> Just $
330 PackageBuildWarning $
331 quote (prettyShow tt) ++ " is not a supported test suite version. "
332 ++ "Either remove the 'type' field or use a known type. "
333 ++ "The known test suite types are: "
334 ++ commaSep (map prettyShow knownTestTypes)
335 _ -> Nothing
337 , check mainIsWrongExt $
338 PackageBuildImpossible $
339 "The 'main-is' field must specify a '.hs' or '.lhs' file "
340 ++ "(even if it is generated by a preprocessor), "
341 ++ "or it may specify a C/C++/obj-C source file."
343 , checkSpecVersion pkg CabalSpecV1_18 (mainIsNotHsExt && not mainIsWrongExt) $
344 PackageDistInexcusable $
345 "The package uses a C/C++/obj-C source file for the 'main-is' field. "
346 ++ "To use this feature you need to specify 'cabal-version: 1.18' or higher."
348 -- check that all autogen-modules appear on other-modules
349 , check
350 (not $ and $ map (flip elem (testModules test)) (testModulesAutogen test)) $
351 PackageBuildImpossible $
352 "On test suite '" ++ prettyShow (testName test) ++ "' an 'autogen-module' is not "
353 ++ "on 'other-modules'"
355 -- check that all autogen-includes appear on includes
356 , check
357 (not $ and $ map (flip elem (view L.includes test)) (view L.autogenIncludes test)) $
358 PackageBuildImpossible "An include in 'autogen-includes' is not in 'includes'."
360 where
361 mainIsWrongExt = case testInterface test of
362 TestSuiteExeV10 _ f -> not $ fileExtensionSupportedLanguage f
363 _ -> False
365 mainIsNotHsExt = case testInterface test of
366 TestSuiteExeV10 _ f -> takeExtension f `notElem` [".hs", ".lhs"]
367 _ -> False
369 checkBenchmark :: PackageDescription -> Benchmark -> [PackageCheck]
370 checkBenchmark _pkg bm =
371 catMaybes [
373 case benchmarkInterface bm of
374 BenchmarkUnsupported tt@(BenchmarkTypeUnknown _ _) -> Just $
375 PackageBuildWarning $
376 quote (prettyShow tt) ++ " is not a known type of benchmark. "
377 ++ "Either remove the 'type' field or use a known type. "
378 ++ "The known benchmark types are: "
379 ++ commaSep (map prettyShow knownBenchmarkTypes)
381 BenchmarkUnsupported tt -> Just $
382 PackageBuildWarning $
383 quote (prettyShow tt) ++ " is not a supported benchmark version. "
384 ++ "Either remove the 'type' field or use a known type. "
385 ++ "The known benchmark types are: "
386 ++ commaSep (map prettyShow knownBenchmarkTypes)
387 _ -> Nothing
389 , check mainIsWrongExt $
390 PackageBuildImpossible $
391 "The 'main-is' field must specify a '.hs' or '.lhs' file "
392 ++ "(even if it is generated by a preprocessor)."
394 -- check that all autogen-modules appear on other-modules
395 , check
396 (not $ and $ map (flip elem (benchmarkModules bm)) (benchmarkModulesAutogen bm)) $
397 PackageBuildImpossible $
398 "On benchmark '" ++ prettyShow (benchmarkName bm) ++ "' an 'autogen-module' is "
399 ++ "not on 'other-modules'"
401 -- check that all autogen-includes appear on includes
402 , check
403 (not $ and $ map (flip elem (view L.includes bm)) (view L.autogenIncludes bm)) $
404 PackageBuildImpossible "An include in 'autogen-includes' is not in 'includes'."
406 where
407 mainIsWrongExt = case benchmarkInterface bm of
408 BenchmarkExeV10 _ f -> takeExtension f `notElem` [".hs", ".lhs"]
409 _ -> False
411 -- ------------------------------------------------------------
412 -- * Additional pure checks
413 -- ------------------------------------------------------------
415 checkFields :: PackageDescription -> [PackageCheck]
416 checkFields pkg =
417 catMaybes [
419 check (not . FilePath.Windows.isValid . prettyShow . packageName $ pkg) $
420 PackageDistInexcusable $
421 "The package name '" ++ prettyShow (packageName pkg) ++ "' is "
422 ++ "invalid on Windows. Many tools need to convert package names to "
423 ++ "file names so using this name would cause problems."
425 , check ((isPrefixOf "z-") . prettyShow . packageName $ pkg) $
426 PackageDistInexcusable $
427 "Package names with the prefix 'z-' are reserved by Cabal and "
428 ++ "cannot be used."
430 , check (isNothing (buildTypeRaw pkg) && specVersion pkg < CabalSpecV2_2) $
431 PackageBuildWarning $
432 "No 'build-type' specified. If you do not need a custom Setup.hs or "
433 ++ "./configure script then use 'build-type: Simple'."
435 , check (isJust (setupBuildInfo pkg) && buildType pkg /= Custom) $
436 PackageBuildWarning $
437 "Ignoring the 'custom-setup' section because the 'build-type' is "
438 ++ "not 'Custom'. Use 'build-type: Custom' if you need to use a "
439 ++ "custom Setup.hs script."
441 , check (not (null unknownCompilers)) $
442 PackageBuildWarning $
443 "Unknown compiler " ++ commaSep (map quote unknownCompilers)
444 ++ " in 'tested-with' field."
446 , check (not (null unknownLanguages)) $
447 PackageBuildWarning $
448 "Unknown languages: " ++ commaSep unknownLanguages
450 , check (not (null unknownExtensions)) $
451 PackageBuildWarning $
452 "Unknown extensions: " ++ commaSep unknownExtensions
454 , check (not (null languagesUsedAsExtensions)) $
455 PackageBuildWarning $
456 "Languages listed as extensions: "
457 ++ commaSep languagesUsedAsExtensions
458 ++ ". Languages must be specified in either the 'default-language' "
459 ++ " or the 'other-languages' field."
461 , check (not (null ourDeprecatedExtensions)) $
462 PackageDistSuspicious $
463 "Deprecated extensions: "
464 ++ commaSep (map (quote . prettyShow . fst) ourDeprecatedExtensions)
465 ++ ". " ++ unwords
466 [ "Instead of '" ++ prettyShow ext
467 ++ "' use '" ++ prettyShow replacement ++ "'."
468 | (ext, Just replacement) <- ourDeprecatedExtensions ]
470 , check (ShortText.null (category pkg)) $
471 PackageDistSuspicious "No 'category' field."
473 , check (ShortText.null (maintainer pkg)) $
474 PackageDistSuspicious "No 'maintainer' field."
476 , check (ShortText.null (synopsis pkg) && ShortText.null (description pkg)) $
477 PackageDistInexcusable "No 'synopsis' or 'description' field."
479 , check (ShortText.null (description pkg) && not (ShortText.null (synopsis pkg))) $
480 PackageDistSuspicious "No 'description' field."
482 , check (ShortText.null (synopsis pkg) && not (ShortText.null (description pkg))) $
483 PackageDistSuspicious "No 'synopsis' field."
485 --TODO: recommend the bug reports URL, author and homepage fields
486 --TODO: recommend not using the stability field
487 --TODO: recommend specifying a source repo
489 , check (ShortText.length (synopsis pkg) > 80) $
490 PackageDistSuspicious
491 "The 'synopsis' field is rather long (max 80 chars is recommended)."
493 -- See also https://github.com/haskell/cabal/pull/3479
494 , check (not (ShortText.null (description pkg))
495 && ShortText.length (description pkg) <= ShortText.length (synopsis pkg)) $
496 PackageDistSuspicious $
497 "The 'description' field should be longer than the 'synopsis' "
498 ++ "field. "
499 ++ "It's useful to provide an informative 'description' to allow "
500 ++ "Haskell programmers who have never heard about your package to "
501 ++ "understand the purpose of your package. "
502 ++ "The 'description' field content is typically shown by tooling "
503 ++ "(e.g. 'cabal info', Haddock, Hackage) below the 'synopsis' which "
504 ++ "serves as a headline. "
505 ++ "Please refer to <https://cabal.readthedocs.io/en/stable/"
506 ++ "cabal-package.html#package-properties> for more details."
508 -- check use of impossible constraints "tested-with: GHC== 6.10 && ==6.12"
509 , check (not (null testedWithImpossibleRanges)) $
510 PackageDistInexcusable $
511 "Invalid 'tested-with' version range: "
512 ++ commaSep (map prettyShow testedWithImpossibleRanges)
513 ++ ". To indicate that you have tested a package with multiple "
514 ++ "different versions of the same compiler use multiple entries, "
515 ++ "for example 'tested-with: GHC==6.10.4, GHC==6.12.3' and not "
516 ++ "'tested-with: GHC==6.10.4 && ==6.12.3'."
518 -- for more details on why the following was commented out,
519 -- check https://github.com/haskell/cabal/pull/7470#issuecomment-875878507
520 -- , check (not (null depInternalLibraryWithExtraVersion)) $
521 -- PackageBuildWarning $
522 -- "The package has an extraneous version range for a dependency on an "
523 -- ++ "internal library: "
524 -- ++ commaSep (map prettyShow depInternalLibraryWithExtraVersion)
525 -- ++ ". This version range includes the current package but isn't needed "
526 -- ++ "as the current package's library will always be used."
528 , check (not (null depInternalLibraryWithImpossibleVersion)) $
529 PackageBuildImpossible $
530 "The package has an impossible version range for a dependency on an "
531 ++ "internal library: "
532 ++ commaSep (map prettyShow depInternalLibraryWithImpossibleVersion)
533 ++ ". This version range does not include the current package, and must "
534 ++ "be removed as the current package's library will always be used."
536 -- , check (not (null depInternalExecutableWithExtraVersion)) $
537 -- PackageBuildWarning $
538 -- "The package has an extraneous version range for a dependency on an "
539 -- ++ "internal executable: "
540 -- ++ commaSep (map prettyShow depInternalExecutableWithExtraVersion)
541 -- ++ ". This version range includes the current package but isn't needed "
542 -- ++ "as the current package's executable will always be used."
544 , check (not (null depInternalExecutableWithImpossibleVersion)) $
545 PackageBuildImpossible $
546 "The package has an impossible version range for a dependency on an "
547 ++ "internal executable: "
548 ++ commaSep (map prettyShow depInternalExecutableWithImpossibleVersion)
549 ++ ". This version range does not include the current package, and must "
550 ++ "be removed as the current package's executable will always be used."
552 , check (not (null depMissingInternalExecutable)) $
553 PackageBuildImpossible $
554 "The package depends on a missing internal executable: "
555 ++ commaSep (map prettyShow depInternalExecutableWithImpossibleVersion)
557 where
558 unknownCompilers = [ name | (OtherCompiler name, _) <- testedWith pkg ]
559 unknownLanguages = [ name | bi <- allBuildInfo pkg
560 , UnknownLanguage name <- allLanguages bi ]
561 unknownExtensions = [ name | bi <- allBuildInfo pkg
562 , UnknownExtension name <- allExtensions bi
563 , name `notElem` map prettyShow knownLanguages ]
564 ourDeprecatedExtensions = nub $ catMaybes
565 [ find ((==ext) . fst) deprecatedExtensions
566 | bi <- allBuildInfo pkg
567 , ext <- allExtensions bi ]
568 languagesUsedAsExtensions =
569 [ name | bi <- allBuildInfo pkg
570 , UnknownExtension name <- allExtensions bi
571 , name `elem` map prettyShow knownLanguages ]
573 testedWithImpossibleRanges =
574 [ Dependency (mkPackageName (prettyShow compiler)) vr mainLibSet
575 | (compiler, vr) <- testedWith pkg
576 , isNoVersion vr ]
578 internalLibraries =
579 map (maybe (packageName pkg) (unqualComponentNameToPackageName) . libraryNameString . libName)
580 (allLibraries pkg)
582 internalExecutables = map exeName $ executables pkg
584 internalLibDeps =
585 [ dep
586 | bi <- allBuildInfo pkg
587 , dep@(Dependency name _ _) <- targetBuildDepends bi
588 , name `elem` internalLibraries
591 internalExeDeps =
592 [ dep
593 | bi <- allBuildInfo pkg
594 , dep <- getAllToolDependencies pkg bi
595 , isInternal pkg dep
598 -- depInternalLibraryWithExtraVersion =
599 -- [ dep
600 -- | dep@(Dependency _ versionRange _) <- internalLibDeps
601 -- , not $ isAnyVersion versionRange
602 -- , packageVersion pkg `withinRange` versionRange
603 -- ]
605 depInternalLibraryWithImpossibleVersion =
606 [ dep
607 | dep@(Dependency _ versionRange _) <- internalLibDeps
608 , not $ packageVersion pkg `withinRange` versionRange
611 -- depInternalExecutableWithExtraVersion =
612 -- [ dep
613 -- | dep@(ExeDependency _ _ versionRange) <- internalExeDeps
614 -- , not $ isAnyVersion versionRange
615 -- , packageVersion pkg `withinRange` versionRange
616 -- ]
618 depInternalExecutableWithImpossibleVersion =
619 [ dep
620 | dep@(ExeDependency _ _ versionRange) <- internalExeDeps
621 , not $ packageVersion pkg `withinRange` versionRange
624 depMissingInternalExecutable =
625 [ dep
626 | dep@(ExeDependency _ eName _) <- internalExeDeps
627 , not $ eName `elem` internalExecutables
631 checkLicense :: PackageDescription -> [PackageCheck]
632 checkLicense pkg = case licenseRaw pkg of
633 Right l -> checkOldLicense pkg l
634 Left l -> checkNewLicense pkg l
636 checkNewLicense :: PackageDescription -> SPDX.License -> [PackageCheck]
637 checkNewLicense _pkg lic = catMaybes
638 [ check (lic == SPDX.NONE) $
639 PackageDistInexcusable
640 "The 'license' field is missing or is NONE."
643 checkOldLicense :: PackageDescription -> License -> [PackageCheck]
644 checkOldLicense pkg lic = catMaybes
645 [ check (lic == UnspecifiedLicense) $
646 PackageDistInexcusable
647 "The 'license' field is missing."
649 , check (lic == AllRightsReserved) $
650 PackageDistSuspicious
651 "The 'license' is AllRightsReserved. Is that really what you want?"
653 , checkVersion CabalSpecV1_4 (lic `notElem` compatLicenses) $
654 PackageDistInexcusable $
655 "Unfortunately the license " ++ quote (prettyShow (license pkg))
656 ++ " messes up the parser in earlier Cabal versions so you need to "
657 ++ "specify 'cabal-version: >= 1.4'. Alternatively if you require "
658 ++ "compatibility with earlier Cabal versions then use 'OtherLicense'."
660 , case lic of
661 UnknownLicense l -> Just $
662 PackageBuildWarning $
663 quote ("license: " ++ l) ++ " is not a recognised license. The "
664 ++ "known licenses are: "
665 ++ commaSep (map prettyShow knownLicenses)
666 _ -> Nothing
668 , check (lic == BSD4) $
669 PackageDistSuspicious $
670 "Using 'license: BSD4' is almost always a misunderstanding. 'BSD4' "
671 ++ "refers to the old 4-clause BSD license with the advertising "
672 ++ "clause. 'BSD3' refers the new 3-clause BSD license."
674 , case unknownLicenseVersion (lic) of
675 Just knownVersions -> Just $
676 PackageDistSuspicious $
677 "'license: " ++ prettyShow (lic) ++ "' is not a known "
678 ++ "version of that license. The known versions are "
679 ++ commaSep (map prettyShow knownVersions)
680 ++ ". If this is not a mistake and you think it should be a known "
681 ++ "version then please file a ticket."
682 _ -> Nothing
684 , check (lic `notElem` [ AllRightsReserved
685 , UnspecifiedLicense, PublicDomain]
686 -- AllRightsReserved and PublicDomain are not strictly
687 -- licenses so don't need license files.
688 && null (licenseFiles pkg)) $
689 PackageDistSuspicious "A 'license-file' is not specified."
691 where
692 unknownLicenseVersion (GPL (Just v))
693 | v `notElem` knownVersions = Just knownVersions
694 where knownVersions = [ v' | GPL (Just v') <- knownLicenses ]
695 unknownLicenseVersion (LGPL (Just v))
696 | v `notElem` knownVersions = Just knownVersions
697 where knownVersions = [ v' | LGPL (Just v') <- knownLicenses ]
698 unknownLicenseVersion (AGPL (Just v))
699 | v `notElem` knownVersions = Just knownVersions
700 where knownVersions = [ v' | AGPL (Just v') <- knownLicenses ]
701 unknownLicenseVersion (Apache (Just v))
702 | v `notElem` knownVersions = Just knownVersions
703 where knownVersions = [ v' | Apache (Just v') <- knownLicenses ]
704 unknownLicenseVersion _ = Nothing
706 checkVersion :: CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
707 checkVersion ver cond pc
708 | specVersion pkg >= ver = Nothing
709 | otherwise = check cond pc
711 compatLicenses = [ GPL Nothing, LGPL Nothing, AGPL Nothing, BSD3, BSD4
712 , PublicDomain, AllRightsReserved
713 , UnspecifiedLicense, OtherLicense ]
715 checkSourceRepos :: PackageDescription -> [PackageCheck]
716 checkSourceRepos pkg =
717 catMaybes $ concat [[
719 case repoKind repo of
720 RepoKindUnknown kind -> Just $ PackageDistInexcusable $
721 quote kind ++ " is not a recognised kind of source-repository. "
722 ++ "The repo kind is usually 'head' or 'this'"
723 _ -> Nothing
725 , check (isNothing (repoType repo)) $
726 PackageDistInexcusable
727 "The source-repository 'type' is a required field."
729 , check (isNothing (repoLocation repo)) $
730 PackageDistInexcusable
731 "The source-repository 'location' is a required field."
733 , check (repoType repo == Just (KnownRepoType CVS) && isNothing (repoModule repo)) $
734 PackageDistInexcusable
735 "For a CVS source-repository, the 'module' is a required field."
737 , check (repoKind repo == RepoThis && isNothing (repoTag repo)) $
738 PackageDistInexcusable $
739 "For the 'this' kind of source-repository, the 'tag' is a required "
740 ++ "field. It should specify the tag corresponding to this version "
741 ++ "or release of the package."
743 , check (maybe False isAbsoluteOnAnyPlatform (repoSubdir repo)) $
744 PackageDistInexcusable
745 "The 'subdir' field of a source-repository must be a relative path."
747 , do
748 subdir <- repoSubdir repo
749 err <- isGoodRelativeDirectoryPath subdir
750 return $ PackageDistInexcusable $
751 "The 'subdir' field of a source-repository is not a good relative path: " ++ show err
753 | repo <- sourceRepos pkg ]
755 --TODO: check location looks like a URL for some repo types.
757 -- | Checks GHC options from all ghc-*-options fields in the given
758 -- PackageDescription and reports commonly misused or non-portable flags
759 checkAllGhcOptions :: PackageDescription -> [PackageCheck]
760 checkAllGhcOptions pkg =
761 checkGhcOptions "ghc-options" (hcOptions GHC) pkg
762 ++ checkGhcOptions "ghc-prof-options" (hcProfOptions GHC) pkg
763 ++ checkGhcOptions "ghc-shared-options" (hcSharedOptions GHC) pkg
765 -- | Extracts GHC options belonging to the given field from the given
766 -- PackageDescription using given function and checks them for commonly misused
767 -- or non-portable flags
768 checkGhcOptions :: String -> (BuildInfo -> [String]) -> PackageDescription -> [PackageCheck]
769 checkGhcOptions fieldName getOptions pkg =
770 catMaybes [
772 checkFlags ["-fasm"] $
773 PackageDistInexcusable $
774 "'" ++ fieldName ++ ": -fasm' is unnecessary and will not work on CPU "
775 ++ "architectures other than x86, x86-64, ppc or sparc."
777 , checkFlags ["-fvia-C"] $
778 PackageDistSuspicious $
779 "'" ++ fieldName ++": -fvia-C' is usually unnecessary. If your package "
780 ++ "needs -via-C for correctness rather than performance then it "
781 ++ "is using the FFI incorrectly and will probably not work with GHC "
782 ++ "6.10 or later."
784 , checkFlags ["-fhpc"] $
785 PackageDistInexcusable $
786 "'" ++ fieldName ++ ": -fhpc' is not necessary. Use the configure flag "
787 ++ " --enable-coverage instead."
789 , checkFlags ["-prof"] $
790 PackageBuildWarning $
791 "'" ++ fieldName ++ ": -prof' is not necessary and will lead to problems "
792 ++ "when used on a library. Use the configure flag "
793 ++ "--enable-library-profiling and/or --enable-profiling."
795 , checkFlags ["-o"] $
796 PackageBuildWarning $
797 "'" ++ fieldName ++ ": -o' is not needed. "
798 ++ "The output files are named automatically."
800 , checkFlags ["-hide-package"] $
801 PackageBuildWarning $
802 "'" ++ fieldName ++ ": -hide-package' is never needed. "
803 ++ "Cabal hides all packages."
805 , checkFlags ["--make"] $
806 PackageBuildWarning $
807 "'" ++ fieldName ++ ": --make' is never needed. Cabal uses this automatically."
809 , checkFlags ["-main-is"] $
810 PackageDistSuspicious $
811 "'" ++ fieldName ++ ": -main-is' is not portable."
813 , checkNonTestAndBenchmarkFlags ["-O0", "-Onot"] $
814 PackageDistSuspicious $
815 "'" ++ fieldName ++ ": -O0' is not needed. "
816 ++ "Use the --disable-optimization configure flag."
818 , checkTestAndBenchmarkFlags ["-O0", "-Onot"] $
819 PackageDistSuspiciousWarn $
820 "'" ++ fieldName ++ ": -O0' is not needed. "
821 ++ "Use the --disable-optimization configure flag."
823 , checkFlags [ "-O", "-O1"] $
824 PackageDistInexcusable $
825 "'" ++ fieldName ++ ": -O' is not needed. "
826 ++ "Cabal automatically adds the '-O' flag. "
827 ++ "Setting it yourself interferes with the --disable-optimization flag."
829 , checkFlags ["-O2"] $
830 PackageDistSuspiciousWarn $
831 "'" ++ fieldName ++ ": -O2' is rarely needed. "
832 ++ "Check that it is giving a real benefit "
833 ++ "and not just imposing longer compile times on your users."
835 , checkFlags ["-split-sections"] $
836 PackageBuildWarning $
837 "'" ++ fieldName ++ ": -split-sections' is not needed. "
838 ++ "Use the --enable-split-sections configure flag."
840 , checkFlags ["-split-objs"] $
841 PackageBuildWarning $
842 "'" ++ fieldName ++ ": -split-objs' is not needed. "
843 ++ "Use the --enable-split-objs configure flag."
845 , checkFlags ["-optl-Wl,-s", "-optl-s"] $
846 PackageDistInexcusable $
847 "'" ++ fieldName ++ ": -optl-Wl,-s' is not needed and is not portable to all"
848 ++ " operating systems. Cabal 1.4 and later automatically strip"
849 ++ " executables. Cabal also has a flag --disable-executable-stripping"
850 ++ " which is necessary when building packages for some Linux"
851 ++ " distributions and using '-optl-Wl,-s' prevents that from working."
853 , checkFlags ["-fglasgow-exts"] $
854 PackageDistSuspicious $
855 "Instead of '" ++ fieldName ++ ": -fglasgow-exts' it is preferable to use "
856 ++ "the 'extensions' field."
858 , check ("-threaded" `elem` lib_ghc_options) $
859 PackageBuildWarning $
860 "'" ++ fieldName ++ ": -threaded' has no effect for libraries. It should "
861 ++ "only be used for executables."
863 , check ("-rtsopts" `elem` lib_ghc_options) $
864 PackageBuildWarning $
865 "'" ++ fieldName ++ ": -rtsopts' has no effect for libraries. It should "
866 ++ "only be used for executables."
868 , check (any (\opt -> "-with-rtsopts" `isPrefixOf` opt) lib_ghc_options) $
869 PackageBuildWarning $
870 "'" ++ fieldName ++ ": -with-rtsopts' has no effect for libraries. It "
871 ++ "should only be used for executables."
873 , checkAlternatives fieldName "extensions"
874 [ (flag, prettyShow extension) | flag <- ghc_options_no_rtsopts
875 , Just extension <- [ghcExtension flag] ]
877 , checkAlternatives fieldName "extensions"
878 [ (flag, extension) | flag@('-':'X':extension) <- ghc_options_no_rtsopts ]
880 , checkAlternatives fieldName "cpp-options" $
881 [ (flag, flag) | flag@('-':'D':_) <- ghc_options_no_rtsopts ]
882 ++ [ (flag, flag) | flag@('-':'U':_) <- ghc_options_no_rtsopts ]
884 , checkAlternatives fieldName "include-dirs"
885 [ (flag, dir) | flag@('-':'I':dir) <- ghc_options_no_rtsopts ]
887 , checkAlternatives fieldName "extra-libraries"
888 [ (flag, lib) | flag@('-':'l':lib) <- ghc_options_no_rtsopts ]
890 , checkAlternatives fieldName "extra-libraries-static"
891 [ (flag, lib) | flag@('-':'l':lib) <- ghc_options_no_rtsopts ]
893 , checkAlternatives fieldName "extra-lib-dirs"
894 [ (flag, dir) | flag@('-':'L':dir) <- ghc_options_no_rtsopts ]
896 , checkAlternatives fieldName "extra-lib-dirs-static"
897 [ (flag, dir) | flag@('-':'L':dir) <- ghc_options_no_rtsopts ]
899 , checkAlternatives fieldName "frameworks"
900 [ (flag, fmwk) | (flag@"-framework", fmwk) <-
901 zip ghc_options_no_rtsopts (safeTail ghc_options_no_rtsopts) ]
903 , checkAlternatives fieldName "extra-framework-dirs"
904 [ (flag, dir) | (flag@"-framework-path", dir) <-
905 zip ghc_options_no_rtsopts (safeTail ghc_options_no_rtsopts) ]
908 where
909 all_ghc_options = concatMap getOptions (allBuildInfo pkg)
910 ghc_options_no_rtsopts = rmRtsOpts all_ghc_options
911 lib_ghc_options = concatMap (getOptions . libBuildInfo)
912 (allLibraries pkg)
913 test_ghc_options = concatMap (getOptions . testBuildInfo)
914 (testSuites pkg)
915 benchmark_ghc_options = concatMap (getOptions . benchmarkBuildInfo)
916 (benchmarks pkg)
917 test_and_benchmark_ghc_options = test_ghc_options ++
918 benchmark_ghc_options
919 non_test_and_benchmark_ghc_options = concatMap getOptions
920 (allBuildInfo (pkg { testSuites = []
921 , benchmarks = []
924 checkFlags :: [String] -> PackageCheck -> Maybe PackageCheck
925 checkFlags flags = check (any (`elem` flags) all_ghc_options)
927 checkTestAndBenchmarkFlags :: [String] -> PackageCheck -> Maybe PackageCheck
928 checkTestAndBenchmarkFlags flags = check (any (`elem` flags) test_and_benchmark_ghc_options)
930 checkNonTestAndBenchmarkFlags :: [String] -> PackageCheck -> Maybe PackageCheck
931 checkNonTestAndBenchmarkFlags flags = check (any (`elem` flags) non_test_and_benchmark_ghc_options)
933 ghcExtension ('-':'f':name) = case name of
934 "allow-overlapping-instances" -> enable OverlappingInstances
935 "no-allow-overlapping-instances" -> disable OverlappingInstances
936 "th" -> enable TemplateHaskell
937 "no-th" -> disable TemplateHaskell
938 "ffi" -> enable ForeignFunctionInterface
939 "no-ffi" -> disable ForeignFunctionInterface
940 "fi" -> enable ForeignFunctionInterface
941 "no-fi" -> disable ForeignFunctionInterface
942 "monomorphism-restriction" -> enable MonomorphismRestriction
943 "no-monomorphism-restriction" -> disable MonomorphismRestriction
944 "mono-pat-binds" -> enable MonoPatBinds
945 "no-mono-pat-binds" -> disable MonoPatBinds
946 "allow-undecidable-instances" -> enable UndecidableInstances
947 "no-allow-undecidable-instances" -> disable UndecidableInstances
948 "allow-incoherent-instances" -> enable IncoherentInstances
949 "no-allow-incoherent-instances" -> disable IncoherentInstances
950 "arrows" -> enable Arrows
951 "no-arrows" -> disable Arrows
952 "generics" -> enable Generics
953 "no-generics" -> disable Generics
954 "implicit-prelude" -> enable ImplicitPrelude
955 "no-implicit-prelude" -> disable ImplicitPrelude
956 "implicit-params" -> enable ImplicitParams
957 "no-implicit-params" -> disable ImplicitParams
958 "bang-patterns" -> enable BangPatterns
959 "no-bang-patterns" -> disable BangPatterns
960 "scoped-type-variables" -> enable ScopedTypeVariables
961 "no-scoped-type-variables" -> disable ScopedTypeVariables
962 "extended-default-rules" -> enable ExtendedDefaultRules
963 "no-extended-default-rules" -> disable ExtendedDefaultRules
964 _ -> Nothing
965 ghcExtension "-cpp" = enable CPP
966 ghcExtension _ = Nothing
968 enable e = Just (EnableExtension e)
969 disable e = Just (DisableExtension e)
971 rmRtsOpts :: [String] -> [String]
972 rmRtsOpts ("-with-rtsopts":_:xs) = rmRtsOpts xs
973 rmRtsOpts (x:xs) = x : rmRtsOpts xs
974 rmRtsOpts [] = []
976 checkCCOptions :: PackageDescription -> [PackageCheck]
977 checkCCOptions = checkCLikeOptions "C" "cc-options" ccOptions
979 checkCxxOptions :: PackageDescription -> [PackageCheck]
980 checkCxxOptions = checkCLikeOptions "C++" "cxx-options" cxxOptions
982 checkCLikeOptions :: String -> String -> (BuildInfo -> [String]) -> PackageDescription -> [PackageCheck]
983 checkCLikeOptions label prefix accessor pkg =
984 catMaybes [
986 checkAlternatives prefix "include-dirs"
987 [ (flag, dir) | flag@('-':'I':dir) <- all_cLikeOptions ]
989 , checkAlternatives prefix "extra-libraries"
990 [ (flag, lib) | flag@('-':'l':lib) <- all_cLikeOptions ]
992 , checkAlternatives prefix "extra-lib-dirs"
993 [ (flag, dir) | flag@('-':'L':dir) <- all_cLikeOptions ]
995 , checkAlternatives "ld-options" "extra-libraries"
996 [ (flag, lib) | flag@('-':'l':lib) <- all_ldOptions ]
998 , checkAlternatives "ld-options" "extra-lib-dirs"
999 [ (flag, dir) | flag@('-':'L':dir) <- all_ldOptions ]
1001 , checkCCFlags [ "-O", "-Os", "-O0", "-O1", "-O2", "-O3" ] $
1002 PackageDistSuspicious $
1003 "'"++prefix++": -O[n]' is generally not needed. When building with "
1004 ++ " optimisations Cabal automatically adds '-O2' for "++label++" code. "
1005 ++ "Setting it yourself interferes with the --disable-optimization flag."
1008 where all_cLikeOptions = [ opts | bi <- allBuildInfo pkg
1009 , opts <- accessor bi ]
1010 all_ldOptions = [ opts | bi <- allBuildInfo pkg
1011 , opts <- ldOptions bi ]
1013 checkCCFlags :: [String] -> PackageCheck -> Maybe PackageCheck
1014 checkCCFlags flags = check (any (`elem` flags) all_cLikeOptions)
1016 checkCPPOptions :: PackageDescription -> [PackageCheck]
1017 checkCPPOptions pkg = catMaybes
1018 [ checkAlternatives "cpp-options" "include-dirs"
1019 [ (flag, dir) | flag@('-':'I':dir) <- all_cppOptions ]
1022 [ PackageBuildWarning $ "'cpp-options: " ++ opt ++ "' is not a portable C-preprocessor flag."
1023 | opt <- all_cppOptions
1024 -- "-I" is handled above, we allow only -DNEWSTUFF and -UOLDSTUFF
1025 , not $ any (`isPrefixOf` opt) ["-D", "-U", "-I" ]
1027 where
1028 all_cppOptions = [ opts | bi <- allBuildInfo pkg, opts <- cppOptions bi ]
1030 checkAlternatives :: String -> String -> [(String, String)]
1031 -> Maybe PackageCheck
1032 checkAlternatives badField goodField flags =
1033 check (not (null badFlags)) $
1034 PackageBuildWarning $
1035 "Instead of " ++ quote (badField ++ ": " ++ unwords badFlags)
1036 ++ " use " ++ quote (goodField ++ ": " ++ unwords goodFlags)
1038 where (badFlags, goodFlags) = unzip flags
1040 data PathKind
1041 = PathKindFile
1042 | PathKindDirectory
1043 | PathKindGlob
1044 deriving (Eq)
1046 checkPaths :: PackageDescription -> [PackageCheck]
1047 checkPaths pkg =
1048 checkPackageFileNamesWithGlob
1049 [ (kind == PathKindGlob, path)
1050 | (path, _, kind) <- relPaths ++ absPaths
1053 [ PackageBuildWarning $
1054 quote (field ++ ": " ++ path)
1055 ++ " is a relative path outside of the source tree. "
1056 ++ "This will not work when generating a tarball with 'sdist'."
1057 | (path, field, _) <- relPaths ++ absPaths
1058 , isOutsideTree path ]
1060 [ PackageDistInexcusable $
1061 quote (field ++ ": " ++ path) ++ " specifies an absolute path, but the "
1062 ++ quote field ++ " field must use relative paths."
1063 | (path, field, _) <- relPaths
1064 , isAbsoluteOnAnyPlatform path ]
1066 [ PackageDistInexcusable $
1067 quote (field ++ ": " ++ path) ++ " is not a good relative path: " ++ show err
1068 | (path, field, kind) <- relPaths
1069 -- these are not paths, but globs...
1070 , err <- maybeToList $ case kind of
1071 PathKindFile -> isGoodRelativeFilePath path
1072 PathKindGlob -> isGoodRelativeGlob path
1073 PathKindDirectory -> isGoodRelativeDirectoryPath path
1076 [ PackageDistInexcusable $
1077 quote (field ++ ": " ++ path) ++ " points inside the 'dist' "
1078 ++ "directory. This is not reliable because the location of this "
1079 ++ "directory is configurable by the user (or package manager). In "
1080 ++ "addition the layout of the 'dist' directory is subject to change "
1081 ++ "in future versions of Cabal."
1082 | (path, field, _) <- relPaths ++ absPaths
1083 , isInsideDist path ]
1085 [ PackageDistInexcusable $
1086 "The 'ghc-options' contain the path '" ++ path ++ "' which points "
1087 ++ "inside the 'dist' directory. This is not reliable because the "
1088 ++ "location of this directory is configurable by the user (or package "
1089 ++ "manager). In addition the layout of the 'dist' directory is subject "
1090 ++ "to change in future versions of Cabal."
1091 | bi <- allBuildInfo pkg
1092 , (GHC, flags) <- perCompilerFlavorToList $ options bi
1093 , path <- flags
1094 , isInsideDist path ]
1096 [ PackageDistInexcusable $
1097 "In the 'data-files' field: " ++ explainGlobSyntaxError pat err
1098 | pat <- dataFiles pkg
1099 , Left err <- [parseFileGlob (specVersion pkg) pat]
1102 [ PackageDistInexcusable $
1103 "In the 'extra-source-files' field: " ++ explainGlobSyntaxError pat err
1104 | pat <- extraSrcFiles pkg
1105 , Left err <- [parseFileGlob (specVersion pkg) pat]
1108 [ PackageDistInexcusable $
1109 "In the 'extra-doc-files' field: " ++ explainGlobSyntaxError pat err
1110 | pat <- extraDocFiles pkg
1111 , Left err <- [parseFileGlob (specVersion pkg) pat]
1113 where
1114 isOutsideTree path = case splitDirectories path of
1115 "..":_ -> True
1116 ".":"..":_ -> True
1117 _ -> False
1118 isInsideDist path = case map lowercase (splitDirectories path) of
1119 "dist" :_ -> True
1120 ".":"dist":_ -> True
1121 _ -> False
1123 -- paths that must be relative
1124 relPaths :: [(FilePath, String, PathKind)]
1125 relPaths =
1126 [ (path, "extra-source-files", PathKindGlob) | path <- extraSrcFiles pkg ] ++
1127 [ (path, "extra-tmp-files", PathKindFile) | path <- extraTmpFiles pkg ] ++
1128 [ (path, "extra-doc-files", PathKindGlob) | path <- extraDocFiles pkg ] ++
1129 [ (path, "data-files", PathKindGlob) | path <- dataFiles pkg ] ++
1130 [ (path, "data-dir", PathKindDirectory) | path <- [dataDir pkg]] ++
1131 [ (path, "license-file", PathKindFile) | path <- map getSymbolicPath $ licenseFiles pkg ] ++
1132 concat
1133 [ [ (path, "asm-sources", PathKindFile) | path <- asmSources bi ] ++
1134 [ (path, "cmm-sources", PathKindFile) | path <- cmmSources bi ] ++
1135 [ (path, "c-sources", PathKindFile) | path <- cSources bi ] ++
1136 [ (path, "cxx-sources", PathKindFile) | path <- cxxSources bi ] ++
1137 [ (path, "js-sources", PathKindFile) | path <- jsSources bi ] ++
1138 [ (path, "install-includes", PathKindFile) | path <- installIncludes bi ] ++
1139 [ (path, "hs-source-dirs", PathKindDirectory) | path <- map getSymbolicPath $ hsSourceDirs bi ]
1140 | bi <- allBuildInfo pkg
1143 -- paths that are allowed to be absolute
1144 absPaths :: [(FilePath, String, PathKind)]
1145 absPaths = concat
1146 [ [ (path, "includes", PathKindFile) | path <- includes bi ] ++
1147 [ (path, "include-dirs", PathKindDirectory) | path <- includeDirs bi ] ++
1148 [ (path, "extra-lib-dirs", PathKindDirectory) | path <- extraLibDirs bi ] ++
1149 [ (path, "extra-lib-dirs-static", PathKindDirectory) | path <- extraLibDirsStatic bi ]
1150 | bi <- allBuildInfo pkg
1153 --TODO: check sets of paths that would be interpreted differently between Unix
1154 -- and windows, ie case-sensitive or insensitive. Things that might clash, or
1155 -- conversely be distinguished.
1157 --TODO: use the tar path checks on all the above paths
1159 -- | Check that the package declares the version in the @\"cabal-version\"@
1160 -- field correctly.
1162 checkCabalVersion :: PackageDescription -> [PackageCheck]
1163 checkCabalVersion pkg =
1164 catMaybes [
1166 -- check use of test suite sections
1167 checkVersion CabalSpecV1_8 (not (null $ testSuites pkg)) $
1168 PackageDistInexcusable $
1169 "The 'test-suite' section is new in Cabal 1.10. "
1170 ++ "Unfortunately it messes up the parser in older Cabal versions "
1171 ++ "so you must specify at least 'cabal-version: >= 1.8', but note "
1172 ++ "that only Cabal 1.10 and later can actually run such test suites."
1174 -- check use of default-language field
1175 -- note that we do not need to do an equivalent check for the
1176 -- other-language field since that one does not change behaviour
1177 , checkVersion CabalSpecV1_10 (any isJust (buildInfoField defaultLanguage)) $
1178 PackageBuildWarning $
1179 "To use the 'default-language' field the package needs to specify "
1180 ++ "at least 'cabal-version: >= 1.10'."
1182 , check (specVersion pkg >= CabalSpecV1_10 && specVersion pkg < CabalSpecV3_4
1183 && (any isNothing (buildInfoField defaultLanguage))) $
1184 PackageBuildWarning $
1185 "Packages using 'cabal-version: >= 1.10' and before 'cabal-version: 3.4' must specify the "
1186 ++ "'default-language' field for each component (e.g. Haskell98 or "
1187 ++ "Haskell2010). If a component uses different languages in "
1188 ++ "different modules then list the other ones in the "
1189 ++ "'other-languages' field."
1191 , checkVersion CabalSpecV1_18
1192 (not . null $ extraDocFiles pkg) $
1193 PackageDistInexcusable $
1194 "To use the 'extra-doc-files' field the package needs to specify "
1195 ++ "'cabal-version: 1.18' or higher."
1197 , checkVersion CabalSpecV2_0
1198 (not (null (subLibraries pkg))) $
1199 PackageDistInexcusable $
1200 "To use multiple 'library' sections or a named library section "
1201 ++ "the package needs to specify at least 'cabal-version: 2.0'."
1203 -- check use of reexported-modules sections
1204 , checkVersion CabalSpecV1_22
1205 (any (not.null.reexportedModules) (allLibraries pkg)) $
1206 PackageDistInexcusable $
1207 "To use the 'reexported-module' field the package needs to specify "
1208 ++ "'cabal-version: 1.22' or higher."
1210 -- check use of thinning and renaming
1211 , checkVersion CabalSpecV2_0 usesBackpackIncludes $
1212 PackageDistInexcusable $
1213 "To use the 'mixins' field the package needs to specify "
1214 ++ "at least 'cabal-version: 2.0'."
1216 -- check use of 'extra-framework-dirs' field
1217 , checkVersion CabalSpecV1_24 (any (not . null) (buildInfoField extraFrameworkDirs)) $
1218 -- Just a warning, because this won't break on old Cabal versions.
1219 PackageDistSuspiciousWarn $
1220 "To use the 'extra-framework-dirs' field the package needs to specify"
1221 ++ " 'cabal-version: 1.24' or higher."
1223 -- check use of default-extensions field
1224 -- don't need to do the equivalent check for other-extensions
1225 , checkVersion CabalSpecV1_10 (any (not . null) (buildInfoField defaultExtensions)) $
1226 PackageBuildWarning $
1227 "To use the 'default-extensions' field the package needs to specify "
1228 ++ "at least 'cabal-version: >= 1.10'."
1230 -- check use of extensions field
1231 , check (specVersion pkg >= CabalSpecV1_10
1232 && (any (not . null) (buildInfoField oldExtensions))) $
1233 PackageBuildWarning $
1234 "For packages using 'cabal-version: >= 1.10' the 'extensions' "
1235 ++ "field is deprecated. The new 'default-extensions' field lists "
1236 ++ "extensions that are used in all modules in the component, while "
1237 ++ "the 'other-extensions' field lists extensions that are used in "
1238 ++ "some modules, e.g. via the {-# LANGUAGE #-} pragma."
1240 , checkVersion CabalSpecV3_0 (any (not . null)
1241 (concatMap buildInfoField
1242 [ asmSources
1243 , cmmSources
1244 , extraBundledLibs
1245 , extraLibFlavours ])) $
1246 PackageDistInexcusable $
1247 "The use of 'asm-sources', 'cmm-sources', 'extra-bundled-libraries' "
1248 ++ " and 'extra-library-flavours' requires the package "
1249 ++ " to specify at least 'cabal-version: 3.0'."
1251 , checkVersion CabalSpecV3_0 (any (not . null) $ buildInfoField extraDynLibFlavours) $
1252 PackageDistInexcusable $
1253 "The use of 'extra-dynamic-library-flavours' requires the package "
1254 ++ " to specify at least 'cabal-version: 3.0'. The flavours are: "
1255 ++ commaSep [ flav
1256 | flavs <- buildInfoField extraDynLibFlavours
1257 , flav <- flavs ]
1259 , checkVersion CabalSpecV2_2 (any (not . null)
1260 (buildInfoField virtualModules)) $
1261 PackageDistInexcusable $
1262 "The use of 'virtual-modules' requires the package "
1263 ++ " to specify at least 'cabal-version: 2.2'."
1265 -- check use of "source-repository" section
1266 , checkVersion CabalSpecV1_6 (not (null (sourceRepos pkg))) $
1267 PackageDistInexcusable $
1268 "The 'source-repository' section is new in Cabal 1.6. "
1269 ++ "Unfortunately it messes up the parser in earlier Cabal versions "
1270 ++ "so you need to specify 'cabal-version: >= 1.6'."
1272 -- check for new language extensions
1273 , checkVersion CabalSpecV1_2 (not (null mentionedExtensionsThatNeedCabal12)) $
1274 PackageDistInexcusable $
1275 "Unfortunately the language extensions "
1276 ++ commaSep (map (quote . prettyShow) mentionedExtensionsThatNeedCabal12)
1277 ++ " break the parser in earlier Cabal versions so you need to "
1278 ++ "specify 'cabal-version: >= 1.2'. Alternatively if you require "
1279 ++ "compatibility with earlier Cabal versions then you may be able to "
1280 ++ "use an equivalent compiler-specific flag."
1282 , checkVersion CabalSpecV1_4 (not (null mentionedExtensionsThatNeedCabal14)) $
1283 PackageDistInexcusable $
1284 "Unfortunately the language extensions "
1285 ++ commaSep (map (quote . prettyShow) mentionedExtensionsThatNeedCabal14)
1286 ++ " break the parser in earlier Cabal versions so you need to "
1287 ++ "specify 'cabal-version: >= 1.4'. Alternatively if you require "
1288 ++ "compatibility with earlier Cabal versions then you may be able to "
1289 ++ "use an equivalent compiler-specific flag."
1291 , check (specVersion pkg >= CabalSpecV1_24
1292 && isNothing (setupBuildInfo pkg)
1293 && buildType pkg == Custom) $
1294 PackageBuildWarning $
1295 "Packages using 'cabal-version: 1.24' or higher with 'build-type: Custom' "
1296 ++ "must use a 'custom-setup' section with a 'setup-depends' field "
1297 ++ "that specifies the dependencies of the Setup.hs script itself. "
1298 ++ "The 'setup-depends' field uses the same syntax as 'build-depends', "
1299 ++ "so a simple example would be 'setup-depends: base, Cabal'."
1301 , check (specVersion pkg < CabalSpecV1_24
1302 && isNothing (setupBuildInfo pkg)
1303 && buildType pkg == Custom) $
1304 PackageDistSuspiciousWarn $
1305 "From version 1.24 cabal supports specifying explicit dependencies "
1306 ++ "for Custom setup scripts. Consider using 'cabal-version: 1.24' or higher "
1307 ++ "and adding a 'custom-setup' section with a 'setup-depends' field "
1308 ++ "that specifies the dependencies of the Setup.hs script itself. "
1309 ++ "The 'setup-depends' field uses the same syntax as 'build-depends', "
1310 ++ "so a simple example would be 'setup-depends: base, Cabal'."
1312 , check (specVersion pkg >= CabalSpecV2_0
1313 && elem (autogenPathsModuleName pkg) allModuleNames
1314 && not (elem (autogenPathsModuleName pkg) allModuleNamesAutogen) ) $
1315 PackageDistInexcusable $
1316 "Packages using 'cabal-version: 2.0' and the autogenerated "
1317 ++ "module Paths_* must include it also on the 'autogen-modules' field "
1318 ++ "besides 'exposed-modules' and 'other-modules'. This specifies that "
1319 ++ "the module does not come with the package and is generated on "
1320 ++ "setup. Modules built with a custom Setup.hs script also go here "
1321 ++ "to ensure that commands like sdist don't fail."
1324 where
1325 -- Perform a check on packages that use a version of the spec less than
1326 -- the version given. This is for cases where a new Cabal version adds
1327 -- a new feature and we want to check that it is not used prior to that
1328 -- version.
1329 checkVersion :: CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
1330 checkVersion ver cond pc
1331 | specVersion pkg >= ver = Nothing
1332 | otherwise = check cond pc
1334 buildInfoField field = map field (allBuildInfo pkg)
1336 usesBackpackIncludes = any (not . null . mixins) (allBuildInfo pkg)
1338 mentionedExtensions = [ ext | bi <- allBuildInfo pkg
1339 , ext <- allExtensions bi ]
1340 mentionedExtensionsThatNeedCabal12 =
1341 nub (filter (`elem` compatExtensionsExtra) mentionedExtensions)
1343 -- As of Cabal-1.4 we can add new extensions without worrying about
1344 -- breaking old versions of cabal.
1345 mentionedExtensionsThatNeedCabal14 =
1346 nub (filter (`notElem` compatExtensions) mentionedExtensions)
1348 -- The known extensions in Cabal-1.2.3
1349 compatExtensions =
1350 map EnableExtension
1351 [ OverlappingInstances, UndecidableInstances, IncoherentInstances
1352 , RecursiveDo, ParallelListComp, MultiParamTypeClasses
1353 , FunctionalDependencies, Rank2Types
1354 , RankNTypes, PolymorphicComponents, ExistentialQuantification
1355 , ScopedTypeVariables, ImplicitParams, FlexibleContexts
1356 , FlexibleInstances, EmptyDataDecls, CPP, BangPatterns
1357 , TypeSynonymInstances, TemplateHaskell, ForeignFunctionInterface
1358 , Arrows, Generics, NamedFieldPuns, PatternGuards
1359 , GeneralizedNewtypeDeriving, ExtensibleRecords, RestrictedTypeSynonyms
1360 , HereDocuments] ++
1361 map DisableExtension
1362 [MonomorphismRestriction, ImplicitPrelude] ++
1363 compatExtensionsExtra
1365 -- The extra known extensions in Cabal-1.2.3 vs Cabal-1.1.6
1366 -- (Cabal-1.1.6 came with ghc-6.6. Cabal-1.2 came with ghc-6.8)
1367 compatExtensionsExtra =
1368 map EnableExtension
1369 [ KindSignatures, MagicHash, TypeFamilies, StandaloneDeriving
1370 , UnicodeSyntax, PatternSignatures, UnliftedFFITypes, LiberalTypeSynonyms
1371 , TypeOperators, RecordWildCards, RecordPuns, DisambiguateRecordFields
1372 , OverloadedStrings, GADTs, RelaxedPolyRec
1373 , ExtendedDefaultRules, UnboxedTuples, DeriveDataTypeable
1374 , ConstrainedClassMethods
1375 ] ++
1376 map DisableExtension
1377 [MonoPatBinds]
1379 allModuleNames =
1380 (case library pkg of
1381 Nothing -> []
1382 (Just lib) -> explicitLibModules lib
1384 ++ concatMap otherModules (allBuildInfo pkg)
1386 allModuleNamesAutogen = concatMap autogenModules (allBuildInfo pkg)
1388 -- ------------------------------------------------------------
1389 -- * Checks on the GenericPackageDescription
1390 -- ------------------------------------------------------------
1392 -- | Check the build-depends fields for any weirdness or bad practice.
1394 checkPackageVersions :: GenericPackageDescription -> [PackageCheck]
1395 checkPackageVersions pkg =
1396 catMaybes [
1398 -- Check that the version of base is bounded above.
1399 -- For example this bans "build-depends: base >= 3".
1400 -- It should probably be "build-depends: base >= 3 && < 4"
1401 -- which is the same as "build-depends: base == 3.*"
1402 check (not (hasUpperBound baseDependency)) $
1403 PackageDistInexcusable $
1404 "The dependency 'build-depends: base' does not specify an upper "
1405 ++ "bound on the version number. Each major release of the 'base' "
1406 ++ "package changes the API in various ways and most packages will "
1407 ++ "need some changes to compile with it. The recommended practice "
1408 ++ "is to specify an upper bound on the version of the 'base' "
1409 ++ "package. This ensures your package will continue to build when a "
1410 ++ "new major version of the 'base' package is released. If you are "
1411 ++ "not sure what upper bound to use then use the next major "
1412 ++ "version. For example if you have tested your package with 'base' "
1413 ++ "version 4.5 and 4.6 then use 'build-depends: base >= 4.5 && < 4.7'."
1416 where
1417 baseDependency = case typicalPkg pkg of
1418 Right (pkg', _) | not (null baseDeps) ->
1419 foldr intersectVersionRanges anyVersion baseDeps
1420 where
1421 baseDeps =
1422 [ vr | Dependency pname vr _ <- allBuildDepends pkg'
1423 , pname == mkPackageName "base" ]
1425 -- Just in case finalizePD fails for any reason,
1426 -- or if the package doesn't depend on the base package at all,
1427 -- then we will just skip the check, since hasUpperBound noVersion = True
1428 _ -> noVersion
1430 checkConditionals :: GenericPackageDescription -> [PackageCheck]
1431 checkConditionals pkg =
1432 catMaybes [
1434 check (not $ null unknownOSs) $
1435 PackageDistInexcusable $
1436 "Unknown operating system name "
1437 ++ commaSep (map quote unknownOSs)
1439 , check (not $ null unknownArches) $
1440 PackageDistInexcusable $
1441 "Unknown architecture name "
1442 ++ commaSep (map quote unknownArches)
1444 , check (not $ null unknownImpls) $
1445 PackageDistInexcusable $
1446 "Unknown compiler name "
1447 ++ commaSep (map quote unknownImpls)
1449 where
1450 unknownOSs = [ os | OS (OtherOS os) <- conditions ]
1451 unknownArches = [ arch | Arch (OtherArch arch) <- conditions ]
1452 unknownImpls = [ impl | Impl (OtherCompiler impl) _ <- conditions ]
1453 conditions = concatMap fvs (maybeToList (condLibrary pkg))
1454 ++ concatMap (fvs . snd) (condSubLibraries pkg)
1455 ++ concatMap (fvs . snd) (condForeignLibs pkg)
1456 ++ concatMap (fvs . snd) (condExecutables pkg)
1457 ++ concatMap (fvs . snd) (condTestSuites pkg)
1458 ++ concatMap (fvs . snd) (condBenchmarks pkg)
1459 fvs (CondNode _ _ ifs) = concatMap compfv ifs -- free variables
1460 compfv (CondBranch c ct mct) = condfv c ++ fvs ct ++ maybe [] fvs mct
1461 condfv c = case c of
1462 Var v -> [v]
1463 Lit _ -> []
1464 CNot c1 -> condfv c1
1465 COr c1 c2 -> condfv c1 ++ condfv c2
1466 CAnd c1 c2 -> condfv c1 ++ condfv c2
1468 checkFlagNames :: GenericPackageDescription -> [PackageCheck]
1469 checkFlagNames gpd
1470 | null invalidFlagNames = []
1471 | otherwise = [ PackageDistInexcusable
1472 $ "Suspicious flag names: " ++ unwords invalidFlagNames ++ ". "
1473 ++ "To avoid ambiguity in command line interfaces, flag shouldn't "
1474 ++ "start with a dash. Also for better compatibility, flag names "
1475 ++ "shouldn't contain non-ascii characters."
1477 where
1478 invalidFlagNames =
1479 [ fn
1480 | flag <- genPackageFlags gpd
1481 , let fn = unFlagName (flagName flag)
1482 , invalidFlagName fn
1484 -- starts with dash
1485 invalidFlagName ('-':_) = True
1486 -- mon ascii letter
1487 invalidFlagName cs = any (not . isAscii) cs
1489 checkUnusedFlags :: GenericPackageDescription -> [PackageCheck]
1490 checkUnusedFlags gpd
1491 | declared == used = []
1492 | otherwise = [ PackageDistSuspicious
1493 $ "Declared and used flag sets differ: "
1494 ++ s declared ++ " /= " ++ s used ++ ". "
1496 where
1497 s :: Set.Set FlagName -> String
1498 s = commaSep . map unFlagName . Set.toList
1500 declared :: Set.Set FlagName
1501 declared = toSetOf (L.genPackageFlags . traverse . L.flagName) gpd
1503 used :: Set.Set FlagName
1504 used = mconcat
1505 [ toSetOf (L.condLibrary . traverse . traverseCondTreeV . L._PackageFlag) gpd
1506 , toSetOf (L.condSubLibraries . traverse . _2 . traverseCondTreeV . L._PackageFlag) gpd
1507 , toSetOf (L.condForeignLibs . traverse . _2 . traverseCondTreeV . L._PackageFlag) gpd
1508 , toSetOf (L.condExecutables . traverse . _2 . traverseCondTreeV . L._PackageFlag) gpd
1509 , toSetOf (L.condTestSuites . traverse . _2 . traverseCondTreeV . L._PackageFlag) gpd
1510 , toSetOf (L.condBenchmarks . traverse . _2 . traverseCondTreeV . L._PackageFlag) gpd
1513 checkUnicodeXFields :: GenericPackageDescription -> [PackageCheck]
1514 checkUnicodeXFields gpd
1515 | null nonAsciiXFields = []
1516 | otherwise = [ PackageDistInexcusable
1517 $ "Non ascii custom fields: " ++ unwords nonAsciiXFields ++ ". "
1518 ++ "For better compatibility, custom field names "
1519 ++ "shouldn't contain non-ascii characters."
1521 where
1522 nonAsciiXFields :: [String]
1523 nonAsciiXFields = [ n | (n, _) <- xfields, any (not . isAscii) n ]
1525 xfields :: [(String,String)]
1526 xfields = DList.runDList $ mconcat
1527 [ toDListOf (L.packageDescription . L.customFieldsPD . traverse) gpd
1528 , toDListOf (L.traverseBuildInfos . L.customFieldsBI . traverse) gpd
1531 -- | cabal-version <2.2 + Paths_module + default-extensions: doesn't build.
1532 checkPathsModuleExtensions :: PackageDescription -> [PackageCheck]
1533 checkPathsModuleExtensions pd
1534 | specVersion pd >= CabalSpecV2_2 = []
1535 | any checkBI (allBuildInfo pd) || any checkLib (allLibraries pd)
1536 = return $ PackageBuildImpossible $ unwords
1537 [ "Packages using RebindableSyntax with OverloadedStrings or"
1538 , "OverloadedLists in default-extensions, in conjunction with the"
1539 , "autogenerated module Paths_*, are known to cause compile failures"
1540 , "with Cabal < 2.2. To use these default-extensions with a Paths_*"
1541 , "autogen module, specify at least 'cabal-version: 2.2'."
1543 | otherwise = []
1544 where
1545 mn = autogenPathsModuleName pd
1547 checkLib :: Library -> Bool
1548 checkLib l = mn `elem` exposedModules l && checkExts (l ^. L.defaultExtensions)
1550 checkBI :: BuildInfo -> Bool
1551 checkBI bi =
1552 (mn `elem` otherModules bi || mn `elem` autogenModules bi) &&
1553 checkExts (bi ^. L.defaultExtensions)
1555 checkExts exts = rebind `elem` exts && (strings `elem` exts || lists `elem` exts)
1556 where
1557 rebind = EnableExtension RebindableSyntax
1558 strings = EnableExtension OverloadedStrings
1559 lists = EnableExtension OverloadedLists
1561 -- | Checks GHC options from all ghc-*-options fields from the given BuildInfo
1562 -- and reports flags that are OK during development process, but are
1563 -- unacceptable in a distributed package
1564 checkDevelopmentOnlyFlagsBuildInfo :: BuildInfo -> [PackageCheck]
1565 checkDevelopmentOnlyFlagsBuildInfo bi =
1566 checkDevelopmentOnlyFlagsOptions "ghc-options" (hcOptions GHC bi)
1567 ++ checkDevelopmentOnlyFlagsOptions "ghc-prof-options" (hcProfOptions GHC bi)
1568 ++ checkDevelopmentOnlyFlagsOptions "ghc-shared-options" (hcSharedOptions GHC bi)
1570 -- | Checks the given list of flags belonging to the given field and reports
1571 -- flags that are OK during development process, but are unacceptable in a
1572 -- distributed package
1573 checkDevelopmentOnlyFlagsOptions :: String -> [String] -> [PackageCheck]
1574 checkDevelopmentOnlyFlagsOptions fieldName ghcOptions =
1575 catMaybes [
1577 check (has_Werror) $
1578 PackageDistInexcusable $
1579 "'" ++ fieldName ++ ": -Werror' makes the package easy to "
1580 ++ "break with future GHC versions because new GHC versions often "
1581 ++ "add new warnings."
1582 ++ extraExplanation
1584 , check (has_J) $
1585 PackageDistInexcusable $
1586 "'" ++ fieldName ++ ": -j[N]' can make sense for specific user's setup,"
1587 ++ " but it is not appropriate for a distributed package."
1588 ++ extraExplanation
1590 , checkFlags ["-fdefer-type-errors"] $
1591 PackageDistInexcusable $
1592 "'" ++ fieldName ++ ": -fdefer-type-errors' is fine during development but "
1593 ++ "is not appropriate for a distributed package."
1594 ++ extraExplanation
1596 -- -dynamic is not a debug flag
1597 , check (any (\opt -> "-d" `isPrefixOf` opt && opt /= "-dynamic")
1598 ghcOptions) $
1599 PackageDistInexcusable $
1600 "'" ++ fieldName ++ ": -d*' debug flags are not appropriate "
1601 ++ "for a distributed package."
1602 ++ extraExplanation
1604 , checkFlags ["-fprof-auto", "-fprof-auto-top", "-fprof-auto-calls",
1605 "-fprof-cafs", "-fno-prof-count-entries",
1606 "-auto-all", "-auto", "-caf-all"] $
1607 PackageDistSuspicious $
1608 "'" ++ fieldName ++ ": -fprof*' profiling flags are typically not "
1609 ++ "appropriate for a distributed library package. These flags are "
1610 ++ "useful to profile this package, but when profiling other packages "
1611 ++ "that use this one these flags clutter the profile output with "
1612 ++ "excessive detail. If you think other packages really want to see "
1613 ++ "cost centres from this package then use '-fprof-auto-exported' "
1614 ++ "which puts cost centres only on exported functions."
1615 ++ extraExplanation
1617 where
1618 extraExplanation =
1619 " Alternatively, if you want to use this, make it conditional based "
1620 ++ "on a Cabal configuration flag (with 'manual: True' and 'default: "
1621 ++ "False') and enable that flag during development."
1623 has_Werror = "-Werror" `elem` ghcOptions
1624 has_J = any
1625 (\o -> case o of
1626 "-j" -> True
1627 ('-' : 'j' : d : _) -> isDigit d
1628 _ -> False
1630 ghcOptions
1631 checkFlags :: [String] -> PackageCheck -> Maybe PackageCheck
1632 checkFlags flags = check (any (`elem` flags) ghcOptions)
1634 checkDevelopmentOnlyFlags :: GenericPackageDescription -> [PackageCheck]
1635 checkDevelopmentOnlyFlags pkg =
1636 concatMap checkDevelopmentOnlyFlagsBuildInfo
1637 [ bi
1638 | (conditions, bi) <- allConditionalBuildInfo
1639 , not (any guardedByManualFlag conditions) ]
1640 where
1641 guardedByManualFlag = definitelyFalse
1643 -- We've basically got three-values logic here: True, False or unknown
1644 -- hence this pattern to propagate the unknown cases properly.
1645 definitelyFalse (Var (PackageFlag n)) = maybe False not (Map.lookup n manualFlags)
1646 definitelyFalse (Var _) = False
1647 definitelyFalse (Lit b) = not b
1648 definitelyFalse (CNot c) = definitelyTrue c
1649 definitelyFalse (COr c1 c2) = definitelyFalse c1 && definitelyFalse c2
1650 definitelyFalse (CAnd c1 c2) = definitelyFalse c1 || definitelyFalse c2
1652 definitelyTrue (Var (PackageFlag n)) = fromMaybe False (Map.lookup n manualFlags)
1653 definitelyTrue (Var _) = False
1654 definitelyTrue (Lit b) = b
1655 definitelyTrue (CNot c) = definitelyFalse c
1656 definitelyTrue (COr c1 c2) = definitelyTrue c1 || definitelyTrue c2
1657 definitelyTrue (CAnd c1 c2) = definitelyTrue c1 && definitelyTrue c2
1659 manualFlags = Map.fromList
1660 [ (flagName flag, flagDefault flag)
1661 | flag <- genPackageFlags pkg
1662 , flagManual flag ]
1664 allConditionalBuildInfo :: [([Condition ConfVar], BuildInfo)]
1665 allConditionalBuildInfo =
1666 concatMap (collectCondTreePaths libBuildInfo)
1667 (maybeToList (condLibrary pkg))
1669 ++ concatMap (collectCondTreePaths libBuildInfo . snd)
1670 (condSubLibraries pkg)
1672 ++ concatMap (collectCondTreePaths buildInfo . snd)
1673 (condExecutables pkg)
1675 ++ concatMap (collectCondTreePaths testBuildInfo . snd)
1676 (condTestSuites pkg)
1678 ++ concatMap (collectCondTreePaths benchmarkBuildInfo . snd)
1679 (condBenchmarks pkg)
1681 -- get all the leaf BuildInfo, paired up with the path (in the tree sense)
1682 -- of if-conditions that guard it
1683 collectCondTreePaths :: (a -> b)
1684 -> CondTree v c a
1685 -> [([Condition v], b)]
1686 collectCondTreePaths mapData = go []
1687 where
1688 go conditions condNode =
1689 -- the data at this level in the tree:
1690 (reverse conditions, mapData (condTreeData condNode))
1692 : concat
1693 [ go (condition:conditions) ifThen
1694 | (CondBranch condition ifThen _) <- condTreeComponents condNode ]
1696 ++ concat
1697 [ go (condition:conditions) elseThen
1698 | (CondBranch condition _ (Just elseThen)) <- condTreeComponents condNode ]
1701 -- ------------------------------------------------------------
1702 -- * Checks involving files in the package
1703 -- ------------------------------------------------------------
1705 -- | Sanity check things that requires IO. It looks at the files in the
1706 -- package and expects to find the package unpacked in at the given file path.
1708 checkPackageFiles :: Verbosity -> PackageDescription -> FilePath -> IO [PackageCheck]
1709 checkPackageFiles verbosity pkg root = do
1710 contentChecks <- checkPackageContent checkFilesIO pkg
1711 preDistributionChecks <- checkPackageFilesPreDistribution verbosity pkg root
1712 -- Sort because different platforms will provide files from
1713 -- `getDirectoryContents` in different orders, and we'd like to be
1714 -- stable for test output.
1715 return (sort contentChecks ++ sort preDistributionChecks)
1716 where
1717 checkFilesIO = CheckPackageContentOps {
1718 doesFileExist = System.doesFileExist . relative,
1719 doesDirectoryExist = System.doesDirectoryExist . relative,
1720 getDirectoryContents = System.Directory.getDirectoryContents . relative,
1721 getFileContents = BS.readFile . relative
1723 relative path = root </> path
1725 -- | A record of operations needed to check the contents of packages.
1726 -- Used by 'checkPackageContent'.
1728 data CheckPackageContentOps m = CheckPackageContentOps {
1729 doesFileExist :: FilePath -> m Bool,
1730 doesDirectoryExist :: FilePath -> m Bool,
1731 getDirectoryContents :: FilePath -> m [FilePath],
1732 getFileContents :: FilePath -> m BS.ByteString
1735 -- | Sanity check things that requires looking at files in the package.
1736 -- This is a generalised version of 'checkPackageFiles' that can work in any
1737 -- monad for which you can provide 'CheckPackageContentOps' operations.
1739 -- The point of this extra generality is to allow doing checks in some virtual
1740 -- file system, for example a tarball in memory.
1742 checkPackageContent :: (Monad m, Applicative m)
1743 => CheckPackageContentOps m
1744 -> PackageDescription
1745 -> m [PackageCheck]
1746 checkPackageContent ops pkg = do
1747 cabalBomError <- checkCabalFileBOM ops
1748 cabalNameError <- checkCabalFileName ops pkg
1749 licenseErrors <- checkLicensesExist ops pkg
1750 setupError <- checkSetupExists ops pkg
1751 configureError <- checkConfigureExists ops pkg
1752 localPathErrors <- checkLocalPathsExist ops pkg
1753 vcsLocation <- checkMissingVcsInfo ops pkg
1755 return $ licenseErrors
1756 ++ catMaybes [cabalBomError, cabalNameError, setupError, configureError]
1757 ++ localPathErrors
1758 ++ vcsLocation
1760 checkCabalFileBOM :: Monad m => CheckPackageContentOps m
1761 -> m (Maybe PackageCheck)
1762 checkCabalFileBOM ops = do
1763 epdfile <- findPackageDesc ops
1764 case epdfile of
1765 -- MASSIVE HACK. If the Cabal file doesn't exist, that is
1766 -- a very strange situation to be in, because the driver code
1767 -- in 'Distribution.Setup' ought to have noticed already!
1768 -- But this can be an issue, see #3552 and also when
1769 -- --cabal-file is specified. So if you can't find the file,
1770 -- just don't bother with this check.
1771 Left _ -> return $ Nothing
1772 Right pdfile -> (flip check pc . BS.isPrefixOf bomUtf8)
1773 `liftM` (getFileContents ops pdfile)
1774 where pc = PackageDistInexcusable $
1775 pdfile ++ " starts with an Unicode byte order mark (BOM)."
1776 ++ " This may cause problems with older cabal versions."
1778 where
1779 bomUtf8 :: BS.ByteString
1780 bomUtf8 = BS.pack [0xef,0xbb,0xbf] -- U+FEFF encoded as UTF8
1782 checkCabalFileName :: Monad m => CheckPackageContentOps m
1783 -> PackageDescription
1784 -> m (Maybe PackageCheck)
1785 checkCabalFileName ops pkg = do
1786 -- findPackageDesc already takes care to detect missing/multiple
1787 -- .cabal files; we don't include this check in 'findPackageDesc' in
1788 -- order not to short-cut other checks which call 'findPackageDesc'
1789 epdfile <- findPackageDesc ops
1790 case epdfile of
1791 -- see "MASSIVE HACK" note in 'checkCabalFileBOM'
1792 Left _ -> return Nothing
1793 Right pdfile
1794 | takeFileName pdfile == expectedCabalname -> return Nothing
1795 | otherwise -> return $ Just $ PackageDistInexcusable $
1796 "The filename " ++ quote pdfile ++ " does not match package name " ++
1797 "(expected: " ++ quote expectedCabalname ++ ")"
1798 where
1799 pkgname = unPackageName . packageName $ pkg
1800 expectedCabalname = pkgname <.> "cabal"
1803 -- |Find a package description file in the given directory. Looks for
1804 -- @.cabal@ files. Like 'Distribution.Simple.Utils.findPackageDesc',
1805 -- but generalized over monads.
1806 findPackageDesc :: Monad m => CheckPackageContentOps m
1807 -> m (Either PackageCheck FilePath) -- ^<pkgname>.cabal
1808 findPackageDesc ops
1809 = do let dir = "."
1810 files <- getDirectoryContents ops dir
1811 -- to make sure we do not mistake a ~/.cabal/ dir for a <pkgname>.cabal
1812 -- file we filter to exclude dirs and null base file names:
1813 cabalFiles <- filterM (doesFileExist ops)
1814 [ dir </> file
1815 | file <- files
1816 , let (name, ext) = splitExtension file
1817 , not (null name) && ext == ".cabal" ]
1818 case cabalFiles of
1819 [] -> return (Left $ PackageBuildImpossible noDesc)
1820 [cabalFile] -> return (Right cabalFile)
1821 multiple -> return (Left $ PackageBuildImpossible
1822 $ multiDesc multiple)
1824 where
1825 noDesc :: String
1826 noDesc = "No cabal file found.\n"
1827 ++ "Please create a package description file <pkgname>.cabal"
1829 multiDesc :: [String] -> String
1830 multiDesc l = "Multiple cabal files found while checking.\n"
1831 ++ "Please use only one of: "
1832 ++ intercalate ", " l
1834 checkLicensesExist :: (Monad m, Applicative m)
1835 => CheckPackageContentOps m
1836 -> PackageDescription
1837 -> m [PackageCheck]
1838 checkLicensesExist ops pkg = do
1839 exists <- traverse (doesFileExist ops . getSymbolicPath) (licenseFiles pkg)
1840 return
1841 [ PackageBuildWarning $
1842 "The '" ++ fieldname ++ "' field refers to the file "
1843 ++ quote (getSymbolicPath file) ++ " which does not exist."
1844 | (file, False) <- zip (licenseFiles pkg) exists ]
1845 where
1846 fieldname | length (licenseFiles pkg) == 1 = "license-file"
1847 | otherwise = "license-files"
1849 checkSetupExists :: Monad m => CheckPackageContentOps m
1850 -> PackageDescription
1851 -> m (Maybe PackageCheck)
1852 checkSetupExists ops pkg = do
1853 let simpleBuild = buildType pkg == Simple
1854 hsexists <- doesFileExist ops "Setup.hs"
1855 lhsexists <- doesFileExist ops "Setup.lhs"
1856 return $ check (not simpleBuild && not hsexists && not lhsexists) $
1857 PackageDistInexcusable $
1858 "The package is missing a Setup.hs or Setup.lhs script."
1860 checkConfigureExists :: Monad m => CheckPackageContentOps m
1861 -> PackageDescription
1862 -> m (Maybe PackageCheck)
1863 checkConfigureExists ops pd
1864 | buildType pd == Configure = do
1865 exists <- doesFileExist ops "configure"
1866 return $ check (not exists) $
1867 PackageBuildWarning $
1868 "The 'build-type' is 'Configure' but there is no 'configure' script. "
1869 ++ "You probably need to run 'autoreconf -i' to generate it."
1870 | otherwise = return Nothing
1872 checkLocalPathsExist :: Monad m => CheckPackageContentOps m
1873 -> PackageDescription
1874 -> m [PackageCheck]
1875 checkLocalPathsExist ops pkg = do
1876 let dirs = [ (dir, kind)
1877 | bi <- allBuildInfo pkg
1878 , (dir, kind) <-
1879 [ (dir, "extra-lib-dirs") | dir <- extraLibDirs bi ]
1880 ++ [ (dir, "extra-lib-dirs-static") | dir <- extraLibDirsStatic bi ]
1881 ++ [ (dir, "extra-framework-dirs")
1882 | dir <- extraFrameworkDirs bi ]
1883 ++ [ (dir, "include-dirs") | dir <- includeDirs bi ]
1884 ++ [ (getSymbolicPath dir, "hs-source-dirs") | dir <- hsSourceDirs bi ]
1885 , isRelativeOnAnyPlatform dir ]
1886 missing <- filterM (liftM not . doesDirectoryExist ops . fst) dirs
1887 return [ PackageBuildWarning {
1888 explanation = quote (kind ++ ": " ++ dir)
1889 ++ " specifies a directory which does not exist."
1891 | (dir, kind) <- missing ]
1893 checkMissingVcsInfo :: (Monad m, Applicative m)
1894 => CheckPackageContentOps m
1895 -> PackageDescription
1896 -> m [PackageCheck]
1897 checkMissingVcsInfo ops pkg | null (sourceRepos pkg) = do
1898 vcsInUse <- liftM or $ traverse (doesDirectoryExist ops) repoDirnames
1899 if vcsInUse
1900 then return [ PackageDistSuspicious message ]
1901 else return []
1902 where
1903 repoDirnames = [ dirname | repo <- knownRepoTypes
1904 , dirname <- repoTypeDirname repo]
1905 message = "When distributing packages it is encouraged to specify source "
1906 ++ "control information in the .cabal file using one or more "
1907 ++ "'source-repository' sections. See the Cabal user guide for "
1908 ++ "details."
1910 checkMissingVcsInfo _ _ = return []
1912 repoTypeDirname :: KnownRepoType -> [FilePath]
1913 repoTypeDirname Darcs = ["_darcs"]
1914 repoTypeDirname Git = [".git"]
1915 repoTypeDirname SVN = [".svn"]
1916 repoTypeDirname CVS = ["CVS"]
1917 repoTypeDirname Mercurial = [".hg"]
1918 repoTypeDirname GnuArch = [".arch-params"]
1919 repoTypeDirname Bazaar = [".bzr"]
1920 repoTypeDirname Monotone = ["_MTN"]
1921 repoTypeDirname Pijul = [".pijul"]
1923 -- ------------------------------------------------------------
1924 -- * Checks involving files in the package
1925 -- ------------------------------------------------------------
1927 -- | Check the names of all files in a package for portability problems. This
1928 -- should be done for example when creating or validating a package tarball.
1930 checkPackageFileNames :: [FilePath] -> [PackageCheck]
1931 checkPackageFileNames = checkPackageFileNamesWithGlob . zip (repeat True)
1933 checkPackageFileNamesWithGlob :: [(Bool, FilePath)] -> [PackageCheck]
1934 checkPackageFileNamesWithGlob files =
1935 catMaybes $
1936 checkWindowsPaths files
1938 [ checkTarPath file
1939 | (_, file) <- files
1942 checkWindowsPaths :: [(Bool, FilePath)] -> Maybe PackageCheck
1943 checkWindowsPaths paths =
1944 case filter (not . FilePath.Windows.isValid . escape) paths of
1945 [] -> Nothing
1946 ps -> Just $
1947 PackageDistInexcusable $
1948 "The " ++ quotes (map snd ps) ++ " invalid on Windows, which "
1949 ++ "would cause portability problems for this package. Windows file "
1950 ++ "names cannot contain any of the characters \":*?<>|\" and there "
1951 ++ "a few reserved names including \"aux\", \"nul\", \"con\", "
1952 ++ "\"prn\", \"com1-9\", \"lpt1-9\" and \"clock$\"."
1953 where
1954 -- force a relative name to catch invalid file names like "f:oo" which
1955 -- otherwise parse as file "oo" in the current directory on the 'f' drive.
1956 escape (isGlob, path) = (".\\" ++)
1957 -- glob paths will be expanded before being dereferenced, so asterisks
1958 -- shouldn't count against them.
1959 $ map (\c -> if c == '*' && isGlob then 'x' else c) path
1960 quotes [failed] =
1961 "path " ++ quote failed ++ " is"
1962 quotes failed =
1963 "paths " ++ intercalate ", " (map quote failed) ++ " are"
1965 -- | Check a file name is valid for the portable POSIX tar format.
1967 -- The POSIX tar format has a restriction on the length of file names. It is
1968 -- unfortunately not a simple restriction like a maximum length. The exact
1969 -- restriction is that either the whole path be 100 characters or less, or it
1970 -- be possible to split the path on a directory separator such that the first
1971 -- part is 155 characters or less and the second part 100 characters or less.
1973 checkTarPath :: FilePath -> Maybe PackageCheck
1974 checkTarPath path
1975 | length path > 255 = Just longPath
1976 | otherwise = case pack nameMax (reverse (splitPath path)) of
1977 Left err -> Just err
1978 Right [] -> Nothing
1979 Right (h:rest) -> case pack prefixMax remainder of
1980 Left err -> Just err
1981 Right [] -> Nothing
1982 Right (_:_) -> Just noSplit
1983 where
1984 -- drop the '/' between the name and prefix:
1985 remainder = safeInit h : rest
1987 where
1988 nameMax, prefixMax :: Int
1989 nameMax = 100
1990 prefixMax = 155
1992 pack _ [] = Left emptyName
1993 pack maxLen (c:cs)
1994 | n > maxLen = Left longName
1995 | otherwise = Right (pack' maxLen n cs)
1996 where n = length c
1998 pack' maxLen n (c:cs)
1999 | n' <= maxLen = pack' maxLen n' cs
2000 where n' = n + length c
2001 pack' _ _ cs = cs
2003 longPath = PackageDistInexcusable $
2004 "The following file name is too long to store in a portable POSIX "
2005 ++ "format tar archive. The maximum length is 255 ASCII characters.\n"
2006 ++ "The file in question is:\n " ++ path
2007 longName = PackageDistInexcusable $
2008 "The following file name is too long to store in a portable POSIX "
2009 ++ "format tar archive. The maximum length for the name part (including "
2010 ++ "extension) is 100 ASCII characters. The maximum length for any "
2011 ++ "individual directory component is 155.\n"
2012 ++ "The file in question is:\n " ++ path
2013 noSplit = PackageDistInexcusable $
2014 "The following file name is too long to store in a portable POSIX "
2015 ++ "format tar archive. While the total length is less than 255 ASCII "
2016 ++ "characters, there are unfortunately further restrictions. It has to "
2017 ++ "be possible to split the file path on a directory separator into "
2018 ++ "two parts such that the first part fits in 155 characters or less "
2019 ++ "and the second part fits in 100 characters or less. Basically you "
2020 ++ "have to make the file name or directory names shorter, or you could "
2021 ++ "split a long directory name into nested subdirectories with shorter "
2022 ++ "names.\nThe file in question is:\n " ++ path
2023 emptyName = PackageDistInexcusable $
2024 "Encountered a file with an empty name, something is very wrong! "
2025 ++ "Files with an empty name cannot be stored in a tar archive or in "
2026 ++ "standard file systems."
2028 -- --------------------------------------------------------------
2029 -- * Checks for missing content and other pre-distribution checks
2030 -- --------------------------------------------------------------
2032 -- | Similar to 'checkPackageContent', 'checkPackageFilesPreDistribution'
2033 -- inspects the files included in the package, but is primarily looking for
2034 -- files in the working tree that may have been missed or other similar
2035 -- problems that can only be detected pre-distribution.
2037 -- Because Hackage necessarily checks the uploaded tarball, it is too late to
2038 -- check these on the server; these checks only make sense in the development
2039 -- and package-creation environment. Hence we can use IO, rather than needing
2040 -- to pass a 'CheckPackageContentOps' dictionary around.
2041 checkPackageFilesPreDistribution :: Verbosity -> PackageDescription -> FilePath -> IO [PackageCheck]
2042 -- Note: this really shouldn't return any 'Inexcusable' warnings,
2043 -- because that will make us say that Hackage would reject the package.
2044 -- But, because Hackage doesn't run these tests, that will be a lie!
2045 checkPackageFilesPreDistribution = checkGlobFiles
2047 -- | Discover problems with the package's wildcards.
2048 checkGlobFiles :: Verbosity
2049 -> PackageDescription
2050 -> FilePath
2051 -> IO [PackageCheck]
2052 checkGlobFiles verbosity pkg root =
2053 fmap concat $ for allGlobs $ \(field, dir, glob) ->
2054 -- Note: we just skip over parse errors here; they're reported elsewhere.
2055 case parseFileGlob (specVersion pkg) glob of
2056 Left _ -> return []
2057 Right parsedGlob -> do
2058 results <- runDirFileGlob verbosity (root </> dir) parsedGlob
2059 let individualWarnings = results >>= getWarning field glob
2060 noMatchesWarning =
2061 [ PackageDistSuspiciousWarn $
2062 "In '" ++ field ++ "': the pattern '" ++ glob ++ "' does not"
2063 ++ " match any files."
2064 | all (not . suppressesNoMatchesWarning) results
2066 return (noMatchesWarning ++ individualWarnings)
2067 where
2068 adjustedDataDir = if null (dataDir pkg) then "." else dataDir pkg
2069 allGlobs = concat
2070 [ (,,) "extra-source-files" "." <$> extraSrcFiles pkg
2071 , (,,) "extra-doc-files" "." <$> extraDocFiles pkg
2072 , (,,) "data-files" adjustedDataDir <$> dataFiles pkg
2075 -- If there's a missing directory in play, since our globs don't
2076 -- (currently) support disjunction, that will always mean there are no
2077 -- matches. The no matches error in this case is strictly less informative
2078 -- than the missing directory error, so sit on it.
2079 suppressesNoMatchesWarning (GlobMatch _) = True
2080 suppressesNoMatchesWarning (GlobWarnMultiDot _) = False
2081 suppressesNoMatchesWarning (GlobMissingDirectory _) = True
2083 getWarning :: String -> FilePath -> GlobResult FilePath -> [PackageCheck]
2084 getWarning _ _ (GlobMatch _) =
2086 -- Before Cabal 2.4, the extensions of globs had to match the file
2087 -- exactly. This has been relaxed in 2.4 to allow matching only the
2088 -- suffix. This warning detects when pre-2.4 package descriptions are
2089 -- omitting files purely because of the stricter check.
2090 getWarning field glob (GlobWarnMultiDot file) =
2091 [ PackageDistSuspiciousWarn $
2092 "In '" ++ field ++ "': the pattern '" ++ glob ++ "' does not"
2093 ++ " match the file '" ++ file ++ "' because the extensions do not"
2094 ++ " exactly match (e.g., foo.en.html does not exactly match *.html)."
2095 ++ " To enable looser suffix-only matching, set 'cabal-version: 2.4' or higher."
2097 getWarning field glob (GlobMissingDirectory dir) =
2098 [ PackageDistSuspiciousWarn $
2099 "In '" ++ field ++ "': the pattern '" ++ glob ++ "' attempts to"
2100 ++ " match files in the directory '" ++ dir ++ "', but there is no"
2101 ++ " directory by that name."
2104 -- | Check that setup dependencies, have proper bounds.
2105 -- In particular, @base@ and @Cabal@ upper bounds are mandatory.
2106 checkSetupVersions :: GenericPackageDescription -> [PackageCheck]
2107 checkSetupVersions pkg =
2108 [ emitError nameStr
2109 | (name, vr) <- Map.toList deps
2110 , not (hasUpperBound vr)
2111 , let nameStr = unPackageName name
2112 , nameStr `elem` criticalPkgs
2114 where
2115 criticalPkgs = ["Cabal", "base"]
2116 deps = case typicalPkg pkg of
2117 Right (pkgs', _) ->
2118 Map.fromListWith intersectVersionRanges
2119 [ (pname, vr)
2120 | sbi <- maybeToList $ setupBuildInfo pkgs'
2121 , Dependency pname vr _ <- setupDepends sbi
2123 _ -> Map.empty
2124 emitError nm =
2125 PackageDistInexcusable $
2126 "The dependency 'setup-depends: '"++nm++"' does not specify an "
2127 ++ "upper bound on the version number. Each major release of the "
2128 ++ "'"++nm++"' package changes the API in various ways and most "
2129 ++ "packages will need some changes to compile with it. If you are "
2130 ++ "not sure what upper bound to use then use the next major "
2131 ++ "version."
2133 checkDuplicateModules :: GenericPackageDescription -> [PackageCheck]
2134 checkDuplicateModules pkg =
2135 concatMap checkLib (maybe id (:) (condLibrary pkg) . map snd $ condSubLibraries pkg)
2136 ++ concatMap checkExe (map snd $ condExecutables pkg)
2137 ++ concatMap checkTest (map snd $ condTestSuites pkg)
2138 ++ concatMap checkBench (map snd $ condBenchmarks pkg)
2139 where
2140 -- the duplicate modules check is has not been thoroughly vetted for backpack
2141 checkLib = checkDups "library" (\l -> explicitLibModules l ++ map moduleReexportName (reexportedModules l))
2142 checkExe = checkDups "executable" exeModules
2143 checkTest = checkDups "test suite" testModules
2144 checkBench = checkDups "benchmark" benchmarkModules
2145 checkDups s getModules t =
2146 let sumPair (x,x') (y,y') = (x + x' :: Int, y + y' :: Int)
2147 mergePair (x, x') (y, y') = (x + x', max y y')
2148 maxPair (x, x') (y, y') = (max x x', max y y')
2149 libMap = foldCondTree Map.empty
2150 (\(_,v) -> Map.fromListWith sumPair . map (\x -> (x,(1, 1))) $ getModules v )
2151 (Map.unionWith mergePair) -- if a module may occur in nonexclusive branches count it twice strictly and once loosely.
2152 (Map.unionWith maxPair) -- a module occurs the max of times it might appear in exclusive branches
2154 dupLibsStrict = Map.keys $ Map.filter ((>1) . fst) libMap
2155 dupLibsLax = Map.keys $ Map.filter ((>1) . snd) libMap
2156 in if not (null dupLibsLax)
2157 then [PackageBuildImpossible $ "Duplicate modules in " ++ s ++ ": " ++ commaSep (map prettyShow dupLibsLax)]
2158 else if not (null dupLibsStrict)
2159 then [PackageDistSuspicious $ "Potential duplicate modules (subject to conditionals) in " ++ s ++ ": " ++ commaSep (map prettyShow dupLibsStrict)]
2160 else []
2162 -- ------------------------------------------------------------
2163 -- * Utils
2164 -- ------------------------------------------------------------
2166 quote :: String -> String
2167 quote s = "'" ++ s ++ "'"
2169 commaSep :: [String] -> String
2170 commaSep = intercalate ", "
2172 dups :: Ord a => [a] -> [a]
2173 dups xs = [ x | (x:_:_) <- group (sort xs) ]
2175 fileExtensionSupportedLanguage :: FilePath -> Bool
2176 fileExtensionSupportedLanguage path =
2177 isHaskell || isC
2178 where
2179 extension = takeExtension path
2180 isHaskell = extension `elem` [".hs", ".lhs"]
2181 isC = isJust (filenameCDialect extension)
2183 -- | Whether a path is a good relative path. We aren't worried about perfect
2184 -- cross-platform compatibility here; this function just checks the paths in
2185 -- the (local) @.cabal@ file, while only Hackage needs the portability.
2187 -- >>> let test fp = putStrLn $ show (isGoodRelativeDirectoryPath fp) ++ "; " ++ show (isGoodRelativeFilePath fp)
2189 -- Note that "foo./bar.hs" would be invalid on Windows.
2191 -- >>> traverse_ test ["foo/bar/quu", "a/b.hs", "foo./bar.hs"]
2192 -- Nothing; Nothing
2193 -- Nothing; Nothing
2194 -- Nothing; Nothing
2196 -- Trailing slash is not allowed for files, for directories it is ok.
2198 -- >>> test "foo/"
2199 -- Nothing; Just "trailing slash"
2201 -- Leading @./@ is fine, but @.@ and @./@ are not valid files.
2203 -- >>> traverse_ test [".", "./", "./foo/bar"]
2204 -- Nothing; Just "trailing dot segment"
2205 -- Nothing; Just "trailing slash"
2206 -- Nothing; Nothing
2208 -- Lastly, not good file nor directory cases:
2210 -- >>> traverse_ test ["", "/tmp/src", "foo//bar", "foo/.", "foo/./bar", "foo/../bar"]
2211 -- Just "empty path"; Just "empty path"
2212 -- Just "posix absolute path"; Just "posix absolute path"
2213 -- Just "empty path segment"; Just "empty path segment"
2214 -- Just "trailing same directory segment: ."; Just "trailing same directory segment: ."
2215 -- Just "same directory segment: ."; Just "same directory segment: ."
2216 -- Just "parent directory segment: .."; Just "parent directory segment: .."
2218 -- For the last case, 'isGoodRelativeGlob' doesn't warn:
2220 -- >>> traverse_ (print . isGoodRelativeGlob) ["foo/../bar"]
2221 -- Just "parent directory segment: .."
2223 isGoodRelativeFilePath :: FilePath -> Maybe String
2224 isGoodRelativeFilePath = state0
2225 where
2226 -- initial state
2227 state0 [] = Just "empty path"
2228 state0 (c:cs) | c == '.' = state1 cs
2229 | c == '/' = Just "posix absolute path"
2230 | otherwise = state5 cs
2232 -- after initial .
2233 state1 [] = Just "trailing dot segment"
2234 state1 (c:cs) | c == '.' = state4 cs
2235 | c == '/' = state2 cs
2236 | otherwise = state5 cs
2238 -- after ./ or after / between segments
2239 state2 [] = Just "trailing slash"
2240 state2 (c:cs) | c == '.' = state3 cs
2241 | c == '/' = Just "empty path segment"
2242 | otherwise = state5 cs
2244 -- after non-first segment's .
2245 state3 [] = Just "trailing same directory segment: ."
2246 state3 (c:cs) | c == '.' = state4 cs
2247 | c == '/' = Just "same directory segment: ."
2248 | otherwise = state5 cs
2250 -- after ..
2251 state4 [] = Just "trailing parent directory segment: .."
2252 state4 (c:cs) | c == '.' = state5 cs
2253 | c == '/' = Just "parent directory segment: .."
2254 | otherwise = state5 cs
2256 -- in a segment which is ok.
2257 state5 [] = Nothing
2258 state5 (c:cs) | c == '.' = state5 cs
2259 | c == '/' = state2 cs
2260 | otherwise = state5 cs
2262 -- | See 'isGoodRelativeFilePath'.
2264 -- This is barebones function. We check whether the glob is a valid file
2265 -- by replacing stars @*@ with @x@ses.
2266 isGoodRelativeGlob :: FilePath -> Maybe String
2267 isGoodRelativeGlob = isGoodRelativeFilePath . map f where
2268 f '*' = 'x'
2269 f c = c
2271 -- | See 'isGoodRelativeFilePath'.
2272 isGoodRelativeDirectoryPath :: FilePath -> Maybe String
2273 isGoodRelativeDirectoryPath = state0
2274 where
2275 -- initial state
2276 state0 [] = Just "empty path"
2277 state0 (c:cs) | c == '.' = state5 cs
2278 | c == '/' = Just "posix absolute path"
2279 | otherwise = state4 cs
2281 -- after initial ./ or after / between segments
2282 state1 [] = Nothing
2283 state1 (c:cs) | c == '.' = state2 cs
2284 | c == '/' = Just "empty path segment"
2285 | otherwise = state4 cs
2287 -- after non-first setgment's .
2288 state2 [] = Just "trailing same directory segment: ."
2289 state2 (c:cs) | c == '.' = state3 cs
2290 | c == '/' = Just "same directory segment: ."
2291 | otherwise = state4 cs
2293 -- after ..
2294 state3 [] = Just "trailing parent directory segment: .."
2295 state3 (c:cs) | c == '.' = state4 cs
2296 | c == '/' = Just "parent directory segment: .."
2297 | otherwise = state4 cs
2299 -- in a segment which is ok.
2300 state4 [] = Nothing
2301 state4 (c:cs) | c == '.' = state4 cs
2302 | c == '/' = state1 cs
2303 | otherwise = state4 cs
2305 -- after initial .
2306 state5 [] = Nothing -- "."
2307 state5 (c:cs) | c == '.' = state3 cs
2308 | c == '/' = state1 cs
2309 | otherwise = state4 cs
2311 -- [Note: Good relative paths]
2313 -- Using @kleene@ we can define an extended regex:
2315 -- @
2316 -- import Algebra.Lattice
2317 -- import Kleene
2318 -- import Kleene.ERE (ERE (..), intersections)
2320 -- data C = CDot | CSlash | CChar
2321 -- deriving (Eq, Ord, Enum, Bounded, Show)
2323 -- reservedR :: ERE C
2324 -- reservedR = notChar CSlash
2326 -- pathPieceR :: ERE C
2327 -- pathPieceR = intersections
2328 -- [ plus reservedR
2329 -- , ERENot (string [CDot])
2330 -- , ERENot (string [CDot,CDot])
2331 -- ]
2333 -- filePathR :: ERE C
2334 -- filePathR = optional (string [CDot, CSlash]) <> pathPieceR <> star (char CSlash <> pathPieceR)
2336 -- dirPathR :: ERE C
2337 -- dirPathR = (char CDot \/ filePathR) <> optional (char CSlash)
2339 -- plus :: ERE C -> ERE C
2340 -- plus r = r <> star r
2342 -- optional :: ERE C -> ERE C
2343 -- optional r = mempty \/ r
2344 -- @
2346 -- Results in following state machine for @filePathR@
2348 -- @
2349 -- 0 -> \x -> if
2350 -- | x <= CDot -> 1
2351 -- | otherwise -> 5
2352 -- 1 -> \x -> if
2353 -- | x <= CDot -> 4
2354 -- | x <= CSlash -> 2
2355 -- | otherwise -> 5
2356 -- 2 -> \x -> if
2357 -- | x <= CDot -> 3
2358 -- | otherwise -> 5
2359 -- 3 -> \x -> if
2360 -- | x <= CDot -> 4
2361 -- | otherwise -> 5
2362 -- 4 -> \x -> if
2363 -- | x <= CDot -> 5
2364 -- | otherwise -> 5
2365 -- 5+ -> \x -> if
2366 -- | x <= CDot -> 5
2367 -- | x <= CSlash -> 2
2368 -- | otherwise -> 5
2369 -- @
2371 -- and @dirPathR@:
2373 -- @
2374 -- 0 -> \x -> if
2375 -- | x <= CDot -> 5
2376 -- | otherwise -> 4
2377 -- 1+ -> \x -> if
2378 -- | x <= CDot -> 2
2379 -- | otherwise -> 4
2380 -- 2 -> \x -> if
2381 -- | x <= CDot -> 3
2382 -- | otherwise -> 4
2383 -- 3 -> \x -> if
2384 -- | x <= CDot -> 4
2385 -- | otherwise -> 4
2386 -- 4+ -> \x -> if
2387 -- | x <= CDot -> 4
2388 -- | x <= CSlash -> 1
2389 -- | otherwise -> 4
2390 -- 5+ -> \x -> if
2391 -- | x <= CDot -> 3
2392 -- | x <= CSlash -> 1
2393 -- | otherwise -> 4
2394 -- @
2397 -- TODO: What we really want to do is test if there exists any
2398 -- configuration in which the base version is unbounded above.
2399 -- However that's a bit tricky because there are many possible
2400 -- configurations. As a cheap easy and safe approximation we will
2401 -- pick a single "typical" configuration and check if that has an
2402 -- open upper bound. To get a typical configuration we finalise
2403 -- using no package index and the current platform.
2404 typicalPkg :: GenericPackageDescription
2405 -> Either [Dependency] (PackageDescription, FlagAssignment)
2406 typicalPkg = finalizePD
2407 mempty defaultComponentRequestedSpec (const True)
2408 buildPlatform
2409 (unknownCompilerInfo
2410 (CompilerId buildCompilerFlavor nullVersion)
2411 NoAbiTag)