-- |
-- 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 :: forall (m :: * -> *).
Monad m =>
Bool -> [AssocDep] -> Library -> CheckM m ()
checkLibrary
  Bool
isSub
  [AssocDep]
ads
  lib :: Library
lib@( Library
          LibraryName
libName_
          [ModuleName]
_exposedModules_
          [ModuleReexport]
reexportedModules_
          [ModuleName]
signatures_
          Bool
_libExposed_
          LibraryVisibility
_libVisibility_
          BuildInfo
libBuildInfo_
        ) = do
    (ModuleName -> CheckM m ()) -> [ModuleName] -> CheckM m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ModuleName -> CheckM m ()
forall (m :: * -> *). Monad m => ModuleName -> CheckM m ()
checkModuleName (Library -> [ModuleName]
explicitLibModules Library
lib)

    Bool -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
Bool -> PackageCheck -> CheckM m ()
checkP
      (LibraryName
libName_ LibraryName -> LibraryName -> Bool
forall a. Eq a => a -> a -> Bool
== LibraryName
LMainLibName Bool -> Bool -> Bool
&& Bool
isSub)
      (CheckExplanation -> PackageCheck
PackageBuildImpossible CheckExplanation
UnnamedInternal)
    -- TODO: bogus if a required-signature was passed through.
    Bool -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
Bool -> PackageCheck -> CheckM m ()
checkP
      ([ModuleName] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Library -> [ModuleName]
explicitLibModules Library
lib) Bool -> Bool -> Bool
&& [ModuleReexport] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ModuleReexport]
reexportedModules_)
      (CheckExplanation -> PackageCheck
PackageDistSuspiciousWarn (LibraryName -> CheckExplanation
NoModulesExposed LibraryName
libName_))
    -- TODO parse-caught check, can safely remove.
    CabalSpecVersion -> Bool -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
CabalSpecVersion -> Bool -> PackageCheck -> CheckM m ()
checkSpecVer
      CabalSpecVersion
CabalSpecV2_0
      (Bool -> Bool
not (Bool -> Bool) -> ([ModuleName] -> Bool) -> [ModuleName] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ModuleName] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([ModuleName] -> Bool) -> [ModuleName] -> Bool
forall a b. (a -> b) -> a -> b
$ [ModuleName]
signatures_)
      (CheckExplanation -> PackageCheck
PackageDistInexcusable CheckExplanation
SignaturesCabal2)
    -- autogen/includes checks.
    Bool -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
Bool -> PackageCheck -> CheckM m ()
checkP
      ( Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
          (ModuleName -> Bool) -> [ModuleName] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all
            ((ModuleName -> [ModuleName] -> Bool)
-> [ModuleName] -> ModuleName -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip ModuleName -> [ModuleName] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (Library -> [ModuleName]
explicitLibModules Library
lib))
            (Library -> [ModuleName]
libModulesAutogen Library
lib)
      )
      (CheckExplanation -> PackageCheck
PackageBuildImpossible CheckExplanation
AutogenNotExposed)
    -- check that all autogen-includes appear on includes or
    -- install-includes.
    Bool -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
Bool -> PackageCheck -> CheckM m ()
checkP
      ( Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
          (SymbolicPathX 'OnlyRelative Include 'File -> Bool)
-> [SymbolicPathX 'OnlyRelative Include 'File] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all
            ((FilePath -> [FilePath] -> Bool) -> [FilePath] -> FilePath -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip FilePath -> [FilePath] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (Library -> [FilePath]
forall a. HasBuildInfo a => a -> [FilePath]
allExplicitIncludes Library
lib) (FilePath -> Bool)
-> (SymbolicPathX 'OnlyRelative Include 'File -> FilePath)
-> SymbolicPathX 'OnlyRelative Include 'File
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SymbolicPathX 'OnlyRelative Include 'File -> FilePath
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> FilePath
getSymbolicPath)
            (Getting
  [SymbolicPathX 'OnlyRelative Include 'File]
  Library
  [SymbolicPathX 'OnlyRelative Include 'File]
-> Library -> [SymbolicPathX 'OnlyRelative Include 'File]
forall a s. Getting a s a -> s -> a
view Getting
  [SymbolicPathX 'OnlyRelative Include 'File]
  Library
  [SymbolicPathX 'OnlyRelative Include 'File]
forall a.
HasBuildInfo a =>
Lens' a [SymbolicPathX 'OnlyRelative Include 'File]
Lens' Library [SymbolicPathX 'OnlyRelative Include 'File]
L.autogenIncludes Library
lib)
      )
      (PackageCheck -> CheckM m ()) -> PackageCheck -> CheckM m ()
forall a b. (a -> b) -> a -> b
$ (CheckExplanation -> PackageCheck
PackageBuildImpossible CheckExplanation
AutogenIncludesNotIncluded)

    -- § Build infos.
    CEType -> [ModuleName] -> [AssocDep] -> BuildInfo -> CheckM m ()
forall (m :: * -> *).
Monad m =>
CEType -> [ModuleName] -> [AssocDep] -> BuildInfo -> CheckM m ()
checkBuildInfo
      (LibraryName -> CEType
CETLibrary LibraryName
libName_)
      (Library -> [ModuleName]
explicitLibModules Library
lib)
      [AssocDep]
ads
      BuildInfo
libBuildInfo_

    -- Feature checks.
    -- check use of reexported-modules sections
    CabalSpecVersion -> Bool -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
CabalSpecVersion -> Bool -> PackageCheck -> CheckM m ()
checkSpecVer
      CabalSpecVersion
CabalSpecV1_22
      (Bool -> Bool
not (Bool -> Bool)
-> ([ModuleReexport] -> Bool) -> [ModuleReexport] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ModuleReexport] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([ModuleReexport] -> Bool) -> [ModuleReexport] -> Bool
forall a b. (a -> b) -> a -> b
$ [ModuleReexport]
reexportedModules_)
      (CheckExplanation -> PackageCheck
PackageDistInexcusable CheckExplanation
CVReexported)
    where
      allExplicitIncludes :: L.HasBuildInfo a => a -> [FilePath]
      allExplicitIncludes :: forall a. HasBuildInfo a => a -> [FilePath]
allExplicitIncludes a
x =
        (SymbolicPathX 'AllowAbsolute Include 'File -> FilePath)
