Cabal-3.16.0.0: src/Distribution/PackageDescription/Check/Target.hs
-- |
-- Module : Distribution.PackageDescription.Check.Target
-- Copyright : Lennart Kolmodin 2008, Francesco Ariis 2023
-- License : BSD3
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
--
-- Fully-realised target (library, executable, …) checking functions.
module Distribution.PackageDescription.Check.Target
( checkLibrary
, checkForeignLib
, checkExecutable
, checkTestSuite
, checkBenchmark
) where
import Distribution.Compat.Prelude
import Prelude ()
import Distribution.CabalSpecVersion
import Distribution.Compat.Lens
import Distribution.Compiler
import Distribution.ModuleName (ModuleName, toFilePath)
import Distribution.Package
import Distribution.PackageDescription
import Distribution.PackageDescription.Check.Common
import Distribution.PackageDescription.Check.Monad
import Distribution.PackageDescription.Check.Paths
import Distribution.Pretty (prettyShow)
import Distribution.Simple.BuildPaths
( autogenPackageInfoModuleName
, autogenPathsModuleName
)
import Distribution.Simple.Utils hiding (findPackageDesc, notice)
import Distribution.Types.PackageName.Magic
import Distribution.Utils.Path
import Distribution.Version
import Language.Haskell.Extension
import System.FilePath (takeExtension)
import Control.Monad
import qualified Distribution.Types.BuildInfo.Lens as L
checkLibrary
:: Monad m
=> Bool -- Is this a sublibrary?
-> [AssocDep] -- “Inherited” dependencies for PVP checks.
-> Library
-> CheckM m ()
checkLibrary
isSub
ads
lib@( Library
libName_
_exposedModules_
reexportedModules_
signatures_
_libExposed_
_libVisibility_
libBuildInfo_
) = do
mapM_ checkModuleName (explicitLibModules lib)
checkP
(libName_ == LMainLibName && isSub)
(PackageBuildImpossible UnnamedInternal)
-- TODO: bogus if a required-signature was passed through.
checkP
(null (explicitLibModules lib) && null reexportedModules_)
(PackageDistSuspiciousWarn (NoModulesExposed libName_))
-- TODO parse-caught check, can safely remove.
checkSpecVer
CabalSpecV2_0
(not . null $ signatures_)
(PackageDistInexcusable SignaturesCabal2)
-- autogen/includes checks.
checkP
( not $
all
(flip elem (explicitLibModules lib))
(libModulesAutogen lib)
)
(PackageBuildImpossible AutogenNotExposed)
-- check that all autogen-includes appear on includes or
-- install-includes.
checkP
( not $
all
(flip elem (allExplicitIncludes lib) . getSymbolicPath)
(view L.autogenIncludes lib)
)
$ (PackageBuildImpossible AutogenIncludesNotIncluded)
-- § Build infos.
checkBuildInfo
(CETLibrary libName_)
(explicitLibModules lib)
ads
libBuildInfo_
-- Feature checks.
-- check use of reexported-modules sections
checkSpecVer
CabalSpecV1_22
(not . null $ reexportedModules_)
(PackageDistInexcusable CVReexported)
where
allExplicitIncludes :: L.HasBuildInfo a => a -> [FilePath]
allExplicitIncludes x =
map getSymbolicPath (view L.includes x)
++ map getSymbolicPath (view L.installIncludes x)
checkForeignLib :: Monad m => ForeignLib -> CheckM m ()
checkForeignLib
( ForeignLib
foreignLibName_
_foreignLibType_
_foreignLibOptions_
foreignLibBuildInfo_
_foreignLibVersionInfo_
_foreignLibVersionLinux_
_foreignLibModDefFile_
) = do
checkBuildInfo
(CETForeignLibrary foreignLibName_)
[]
[]
foreignLibBuildInfo_
checkExecutable
:: Monad m
=> [AssocDep] -- “Inherited” dependencies for PVP checks.
-> Executable
-> CheckM m ()
checkExecutable
ads
exe@( Executable
exeName_
symbolicModulePath_
_exeScope_
buildInfo_
) = do
-- Target type/name (exe).
let cet = CETExecutable exeName_
modulePath_ = getSymbolicPath symbolicModulePath_
mapM_ checkModuleName (exeModules exe)
-- § Exe specific checks
checkP
(null modulePath_)
(PackageBuildImpossible (NoMainIs exeName_))
-- This check does not apply to scripts.
pid <- asksCM (pnPackageId . ccNames)
checkP
( pid /= fakePackageId
&& not (null modulePath_)
&& not (fileExtensionSupportedLanguage $ modulePath_)
)
(PackageBuildImpossible NoHsLhsMain)
-- § Features check
checkSpecVer
CabalSpecV1_18
( fileExtensionSupportedLanguage modulePath_
&& takeExtension modulePath_ `notElem` [".hs", ".lhs"]
)
(PackageDistInexcusable MainCCabal1_18)
-- Alas exeModules ad exeModulesAutogen (exported from
-- Distribution.Types.Executable) take `Executable` as a parameter.
checkP
(not $ all (flip elem (exeModules exe)) (exeModulesAutogen exe))
(PackageBuildImpossible $ AutogenNoOther cet)
checkP
( not $
all
(flip elem (view L.includes exe) . relativeSymbolicPath)
(view L.autogenIncludes exe)
)
(PackageBuildImpossible AutogenIncludesNotIncludedExe)
-- § Build info checks.
checkBuildInfo cet [] ads buildInfo_
checkTestSuite
:: Monad m
=> [AssocDep] -- “Inherited” dependencies for PVP checks.
-> TestSuite
-> CheckM m ()
checkTestSuite
ads
ts@( TestSuite
testName_
testInterface_
testBuildInfo_
_testCodeGenerators_
) = do
-- Target type/name (test).
let cet = CETTest testName_
-- § TS specific checks.
-- TODO caught by the parser, can remove safely
case testInterface_ of
TestSuiteUnsupported tt@(TestTypeUnknown _ _) ->
tellP (PackageBuildWarning $ TestsuiteTypeNotKnown tt)
TestSuiteUnsupported tt ->
tellP (PackageBuildWarning $ TestsuiteNotSupported tt)
_ -> return ()
mapM_ checkModuleName (testModules ts)
checkP
mainIsWrongExt
(PackageBuildImpossible NoHsLhsMain)
checkP
( not $
all
(flip elem (testModules ts))
(testModulesAutogen ts)
)
(PackageBuildImpossible $ AutogenNoOther cet)
checkP
( not $
all
(flip elem (view L.includes ts) . relativeSymbolicPath)
(view L.autogenIncludes ts)
)
(PackageBuildImpossible AutogenIncludesNotIncludedExe)
-- § Feature checks.
checkSpecVer
CabalSpecV1_18
(mainIsNotHsExt && not mainIsWrongExt)
(PackageDistInexcusable MainCCabal1_18)
-- § Build info checks.
checkBuildInfo cet [] ads testBuildInfo_
where
mainIsWrongExt =
case testInterface_ of
TestSuiteExeV10 _ f -> not (fileExtensionSupportedLanguage $ getSymbolicPath f)
_ -> False
mainIsNotHsExt =
case testInterface_ of
TestSuiteExeV10 _ f -> takeExtension (getSymbolicPath f) `notElem` [".hs", ".lhs"]
_ -> False
checkBenchmark
:: Monad m
=> [AssocDep] -- “Inherited” dependencies for PVP checks.
-> Benchmark
-> CheckM m ()
checkBenchmark
ads
bm@( Benchmark
benchmarkName_
benchmarkInterface_
benchmarkBuildInfo_
) = do
-- Target type/name (benchmark).
let cet = CETBenchmark benchmarkName_
mapM_ checkModuleName (benchmarkModules bm)
-- § Interface & bm specific tests.
case benchmarkInterface_ of
BenchmarkUnsupported tt@(BenchmarkTypeUnknown _ _) ->
tellP (PackageBuildWarning $ BenchmarkTypeNotKnown tt)
BenchmarkUnsupported tt ->
tellP (PackageBuildWarning $ BenchmarkNotSupported tt)
_ -> return ()
checkP
mainIsWrongExt
(PackageBuildImpossible NoHsLhsMainBench)
checkP
( not $
all
(flip elem (benchmarkModules bm))
(benchmarkModulesAutogen bm)
)
(PackageBuildImpossible $ AutogenNoOther cet)
checkP
( not $
all
(flip elem (view L.includes bm) . relativeSymbolicPath)
(view L.autogenIncludes bm)
)
(PackageBuildImpossible AutogenIncludesNotIncludedExe)
-- § BuildInfo checks.
checkBuildInfo cet [] ads benchmarkBuildInfo_
where
-- Cannot abstract with similar function in checkTestSuite,
-- they are different.
mainIsWrongExt =
case benchmarkInterface_ of
BenchmarkExeV10 _ f -> takeExtension (getSymbolicPath f) `notElem` [".hs", ".lhs"]
_ -> False
-- | Check if a module name is valid on both Windows and Posix systems
checkModuleName :: Monad m => ModuleName -> CheckM m ()
checkModuleName moduleName =
checkPackageFileNamesWithGlob PathKindFile (toFilePath moduleName)
-- ------------------------------------------------------------
-- Build info
-- ------------------------------------------------------------
-- Check a great deal of things in buildInfo.
-- With 'checkBuildInfo' we cannot follow the usual “pattern match
-- everything” method, for the number of BuildInfo fields (almost 50)
-- but more importantly because accessing options, etc. is done
-- with functions from 'Distribution.Types.BuildInfo' (e.g. 'hcOptions').
-- Duplicating the effort here means risk of diverging definitions for
-- little gain (most likely if a field is added to BI, the relevant
-- function will be tweaked in Distribution.Types.BuildInfo too).
checkBuildInfo
:: Monad m
=> CEType -- Name and type of the target.
-> [ModuleName] -- Additional module names which cannot be
-- extracted from BuildInfo (mainly: exposed
-- library modules).
-> [AssocDep] -- Inherited “internal” (main lib, named
-- internal libs) dependencies.
-> BuildInfo
-> CheckM m ()
checkBuildInfo cet ams ads bi = do
-- For the sake of clarity, we split che checks in various
-- (top level) functions, even if we are not actually going
-- deeper in the traversal.
checkBuildInfoOptions (cet2bit cet) bi
checkBuildInfoPathsContent bi
checkBuildInfoPathsWellFormedness bi
sv <- asksCM ccSpecVersion
checkBuildInfoFeatures bi sv
checkAutogenModules ams bi
-- PVP: we check for base and all other deps.
let ds = mergeDependencies $ targetBuildDepends bi
(ids, rds) <-
partitionDeps
ads
[mkUnqualComponentName "base"]
ds
let ick = const (PackageDistInexcusable BaseNoUpperBounds)
rck = PackageDistSuspiciousWarn . MissingUpperBounds cet
leuck = PackageDistSuspiciousWarn . LEUpperBounds cet
tzuck = PackageDistSuspiciousWarn . TrailingZeroUpperBounds cet
gtlck = PackageDistSuspiciousWarn . GTLowerBounds cet
checkPVP (checkDependencyVersionRange $ not . hasUpperBound) ick ids
unless
(isInternalTarget cet)
(checkPVPs (checkDependencyVersionRange $ not . hasUpperBound) rck rds)
unless
(isInternalTarget cet)
(checkPVPs (checkDependencyVersionRange hasLEUpperBound) leuck ds)
unless
(isInternalTarget cet)
(checkPVPs (checkDependencyVersionRange hasTrailingZeroUpperBound) tzuck ds)
unless
(isInternalTarget cet)
(checkPVPs (checkDependencyVersionRange hasGTLowerBound) gtlck ds)
-- Custom fields well-formedness (ASCII).
mapM_ checkCustomField (customFieldsBI bi)
-- Content.
mapM_ (checkLocalPathExist "extra-lib-dirs" . getSymbolicPath) (extraLibDirs bi)
mapM_
(checkLocalPathExist "extra-lib-dirs-static" . getSymbolicPath)
(extraLibDirsStatic bi)
mapM_
(checkLocalPathExist "extra-framework-dirs" . getSymbolicPath)
(extraFrameworkDirs bi)
mapM_ (checkLocalPathExist "include-dirs" . getSymbolicPath) (includeDirs bi)
mapM_
(checkLocalPathExist "hs-source-dirs" . getSymbolicPath)
(hsSourceDirs bi)
-- Well formedness of BI contents (no `Haskell2015`, no deprecated
-- extensions etc).
checkBuildInfoPathsContent :: Monad m => BuildInfo -> CheckM m ()
checkBuildInfoPathsContent bi = do
mapM_ checkLang (allLanguages bi)
mapM_ checkExt (allExtensions bi)
mapM_ checkIntDep (targetBuildDepends bi)
df <- asksCM ccDesugar
-- This way we can use the same function for legacy&non exedeps.
let ds = buildToolDepends bi ++ catMaybes (map df $ buildTools bi)
mapM_ checkBTDep ds
where
checkLang :: Monad m => Language -> CheckM m ()
checkLang (UnknownLanguage n) =
tellP (PackageBuildWarning (UnknownLanguages [n]))
checkLang _ = return ()
checkExt :: Monad m => Extension -> CheckM m ()
checkExt (UnknownExtension n)
| n `elem` map prettyShow knownLanguages =
tellP (PackageBuildWarning (LanguagesAsExtension [n]))
| otherwise =
tellP (PackageBuildWarning (UnknownExtensions [n]))
checkExt n = do
let dss = filter (\(a, _) -> a == n) deprecatedExtensions
checkP
(not . null $ dss)
(PackageDistSuspicious $ DeprecatedExtensions dss)
checkIntDep :: Monad m => Dependency -> CheckM m ()
checkIntDep d@(Dependency name vrange _) = do
mpn <-
asksCM
( packageNameToUnqualComponentName
. pkgName
. pnPackageId
. ccNames
)
lns <- asksCM (pnSubLibs . ccNames)
pVer <- asksCM (pkgVersion . pnPackageId . ccNames)
let allLibNs = mpn : lns
when
( mpn == packageNameToUnqualComponentName name
-- Make sure it is not a library with the
-- same name from another package.
&& packageNameToUnqualComponentName name `elem` allLibNs
)
( checkP
(not $ pVer `withinRange` vrange)
(PackageBuildImpossible $ ImpossibleInternalDep [d])
)
checkBTDep :: Monad m => ExeDependency -> CheckM m ()
checkBTDep ed@(ExeDependency n name vrange) = do
exns <- asksCM (pnExecs . ccNames)
pVer <- asksCM (pkgVersion . pnPackageId . ccNames)
pNam <- asksCM (pkgName . pnPackageId . ccNames)
checkP
( n == pNam
&& name `notElem` exns -- internal
-- not present
)
(PackageBuildImpossible $ MissingInternalExe [ed])
when
(name `elem` exns)
( checkP
(not $ pVer `withinRange` vrange)
(PackageBuildImpossible $ ImpossibleInternalExe [ed])
)
-- Paths well-formedness check for BuildInfo.
checkBuildInfoPathsWellFormedness :: Monad m => BuildInfo -> CheckM m ()
checkBuildInfoPathsWellFormedness bi = do
mapM_ (checkPath False "asm-sources" PathKindFile . getSymbolicPath) (asmSources bi)
mapM_ (checkPath False "cmm-sources" PathKindFile . getSymbolicPath) (cmmSources bi)
mapM_ (checkPath False "c-sources" PathKindFile . getSymbolicPath) (cSources bi)
mapM_ (checkPath False "cxx-sources" PathKindFile . getSymbolicPath) (cxxSources bi)
mapM_ (checkPath False "js-sources" PathKindFile . getSymbolicPath) (jsSources bi)
mapM_
(checkPath False "install-includes" PathKindFile . getSymbolicPath)
(installIncludes bi)
mapM_
(checkPath False "hs-source-dirs" PathKindDirectory . getSymbolicPath)
(hsSourceDirs bi)
-- Possibly absolute paths.
mapM_ (checkPath True "includes" PathKindFile . getSymbolicPath) (includes bi)
mapM_
(checkPath True "include-dirs" PathKindDirectory . getSymbolicPath)
(includeDirs bi)
mapM_
(checkPath True "extra-lib-dirs" PathKindDirectory . getSymbolicPath)
(extraLibDirs bi)
mapM_
(checkPath True "extra-lib-dirs-static" PathKindDirectory . getSymbolicPath)
(extraLibDirsStatic bi)
mapM_ checkOptionPath (perCompilerFlavorToList $ options bi)
where
checkOptionPath
:: Monad m
=> (CompilerFlavor, [FilePath])
-> CheckM m ()
checkOptionPath (GHC, paths) =
mapM_
( \path ->
checkP
(isInsideDist path)
(PackageDistInexcusable $ DistPoint Nothing path)
)
paths
checkOptionPath _ = return ()
-- Checks for features that can be present in BuildInfo only with certain
-- CabalSpecVersion.
checkBuildInfoFeatures
:: Monad m
=> BuildInfo
-> CabalSpecVersion
-> CheckM m ()
checkBuildInfoFeatures bi sv = do
-- Default language can be used only w/ spec ≥ 1.10
checkSpecVer
CabalSpecV1_10
(isJust $ defaultLanguage bi)
(PackageBuildWarning CVDefaultLanguage)
-- CheckSpecVer sv.
checkDefaultLanguage
-- Check use of 'extra-framework-dirs' field.
checkSpecVer
CabalSpecV1_24
(not . null $ extraFrameworkDirs bi)
(PackageDistSuspiciousWarn CVExtraFrameworkDirs)
-- Check use of default-extensions field don't need to do the
-- equivalent check for other-extensions.
checkSpecVer
CabalSpecV1_10
(not . null $ defaultExtensions bi)
(PackageBuildWarning CVDefaultExtensions)
-- Check use of extensions field
checkP
(sv >= CabalSpecV1_10 && (not . null $ oldExtensions bi))
(PackageBuildWarning CVExtensionsDeprecated)
-- asm-sources, cmm-sources and friends only w/ spec ≥ 1.10
checkCVSources (map getSymbolicPath $ asmSources bi)
checkCVSources (map getSymbolicPath $ cmmSources bi)
checkCVSources (extraBundledLibs bi)
checkCVSources (extraLibFlavours bi)
-- extra-dynamic-library-flavours requires ≥ 3.0
checkSpecVer
CabalSpecV3_0
(not . null $ extraDynLibFlavours bi)
(PackageDistInexcusable $ CVExtraDynamic [extraDynLibFlavours bi])
-- virtual-modules requires ≥ 2.2
checkSpecVer CabalSpecV2_2 (not . null $ virtualModules bi) $
(PackageDistInexcusable CVVirtualModules)
-- Check use of thinning and renaming.
checkSpecVer
CabalSpecV2_0
(not . null $ mixins bi)
(PackageDistInexcusable CVMixins)
checkBuildInfoExtensions bi
where
checkCVSources :: Monad m => [FilePath] -> CheckM m ()
checkCVSources cvs =
checkSpecVer
CabalSpecV3_0
(not . null $ cvs)
(PackageDistInexcusable CVSources)
checkDefaultLanguage :: Monad m => CheckM m ()
checkDefaultLanguage = do
-- < 1.10 has no `default-language` field.
when
(sv >= CabalSpecV1_10 && isNothing (defaultLanguage bi))
-- < 3.4 mandatory, after just a suggestion.
( if sv < CabalSpecV3_4
then tellP (PackageBuildWarning CVDefaultLanguageComponent)
else tellP (PackageDistInexcusable CVDefaultLanguageComponentSoft)
)
-- Tests for extensions usage which can break Cabal < 1.4.
checkBuildInfoExtensions :: Monad m => BuildInfo -> CheckM m ()
checkBuildInfoExtensions bi = do
let exts = allExtensions bi
extCabal1_2 = nub $ filter (`elem` compatExtensionsExtra) exts
extCabal1_4 = nub $ filter (`notElem` compatExtensions) exts
-- As of Cabal-1.4 we can add new extensions without worrying
-- about breaking old versions of cabal.
checkSpecVer
CabalSpecV1_2
(not . null $ extCabal1_2)
( PackageDistInexcusable $
CVExtensions CabalSpecV1_2 extCabal1_2
)
checkSpecVer
CabalSpecV1_4
(not . null $ extCabal1_4)
( PackageDistInexcusable $
CVExtensions CabalSpecV1_4 extCabal1_4
)
where
-- The known extensions in Cabal-1.2.3
compatExtensions :: [Extension]
compatExtensions =
map
EnableExtension
[ OverlappingInstances
, UndecidableInstances
, IncoherentInstances
, RecursiveDo
, ParallelListComp
, MultiParamTypeClasses
, FunctionalDependencies
, Rank2Types
, RankNTypes
, PolymorphicComponents
, ExistentialQuantification
, ScopedTypeVariables
, ImplicitParams
, FlexibleContexts
, FlexibleInstances
, EmptyDataDecls
, CPP
, BangPatterns
, TypeSynonymInstances
, TemplateHaskell
, ForeignFunctionInterface
, Arrows
, Generics
, NamedFieldPuns
, PatternGuards
, GeneralizedNewtypeDeriving
, ExtensibleRecords
, RestrictedTypeSynonyms
, HereDocuments
]
++ map
DisableExtension
[MonomorphismRestriction, ImplicitPrelude]
++ compatExtensionsExtra
-- The extra known extensions in Cabal-1.2.3 vs Cabal-1.1.6
-- (Cabal-1.1.6 came with ghc-6.6. Cabal-1.2 came with ghc-6.8)
compatExtensionsExtra :: [Extension]
compatExtensionsExtra =
map
EnableExtension
[ KindSignatures
, MagicHash
, TypeFamilies
, StandaloneDeriving
, UnicodeSyntax
, PatternSignatures
, UnliftedFFITypes
, LiberalTypeSynonyms
, TypeOperators
, RecordWildCards
, RecordPuns
, DisambiguateRecordFields
, OverloadedStrings
, GADTs
, RelaxedPolyRec
, ExtendedDefaultRules
, UnboxedTuples
, DeriveDataTypeable
, ConstrainedClassMethods
]
++ map
DisableExtension
[MonoPatBinds]
-- Autogenerated modules (Paths_, PackageInfo_) checks. We could pass this
-- function something more specific than the whole BuildInfo, but it would be
-- a tuple of [ModuleName] lists, error prone.
checkAutogenModules
:: Monad m
=> [ModuleName] -- Additional modules not present
-- in BuildInfo (e.g. exposed library
-- modules).
-> BuildInfo
-> CheckM m ()
checkAutogenModules ams bi = do
pkgId <- asksCM (pnPackageId . ccNames)
let
-- It is an unfortunate reality that autogenPathsModuleName
-- and autogenPackageInfoModuleName work on PackageDescription
-- while not needing it all, but just the `package` bit.
minimalPD = emptyPackageDescription{package = pkgId}
autoPathsName = autogenPathsModuleName minimalPD
autoInfoModuleName = autogenPackageInfoModuleName minimalPD
-- Autogenerated module + some default extension build failure.
autogenCheck autoPathsName CVAutogenPaths
rebindableClashCheck autoPathsName RebindableClashPaths
-- Paths_* module + some default extension build failure.
autogenCheck autoInfoModuleName CVAutogenPackageInfo
rebindableClashCheck autoInfoModuleName RebindableClashPackageInfo
-- PackageInfo_* module + cabal-version < 3.12
-- See Mikolaj’s comments on #9481 on why this has to be
-- PackageBuildImpossible and not merely PackageDistInexcusable.
checkSpecVer
CabalSpecV3_12
(elem autoInfoModuleName allModsForAuto)
(PackageBuildImpossible CVAutogenPackageInfoGuard)
where
allModsForAuto :: [ModuleName]
allModsForAuto = ams ++ otherModules bi
autogenCheck
:: Monad m
=> ModuleName
-> CheckExplanation
-> CheckM m ()
autogenCheck name warning = do
sv <- asksCM ccSpecVersion
checkP
( sv >= CabalSpecV2_0
&& elem name allModsForAuto
&& notElem name (autogenModules bi)
)
(PackageDistInexcusable warning)
rebindableClashCheck
:: Monad m
=> ModuleName
-> CheckExplanation
-> CheckM m ()
rebindableClashCheck name warning = do
checkSpecVer
CabalSpecV2_2
( ( name `elem` otherModules bi
|| name `elem` autogenModules bi
)
&& checkExts
)
(PackageBuildImpossible warning)
-- Do we have some peculiar extensions active which would interfere
-- (cabal-version <2.2) with Paths_modules?
checkExts :: Bool
checkExts =
let exts = defaultExtensions bi
in rebind `elem` exts
&& (strings `elem` exts || lists `elem` exts)
where
rebind = EnableExtension RebindableSyntax
strings = EnableExtension OverloadedStrings
lists = EnableExtension OverloadedLists
checkLocalPathExist
:: Monad m
=> String -- .cabal field where we found the error.
-> FilePath
-> CheckM m ()
checkLocalPathExist title dir =
checkPkg
( \ops -> do
dn <- not <$> doesDirectoryExist ops dir
let rp = not (isAbsoluteOnAnyPlatform dir)
return (rp && dn)
)
(PackageBuildWarning $ UnknownDirectory title dir)
-- PVP --
-- Sometimes we read (or end up with) “straddle” deps declarations
-- like this:
--
-- build-depends: base > 3, base < 4
--
-- `mergeDependencies` reduces that to base > 3 && < 4, _while_ maintaining
-- dependencies order in the list (better UX).
mergeDependencies :: [Dependency] -> [Dependency]
mergeDependencies [] = []
mergeDependencies l@(d : _) =
let (sames, diffs) = partition ((== depName d) . depName) l
merged =
Dependency
(depPkgName d)
( foldl intersectVersionRanges anyVersion $
map depVerRange sames
)
(depLibraries d)
in merged : mergeDependencies diffs
where
depName :: Dependency -> String
depName wd = unPackageName . depPkgName $ wd
-- Is this an internal target? We do not perform PVP checks on those,
-- see https://github.com/haskell/cabal/pull/8361#issuecomment-1577547091
isInternalTarget :: CEType -> Bool
isInternalTarget (CETLibrary{}) = False
isInternalTarget (CETForeignLibrary{}) = False
isInternalTarget (CETExecutable{}) = False
isInternalTarget (CETTest{}) = True
isInternalTarget (CETBenchmark{}) = True
isInternalTarget (CETSetup{}) = False
-- ------------------------------------------------------------
-- Options
-- ------------------------------------------------------------
-- Target type for option checking.
data BITarget = BITLib | BITTestBench | BITOther
deriving (Eq, Show)
cet2bit :: CEType -> BITarget
cet2bit (CETLibrary{}) = BITLib
cet2bit (CETForeignLibrary{}) = BITLib
cet2bit (CETExecutable{}) = BITOther
cet2bit (CETTest{}) = BITTestBench
cet2bit (CETBenchmark{}) = BITTestBench
cet2bit CETSetup = BITOther
-- General check on all options (ghc, C, C++, …) for common inaccuracies.
checkBuildInfoOptions :: Monad m => BITarget -> BuildInfo -> CheckM m ()
checkBuildInfoOptions t bi = do
checkGHCOptions "ghc-options" t (hcOptions GHC bi)
checkGHCOptions "ghc-prof-options" t (hcProfOptions GHC bi)
checkGHCOptions "ghc-shared-options" t (hcSharedOptions GHC bi)
let ldOpts = ldOptions bi
checkCLikeOptions LangC "cc-options" (ccOptions bi) ldOpts
checkCLikeOptions LangCPlusPlus "cxx-options" (cxxOptions bi) ldOpts
checkCPPOptions (cppOptions bi)
checkJSPOptions (jsppOptions bi)
-- | Checks GHC options for commonly misused or non-portable flags.
checkGHCOptions
:: Monad m
=> CabalField -- .cabal field name where we found the error.
-> BITarget -- Target type.
-> [String] -- Options (alas in String form).
-> CheckM m ()
checkGHCOptions title t opts = do
checkGeneral
case t of
BITLib -> sequence_ [checkLib, checkNonTestBench]
BITTestBench -> checkTestBench
BITOther -> checkNonTestBench
where
checkFlags :: Monad m => [String] -> PackageCheck -> CheckM m ()
checkFlags fs ck = checkP (any (`elem` fs) opts) ck
checkFlagsP
:: Monad m
=> (String -> Bool)
-> (String -> PackageCheck)
-> CheckM m ()
checkFlagsP p ckc =
case filter p opts of
[] -> return ()
(_ : _) -> tellP (ckc title)
checkGeneral = do
checkFlags
["-fasm"]
(PackageDistInexcusable $ OptFasm title)
checkFlags
["-fhpc"]
(PackageDistInexcusable $ OptHpc title)
checkFlags
["-prof"]
(PackageBuildWarning $ OptProf title)
pid <- asksCM (pnPackageId . ccNames)
-- Scripts add the -o flag in the fake-package.cabal in order to have the
-- executable name match the script name even when there are characters
-- in the script name which are illegal to have as a target name.
unless (pid == fakePackageId) $
checkFlags
["-o"]
(PackageBuildWarning $ OptO title)
checkFlags
["-hide-package"]
(PackageBuildWarning $ OptHide title)
checkFlags
["--make"]
(PackageBuildWarning $ OptMake title)
checkFlags
["-O", "-O1"]
(PackageDistInexcusable $ OptOOne title)
checkFlags
["-O2"]
(PackageDistSuspiciousWarn $ OptOTwo title)
checkFlags
["-split-sections"]
(PackageBuildWarning $ OptSplitSections title)
checkFlags
["-split-objs"]
(PackageBuildWarning $ OptSplitObjs title)
checkFlags
["-optl-Wl,-s", "-optl-s"]
(PackageDistInexcusable $ OptWls title)
checkFlags
["-fglasgow-exts"]
(PackageDistSuspicious $ OptExts title)
let ghcNoRts = rmRtsOpts opts
checkAlternatives
title
"default-extensions"
[ (flag, prettyShow extension)
| flag <- ghcNoRts
, Just extension <- [ghcExtension flag]
]
checkAlternatives
title
"default-extensions"
[ (flag, extension)
| flag@('-' : 'X' : extension) <- ghcNoRts
]
checkAlternatives
title
"cpp-options"
( [(flag, flag) | flag@('-' : 'D' : _) <- ghcNoRts]
++ [(flag, flag) | flag@('-' : 'U' : _) <- ghcNoRts]
)
checkAlternatives
title
"jspp-options"
( [(flag, flag) | flag@('-' : 'D' : _) <- ghcNoRts]
++ [(flag, flag) | flag@('-' : 'U' : _) <- ghcNoRts]
)
checkAlternatives
title
"include-dirs"
[(flag, dir) | flag@('-' : 'I' : dir) <- ghcNoRts]
checkAlternatives
title
"extra-libraries"
[(flag, lib) | flag@('-' : 'l' : lib) <- ghcNoRts]
checkAlternatives
title
"extra-libraries-static"
[(flag, lib) | flag@('-' : 'l' : lib) <- ghcNoRts]
checkAlternatives
title
"extra-lib-dirs"
[(flag, dir) | flag@('-' : 'L' : dir) <- ghcNoRts]
checkAlternatives
title
"extra-lib-dirs-static"
[(flag, dir) | flag@('-' : 'L' : dir) <- ghcNoRts]
checkAlternatives
title
"frameworks"
[ (flag, fmwk)
| (flag@"-framework", fmwk) <-
zip ghcNoRts (safeTail ghcNoRts)
]
checkAlternatives
title
"extra-framework-dirs"
[ (flag, dir)
| (flag@"-framework-path", dir) <-
zip ghcNoRts (safeTail ghcNoRts)
]
-- Old `checkDevelopmentOnlyFlagsOptions` section
checkFlags
["-Werror"]
(PackageDistInexcusable $ WErrorUnneeded title)
checkFlags
["-fdefer-type-errors"]
(PackageDistInexcusable $ FDeferTypeErrorsUnneeded title)
checkFlags
[ "-fprof-auto"
, "-fprof-auto-top"
, "-fprof-auto-calls"
, "-fprof-cafs"
, "-fno-prof-count-entries"
, "-auto-all"
, "-auto"
, "-caf-all"
]
(PackageDistSuspicious $ ProfilingUnneeded title)
checkFlagsP
( \opt ->
"-d" `isPrefixOf` opt
&& opt /= "-dynamic"
)
(PackageDistInexcusable . DynamicUnneeded)
checkFlagsP
( \opt -> case opt of
"-j" -> True
('-' : 'j' : d : _) -> isDigit d
_ -> False
)
(PackageDistInexcusable . JUnneeded)
checkLib = do
checkP
("-rtsopts" `elem` opts)
(PackageBuildWarning $ OptRts title)
checkP
(any (\opt -> "-with-rtsopts" `isPrefixOf` opt) opts)
(PackageBuildWarning $ OptWithRts title)
checkTestBench = do
checkFlags
["-O0", "-Onot"]
(PackageDistSuspiciousWarn $ OptONot title)
checkNonTestBench = do
checkFlags
["-O0", "-Onot"]
(PackageDistSuspicious $ OptONot title)
ghcExtension ('-' : 'f' : name) = case name of
"allow-overlapping-instances" -> enable OverlappingInstances
"no-allow-overlapping-instances" -> disable OverlappingInstances
"th" -> enable TemplateHaskell
"no-th" -> disable TemplateHaskell
"ffi" -> enable ForeignFunctionInterface
"no-ffi" -> disable ForeignFunctionInterface
"fi" -> enable ForeignFunctionInterface
"no-fi" -> disable ForeignFunctionInterface
"monomorphism-restriction" -> enable MonomorphismRestriction
"no-monomorphism-restriction" -> disable MonomorphismRestriction
"mono-pat-binds" -> enable MonoPatBinds
"no-mono-pat-binds" -> disable MonoPatBinds
"allow-undecidable-instances" -> enable UndecidableInstances
"no-allow-undecidable-instances" -> disable UndecidableInstances
"allow-incoherent-instances" -> enable IncoherentInstances
"no-allow-incoherent-instances" -> disable IncoherentInstances
"arrows" -> enable Arrows
"no-arrows" -> disable Arrows
"generics" -> enable Generics
"no-generics" -> disable Generics
"implicit-prelude" -> enable ImplicitPrelude
"no-implicit-prelude" -> disable ImplicitPrelude
"implicit-params" -> enable ImplicitParams
"no-implicit-params" -> disable ImplicitParams
"bang-patterns" -> enable BangPatterns
"no-bang-patterns" -> disable BangPatterns
"scoped-type-variables" -> enable ScopedTypeVariables
"no-scoped-type-variables" -> disable ScopedTypeVariables
"extended-default-rules" -> enable ExtendedDefaultRules
"no-extended-default-rules" -> disable ExtendedDefaultRules
_ -> Nothing
ghcExtension "-cpp" = enable CPP
ghcExtension _ = Nothing
enable e = Just (EnableExtension e)
disable e = Just (DisableExtension e)
rmRtsOpts :: [String] -> [String]
rmRtsOpts ("-with-rtsopts" : _ : xs) = rmRtsOpts xs
rmRtsOpts (x : xs) = x : rmRtsOpts xs
rmRtsOpts [] = []
checkCLikeOptions
:: Monad m
=> WarnLang -- Language we are warning about (C or C++).
-> CabalField -- Field where we found the error.
-> [String] -- Options in string form.
-> [String] -- Link options in String form.
-> CheckM m ()
checkCLikeOptions label prefix opts ldOpts = do
checkAlternatives
prefix
"include-dirs"
[(flag, dir) | flag@('-' : 'I' : dir) <- opts]
checkAlternatives
prefix
"extra-libraries"
[(flag, lib) | flag@('-' : 'l' : lib) <- opts]
checkAlternatives
prefix
"extra-lib-dirs"
[(flag, dir) | flag@('-' : 'L' : dir) <- opts]
checkAlternatives
"ld-options"
"extra-libraries"
[(flag, lib) | flag@('-' : 'l' : lib) <- ldOpts]
checkAlternatives
"ld-options"
"extra-lib-dirs"
[(flag, dir) | flag@('-' : 'L' : dir) <- ldOpts]
checkP
(any (`elem` ["-O", "-Os", "-O0", "-O1", "-O2", "-O3"]) opts)
(PackageDistSuspicious $ COptONumber prefix label)
checkAlternatives
:: Monad m
=> CabalField -- Wrong field.
-> CabalField -- Appropriate field.
-> [(String, String)] -- List of good and bad flags.
-> CheckM m ()
checkAlternatives badField goodField flags = do
let (badFlags, _) = unzip flags
checkP
(not $ null badFlags)
(PackageBuildWarning $ OptAlternatives badField goodField flags)
checkCPPOptions
:: Monad m
=> [String] -- Options in String form.
-> CheckM m ()
checkCPPOptions opts = do
checkAlternatives
"cpp-options"
"include-dirs"
[(flag, dir) | flag@('-' : 'I' : dir) <- opts]
mapM_
( \opt ->
checkP
(not $ any (`isPrefixOf` opt) ["-D", "-U", "-I"])
(PackageBuildWarning (COptCPP opt))
)
opts
checkJSPOptions
:: Monad m
=> [String] -- Options in String form.
-> CheckM m ()
checkJSPOptions opts = do
checkAlternatives
"jspp-options"
"include-dirs"
[(flag, dir) | flag@('-' : 'I' : dir) <- opts]
mapM_
( \opt ->
checkP
(not $ any (`isPrefixOf` opt) ["-D", "-U", "-I"])
(PackageBuildWarning (OptJSPP opt))
)
opts