-> [SymbolicPathX 'AllowAbsolute Include 'File] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map SymbolicPathX 'AllowAbsolute Include 'File -> FilePath
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> FilePath
getSymbolicPath (Getting
  [SymbolicPathX 'AllowAbsolute Include 'File]
  a
  [SymbolicPathX 'AllowAbsolute Include 'File]
-> a -> [SymbolicPathX 'AllowAbsolute Include 'File]
forall a s. Getting a s a -> s -> a
view Getting
  [SymbolicPathX 'AllowAbsolute Include 'File]
  a
  [SymbolicPathX 'AllowAbsolute Include 'File]
forall a.
HasBuildInfo a =>
Lens' a [SymbolicPathX 'AllowAbsolute Include 'File]
Lens' a [SymbolicPathX 'AllowAbsolute Include 'File]
L.includes a
x)
          [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (SymbolicPathX 'OnlyRelative Include 'File -> FilePath)
-> [SymbolicPathX 'OnlyRelative Include 'File] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map SymbolicPathX 'OnlyRelative Include 'File -> FilePath
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> FilePath
getSymbolicPath (Getting
  [SymbolicPathX 'OnlyRelative Include 'File]
  a
  [SymbolicPathX 'OnlyRelative Include 'File]
-> a -> [SymbolicPathX 'OnlyRelative Include 'File]
forall a s. Getting a s a -> s -> a
view Getting
  [SymbolicPathX 'OnlyRelative Include 'File]
  a
  [SymbolicPathX 'OnlyRelative Include 'File]
forall a.
HasBuildInfo a =>
Lens' a [SymbolicPathX 'OnlyRelative Include 'File]
Lens' a [SymbolicPathX 'OnlyRelative Include 'File]
L.installIncludes a
x)

checkForeignLib :: Monad m => ForeignLib -> CheckM m ()
checkForeignLib :: forall (m :: * -> *). Monad m => ForeignLib -> CheckM m ()
checkForeignLib
  ( ForeignLib
      UnqualComponentName
foreignLibName_
      ForeignLibType
_foreignLibType_
      [ForeignLibOption]
_foreignLibOptions_
      BuildInfo
foreignLibBuildInfo_
      Maybe LibVersionInfo
_foreignLibVersionInfo_
      Maybe Version
_foreignLibVersionLinux_
      [RelativePath Source 'File]
_foreignLibModDefFile_
    ) = do
    CEType -> [ModuleName] -> [AssocDep] -> BuildInfo -> CheckM m ()
forall (m :: * -> *).
Monad m =>
CEType -> [ModuleName] -> [AssocDep] -> BuildInfo -> CheckM m ()
checkBuildInfo
      (UnqualComponentName -> CEType
CETForeignLibrary UnqualComponentName
foreignLibName_)
      []
      []
      BuildInfo
foreignLibBuildInfo_

checkExecutable
  :: Monad m
  => [AssocDep] -- “Inherited” dependencies for PVP checks.
  -> Executable
  -> CheckM m ()
checkExecutable :: forall (m :: * -> *).
Monad m =>
[AssocDep] -> Executable -> CheckM m ()
checkExecutable
  [AssocDep]
ads
  exe :: Executable
exe@( Executable
          UnqualComponentName
exeName_
          RelativePath Source 'File
symbolicModulePath_
          ExecutableScope
_exeScope_
          BuildInfo
buildInfo_
        ) = do
    -- Target type/name (exe).
    let cet :: CEType
cet = UnqualComponentName -> CEType
CETExecutable UnqualComponentName
exeName_
        modulePath_ :: FilePath
modulePath_ = RelativePath Source 'File -> FilePath
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> FilePath
getSymbolicPath RelativePath Source 'File
symbolicModulePath_

    (ModuleName -> CheckM m ()) -> [ModuleName] -> CheckM m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ModuleName -> CheckM m ()
forall (m :: * -> *). Monad m => ModuleName -> CheckM m ()
checkModuleName (Executable -> [ModuleName]
exeModules Executable
exe)

    -- § Exe specific checks
    Bool -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
Bool -> PackageCheck -> CheckM m ()
checkP
      (FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
modulePath_)
      (CheckExplanation -> PackageCheck
PackageBuildImpossible (UnqualComponentName -> CheckExplanation
NoMainIs UnqualComponentName
exeName_))
    -- This check does not apply to scripts.
    pid <- (CheckCtx m -> PackageIdentifier) -> CheckM m PackageIdentifier
forall (m :: * -> *) a. Monad m => (CheckCtx m -> a) -> CheckM m a
asksCM (PNames -> PackageIdentifier
pnPackageId (PNames -> PackageIdentifier)
-> (CheckCtx m -> PNames) -> CheckCtx m -> PackageIdentifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CheckCtx m -> PNames
forall (m :: * -> *). CheckCtx m -> PNames
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 :: forall (m :: * -> *).
Monad m =>
[AssocDep] -> TestSuite -> CheckM m ()
checkTestSuite
  [AssocDep]
ads
  ts :: TestSuite
ts@( TestSuite
        UnqualComponentName
testName_
        TestSuiteInterface
testInterface_
        BuildInfo
testBuildInfo_
        [FilePath]
_testCodeGenerators_
      ) = do
    -- Target type/name (test).
    let cet :: CEType
cet = UnqualComponentName -> CEType
CETTest UnqualComponentName
testName_

    -- § TS specific checks.
    -- TODO caught by the parser, can remove safely
    case TestSuiteInterface
testInterface_ of
      TestSuiteUnsupported tt :: TestType
tt@(TestTypeUnknown FilePath
_ Version
_) ->
        PackageCheck -> CheckM m ()
forall (m :: * -> *). Monad m => PackageCheck -> CheckM m ()
tellP (CheckExplanation -> PackageCheck
PackageBuildWarning (CheckExplanation -> PackageCheck)
-> CheckExplanation -> PackageCheck
forall a b. (a -> b) -> a -> b
$ TestType -> CheckExplanation
TestsuiteTypeNotKnown TestType
tt)
      TestSuiteUnsupported TestType
tt ->
        PackageCheck -> CheckM m ()
forall (m :: * -> *). Monad m => PackageCheck -> CheckM m ()
tellP (CheckExplanation -> PackageCheck
PackageBuildWarning (CheckExplanation -> PackageCheck)
-> CheckExplanation -> PackageCheck
forall a b. (a -> b) -> a -> b
$ TestType -> CheckExplanation
TestsuiteNotSupported TestType
tt)
      TestSuiteInterface
_ -> () -> CheckM m ()
forall a. a -> CheckM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    (ModuleName -> CheckM m ()) -> [ModuleName] -> CheckM m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ModuleName -> CheckM m ()
forall (m :: * -> *). Monad m => ModuleName -> CheckM m ()
checkModuleName (TestSuite -> [ModuleName]
testModules TestSuite
ts)

    Bool -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
Bool -> PackageCheck -> CheckM m ()
checkP
      Bool
mainIsWrongExt
      (CheckExplanation -> PackageCheck
PackageBuildImpossible CheckExplanation
NoHsLhsMain)
    Bool -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
Bool -> PackageCheck -> CheckM m ()
checkP
      ( Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
          (ModuleName -> Bool) -> [ModuleName] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all
            ((ModuleName -> [ModuleName] -> Bool)
-> [ModuleName] -> ModuleName -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip ModuleName -> [ModuleName] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (TestSuite -> [ModuleName]
testModules TestSuite
ts))
            (TestSuite -> [ModuleName]
testModulesAutogen TestSuite
ts)
      )
      (CheckExplanation -> PackageCheck
PackageBuildImpossible (CheckExplanation -> PackageCheck)
-> CheckExplanation -> PackageCheck
forall a b. (a -> b) -> a -> b
$ CEType -> CheckExplanation
AutogenNoOther CEType
cet)
    Bool -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
Bool -> PackageCheck -> CheckM m ()
checkP
      ( Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
          (SymbolicPathX 'OnlyRelative Include 'File -> Bool)
-> [SymbolicPathX 'OnlyRelative Include 'File] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all
            ((SymbolicPathX 'AllowAbsolute Include 'File
 -> [SymbolicPathX 'AllowAbsolute Include 'File] -> Bool)
-> [SymbolicPathX 'AllowAbsolute Include 'File]
-> SymbolicPathX 'AllowAbsolute Include 'File
-> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip SymbolicPathX 'AllowAbsolute Include 'File
-> [SymbolicPathX 'AllowAbsolute Include 'File] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (Getting
  [SymbolicPathX 'AllowAbsolute Include 'File]
  TestSuite
  [SymbolicPathX 'AllowAbsolute Include 'File]
-> TestSuite -> [SymbolicPathX 'AllowAbsolute Include 'File]
forall a s. Getting a s a -> s -> a
view Getting
  [SymbolicPathX 'AllowAbsolute Include 'File]
  TestSuite
  [SymbolicPathX 'AllowAbsolute Include 'File]
forall a.
HasBuildInfo a =>
Lens' a [SymbolicPathX 'AllowAbsolute Include 'File]
Lens' TestSuite [SymbolicPathX 'AllowAbsolute Include 'File]
L.includes TestSuite
ts) (SymbolicPathX 'AllowAbsolute Include 'File -> Bool)
-> (SymbolicPathX 'OnlyRelative Include 'File
    -> SymbolicPathX 'AllowAbsolute Include 'File)
-> SymbolicPathX 'OnlyRelative Include 'File
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SymbolicPathX 'OnlyRelative Include 'File
-> SymbolicPathX 'AllowAbsolute Include 'File
forall from (to :: FileOrDir).
RelativePath from to -> SymbolicPath from to
relativeSymbolicPath)
            (Getting
  [SymbolicPathX 'OnlyRelative Include 'File]
  TestSuite
  [SymbolicPathX 'OnlyRelative Include 'File]
-> TestSuite -> [SymbolicPathX 'OnlyRelative Include 'File]
forall a s. Getting a s a -> s -> a
view Getting
  [SymbolicPathX 'OnlyRelative Include 'File]
  TestSuite
  [SymbolicPathX 'OnlyRelative Include 'File]
forall a.
HasBuildInfo a =>
Lens' a [SymbolicPathX 'OnlyRelative Include 'File]
Lens' TestSuite [SymbolicPathX 'OnlyRelative Include 'File]
L.autogenIncludes TestSuite
ts)
      )
      (CheckExplanation -> PackageCheck
PackageBuildImpossible CheckExplanation
AutogenIncludesNotIncludedExe)

    -- § Feature checks.
    CabalSpecVersion -> Bool -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
CabalSpecVersion -> Bool -> PackageCheck -> CheckM m ()
checkSpecVer
      CabalSpecVersion
CabalSpecV1_18
      (Bool
mainIsNotHsExt Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
mainIsWrongExt)
      (CheckExplanation -> PackageCheck
PackageDistInexcusable CheckExplanation
MainCCabal1_18)

    -- § Build info checks.
    CEType -> [ModuleName] -> [AssocDep] -> BuildInfo -> CheckM m ()
forall (m :: * -> *).
Monad m =>
CEType -> [ModuleName] -> [AssocDep] -> BuildInfo -> CheckM m ()
checkBuildInfo CEType
cet [] [AssocDep]
ads BuildInfo
testBuildInfo_
    where
      mainIsWrongExt :: Bool
mainIsWrongExt =
        case TestSuiteInterface
testInterface_ of
          TestSuiteExeV10 Version
_ RelativePath Source 'File
f -> Bool -> Bool
not (FilePath -> Bool
fileExtensionSupportedLanguage (FilePath -> Bool) -> FilePath -> Bool
forall a b. (a -> b) -> a -> b
$ RelativePath Source 'File -> FilePath
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> FilePath
getSymbolicPath RelativePath Source 'File
f)
          TestSuiteInterface
_ -> Bool
False

      mainIsNotHsExt :: Bool
mainIsNotHsExt =
        case TestSuiteInterface
testInterface_ of
          TestSuiteExeV10 Version
_ RelativePath Source 'File
f -> FilePath -> FilePath
takeExtension (RelativePath Source 'File -> FilePath
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> FilePath
getSymbolicPath RelativePath Source 'File
f) FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [FilePath
".hs", FilePath
".lhs"]
          TestSuiteInterface
_ -> Bool
False

checkBenchmark
  :: Monad m
  => [AssocDep] -- “Inherited” dependencies for PVP checks.
  -> Benchmark
  -> CheckM m ()
checkBenchmark :: forall (m :: * -> *).
Monad m =>
[AssocDep] -> Benchmark -> CheckM m ()
checkBenchmark
  [AssocDep]
ads
  bm :: Benchmark
bm@( Benchmark
        UnqualComponentName
benchmarkName_
        BenchmarkInterface
benchmarkInterface_
        BuildInfo
benchmarkBuildInfo_
      ) = do
    -- Target type/name (benchmark).
    let cet :: CEType
cet = UnqualComponentName -> CEType
CETBenchmark UnqualComponentName
benchmarkName_

    (ModuleName -> CheckM m ()) -> [ModuleName] -> CheckM m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ModuleName -> CheckM m ()
forall (m :: * -> *). Monad m => ModuleName -> CheckM m ()
checkModuleName (Benchmark -> [ModuleName]
benchmarkModules Benchmark
bm)

    -- § Interface & bm specific tests.
    case BenchmarkInterface
benchmarkInterface_ of
      BenchmarkUnsupported tt :: BenchmarkType
tt@(BenchmarkTypeUnknown FilePath
_ Version
_) ->
        PackageCheck -> CheckM m ()
forall (m :: * -> *). Monad m => PackageCheck -> CheckM m ()
tellP (CheckExplanation -> PackageCheck
PackageBuildWarning (CheckExplanation -> PackageCheck)
-> CheckExplanation -> PackageCheck
forall a b. (a -> b) -> a -> b
$ BenchmarkType -> CheckExplanation
BenchmarkTypeNotKnown BenchmarkType
tt)
      BenchmarkUnsupported BenchmarkType
tt ->
        PackageCheck -> CheckM m ()
forall (m :: * -> *). Monad m => PackageCheck -> CheckM m ()
tellP (CheckExplanation -> PackageCheck
PackageBuildWarning (CheckExplanation -> PackageCheck)
-> CheckExplanation -> PackageCheck
forall a b. (a -> b) -> a -> b
$ BenchmarkType -> CheckExplanation
BenchmarkNotSupported BenchmarkType
tt)
      BenchmarkInterface
_ -> () -> CheckM m ()
forall a. a -> CheckM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Bool -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
Bool -> PackageCheck -> CheckM m ()
checkP
      Bool
mainIsWrongExt
      (CheckExplanation -> PackageCheck
PackageBuildImpossible CheckExplanation
NoHsLhsMainBench)

    Bool -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
Bool -> PackageCheck -> CheckM m ()
checkP
      ( Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
          (ModuleName -> Bool) -> [ModuleName] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all
            ((ModuleName -> [ModuleName] -> Bool)
-> [ModuleName] -> ModuleName -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip ModuleName -> [ModuleName] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (Benchmark -> [ModuleName]
benchmarkModules Benchmark
bm))
            (Benchmark -> [ModuleName]
benchmarkModulesAutogen Benchmark
bm)
      )
      (CheckExplanation -> PackageCheck
PackageBuildImpossible (CheckExplanation -> PackageCheck)
-> CheckExplanation -> PackageCheck
forall a b. (a -> b) -> a -> b
$ CEType -> CheckExplanation
AutogenNoOther CEType
cet)

    Bool -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
Bool -> PackageCheck -> CheckM m ()
checkP
      ( Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
          (SymbolicPathX 'OnlyRelative Include 'File -> Bool)
-> [SymbolicPathX 'OnlyRelative Include 'File] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all
            ((SymbolicPathX 'AllowAbsolute Include 'File
 -> [SymbolicPathX 'AllowAbsolute Include 'File] -> Bool)
-> [SymbolicPathX 'AllowAbsolute Include 'File]
-> SymbolicPathX 'AllowAbsolute Include 'File
-> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip SymbolicPathX 'AllowAbsolute Include 'File
-> [SymbolicPathX 'AllowAbsolute Include 'File] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (Getting
  [SymbolicPathX 'AllowAbsolute Include 'File]
  Benchmark
  [SymbolicPathX 'AllowAbsolute Include 'File]
-> Benchmark -> [SymbolicPathX 'AllowAbsolute Include 'File]
forall a s. Getting a s a -> s -> a
view Getting
  [SymbolicPathX 'AllowAbsolute Include 'File]
  Benchmark
  [SymbolicPathX 'AllowAbsolute Include 'File]
forall a.
HasBuildInfo a =>
Lens' a [SymbolicPathX 'AllowAbsolute Include 'File]
Lens' Benchmark [SymbolicPathX 'AllowAbsolute Include 'File]
L.includes Benchmark
bm) (SymbolicPathX 'AllowAbsolute Include 'File -> Bool)
-> (SymbolicPathX 'OnlyRelative Include 'File
    -> SymbolicPathX 'AllowAbsolute Include 'File)
-> SymbolicPathX 'OnlyRelative Include 'File
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SymbolicPathX 'OnlyRelative Include 'File
-> SymbolicPathX 'AllowAbsolute Include 'File
forall from (to :: FileOrDir).
RelativePath from to -> SymbolicPath from to
relativeSymbolicPath)
            (Getting
  [SymbolicPathX 'OnlyRelative Include 'File]
  Benchmark
  [SymbolicPathX 'OnlyRelative Include 'File]
-> Benchmark -> [SymbolicPathX 'OnlyRelative Include 'File]
forall a s. Getting a s a -> s -> a
view Getting
  [SymbolicPathX 'OnlyRelative Include 'File]
  Benchmark
  [SymbolicPathX 'OnlyRelative Include 'File]
forall a.
HasBuildInfo a =>
Lens' a [SymbolicPathX 'OnlyRelative Include 'File]
Lens' Benchmark [SymbolicPathX 'OnlyRelative Include 'File]
L.autogenIncludes Benchmark
bm)
      )
      (CheckExplanation -> PackageCheck
PackageBuildImpossible CheckExplanation
AutogenIncludesNotIncludedExe)

    -- § BuildInfo checks.
    CEType -> [ModuleName] -> [AssocDep] -> BuildInfo -> CheckM m ()
forall (m :: * -> *).
Monad m =>
CEType -> [ModuleName] -> [AssocDep] -> BuildInfo -> CheckM m ()
checkBuildInfo CEType
cet [] [AssocDep]
ads BuildInfo
benchmarkBuildInfo_
    where
      -- Cannot abstract with similar function in checkTestSuite,
      -- they are different.
      mainIsWrongExt :: Bool
mainIsWrongExt =
        case BenchmarkInterface
benchmarkInterface_ of
          BenchmarkExeV10 Version
_ RelativePath Source 'File
f -> FilePath -> FilePath
takeExtension (RelativePath Source 'File -> FilePath
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> FilePath
getSymbolicPath RelativePath Source 'File
f) FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [FilePath
".hs", FilePath
".lhs"]
          BenchmarkInterface
_ -> Bool
False

-- | Check if a module name is valid on both Windows and Posix systems
checkModuleName :: Monad m => ModuleName -> CheckM m ()
checkModuleName :: forall (m :: * -> *). Monad m => ModuleName -> CheckM m ()
checkModuleName ModuleName
moduleName =
  PathKind -> FilePath -> CheckM m ()
forall (m :: * -> *).
Monad m =>
PathKind -> FilePath -> CheckM m ()
checkPackageFileNamesWithGlob PathKind
PathKindFile (ModuleName -> FilePath
toFilePath ModuleName
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 :: forall (m :: * -> *).
Monad m =>
CEType -> [ModuleName] -> [AssocDep] -> BuildInfo -> CheckM m ()
checkBuildInfo CEType
cet [ModuleName]
ams [AssocDep]
ads BuildInfo
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.

  BITarget -> BuildInfo -> CheckM m ()
forall (m :: * -> *).
Monad m =>
BITarget -> BuildInfo -> CheckM m ()
checkBuildInfoOptions (CEType -> BITarget
cet2bit CEType
cet) BuildInfo
bi
  BuildInfo -> CheckM m ()
forall (m :: * -> *). Monad m => BuildInfo -> CheckM m ()
checkBuildInfoPathsContent BuildInfo
bi
  BuildInfo -> CheckM m ()
forall (m :: * -> *). Monad m => BuildInfo -> CheckM m ()
checkBuildInfoPathsWellFormedness BuildInfo
bi

  sv <- (CheckCtx m -> CabalSpecVersion) -> CheckM m CabalSpecVersion
forall (m :: * -> *) a. Monad m => (CheckCtx m -> a) -> CheckM m a
asksCM CheckCtx m -> CabalSpecVersion
forall (m :: * -> *). CheckCtx m -> CabalSpecVersion
ccSpecVersion
  checkBuildInfoFeatures bi sv

  checkAutogenModules ams bi

  -- PVP: we check for base and all other deps.
  let ds = [Dependency] -> [Dependency]
mergeDependencies ([Dependency] -> [Dependency]) -> [Dependency] -> [Dependency]
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [Dependency]
targetBuildDepends BuildInfo
bi
  (ids, rds) <-
    partitionDeps
      ads
      [mkUnqualComponentName "base"]
      ds
  let ick = PackageCheck -> b -> PackageCheck
forall a b. a -> b -> a
const (CheckExplanation -> PackageCheck
PackageDistInexcusable CheckExplanation
BaseNoUpperBounds)
      rck = CheckExplanation -> PackageCheck
PackageDistSuspiciousWarn (CheckExplanation -> PackageCheck)
-> ([FilePath] -> CheckExplanation) -> [FilePath] -> PackageCheck
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CEType -> [FilePath] -> CheckExplanation
MissingUpperBounds CEType
cet
      leuck = CheckExplanation -> PackageCheck
PackageDistSuspiciousWarn (CheckExplanation -> PackageCheck)
-> ([FilePath] -> CheckExplanation) -> [FilePath] -> PackageCheck
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CEType -> [FilePath] -> CheckExplanation
LEUpperBounds CEType
cet
      tzuck = CheckExplanation -> PackageCheck
PackageDistSuspiciousWarn (CheckExplanation -> PackageCheck)
-> ([FilePath] -> CheckExplanation) -> [FilePath] -> PackageCheck
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CEType -> [FilePath] -> CheckExplanation
TrailingZeroUpperBounds CEType
cet
      gtlck = CheckExplanation -> PackageCheck
PackageDistSuspiciousWarn (CheckExplanation -> PackageCheck)
-> ([FilePath] -> CheckExplanation) -> [FilePath] -> PackageCheck
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CEType -> [FilePath] -> CheckExplanation
GTLowerBounds CEType
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 :: forall (m :: * -> *). Monad m => BuildInfo -> CheckM m ()
checkBuildInfoPathsContent BuildInfo
bi = do
  (Language -> CheckM m ()) -> [Language] -> CheckM m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Language -> CheckM m ()
forall (m :: * -> *). Monad m => Language -> CheckM m ()
checkLang (BuildInfo -> [Language]
allLanguages BuildInfo
bi)
  (Extension -> CheckM m ()) -> [Extension] -> CheckM m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Extension -> CheckM m ()
forall (m :: * -> *). Monad m => Extension -> CheckM m ()
checkExt (BuildInfo -> [Extension]
allExtensions BuildInfo
bi)
  (Dependency -> CheckM m ()) -> [Dependency] -> CheckM m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Dependency -> CheckM m ()
forall (m :: * -> *). Monad m => Dependency -> CheckM m ()
checkIntDep (BuildInfo -> [Dependency]
targetBuildDepends BuildInfo
bi)
  df <- (CheckCtx m -> LegacyExeDependency -> Maybe ExeDependency)
-> CheckM m (LegacyExeDependency -> Maybe ExeDependency)
forall (m :: * -> *) a. Monad m => (CheckCtx m -> a) -> CheckM m a
asksCM CheckCtx m -> LegacyExeDependency -> Maybe ExeDependency
forall (m :: * -> *).
CheckCtx m -> LegacyExeDependency -> Maybe ExeDependency
ccDesugar
  -- This way we can use the same function for legacy&non exedeps.
  let ds = BuildInfo -> [ExeDependency]
buildToolDepends BuildInfo
bi [ExeDependency] -> [ExeDependency] -> [ExeDependency]
forall a. [a] -> [a] -> [a]
++ [Maybe ExeDependency] -> [ExeDependency]
forall a. [Maybe a] -> [a]
catMaybes ((LegacyExeDependency -> Maybe ExeDependency)
-> [LegacyExeDependency] -> [Maybe ExeDependency]
forall a b. (a -> b) -> [a] -> [b]
map LegacyExeDependency -> Maybe ExeDependency
df ([LegacyExeDependency] -> [Maybe ExeDependency])
-> [LegacyExeDependency] -> [Maybe ExeDependency]
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [LegacyExeDependency]
buildTools BuildInfo
bi)
  mapM_ checkBTDep ds
  where
    checkLang :: Monad m => Language -> CheckM m ()
    checkLang :: forall (m :: * -> *). Monad m => Language -> CheckM m ()
checkLang (UnknownLanguage FilePath
n) =
      PackageCheck -> CheckM m ()
forall (m :: * -> *). Monad m => PackageCheck -> CheckM m ()
tellP (CheckExplanation -> PackageCheck
PackageBuildWarning ([FilePath] -> CheckExplanation
UnknownLanguages [FilePath
n]))
    checkLang Language
_ = () -> CheckM m ()
forall a. a -> CheckM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    checkExt :: Monad m => Extension -> CheckM m ()
    checkExt :: forall (m :: * -> *). Monad m => Extension -> CheckM m ()
checkExt (UnknownExtension FilePath
n)
      | FilePath
n FilePath -> [FilePath] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Language -> FilePath) -> [Language] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Language -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow [Language]
knownLanguages =
          PackageCheck -> CheckM m ()
forall (m :: * -> *). Monad m => PackageCheck -> CheckM m ()
tellP (CheckExplanation -> PackageCheck
PackageBuildWarning ([FilePath] -> CheckExplanation
LanguagesAsExtension [FilePath
n]))
      | Bool
otherwise =
          PackageCheck -> CheckM m ()
forall (m :: * -> *). Monad m => PackageCheck -> CheckM m ()
tellP (CheckExplanation -> PackageCheck
PackageBuildWarning ([FilePath] -> CheckExplanation
UnknownExtensions [FilePath
n]))
    checkExt Extension
n = do
      let dss :: [(Extension, Maybe Extension)]
dss = ((Extension, Maybe Extension) -> Bool)
-> [(Extension, Maybe Extension)] -> [(Extension, Maybe Extension)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Extension
a, Maybe Extension
_) -> Extension
a Extension -> Extension -> Bool
forall a. Eq a => a -> a -> Bool
== Extension
n) [(Extension, Maybe Extension)]
deprecatedExtensions
      Bool -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
Bool -> PackageCheck -> CheckM m ()
checkP
        (Bool -> Bool
not (Bool -> Bool)
-> ([(Extension, Maybe Extension)] -> Bool)
-> [(Extension, Maybe Extension)]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Extension, Maybe Extension)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([(Extension, Maybe Extension)] -> Bool)
-> [(Extension, Maybe Extension)] -> Bool
forall a b. (a -> b) -> a -> b
$ [(Extension, Maybe Extension)]
dss)
        (CheckExplanation -> PackageCheck
PackageDistSuspicious (CheckExplanation -> PackageCheck)
-> CheckExplanation -> PackageCheck
forall a b. (a -> b) -> a -> b
$ [(Extension, Maybe Extension)] -> CheckExplanation
DeprecatedExtensions [(Extension, Maybe Extension)]
dss)

    checkIntDep :: Monad m => Dependency -> CheckM m ()
    checkIntDep :: forall (m :: * -> *). Monad m => Dependency -> CheckM m ()
checkIntDep d :: Dependency
d@(Dependency PackageName
name VersionRange
vrange NonEmptySet LibraryName
_) = do
      mpn <-
        (CheckCtx m -> UnqualComponentName) -> CheckM m UnqualComponentName
forall (m :: * -> *) a. Monad m => (CheckCtx m -> a) -> CheckM m a
asksCM
          ( PackageName -> UnqualComponentName
packageNameToUnqualComponentName
              (PackageName -> UnqualComponentName)
-> (CheckCtx m -> PackageName) -> CheckCtx m -> UnqualComponentName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageIdentifier -> PackageName
pkgName
              (PackageIdentifier -> PackageName)
-> (CheckCtx m -> PackageIdentifier) -> CheckCtx m -> PackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PNames -> PackageIdentifier
pnPackageId
              (PNames -> PackageIdentifier)
-> (CheckCtx m -> PNames) -> CheckCtx m -> PackageIdentifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CheckCtx m -> PNames
forall (m :: * -> *). CheckCtx m -> PNames
ccNames
          )
      lns <- asksCM (pnSubLibs . ccNames)
      pVer <- asksCM (pkgVersion . pnPackageId . ccNames)
      let allLibNs = UnqualComponentName
mpn UnqualComponentName
-> [UnqualComponentName] -> [UnqualComponentName]
forall a. a -> [a] -> [a]
: [UnqualComponentName]
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 :: forall (m :: * -> *). Monad m => ExeDependency -> CheckM m ()
checkBTDep ed :: ExeDependency
ed@(ExeDependency PackageName
n UnqualComponentName
name VersionRange
vrange) = do
      exns <- (CheckCtx m -> [UnqualComponentName])
-> CheckM m [UnqualComponentName]
forall (m :: * -> *) a. Monad m => (CheckCtx m -> a) -> CheckM m a
asksCM (PNames -> [UnqualComponentName]
pnExecs (PNames -> [UnqualComponentName])
-> (CheckCtx m -> PNames) -> CheckCtx m -> [UnqualComponentName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CheckCtx m -> PNames
forall (m :: * -> *). CheckCtx m -> PNames
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 :: forall (m :: * -> *). Monad m => BuildInfo -> CheckM m ()
checkBuildInfoPathsWellFormedness BuildInfo
bi = do
  (SymbolicPathX 'AllowAbsolute Pkg 'File -> CheckM m ())
-> [SymbolicPathX 'AllowAbsolute Pkg 'File] -> CheckM m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Bool -> FilePath -> PathKind -> FilePath -> CheckM m ()
forall (m :: * -> *).
Monad m =>
Bool -> FilePath -> PathKind -> FilePath -> CheckM m ()
checkPath Bool
False FilePath
"asm-sources" PathKind
PathKindFile (FilePath -> CheckM m ())
-> (SymbolicPathX 'AllowAbsolute Pkg 'File -> FilePath)
-> SymbolicPathX 'AllowAbsolute Pkg 'File
-> CheckM m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SymbolicPathX 'AllowAbsolute Pkg 'File -> FilePath
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> FilePath
getSymbolicPath) (BuildInfo -> [SymbolicPathX 'AllowAbsolute Pkg 'File]
asmSources BuildInfo
bi)
  (SymbolicPathX 'AllowAbsolute Pkg 'File -> CheckM m ())
-> [SymbolicPathX 'AllowAbsolute Pkg 'File] -> CheckM m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Bool -> FilePath -> PathKind -> FilePath -> CheckM m ()
forall (m :: * -> *).
Monad m =>
Bool -> FilePath -> PathKind -> FilePath -> CheckM m ()
checkPath Bool
False FilePath
"cmm-sources" PathKind
PathKindFile (FilePath -> CheckM m ())
-> (SymbolicPathX 'AllowAbsolute Pkg 'File -> FilePath)
-> SymbolicPathX 'AllowAbsolute Pkg 'File
-> CheckM m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SymbolicPathX 'AllowAbsolute Pkg 'File -> FilePath
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> FilePath
getSymbolicPath) (BuildInfo -> [SymbolicPathX 'AllowAbsolute Pkg 'File]
cmmSources BuildInfo
bi)
  (SymbolicPathX 'AllowAbsolute Pkg 'File -> CheckM m ())
-> [SymbolicPathX 'AllowAbsolute Pkg 'File] -> CheckM m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Bool -> FilePath -> PathKind -> FilePath -> CheckM m ()
forall (m :: * -> *).
Monad m =>
Bool -> FilePath -> PathKind -> FilePath -> CheckM m ()
checkPath Bool
False FilePath
"c-sources" PathKind
PathKindFile (FilePath -> CheckM m ())
-> (SymbolicPathX 'AllowAbsolute Pkg 'File -> FilePath)
-> SymbolicPathX 'AllowAbsolute Pkg 'File
-> CheckM m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SymbolicPathX 'AllowAbsolute Pkg 'File -> FilePath
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> FilePath
getSymbolicPath) (BuildInfo -> [SymbolicPathX 'AllowAbsolute Pkg 'File]
cSources BuildInfo
bi)
  (SymbolicPathX 'AllowAbsolute Pkg 'File -> CheckM m ())
-> [SymbolicPathX 'AllowAbsolute Pkg 'File] -> CheckM m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Bool -> FilePath -> PathKind -> FilePath -> CheckM m ()
forall (m :: * -> *).
Monad m =>
Bool -> FilePath -> PathKind -> FilePath -> CheckM m ()
checkPath Bool
False FilePath
"cxx-sources" PathKind
PathKindFile (FilePath -> CheckM m ())
-> (SymbolicPathX 'AllowAbsolute Pkg 'File -> FilePath)
-> SymbolicPathX 'AllowAbsolute Pkg 'File
-> CheckM m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SymbolicPathX 'AllowAbsolute Pkg 'File -> FilePath
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> FilePath
getSymbolicPath) (BuildInfo -> [SymbolicPathX 'AllowAbsolute Pkg 'File]
cxxSources BuildInfo
bi)
  (SymbolicPathX 'AllowAbsolute Pkg 'File -> CheckM m ())
-> [SymbolicPathX 'AllowAbsolute Pkg 'File] -> CheckM m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Bool -> FilePath -> PathKind -> FilePath -> CheckM m ()
forall (m :: * -> *).
Monad m =>
Bool -> FilePath -> PathKind -> FilePath -> CheckM m ()
checkPath Bool
False FilePath
"js-sources" PathKind
PathKindFile (FilePath -> CheckM m ())
-> (SymbolicPathX 'AllowAbsolute Pkg 'File -> FilePath)
-> SymbolicPathX 'AllowAbsolute Pkg 'File
-> CheckM m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SymbolicPathX 'AllowAbsolute Pkg 'File -> FilePath
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> FilePath
getSymbolicPath) (BuildInfo -> [SymbolicPathX 'AllowAbsolute Pkg 'File]
jsSources BuildInfo
bi)
  (SymbolicPathX 'OnlyRelative Include 'File -> CheckM m ())
-> [SymbolicPathX 'OnlyRelative Include 'File] -> CheckM m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
    (Bool -> FilePath -> PathKind -> FilePath -> CheckM m ()
forall (m :: * -> *).
Monad m =>
Bool -> FilePath -> PathKind -> FilePath -> CheckM m ()
checkPath Bool
False FilePath
"install-includes" PathKind
PathKindFile (FilePath -> CheckM m ())
-> (SymbolicPathX 'OnlyRelative Include 'File -> FilePath)
-> SymbolicPathX 'OnlyRelative Include 'File
-> CheckM m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SymbolicPathX 'OnlyRelative Include 'File -> FilePath
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> FilePath
getSymbolicPath)
    (BuildInfo -> [SymbolicPathX 'OnlyRelative Include 'File]
installIncludes BuildInfo
bi)
  (SymbolicPathX 'AllowAbsolute Pkg ('Dir Source) -> CheckM m ())
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)] -> CheckM m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
    (Bool -> FilePath -> PathKind -> FilePath -> CheckM m ()
forall (m :: * -> *).
Monad m =>
Bool -> FilePath -> PathKind -> FilePath -> CheckM m ()
checkPath Bool
False FilePath
"hs-source-dirs" PathKind
PathKindDirectory (FilePath -> CheckM m ())
-> (SymbolicPathX 'AllowAbsolute Pkg ('Dir Source) -> FilePath)
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)
-> CheckM m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SymbolicPathX 'AllowAbsolute Pkg ('Dir Source) -> FilePath
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> FilePath
getSymbolicPath)
    (BuildInfo -> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
hsSourceDirs BuildInfo
bi)
  -- Possibly absolute paths.
  (SymbolicPathX 'AllowAbsolute Include 'File -> CheckM m ())
-> [SymbolicPathX 'AllowAbsolute Include 'File] -> CheckM m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Bool -> FilePath -> PathKind -> FilePath -> CheckM m ()
forall (m :: * -> *).
Monad m =>
Bool -> FilePath -> PathKind -> FilePath -> CheckM m ()
checkPath Bool
True FilePath
"includes" PathKind
PathKindFile (FilePath -> CheckM m ())
-> (SymbolicPathX 'AllowAbsolute Include 'File -> FilePath)
-> SymbolicPathX 'AllowAbsolute Include 'File
-> CheckM m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SymbolicPathX 'AllowAbsolute Include 'File -> FilePath
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> FilePath
getSymbolicPath) (BuildInfo -> [SymbolicPathX 'AllowAbsolute Include 'File]
includes BuildInfo
bi)
  (SymbolicPathX 'AllowAbsolute Pkg ('Dir Include) -> CheckM m ())
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Include)] -> CheckM m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
    (Bool -> FilePath -> PathKind -> FilePath -> CheckM m ()
forall (m :: * -> *).
Monad m =>
Bool -> FilePath -> PathKind -> FilePath -> CheckM m ()
checkPath Bool
True FilePath
"include-dirs" PathKind
PathKindDirectory (FilePath -> CheckM m ())
-> (SymbolicPathX 'AllowAbsolute Pkg ('Dir Include) -> FilePath)
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir Include)
-> CheckM m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SymbolicPathX 'AllowAbsolute Pkg ('Dir Include) -> FilePath
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> FilePath
getSymbolicPath)
    (BuildInfo -> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Include)]
includeDirs BuildInfo
bi)
  (SymbolicPathX 'AllowAbsolute Pkg ('Dir Lib) -> CheckM m ())
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Lib)] -> CheckM m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
    (Bool -> FilePath -> PathKind -> FilePath -> CheckM m ()
forall (m :: * -> *).
Monad m =>
Bool -> FilePath -> PathKind -> FilePath -> CheckM m ()
checkPath Bool
True FilePath
"extra-lib-dirs" PathKind
PathKindDirectory (FilePath -> CheckM m ())
-> (SymbolicPathX 'AllowAbsolute Pkg ('Dir Lib) -> FilePath)
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir Lib)
-> CheckM m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SymbolicPathX 'AllowAbsolute Pkg ('Dir Lib) -> FilePath
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> FilePath
getSymbolicPath)
    (BuildInfo -> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Lib)]
extraLibDirs BuildInfo
bi)
  (SymbolicPathX 'AllowAbsolute Pkg ('Dir Lib) -> CheckM m ())
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Lib)] -> CheckM m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
    (Bool -> FilePath -> PathKind -> FilePath -> CheckM m ()
forall (m :: * -> *).
Monad m =>
Bool -> FilePath -> PathKind -> FilePath -> CheckM m ()
checkPath Bool
True FilePath
"extra-lib-dirs-static" PathKind
PathKindDirectory (FilePath -> CheckM m ())
-> (SymbolicPathX 'AllowAbsolute Pkg ('Dir Lib) -> FilePath)
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir Lib)
-> CheckM m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SymbolicPathX 'AllowAbsolute Pkg ('Dir Lib) -> FilePath
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> FilePath
getSymbolicPath)
    (BuildInfo -> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Lib)]
extraLibDirsStatic BuildInfo
bi)
  ((CompilerFlavor, [FilePath]) -> CheckM m ())
-> [(CompilerFlavor, [FilePath])] -> CheckM m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (CompilerFlavor, [FilePath]) -> CheckM m ()
forall (m :: * -> *).
Monad m =>
(CompilerFlavor, [FilePath]) -> CheckM m ()
checkOptionPath (PerCompilerFlavor [FilePath] -> [(CompilerFlavor, [FilePath])]
forall v. PerCompilerFlavor v -> [(CompilerFlavor, v)]
perCompilerFlavorToList (PerCompilerFlavor [FilePath] -> [(CompilerFlavor, [FilePath])])
-> PerCompilerFlavor [FilePath] -> [(CompilerFlavor, [FilePath])]
forall a b. (a -> b) -> a -> b
$ BuildInfo -> PerCompilerFlavor [FilePath]
options BuildInfo
bi)
  where
    checkOptionPath
      :: Monad m
      => (CompilerFlavor, [FilePath])
      -> CheckM m ()
    checkOptionPath :: forall (m :: * -> *).
Monad m =>
(CompilerFlavor, [FilePath]) -> CheckM m ()
checkOptionPath (CompilerFlavor
GHC, [FilePath]
paths) =
      (FilePath -> CheckM m ()) -> [FilePath] -> CheckM m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
        ( \FilePath
path ->
            Bool -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
Bool -> PackageCheck -> CheckM m ()
checkP
              (FilePath -> Bool
isInsideDist FilePath
path)
              (CheckExplanation -> PackageCheck
PackageDistInexcusable (CheckExplanation -> PackageCheck)
-> CheckExplanation -> PackageCheck
forall a b. (a -> b) -> a -> b
$ Maybe FilePath -> FilePath -> CheckExplanation
DistPoint Maybe FilePath
forall a. Maybe a
Nothing FilePath
path)
        )
        [FilePath]
paths
    checkOptionPath (CompilerFlavor, [FilePath])
_ = () -> CheckM m ()
forall a. a -> CheckM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- Checks for features that can be present in BuildInfo only with certain
-- CabalSpecVersion.
checkBuildInfoFeatures
  :: Monad m
  => BuildInfo
  -> CabalSpecVersion
  -> CheckM m ()
checkBuildInfoFeatures :: forall (m :: * -> *).
Monad m =>
BuildInfo -> CabalSpecVersion -> CheckM m ()
checkBuildInfoFeatures BuildInfo
bi CabalSpecVersion
sv = do
  -- Default language can be used only w/ spec ≥ 1.10
  CabalSpecVersion -> Bool -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
CabalSpecVersion -> Bool -> PackageCheck -> CheckM m ()
checkSpecVer
    CabalSpecVersion
CabalSpecV1_10
    (Maybe Language -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Language -> Bool) -> Maybe Language -> Bool
forall a b. (a -> b) -> a -> b
$ BuildInfo -> Maybe Language
defaultLanguage BuildInfo
bi)
    (CheckExplanation -> PackageCheck
PackageBuildWarning CheckExplanation
CVDefaultLanguage)
  -- CheckSpecVer sv.
  CheckM m ()
forall (m :: * -> *). Monad m => CheckM m ()
checkDefaultLanguage
  -- Check use of 'extra-framework-dirs' field.
  CabalSpecVersion -> Bool -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
CabalSpecVersion -> Bool -> PackageCheck -> CheckM m ()
checkSpecVer
    CabalSpecVersion
CabalSpecV1_24
    (Bool -> Bool
not (Bool -> Bool)
-> ([SymbolicPathX 'AllowAbsolute Pkg ('Dir Framework)] -> Bool)
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Framework)]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SymbolicPathX 'AllowAbsolute Pkg ('Dir Framework)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([SymbolicPathX 'AllowAbsolute Pkg ('Dir Framework)] -> Bool)
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Framework)] -> Bool
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Framework)]
extraFrameworkDirs BuildInfo
bi)
    (CheckExplanation -> PackageCheck
PackageDistSuspiciousWarn CheckExplanation
CVExtraFrameworkDirs)
  -- Check use of default-extensions field don't need to do the
  -- equivalent check for other-extensions.
  CabalSpecVersion -> Bool -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
CabalSpecVersion -> Bool -> PackageCheck -> CheckM m ()
checkSpecVer
    CabalSpecVersion
CabalSpecV1_10
    (Bool -> Bool
not (Bool -> Bool) -> ([Extension] -> Bool) -> [Extension] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Extension] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Extension] -> Bool) -> [Extension] -> Bool
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [Extension]
defaultExtensions BuildInfo
bi)
    (CheckExplanation -> PackageCheck
PackageBuildWarning CheckExplanation
CVDefaultExtensions)
  -- Check use of extensions field
  Bool -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
Bool -> PackageCheck -> CheckM m ()
checkP
    (CabalSpecVersion
sv CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecV1_10 Bool -> Bool -> Bool
&& (Bool -> Bool
not (Bool -> Bool) -> ([Extension] -> Bool) -> [Extension] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Extension] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Extension] -> Bool) -> [Extension] -> Bool
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [Extension]
oldExtensions BuildInfo
bi))
    (CheckExplanation -> PackageCheck
PackageBuildWarning CheckExplanation
CVExtensionsDeprecated)

  -- asm-sources, cmm-sources and friends only w/ spec ≥ 1.10
  [FilePath] -> CheckM m ()
forall (m :: * -> *). Monad m => [FilePath] -> CheckM m ()
checkCVSources ((SymbolicPathX 'AllowAbsolute Pkg 'File -> FilePath)
-> [SymbolicPathX 'AllowAbsolute Pkg 'File] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map SymbolicPathX 'AllowAbsolute Pkg 'File -> FilePath
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> FilePath
getSymbolicPath ([SymbolicPathX 'AllowAbsolute Pkg 'File] -> [FilePath])
-> [SymbolicPathX 'AllowAbsolute Pkg 'File] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [SymbolicPathX 'AllowAbsolute Pkg 'File]
asmSources BuildInfo
bi)
  [FilePath] -> CheckM m ()
forall (m :: * -> *). Monad m => [FilePath] -> CheckM m ()
checkCVSources ((SymbolicPathX 'AllowAbsolute Pkg 'File -> FilePath)
-> [SymbolicPathX 'AllowAbsolute Pkg 'File] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map SymbolicPathX 'AllowAbsolute Pkg 'File -> FilePath
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> FilePath
getSymbolicPath ([SymbolicPathX 'AllowAbsolute Pkg 'File] -> [FilePath])
-> [SymbolicPathX 'AllowAbsolute Pkg 'File] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [SymbolicPathX 'AllowAbsolute Pkg 'File]
cmmSources BuildInfo
bi)
  [FilePath] -> CheckM m ()
forall (m :: * -> *). Monad m => [FilePath] -> CheckM m ()
checkCVSources (BuildInfo -> [FilePath]
extraBundledLibs BuildInfo
bi)
  [FilePath] -> CheckM m ()
forall (m :: * -> *). Monad m => [FilePath] -> CheckM m ()
checkCVSources (BuildInfo -> [FilePath]
extraLibFlavours BuildInfo
bi)

  -- extra-dynamic-library-flavours requires ≥ 3.0
  CabalSpecVersion -> Bool -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
CabalSpecVersion -> Bool -> PackageCheck -> CheckM m ()
checkSpecVer
    CabalSpecVersion
CabalSpecV3_0
    (Bool -> Bool
not (Bool -> Bool) -> ([FilePath] -> Bool) -> [FilePath] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([FilePath] -> Bool) -> [FilePath] -> Bool
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [FilePath]
extraDynLibFlavours BuildInfo
bi)
    (CheckExplanation -> PackageCheck
PackageDistInexcusable (CheckExplanation -> PackageCheck)
-> CheckExplanation -> PackageCheck
forall a b. (a -> b) -> a -> b
$ [[FilePath]] -> CheckExplanation
CVExtraDynamic [BuildInfo -> [FilePath]
extraDynLibFlavours BuildInfo
bi])
  -- virtual-modules requires ≥ 2.2
  CabalSpecVersion -> Bool -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
CabalSpecVersion -> Bool -> PackageCheck -> CheckM m ()
checkSpecVer CabalSpecVersion
CabalSpecV2_2 (Bool -> Bool
not (Bool -> Bool) -> ([ModuleName] -> Bool) -> [ModuleName] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ModuleName] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([ModuleName] -> Bool) -> [ModuleName] -> Bool
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [ModuleName]
virtualModules BuildInfo
bi) (PackageCheck -> CheckM m ()) -> PackageCheck -> CheckM m ()
forall a b. (a -> b) -> a -> b
$
    (CheckExplanation -> PackageCheck
PackageDistInexcusable CheckExplanation
CVVirtualModules)
  -- Check use of thinning and renaming.
  CabalSpecVersion -> Bool -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
CabalSpecVersion -> Bool -> PackageCheck -> CheckM m ()
checkSpecVer
    CabalSpecVersion
CabalSpecV2_0
    (Bool -> Bool
not (Bool -> Bool) -> ([Mixin] -> Bool) -> [Mixin] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Mixin] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Mixin] -> Bool) -> [Mixin] -> Bool
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [Mixin]
mixins BuildInfo
bi)
    (CheckExplanation -> PackageCheck
PackageDistInexcusable CheckExplanation
CVMixins)

  BuildInfo -> CheckM m ()
forall (m :: * -> *). Monad m => BuildInfo -> CheckM m ()
checkBuildInfoExtensions BuildInfo
bi
  where
    checkCVSources :: Monad m => [FilePath] -> CheckM m ()
    checkCVSources :: forall (m :: * -> *). Monad m => [FilePath] -> CheckM m ()
checkCVSources [FilePath]
cvs =
      CabalSpecVersion -> Bool -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
CabalSpecVersion -> Bool -> PackageCheck -> CheckM m ()
checkSpecVer
        CabalSpecVersion
CabalSpecV3_0
        (Bool -> Bool
not (Bool -> Bool) -> ([FilePath] -> Bool) -> [FilePath] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([FilePath] -> Bool) -> [FilePath] -> Bool
forall a b. (a -> b) -> a -> b
$ [FilePath]
cvs)
        (CheckExplanation -> PackageCheck
PackageDistInexcusable CheckExplanation
CVSources)

    checkDefaultLanguage :: Monad m => CheckM m ()
    checkDefaultLanguage :: forall (m :: * -> *). Monad m => CheckM m ()
checkDefaultLanguage = do
      -- < 1.10 has no `default-language` field.
      Bool -> CheckM m () -> CheckM m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
        (CabalSpecVersion
sv CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecV1_10 Bool -> Bool -> Bool
&& Maybe Language -> Bool
forall a. Maybe a -> Bool
isNothing (BuildInfo -> Maybe Language
defaultLanguage BuildInfo
bi))
        -- < 3.4 mandatory, after just a suggestion.
        ( if CabalSpecVersion
sv CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
< CabalSpecVersion
CabalSpecV3_4
            then PackageCheck -> CheckM m ()
forall (m :: * -> *). Monad m => PackageCheck -> CheckM m ()
tellP (CheckExplanation -> PackageCheck
PackageBuildWarning CheckExplanation
CVDefaultLanguageComponent)
            else PackageCheck -> CheckM m ()
forall (m :: * -> *). Monad m => PackageCheck -> CheckM m ()
tellP (CheckExplanation -> PackageCheck
PackageDistInexcusable CheckExplanation
CVDefaultLanguageComponentSoft)
        )

-- Tests for extensions usage which can break Cabal < 1.4.
checkBuildInfoExtensions :: Monad m => BuildInfo -> CheckM m ()
checkBuildInfoExtensions :: forall (m :: * -> *). Monad m => BuildInfo -> CheckM m ()
checkBuildInfoExtensions BuildInfo
bi = do
  let exts :: [Extension]
exts = BuildInfo -> [Extension]
allExtensions BuildInfo
bi
      extCabal1_2 :: [Extension]
extCabal1_2 = [Extension] -> [Extension]
forall a. Eq a => [a] -> [a]
nub ([Extension] -> [Extension]) -> [Extension] -> [Extension]
forall a b. (a -> b) -> a -> b
$ (Extension -> Bool) -> [Extension] -> [Extension]
forall a. (a -> Bool) -> [a] -> [a]
filter (Extension -> [Extension] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Extension]
compatExtensionsExtra) [Extension]
exts
      extCabal1_4 :: [Extension]
extCabal1_4 = [Extension] -> [Extension]
forall a. Eq a => [a] -> [a]
nub ([Extension] -> [Extension]) -> [Extension] -> [Extension]
forall a b. (a -> b) -> a -> b
$ (Extension -> Bool) -> [Extension] -> [Extension]
forall a. (a -> Bool) -> [a] -> [a]
filter (Extension -> [Extension] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Extension]
compatExtensions) [Extension]
exts
  -- As of Cabal-1.4 we can add new extensions without worrying
  -- about breaking old versions of cabal.
  CabalSpecVersion -> Bool -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
CabalSpecVersion -> Bool -> PackageCheck -> CheckM m ()
checkSpecVer
    CabalSpecVersion
CabalSpecV1_2
    (Bool -> Bool
not (Bool -> Bool) -> ([Extension] -> Bool) -> [Extension] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Extension] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Extension] -> Bool) -> [Extension] -> Bool
forall a b. (a -> b) -> a -> b
$ [Extension]
extCabal1_2)
    ( CheckExplanation -> PackageCheck
PackageDistInexcusable (CheckExplanation -> PackageCheck)
-> CheckExplanation -> PackageCheck
forall a b. (a -> b) -> a -> b
$
        CabalSpecVersion -> [Extension] -> CheckExplanation
CVExtensions CabalSpecVersion
CabalSpecV1_2 [Extension]
extCabal1_2
    )
  CabalSpecVersion -> Bool -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
CabalSpecVersion -> Bool -> PackageCheck -> CheckM m ()
checkSpecVer
    CabalSpecVersion
CabalSpecV1_4
    (Bool -> Bool
not (Bool -> Bool) -> ([Extension] -> Bool) -> [Extension] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Extension] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Extension] -> Bool) -> [Extension] -> Bool
forall a b. (a -> b) -> a -> b
$ [Extension]
extCabal1_4)
    ( CheckExplanation -> PackageCheck
PackageDistInexcusable (CheckExplanation -> PackageCheck)
-> CheckExplanation -> PackageCheck
forall a b. (a -> b) -> a -> b
$
        CabalSpecVersion -> [Extension] -> CheckExplanation
CVExtensions CabalSpecVersion
CabalSpecV1_4 [Extension]
extCabal1_4
    )
  where
    -- The known extensions in Cabal-1.2.3
    compatExtensions :: [Extension]
    compatExtensions :: [Extension]
compatExtensions =
      (KnownExtension -> Extension) -> [KnownExtension] -> [Extension]
forall a b. (a -> b) -> [a] -> [b]
map
        KnownExtension -> Extension
EnableExtension
        [ KnownExtension
OverlappingInstances
        , KnownExtension
UndecidableInstances
        , KnownExtension
IncoherentInstances
        , KnownExtension
RecursiveDo
        , KnownExtension
ParallelListComp
        , KnownExtension
MultiParamTypeClasses
        , KnownExtension
FunctionalDependencies
        , KnownExtension
Rank2Types
        , KnownExtension
RankNTypes
        , KnownExtension
PolymorphicComponents
        , KnownExtension
ExistentialQuantification
        , KnownExtension
ScopedTypeVariables
        , KnownExtension
ImplicitParams
        , KnownExtension
FlexibleContexts
        , KnownExtension
FlexibleInstances
        , KnownExtension
EmptyDataDecls
        , KnownExtension
CPP
        , KnownExtension
BangPatterns
        , KnownExtension
TypeSynonymInstances
        , KnownExtension
TemplateHaskell
        , KnownExtension
ForeignFunctionInterface
        , KnownExtension
Arrows
        , KnownExtension
Generics
        , KnownExtension
NamedFieldPuns
        , KnownExtension
PatternGuards
        , KnownExtension
GeneralizedNewtypeDeriving
        , KnownExtension
ExtensibleRecords
        , KnownExtension
RestrictedTypeSynonyms
        , KnownExtension
HereDocuments
        ]
        [Extension] -> [Extension] -> [Extension]
forall a. [a] -> [a] -> [a]
++ (KnownExtension -> Extension) -> [KnownExtension] -> [Extension]
forall a b. (a -> b) -> [a] -> [b]
map
          KnownExtension -> Extension
DisableExtension
          [KnownExtension
MonomorphismRestriction, KnownExtension
ImplicitPrelude]
        [Extension] -> [Extension] -> [Extension]
forall a. [a] -> [a] -> [a]
++ [Extension]
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 :: [Extension]
compatExtensionsExtra =
      (KnownExtension -> Extension) -> [KnownExtension] -> [Extension]
forall a b. (a -> b) -> [a] -> [b]
map
        KnownExtension -> Extension
EnableExtension
        [ KnownExtension
KindSignatures
        , KnownExtension
MagicHash
        , KnownExtension
TypeFamilies
        , KnownExtension
StandaloneDeriving
        , KnownExtension
UnicodeSyntax
        , KnownExtension
PatternSignatures
        , KnownExtension
UnliftedFFITypes
        , KnownExtension
LiberalTypeSynonyms
        , KnownExtension
TypeOperators
        , KnownExtension
RecordWildCards
        , KnownExtension
RecordPuns
        , KnownExtension
DisambiguateRecordFields
        , KnownExtension
OverloadedStrings
        , KnownExtension
GADTs
        , KnownExtension
RelaxedPolyRec
        , KnownExtension
ExtendedDefaultRules
        , KnownExtension
UnboxedTuples
        , KnownExtension
DeriveDataTypeable
        , KnownExtension
ConstrainedClassMethods
        ]
        [Extension] -> [Extension] -> [Extension]
forall a. [a] -> [a] -> [a]
++ (KnownExtension -> Extension) -> [KnownExtension] -> [Extension]
forall a b. (a -> b) -> [a] -> [b]
map
          KnownExtension -> Extension
DisableExtension
          [KnownExtension
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 :: forall (m :: * -> *).
Monad m =>
[ModuleName] -> BuildInfo -> CheckM m ()
checkAutogenModules [ModuleName]
ams BuildInfo
bi = do
  pkgId <- (CheckCtx m -> PackageIdentifier) -> CheckM m PackageIdentifier
forall (m :: * -> *) a. Monad m => (CheckCtx m -> a) -> CheckM m a
asksCM (PNames -> PackageIdentifier
pnPackageId (PNames -> PackageIdentifier)
-> (CheckCtx m -> PNames) -> CheckCtx m -> PackageIdentifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CheckCtx m -> PNames
forall (m :: * -> *). CheckCtx m -> PNames
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 = PackageDescription
emptyPackageDescription{package = pkgId}
    autoPathsName = PackageDescription -> ModuleName
autogenPathsModuleName PackageDescription
minimalPD
    autoInfoModuleName = PackageDescription -> ModuleName
autogenPackageInfoModuleName PackageDescription
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 :: [ModuleName]
allModsForAuto = [ModuleName]
ams [ModuleName] -> [ModuleName] -> [ModuleName]
forall a. [a] -> [a] -> [a]
++ BuildInfo -> [ModuleName]
otherModules BuildInfo
bi

    autogenCheck
      :: Monad m
      => ModuleName
      -> CheckExplanation
      -> CheckM m ()
    autogenCheck :: forall (m :: * -> *).
Monad m =>
ModuleName -> CheckExplanation -> CheckM m ()
autogenCheck ModuleName
name CheckExplanation
warning = do
      sv <- (CheckCtx m -> CabalSpecVersion) -> CheckM m CabalSpecVersion
forall (m :: * -> *) a. Monad m => (CheckCtx m -> a) -> CheckM m a
asksCM CheckCtx m -> CabalSpecVersion
forall (m :: * -> *). CheckCtx m -> CabalSpecVersion
ccSpecVersion
      checkP
        ( sv >= CabalSpecV2_0
            && elem name allModsForAuto
            && notElem name (autogenModules bi)
        )
        (PackageDistInexcusable warning)

    rebindableClashCheck
      :: Monad m
      => ModuleName
      -> CheckExplanation
      -> CheckM m ()
    rebindableClashCheck :: forall (m :: * -> *).
Monad m =>
ModuleName -> CheckExplanation -> CheckM m ()
rebindableClashCheck ModuleName
name CheckExplanation
warning = do
      CabalSpecVersion -> Bool -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
CabalSpecVersion -> Bool -> PackageCheck -> CheckM m ()
checkSpecVer
        CabalSpecVersion
CabalSpecV2_2
        ( ( ModuleName
name ModuleName -> [ModuleName] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` BuildInfo -> [ModuleName]
otherModules BuildInfo
bi
              Bool -> Bool -> Bool
|| ModuleName
name ModuleName -> [ModuleName] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` BuildInfo -> [ModuleName]
autogenModules BuildInfo
bi
          )
            Bool -> Bool -> Bool
&& Bool
checkExts
        )
        (CheckExplanation -> PackageCheck
PackageBuildImpossible CheckExplanation
warning)

    -- Do we have some peculiar extensions active which would interfere
    -- (cabal-version <2.2) with Paths_modules?
    checkExts :: Bool
    checkExts :: Bool
checkExts =
      let exts :: [Extension]
exts = BuildInfo -> [Extension]
defaultExtensions BuildInfo
bi
       in Extension
rebind Extension -> [Extension] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Extension]
exts
            Bool -> Bool -> Bool
&& (Extension
strings Extension -> [Extension] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Extension]
exts Bool -> Bool -> Bool
|| Extension
lists Extension -> [Extension] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Extension]
exts)
      where
        rebind :: Extension
rebind = KnownExtension -> Extension
EnableExtension KnownExtension
RebindableSyntax
        strings :: Extension
strings = KnownExtension -> Extension
EnableExtension KnownExtension
OverloadedStrings
        lists :: Extension
lists = KnownExtension -> Extension
EnableExtension KnownExtension
OverloadedLists

checkLocalPathExist
  :: Monad m
  => String -- .cabal field where we found the error.
  -> FilePath
  -> CheckM m ()
checkLocalPathExist :: forall (m :: * -> *).
Monad m =>
FilePath -> FilePath -> CheckM m ()
checkLocalPathExist FilePath
title FilePath
dir =
  (CheckPackageContentOps m -> m Bool) -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
(CheckPackageContentOps m -> m Bool) -> PackageCheck -> CheckM m ()
checkPkg
    ( \CheckPackageContentOps m
ops -> do
        dn <- Bool -> Bool
not (Bool -> Bool) -> m Bool -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CheckPackageContentOps m -> FilePath -> m Bool
forall (m :: * -> *).
CheckPackageContentOps m -> FilePath -> m Bool
doesDirectoryExist CheckPackageContentOps m
ops FilePath
dir
        let rp = Bool -> Bool
not (FilePath -> Bool
isAbsoluteOnAnyPlatform FilePath
dir)
        return (rp && dn)
    )
    (CheckExplanation -> PackageCheck
PackageBuildWarning (CheckExplanation -> PackageCheck)
-> CheckExplanation -> PackageCheck
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> CheckExplanation
UnknownDirectory FilePath
title FilePath
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 :: [Dependency] -> [Dependency]
mergeDependencies [] = []
mergeDependencies l :: [Dependency]
l@(Dependency
d : [Dependency]
_) =
  let ([Dependency]
sames, [Dependency]
diffs) = (Dependency -> Bool)
-> [Dependency] -> ([Dependency], [Dependency])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== Dependency -> FilePath
depName Dependency
d) (FilePath -> Bool)
-> (Dependency -> FilePath) -> Dependency -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dependency -> FilePath
depName) [Dependency]
l
      merged :: Dependency
merged =
        PackageName
-> VersionRange -> NonEmptySet LibraryName -> Dependency
Dependency
          (Dependency -> PackageName
depPkgName Dependency
d)
          ( (VersionRange -> VersionRange -> VersionRange)
-> VersionRange -> [VersionRange] -> VersionRange
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl VersionRange -> VersionRange -> VersionRange
intersectVersionRanges VersionRange
anyVersion ([VersionRange] -> VersionRange) -> [VersionRange] -> VersionRange
forall a b. (a -> b) -> a -> b
$
              (Dependency -> VersionRange) -> [Dependency] -> [VersionRange]
forall a b. (a -> b) -> [a] -> [b]
map Dependency -> VersionRange
depVerRange [Dependency]
sames
          )
          (Dependency -> NonEmptySet LibraryName
depLibraries Dependency
d)
   in Dependency
merged Dependency -> [Dependency] -> [Dependency]
forall a. a -> [a] -> [a]
: [Dependency] -> [Dependency]
mergeDependencies [Dependency]
diffs
  where
    depName :: Dependency -> String
    depName :: Dependency -> FilePath
depName Dependency
wd = PackageName -> FilePath
unPackageName (PackageName -> FilePath)
-> (Dependency -> PackageName) -> Dependency -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dependency -> PackageName
depPkgName (Dependency -> FilePath) -> Dependency -> FilePath
forall a b. (a -> b) -> a -> b
$ Dependency
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 :: CEType -> Bool
isInternalTarget (CETLibrary{}) = Bool
False
isInternalTarget (CETForeignLibrary{}) = Bool
False
isInternalTarget (CETExecutable{}) = Bool
False
isInternalTarget (CETTest{}) = Bool
True
isInternalTarget (CETBenchmark{}) = Bool
True
isInternalTarget (CETSetup{}) = Bool
False

-- ------------------------------------------------------------
-- Options
-- ------------------------------------------------------------

-- Target type for option checking.
data BITarget = BITLib | BITTestBench | BITOther
  deriving (BITarget -> BITarget -> Bool
(BITarget -> BITarget -> Bool)
-> (BITarget -> BITarget -> Bool) -> Eq BITarget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BITarget -> BITarget -> Bool
== :: BITarget -> BITarget -> Bool
$c/= :: BITarget -> BITarget -> Bool
/= :: BITarget -> BITarget -> Bool
Eq, Int -> BITarget -> FilePath -> FilePath
[BITarget] -> FilePath -> FilePath
BITarget -> FilePath
(Int -> BITarget -> FilePath -> FilePath)
-> (BITarget -> FilePath)
-> ([BITarget] -> FilePath -> FilePath)
-> Show BITarget
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> BITarget -> FilePath -> FilePath
showsPrec :: Int -> BITarget -> FilePath -> FilePath
$cshow :: BITarget -> FilePath
show :: BITarget -> FilePath
$cshowList :: [BITarget] -> FilePath -> FilePath
showList :: [BITarget] -> FilePath -> FilePath
Show)

cet2bit :: CEType -> BITarget
cet2bit :: CEType -> BITarget
cet2bit (CETLibrary{}) = BITarget
BITLib
cet2bit (CETForeignLibrary{}) = BITarget
BITLib
cet2bit (CETExecutable{}) = BITarget
BITOther
cet2bit (CETTest{}) = BITarget
BITTestBench
cet2bit (CETBenchmark{}) = BITarget
BITTestBench
cet2bit CEType
CETSetup = BITarget
BITOther

-- General check on all options (ghc, C, C++, …) for common inaccuracies.
checkBuildInfoOptions :: Monad m => BITarget -> BuildInfo -> CheckM m ()
checkBuildInfoOptions :: forall (m :: * -> *).
Monad m =>
BITarget -> BuildInfo -> CheckM m ()
checkBuildInfoOptions BITarget
t BuildInfo
bi = do
  FilePath -> BITarget -> [FilePath] -> CheckM m ()
forall (m :: * -> *).
Monad m =>
FilePath -> BITarget -> [FilePath] -> CheckM m ()
checkGHCOptions FilePath
"ghc-options" BITarget
t (CompilerFlavor -> BuildInfo -> [FilePath]
hcOptions CompilerFlavor
GHC BuildInfo
bi)
  FilePath -> BITarget -> [FilePath] -> CheckM m ()
forall (m :: * -> *).
Monad m =>
FilePath -> BITarget -> [FilePath] -> CheckM m ()
checkGHCOptions FilePath
"ghc-prof-options" BITarget
t (CompilerFlavor -> BuildInfo -> [FilePath]
hcProfOptions CompilerFlavor
GHC BuildInfo
bi)
  FilePath -> BITarget -> [FilePath] -> CheckM m ()
forall (m :: * -> *).
Monad m =>
FilePath -> BITarget -> [FilePath] -> CheckM m ()
checkGHCOptions FilePath
"ghc-shared-options" BITarget
t (CompilerFlavor -> BuildInfo -> [FilePath]
hcSharedOptions CompilerFlavor
GHC BuildInfo
bi)
  let ldOpts :: [FilePath]
ldOpts = BuildInfo -> [FilePath]
ldOptions BuildInfo
bi
  WarnLang -> FilePath -> [FilePath] -> [FilePath] -> CheckM m ()
forall (m :: * -> *).
Monad m =>
WarnLang -> FilePath -> [FilePath] -> [FilePath] -> CheckM m ()
checkCLikeOptions WarnLang
LangC FilePath
"cc-options" (BuildInfo -> [FilePath]
ccOptions BuildInfo
bi) [FilePath]
ldOpts
  WarnLang -> FilePath -> [FilePath] -> [FilePath] -> CheckM m ()
forall (m :: * -> *).
Monad m =>
WarnLang -> FilePath -> [FilePath] -> [FilePath] -> CheckM m ()
checkCLikeOptions WarnLang
LangCPlusPlus FilePath
"cxx-options" (BuildInfo -> [FilePath]
cxxOptions BuildInfo
bi) [FilePath]
ldOpts
  [FilePath] -> CheckM m ()
forall (m :: * -> *). Monad m => [FilePath] -> CheckM m ()
checkCPPOptions (BuildInfo -> [FilePath]
cppOptions BuildInfo
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 :: forall (m :: * -> *).
Monad m =>
FilePath -> BITarget -> [FilePath] -> CheckM m ()
checkGHCOptions FilePath
title BITarget
t [FilePath]
opts = do
  CheckM m ()
checkGeneral
  case BITarget
t of
    BITarget
BITLib -> [CheckM m ()] -> CheckM m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [CheckM m ()
checkLib, CheckM m ()
checkNonTestBench]
    BITarget
BITTestBench -> CheckM m ()
checkTestBench
    BITarget
BITOther -> CheckM m ()
checkNonTestBench
  where
    checkFlags :: Monad m => [String] -> PackageCheck -> CheckM m ()
    checkFlags :: forall (m :: * -> *).
Monad m =>
[FilePath] -> PackageCheck -> CheckM m ()
checkFlags [FilePath]
fs PackageCheck
ck = Bool -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
Bool -> PackageCheck -> CheckM m ()
checkP ((FilePath -> Bool) -> [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (FilePath -> [FilePath] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
fs) [FilePath]
opts) PackageCheck
ck

    checkFlagsP
      :: Monad m
      => (String -> Bool)
      -> (String -> PackageCheck)
      -> CheckM m ()
    checkFlagsP :: forall (m :: * -> *).
Monad m =>
(FilePath -> Bool) -> (FilePath -> PackageCheck) -> CheckM m ()
checkFlagsP FilePath -> Bool
p FilePath -> PackageCheck
ckc =
      case (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter FilePath -> Bool
p [FilePath]
opts of
        [] -> () -> CheckM m ()
forall a. a -> CheckM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        (FilePath
_ : [FilePath]
_) -> PackageCheck -> CheckM m ()
forall (m :: * -> *). Monad m => PackageCheck -> CheckM m ()
tellP (FilePath -> PackageCheck
ckc FilePath
title)

    checkGeneral :: CheckM m ()
checkGeneral = do
      [FilePath] -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
[FilePath] -> PackageCheck -> CheckM m ()
checkFlags
        [FilePath
"-fasm"]
        (CheckExplanation -> PackageCheck
PackageDistInexcusable (CheckExplanation -> PackageCheck)
-> CheckExplanation -> PackageCheck
forall a b. (a -> b) -> a -> b
$ FilePath -> CheckExplanation
OptFasm FilePath
title)
      [FilePath] -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
[FilePath] -> PackageCheck -> CheckM m ()
checkFlags
        [FilePath
"-fhpc"]
        (CheckExplanation -> PackageCheck
PackageDistInexcusable (CheckExplanation -> PackageCheck)
-> CheckExplanation -> PackageCheck
forall a b. (a -> b) -> a -> b
$ FilePath -> CheckExplanation
OptHpc FilePath
title)
      [FilePath] -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
[FilePath] -> PackageCheck -> CheckM m ()
checkFlags
        [FilePath
"-prof"]
        (CheckExplanation -> PackageCheck
PackageBuildWarning (CheckExplanation -> PackageCheck)
-> CheckExplanation -> PackageCheck
forall a b. (a -> b) -> a -> b
$ FilePath -> CheckExplanation
OptProf FilePath
title)
      pid <- (CheckCtx m -> PackageIdentifier) -> CheckM m PackageIdentifier
forall (m :: * -> *) a. Monad m => (CheckCtx m -> a) -> CheckM m a
asksCM (PNames -> PackageIdentifier
pnPackageId (PNames -> PackageIdentifier)
-> (CheckCtx m -> PNames) -> CheckCtx m -> PackageIdentifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CheckCtx m -> PNames
forall (m :: * -> *). CheckCtx m -> PNames
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 = [FilePath] -> [FilePath]
rmRtsOpts [FilePath]
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
        "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
        ( \FilePath
opt ->
            FilePath
"-d" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` FilePath
opt
              Bool -> Bool -> Bool
&& FilePath
opt FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
"-dynamic"
        )
        (PackageDistInexcusable . DynamicUnneeded)
      checkFlagsP
        ( \FilePath
opt -> case FilePath
opt of
            FilePath
"-j" -> Bool
True
            (Char
'-' : Char
'j' : Char
d : FilePath
_) -> Char -> Bool
isDigit Char
d
            FilePath
_ -> Bool
False
        )
        (PackageDistInexcusable . JUnneeded)

    checkLib :: CheckM m ()
checkLib = do
      Bool -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
Bool -> PackageCheck -> CheckM m ()
checkP
        (FilePath
"-rtsopts" FilePath -> [FilePath] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
opts)
        (CheckExplanation -> PackageCheck
PackageBuildWarning (CheckExplanation -> PackageCheck)
-> CheckExplanation -> PackageCheck
forall a b. (a -> b) -> a -> b
$ FilePath -> CheckExplanation
OptRts FilePath
title)
      Bool -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
Bool -> PackageCheck -> CheckM m ()
checkP
        ((FilePath -> Bool) -> [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\FilePath
opt -> FilePath
"-with-rtsopts" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` FilePath
opt) [FilePath]
opts)
        (CheckExplanation -> PackageCheck
PackageBuildWarning (CheckExplanation -> PackageCheck)
-> CheckExplanation -> PackageCheck
forall a b. (a -> b) -> a -> b
$ FilePath -> CheckExplanation
OptWithRts FilePath
title)

    checkTestBench :: CheckM m ()
checkTestBench = do
      [FilePath] -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
[FilePath] -> PackageCheck -> CheckM m ()
checkFlags
        [FilePath
"-O0", FilePath
"-Onot"]
        (CheckExplanation -> PackageCheck
PackageDistSuspiciousWarn (CheckExplanation -> PackageCheck)
-> CheckExplanation -> PackageCheck
forall a b. (a -> b) -> a -> b
$ FilePath -> CheckExplanation
OptONot FilePath
title)

    checkNonTestBench :: CheckM m ()
checkNonTestBench = do
      [FilePath] -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
[FilePath] -> PackageCheck -> CheckM m ()
checkFlags
        [FilePath
"-O0", FilePath
"-Onot"]
        (CheckExplanation -> PackageCheck
PackageDistSuspicious (CheckExplanation -> PackageCheck)
-> CheckExplanation -> PackageCheck
forall a b. (a -> b) -> a -> b
$ FilePath -> CheckExplanation
OptONot FilePath
title)

    ghcExtension :: FilePath -> Maybe Extension
ghcExtension (Char
'-' : Char
'f' : FilePath
name) = case FilePath
name of
      FilePath
"allow-overlapping-instances" -> KnownExtension -> Maybe Extension
enable KnownExtension
OverlappingInstances
      FilePath
"no-allow-overlapping-instances" -> KnownExtension -> Maybe Extension
disable KnownExtension
OverlappingInstances
      FilePath
"th" -> KnownExtension -> Maybe Extension
enable KnownExtension
TemplateHaskell
      FilePath
"no-th" -> KnownExtension -> Maybe Extension
disable KnownExtension
TemplateHaskell
      FilePath
"ffi" -> KnownExtension -> Maybe Extension
enable KnownExtension
ForeignFunctionInterface
      FilePath
"no-ffi" -> KnownExtension -> Maybe Extension
disable KnownExtension
ForeignFunctionInterface
      FilePath
"fi" -> KnownExtension -> Maybe Extension
enable KnownExtension
ForeignFunctionInterface
      FilePath
"no-fi" -> KnownExtension -> Maybe Extension
disable KnownExtension
ForeignFunctionInterface
      FilePath
"monomorphism-restriction" -> KnownExtension -> Maybe Extension
enable KnownExtension
MonomorphismRestriction
      FilePath
"no-monomorphism-restriction" -> KnownExtension -> Maybe Extension
disable KnownExtension
MonomorphismRestriction
      FilePath
"mono-pat-binds" -> KnownExtension -> Maybe Extension
enable KnownExtension
MonoPatBinds
      FilePath
"no-mono-pat-binds" -> KnownExtension -> Maybe Extension
disable KnownExtension
MonoPatBinds
      FilePath
"allow-undecidable-instances" -> KnownExtension -> Maybe Extension
enable KnownExtension
UndecidableInstances
      FilePath
"no-allow-undecidable-instances" -> KnownExtension -> Maybe Extension
disable KnownExtension
UndecidableInstances
      FilePath
"allow-incoherent-instances" -> KnownExtension -> Maybe Extension
enable KnownExtension
IncoherentInstances
      FilePath
"no-allow-incoherent-instances" -> KnownExtension -> Maybe Extension
disable KnownExtension
IncoherentInstances
      FilePath
"arrows" -> KnownExtension -> Maybe Extension
enable KnownExtension
Arrows
      FilePath
"no-arrows" -> KnownExtension -> Maybe Extension
disable KnownExtension
Arrows
      FilePath
"generics" -> KnownExtension -> Maybe Extension
enable KnownExtension
Generics
      FilePath
"no-generics" -> KnownExtension -> Maybe Extension
disable KnownExtension
Generics
      FilePath
"implicit-prelude" -> KnownExtension -> Maybe Extension
enable KnownExtension
ImplicitPrelude
      FilePath
"no-implicit-prelude" -> KnownExtension -> Maybe Extension
disable KnownExtension
ImplicitPrelude
      FilePath
"implicit-params" -> KnownExtension -> Maybe Extension
enable KnownExtension
ImplicitParams
      FilePath
"no-implicit-params" -> KnownExtension -> Maybe Extension
disable KnownExtension
ImplicitParams
      FilePath
"bang-patterns" -> KnownExtension -> Maybe Extension
enable KnownExtension
BangPatterns
      FilePath
"no-bang-patterns" -> KnownExtension -> Maybe Extension
disable KnownExtension
BangPatterns
      FilePath
"scoped-type-variables" -> KnownExtension -> Maybe Extension
enable KnownExtension
ScopedTypeVariables
      FilePath
"no-scoped-type-variables" -> KnownExtension -> Maybe Extension
disable KnownExtension
ScopedTypeVariables
      FilePath
"extended-default-rules" -> KnownExtension -> Maybe Extension
enable KnownExtension
ExtendedDefaultRules
      FilePath
"no-extended-default-rules" -> KnownExtension -> Maybe Extension
disable KnownExtension
ExtendedDefaultRules
      FilePath
_ -> Maybe Extension
forall a. Maybe a
Nothing
    ghcExtension FilePath
"-cpp" = KnownExtension -> Maybe Extension
enable KnownExtension
CPP
    ghcExtension FilePath
_ = Maybe Extension
forall a. Maybe a
Nothing

    enable :: KnownExtension -> Maybe Extension
enable KnownExtension
e = Extension -> Maybe Extension
forall a. a -> Maybe a
Just (KnownExtension -> Extension
EnableExtension KnownExtension
e)
    disable :: KnownExtension -> Maybe Extension
disable KnownExtension
e = Extension -> Maybe Extension
forall a. a -> Maybe a
Just (KnownExtension -> Extension
DisableExtension KnownExtension
e)

    rmRtsOpts :: [String] -> [String]
    rmRtsOpts :: [FilePath] -> [FilePath]
rmRtsOpts (FilePath
"-with-rtsopts" : FilePath
_ : [FilePath]
xs) = [FilePath] -> [FilePath]
rmRtsOpts [FilePath]
xs
    rmRtsOpts (FilePath
x : [FilePath]
xs) = FilePath
x FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath] -> [FilePath]
rmRtsOpts [FilePath]
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 :: forall (m :: * -> *).
Monad m =>
WarnLang -> FilePath -> [FilePath] -> [FilePath] -> CheckM m ()
checkCLikeOptions WarnLang
label FilePath
prefix [FilePath]
opts [FilePath]
ldOpts = do
  FilePath -> FilePath -> [(FilePath, FilePath)] -> CheckM m ()
forall (m :: * -> *).
Monad m =>
FilePath -> FilePath -> [(FilePath, FilePath)] -> CheckM m ()
checkAlternatives
    FilePath
prefix
    FilePath
"include-dirs"
    [(FilePath
flag, FilePath
dir) | flag :: FilePath
flag@(Char
'-' : Char
'I' : FilePath
dir) <- [FilePath]
opts]
  FilePath -> FilePath -> [(FilePath, FilePath)] -> CheckM m ()
forall (m :: * -> *).
Monad m =>
FilePath -> FilePath -> [(FilePath, FilePath)] -> CheckM m ()
checkAlternatives
    FilePath
prefix
    FilePath
"extra-libraries"
    [(FilePath
flag, FilePath
lib) | flag :: FilePath
flag@(Char
'-' : Char
'l' : FilePath
lib) <- [FilePath]
opts]
  FilePath -> FilePath -> [(FilePath, FilePath)] -> CheckM m ()
forall (m :: * -> *).
Monad m =>
FilePath -> FilePath -> [(FilePath, FilePath)] -> CheckM m ()
checkAlternatives
    FilePath
prefix
    FilePath
"extra-lib-dirs"
    [(FilePath
flag, FilePath
dir) | flag :: FilePath
flag@(Char
'-' : Char
'L' : FilePath
dir) <- [FilePath]
opts]

  FilePath -> FilePath -> [(FilePath, FilePath)] -> CheckM m ()
forall (m :: * -> *).
Monad m =>
FilePath -> FilePath -> [(FilePath, FilePath)] -> CheckM m ()
checkAlternatives
    FilePath
"ld-options"
    FilePath
"extra-libraries"
    [(FilePath
flag, FilePath
lib) | flag :: FilePath
flag@(Char
'-' : Char
'l' : FilePath
lib) <- [FilePath]
ldOpts]
  FilePath -> FilePath -> [(FilePath, FilePath)] -> CheckM m ()
forall (m :: * -> *).
Monad m =>
FilePath -> FilePath -> [(FilePath, FilePath)] -> CheckM m ()
checkAlternatives
    FilePath
"ld-options"
    FilePath
"extra-lib-dirs"
    [(FilePath
flag, FilePath
dir) | flag :: FilePath
flag@(Char
'-' : Char
'L' : FilePath
dir) <- [FilePath]
ldOpts]

  Bool -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
Bool -> PackageCheck -> CheckM m ()
checkP
    ((FilePath -> Bool) -> [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (FilePath -> [FilePath] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath
"-O", FilePath
"-Os", FilePath
"-O0", FilePath
"-O1", FilePath
"-O2", FilePath
"-O3"]) [FilePath]
opts)
    (CheckExplanation -> PackageCheck
PackageDistSuspicious (CheckExplanation -> PackageCheck)
-> CheckExplanation -> PackageCheck
forall a b. (a -> b) -> a -> b
$ FilePath -> WarnLang -> CheckExplanation
COptONumber FilePath
prefix WarnLang
label)

checkAlternatives
  :: Monad m
  => CabalField -- Wrong field.
  -> CabalField -- Appropriate field.
  -> [(String, String)] -- List of good and bad flags.
  -> CheckM m ()
checkAlternatives :: forall (m :: * -> *).
Monad m =>
FilePath -> FilePath -> [(FilePath, FilePath)] -> CheckM m ()
checkAlternatives FilePath
badField FilePath
goodField [(FilePath, FilePath)]
flags = do
  let ([FilePath]
badFlags, [FilePath]
_) = [(FilePath, FilePath)] -> ([FilePath], [FilePath])
forall a b. [(a, b)] -> ([a], [b])
unzip [(FilePath, FilePath)]
flags
  Bool -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
Bool -> PackageCheck -> CheckM m ()
checkP
    (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
badFlags)
    (CheckExplanation -> PackageCheck
PackageBuildWarning (CheckExplanation -> PackageCheck)
-> CheckExplanation -> PackageCheck
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> [(FilePath, FilePath)] -> CheckExplanation
OptAlternatives FilePath
badField FilePath
goodField [(FilePath, FilePath)]
flags)

checkCPPOptions
  :: Monad m
  => [String] -- Options in String form.
  -> CheckM m ()
checkCPPOptions :: forall (m :: * -> *). Monad m => [FilePath] -> CheckM m ()
checkCPPOptions [FilePath]
opts = do
  FilePath -> FilePath -> [(FilePath, FilePath)] -> CheckM m ()
forall (m :: * -> *).
Monad m =>
FilePath -> FilePath -> [(FilePath, FilePath)] -> CheckM m ()
checkAlternatives
    FilePath
"cpp-options"
    FilePath
"include-dirs"
    [(FilePath
flag, FilePath
dir) | flag :: FilePath
flag@(Char
'-' : Char
'I' : FilePath
dir) <- [FilePath]
opts]
  (FilePath -> CheckM m ()) -> [FilePath] -> CheckM m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
    ( \FilePath
opt ->
        Bool -> PackageCheck -> CheckM m ()
forall (m :: * -> *).
Monad m =>
Bool -> PackageCheck -> CheckM m ()
checkP
          (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (FilePath -> Bool) -> [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` FilePath
opt) [FilePath
"-D", FilePath
"-U", FilePath
"-I"])
          (CheckExplanation -> PackageCheck
PackageBuildWarning (FilePath -> CheckExplanation
COptCPP FilePath
opt))
    )
    [FilePath]
opts