-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.PackageDescription.Check
-- Copyright   :  Lennart Kolmodin 2008
-- License     :  BSD3
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- This has code for checking for various problems in packages. There is one
-- set of checks that just looks at a 'PackageDescription' in isolation and
-- another set of checks that also looks at files in the package. Some of the
-- checks are basic sanity checks, others are portability standards that we'd
-- like to encourage. There is a 'PackageCheck' type that distinguishes the
-- different kinds of checks so we can see which ones are appropriate to report
-- in different situations. This code gets used when configuring a package when
-- we consider only basic problems. The higher standard is used when
-- preparing a source tarball and by Hackage when uploading new packages. The
-- reason for this is that we want to hold packages that are expected to be
-- distributed to a higher standard than packages that are only ever expected
-- to be used on the author's own environment.

module Distribution.PackageDescription.Check (
        -- * Package Checking
        CheckExplanation(..),
        PackageCheck(..),
        checkPackage,
        checkConfiguredPackage,
        wrapParseWarning,
        ppPackageCheck,

        -- ** Checking package contents
        checkPackageFiles,
        checkPackageContent,
        CheckPackageContentOps(..),
        checkPackageFileNames,
  ) where

import Data.Foldable                                 (foldrM)
import Distribution.Compat.Prelude
import Prelude ()

import Data.List                                     (delete, group)
import Distribution.CabalSpecVersion
import Distribution.Compat.Lens
import Distribution.Compiler
import Distribution.License
import Distribution.ModuleName                       (ModuleName)
import Distribution.Package
import Distribution.PackageDescription
import Distribution.PackageDescription.Configuration
import Distribution.Parsec.Warning                   (PWarning, showPWarning)
import Distribution.Pretty                           (prettyShow)
import Distribution.Simple.BuildPaths                (autogenPackageInfoModuleName, autogenPathsModuleName)
import Distribution.Simple.BuildToolDepends
import Distribution.Simple.CCompiler
import Distribution.Simple.Glob
import Distribution.Simple.Utils                     hiding (findPackageDesc, notice)
import Distribution.System
import Distribution.Types.ComponentRequestedSpec
import Distribution.Types.PackageName.Magic
import Distribution.Utils.Generic                    (isAscii)
import Distribution.Verbosity
import Distribution.Version
import Distribution.Utils.Path
import Language.Haskell.Extension
import System.FilePath
       ( makeRelative, normalise, splitDirectories, splitExtension, splitPath
       , takeExtension, takeFileName, (<.>), (</>))

import qualified Data.ByteString.Lazy      as BS
import qualified Data.Map                  as Map
import qualified Distribution.Compat.DList as DList
import qualified Distribution.SPDX         as SPDX
import qualified System.Directory          as System

import qualified System.Directory        (getDirectoryContents)
import qualified System.FilePath.Windows as FilePath.Windows (isValid)

import qualified Data.Set as Set
import qualified Distribution.Utils.ShortText as ShortText

import qualified Distribution.Types.BuildInfo.Lens                 as L
import qualified Distribution.Types.GenericPackageDescription.Lens as L
import qualified Distribution.Types.PackageDescription.Lens        as L

-- $setup
-- >>> import Control.Arrow ((&&&))

-- ------------------------------------------------------------
-- * Warning messages
-- ------------------------------------------------------------

-- | Which stanza does `CheckExplanation` refer to?
--
data CEType = CETLibrary | CETExecutable | CETTest | CETBenchmark
    deriving (CEType -> CEType -> Bool
(CEType -> CEType -> Bool)
-> (CEType -> CEType -> Bool) -> Eq CEType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CEType -> CEType -> Bool
== :: CEType -> CEType -> Bool
$c/= :: CEType -> CEType -> Bool
/= :: CEType -> CEType -> Bool
Eq, Eq CEType
Eq CEType =>
(CEType -> CEType -> Ordering)
-> (CEType -> CEType -> Bool)
-> (CEType -> CEType -> Bool)
-> (CEType -> CEType -> Bool)
-> (CEType -> CEType -> Bool)
-> (CEType -> CEType -> CEType)
-> (CEType -> CEType -> CEType)
-> Ord CEType
CEType -> CEType -> Bool
CEType -> CEType -> Ordering
CEType -> CEType -> CEType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CEType -> CEType -> Ordering
compare :: CEType -> CEType -> Ordering
$c< :: CEType -> CEType -> Bool
< :: CEType -> CEType -> Bool
$c<= :: CEType -> CEType -> Bool
<= :: CEType -> CEType -> Bool
$c> :: CEType -> CEType -> Bool
> :: CEType -> CEType -> Bool
$c>= :: CEType -> CEType -> Bool
>= :: CEType -> CEType -> Bool
$cmax :: CEType -> CEType -> CEType
max :: CEType -> CEType -> CEType
$cmin :: CEType -> CEType -> CEType
min :: CEType -> CEType -> CEType
Ord, Int -> CEType -> ShowS
[CEType] -> ShowS
CEType -> String
(Int -> CEType -> ShowS)
-> (CEType -> String) -> ([CEType] -> ShowS) -> Show CEType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CEType -> ShowS
showsPrec :: Int -> CEType -> ShowS
$cshow :: CEType -> String
show :: CEType -> String
$cshowList :: [CEType] -> ShowS
showList :: [CEType] -> ShowS
Show)

-- | Pretty printing `CEType`.
--
ppCE :: CEType -> String
ppCE :: CEType -> String
ppCE CEType
CETLibrary = String
"library"
ppCE CEType
CETExecutable = String
"executable"
ppCE CEType
CETTest = String
"test suite"
ppCE CEType
CETBenchmark = String
"benchmark"

-- | Which field does `CheckExplanation` refer to?
--
data CEField = CEFCategory | CEFMaintainer | CEFSynopsis
             | CEFDescription | CEFSynOrDesc
    deriving (CEField -> CEField -> Bool
(CEField -> CEField -> Bool)
-> (CEField -> CEField -> Bool) -> Eq CEField
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CEField -> CEField -> Bool
== :: CEField -> CEField -> Bool
$c/= :: CEField -> CEField -> Bool
/= :: CEField -> CEField -> Bool
Eq, Eq CEField
Eq CEField =>
(CEField -> CEField -> Ordering)
-> (CEField -> CEField -> Bool)
-> (CEField -> CEField -> Bool)
-> (CEField -> CEField -> Bool)
-> (CEField -> CEField -> Bool)
-> (CEField -> CEField -> CEField)
-> (CEField -> CEField -> CEField)
-> Ord CEField
CEField -> CEField -> Bool
CEField -> CEField -> Ordering
CEField -> CEField -> CEField
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CEField -> CEField -> Ordering
compare :: CEField -> CEField -> Ordering
$c< :: CEField -> CEField -> Bool
< :: CEField -> CEField -> Bool
$c<= :: CEField -> CEField -> Bool
<= :: CEField -> CEField -> Bool
$c> :: CEField -> CEField -> Bool
> :: CEField -> CEField -> Bool
$c>= :: CEField -> CEField -> Bool
>= :: CEField -> CEField -> Bool
$cmax :: CEField -> CEField -> CEField
max :: CEField -> CEField -> CEField
$cmin :: CEField -> CEField -> CEField
min :: CEField -> CEField -> CEField
Ord, Int -> CEField -> ShowS
[CEField] -> ShowS
CEField -> String
(Int -> CEField -> ShowS)
-> (CEField -> String) -> ([CEField] -> ShowS) -> Show CEField
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CEField -> ShowS
showsPrec :: Int -> CEField -> ShowS
$cshow :: CEField -> String
show :: CEField -> String
$cshowList :: [CEField] -> ShowS
showList :: [CEField] -> ShowS
Show)

-- | Pretty printing `CEField`.
--
ppCEField :: CEField -> String
ppCEField :: CEField -> String
ppCEField CEField
CEFCategory = String
"category"
ppCEField CEField
CEFMaintainer = String
"maintainer"
ppCEField CEField
CEFSynopsis = String
"synopsis"
ppCEField CEField
CEFDescription = String
"description"
ppCEField CEField
CEFSynOrDesc = String
"synopsis' or 'description"

-- | Explanations of 'PackageCheck`'s errors/warnings.
--
data CheckExplanation =
          ParseWarning FilePath PWarning
        | NoNameField
        | NoVersionField
        | NoTarget
        | UnnamedInternal
        | DuplicateSections [UnqualComponentName]
        | IllegalLibraryName PackageDescription
        | NoModulesExposed Library
        | SignaturesCabal2
        | AutogenNotExposed
        | AutogenIncludesNotIncluded
        | NoMainIs Executable
        | NoHsLhsMain
        | MainCCabal1_18
        | AutogenNoOther CEType UnqualComponentName
        | AutogenIncludesNotIncludedExe
        | TestsuiteTypeNotKnown TestType
        | TestsuiteNotSupported TestType
        | BenchmarkTypeNotKnown BenchmarkType
        | BenchmarkNotSupported BenchmarkType
        | NoHsLhsMainBench
        | InvalidNameWin PackageDescription
        | ZPrefix
        | NoBuildType
        | NoCustomSetup
        | UnknownCompilers [String]
        | UnknownLanguages [String]
        | UnknownExtensions [String]
        | LanguagesAsExtension [String]
        | DeprecatedExtensions [(Extension, Maybe Extension)]
        | MissingField CEField
        | SynopsisTooLong
        | ShortDesc
        | InvalidTestWith [Dependency]
        | ImpossibleInternalDep [Dependency]
        | ImpossibleInternalExe [ExeDependency]
        | MissingInternalExe [ExeDependency]
        | NONELicense
        | NoLicense
        | AllRightsReservedLicense
        | LicenseMessParse PackageDescription
        | UnrecognisedLicense String
        | UncommonBSD4
        | UnknownLicenseVersion License [Version]
        | NoLicenseFile
        | UnrecognisedSourceRepo String
        | MissingType
        | MissingLocation
        | MissingModule
        | MissingTag
        | SubdirRelPath
        | SubdirGoodRelPath String
        | OptFasm String
        | OptViaC String
        | OptHpc String
        | OptProf String
        | OptO String
        | OptHide String
        | OptMake String
        | OptONot String
        | OptOOne String
        | OptOTwo String
        | OptSplitSections String
        | OptSplitObjs String
        | OptWls String
        | OptExts String
        | OptRts String
        | OptWithRts String
        | COptONumber String String
        | COptCPP String
        | OptAlternatives String String [(String, String)]
        | RelativeOutside String FilePath
        | AbsolutePath String FilePath
        | BadRelativePAth String FilePath String
        | DistPoint (Maybe String) FilePath
        | GlobSyntaxError String String
        | RecursiveGlobInRoot String FilePath
        | InvalidOnWin [FilePath]
        | FilePathTooLong FilePath
        | FilePathNameTooLong FilePath
        | FilePathSplitTooLong FilePath
        | FilePathEmpty
        | CVTestSuite
        | CVDefaultLanguage
        | CVDefaultLanguageComponent
        | CVExtraDocFiles
        | CVMultiLib
        | CVReexported
        | CVMixins
        | CVExtraFrameworkDirs
        | CVDefaultExtensions
        | CVExtensionsDeprecated
        | CVSources
        | CVExtraDynamic [[String]]
        | CVVirtualModules
        | CVSourceRepository
        | CVExtensions CabalSpecVersion [Extension]
        | CVCustomSetup
        | CVExpliticDepsCustomSetup
        | CVAutogenPaths
        | CVAutogenPackageInfo
        | GlobNoMatch String String
        | GlobExactMatch String String FilePath
        | GlobNoDir String String FilePath
        | UnknownOS [String]
        | UnknownArch [String]
        | UnknownCompiler [String]
        | BaseNoUpperBounds
        | MissingUpperBounds [PackageName]
        | SuspiciousFlagName [String]
        | DeclaredUsedFlags (Set FlagName) (Set FlagName)
        | NonASCIICustomField [String]
        | RebindableClashPaths
        | RebindableClashPackageInfo
        | WErrorUnneeded String
        | JUnneeded String
        | FDeferTypeErrorsUnneeded String
        | DynamicUnneeded String
        | ProfilingUnneeded String
        | UpperBoundSetup String
        | DuplicateModule String [ModuleName]
        | PotentialDupModule String [ModuleName]
        | BOMStart FilePath
        | NotPackageName FilePath String
        | NoDesc
        | MultiDesc [String]
        | UnknownFile String (SymbolicPath PackageDir LicenseFile)
        | MissingSetupFile
        | MissingConfigureScript
        | UnknownDirectory String FilePath
        | MissingSourceControl
        | MissingExpectedDocFiles Bool [FilePath]
        | WrongFieldForExpectedDocFiles Bool String [FilePath]
    deriving (CheckExplanation -> CheckExplanation -> Bool
(CheckExplanation -> CheckExplanation -> Bool)
-> (CheckExplanation -> CheckExplanation -> Bool)
-> Eq CheckExplanation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CheckExplanation -> CheckExplanation -> Bool
== :: CheckExplanation -> CheckExplanation -> Bool
$c/= :: CheckExplanation -> CheckExplanation -> Bool
/= :: CheckExplanation -> CheckExplanation -> Bool
Eq, Eq CheckExplanation
Eq CheckExplanation =>
(CheckExplanation -> CheckExplanation -> Ordering)
-> (CheckExplanation -> CheckExplanation -> Bool)
-> (CheckExplanation -> CheckExplanation -> Bool)
-> (CheckExplanation -> CheckExplanation -> Bool)
-> (CheckExplanation -> CheckExplanation -> Bool)
-> (CheckExplanation -> CheckExplanation -> CheckExplanation)
-> (CheckExplanation -> CheckExplanation -> CheckExplanation)
-> Ord CheckExplanation
CheckExplanation -> CheckExplanation -> Bool
CheckExplanation -> CheckExplanation -> Ordering
CheckExplanation -> CheckExplanation -> CheckExplanation
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CheckExplanation -> CheckExplanation -> Ordering
compare :: CheckExplanation -> CheckExplanation -> Ordering
$c< :: CheckExplanation -> CheckExplanation -> Bool
< :: CheckExplanation -> CheckExplanation -> Bool
$c<= :: CheckExplanation -> CheckExplanation -> Bool
<= :: CheckExplanation -> CheckExplanation -> Bool
$c> :: CheckExplanation -> CheckExplanation -> Bool
> :: CheckExplanation -> CheckExplanation -> Bool
$c>= :: CheckExplanation -> CheckExplanation -> Bool
>= :: CheckExplanation -> CheckExplanation -> Bool
$cmax :: CheckExplanation -> CheckExplanation -> CheckExplanation
max :: CheckExplanation -> CheckExplanation -> CheckExplanation
$cmin :: CheckExplanation -> CheckExplanation -> CheckExplanation
min :: CheckExplanation -> CheckExplanation -> CheckExplanation
Ord, Int -> CheckExplanation -> ShowS
[CheckExplanation] -> ShowS
CheckExplanation -> String
(Int -> CheckExplanation -> ShowS)
-> (CheckExplanation -> String)
-> ([CheckExplanation] -> ShowS)
-> Show CheckExplanation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CheckExplanation -> ShowS
showsPrec :: Int -> CheckExplanation -> ShowS
$cshow :: CheckExplanation -> String
show :: CheckExplanation -> String
$cshowList :: [CheckExplanation] -> ShowS
showList :: [CheckExplanation] -> ShowS
Show)

-- | Wraps `ParseWarning` into `PackageCheck`.
--
wrapParseWarning :: FilePath -> PWarning -> PackageCheck
wrapParseWarning :: String -> PWarning -> PackageCheck
wrapParseWarning String
fp PWarning
pw = CheckExplanation -> PackageCheck
PackageDistSuspicious (String -> PWarning -> CheckExplanation
ParseWarning String
fp PWarning
pw)
    -- TODO: as Jul 2022 there is no severity indication attached PWarnType.
    --       Once that is added, we can output something more appropriate
    --       than PackageDistSuspicious for every parse warning.
    --       (see: Cabal-syntax/src/Distribution/Parsec/Warning.hs)

-- | Pretty printing `CheckExplanation`.
--
ppExplanation :: CheckExplanation -> String
ppExplanation :: CheckExplanation -> String
ppExplanation (ParseWarning String
fp PWarning
pp) = String -> PWarning -> String
showPWarning String
fp PWarning
pp
ppExplanation CheckExplanation
NoNameField = String
"No 'name' field."
ppExplanation CheckExplanation
NoVersionField = String
"No 'version' field."
ppExplanation CheckExplanation
NoTarget =
    String
"No executables, libraries, tests, or benchmarks found. Nothing to do."
ppExplanation CheckExplanation
UnnamedInternal =
    String
"Found one or more unnamed internal libraries. Only the non-internal"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" library can have the same name as the package."
ppExplanation (DuplicateSections [UnqualComponentName]
duplicateNames) =
    String
"Duplicate sections: "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep ((UnqualComponentName -> String)
-> [UnqualComponentName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map UnqualComponentName -> String
unUnqualComponentName [UnqualComponentName]
duplicateNames)
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
". The name of every library, executable, test suite,"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" and benchmark section in the package must be unique."
ppExplanation (IllegalLibraryName PackageDescription
pkg) =
    String
"Illegal internal library name "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ PackageName -> String
forall a. Pretty a => a -> String
prettyShow (PackageDescription -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName PackageDescription
pkg)
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
". Internal libraries cannot have the same name as the package."
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" Maybe you wanted a non-internal library?"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" If so, rewrite the section stanza"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" from 'library: '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ PackageName -> String
forall a. Pretty a => a -> String
prettyShow (PackageDescription -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName PackageDescription
pkg)
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' to 'library'."
ppExplanation (NoModulesExposed Library
lib) =
    LibraryName -> String
showLibraryName (Library -> LibraryName
libName Library
lib) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" does not expose any modules"
ppExplanation CheckExplanation
SignaturesCabal2 =
    String
"To use the 'signatures' field the package needs to specify "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"at least 'cabal-version: 2.0'."
ppExplanation CheckExplanation
AutogenNotExposed =
    String
"An 'autogen-module' is neither on 'exposed-modules' or 'other-modules'."
ppExplanation CheckExplanation
AutogenIncludesNotIncluded =
    String
"An include in 'autogen-includes' is neither in 'includes' or "
       String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'install-includes'."
ppExplanation (NoMainIs Executable
exe) =
    String
"No 'main-is' field found for executable " String -> ShowS
forall a. [a] -> [a] -> [a]
++ UnqualComponentName -> String
forall a. Pretty a => a -> String
prettyShow (Executable -> UnqualComponentName
exeName Executable
exe)
ppExplanation CheckExplanation
NoHsLhsMain =
    String
"The 'main-is' field must specify a '.hs' or '.lhs' file "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(even if it is generated by a preprocessor), "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"or it may specify a C/C++/obj-C source file."
ppExplanation CheckExplanation
MainCCabal1_18 =
    String
"The package uses a C/C++/obj-C source file for the 'main-is' field. "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"To use this feature you need to specify 'cabal-version: 1.18' or"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" higher."
ppExplanation (AutogenNoOther CEType
ct UnqualComponentName
ucn) =
    String
"On " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CEType -> String
ppCE CEType
ct String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ UnqualComponentName -> String
forall a. Pretty a => a -> String
prettyShow UnqualComponentName
ucn String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' an 'autogen-module'"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is not on 'other-modules'"
ppExplanation CheckExplanation
AutogenIncludesNotIncludedExe =
    String
"An include in 'autogen-includes' is not in 'includes'."
ppExplanation (TestsuiteTypeNotKnown TestType
tt) =
    ShowS
quote (TestType -> String
forall a. Pretty a => a -> String
prettyShow TestType
tt) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is not a known type of test suite. "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Either remove the 'type' field or use a known type. "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"The known test suite types are: "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep ((TestType -> String) -> [TestType] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map TestType -> String
forall a. Pretty a => a -> String
prettyShow [TestType]
knownTestTypes)
ppExplanation (TestsuiteNotSupported TestType
tt) =
    ShowS
quote (TestType -> String
forall a. Pretty a => a -> String
prettyShow TestType
tt) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is not a supported test suite version. "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Either remove the 'type' field or use a known type. "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"The known test suite types are: "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep ((TestType -> String) -> [TestType] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map TestType -> String
forall a. Pretty a => a -> String
prettyShow [TestType]
knownTestTypes)
ppExplanation (BenchmarkTypeNotKnown BenchmarkType
tt) =
    ShowS
quote (BenchmarkType -> String
forall a. Pretty a => a -> String
prettyShow BenchmarkType
tt) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is not a known type of benchmark. "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Either remove the 'type' field or use a known type. "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"The known benchmark types are: "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep ((BenchmarkType -> String) -> [BenchmarkType] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map BenchmarkType -> String
forall a. Pretty a => a -> String
prettyShow [BenchmarkType]
knownBenchmarkTypes)
ppExplanation (BenchmarkNotSupported BenchmarkType
tt) =
    ShowS
quote (BenchmarkType -> String
forall a. Pretty a => a -> String
prettyShow BenchmarkType
tt) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is not a supported benchmark version. "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Either remove the 'type' field or use a known type. "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"The known benchmark types are: "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep ((BenchmarkType -> String) -> [BenchmarkType] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map BenchmarkType -> String
forall a. Pretty a => a -> String
prettyShow [BenchmarkType]
knownBenchmarkTypes)
ppExplanation CheckExplanation
NoHsLhsMainBench =
    String
"The 'main-is' field must specify a '.hs' or '.lhs' file "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(even if it is generated by a preprocessor)."
ppExplanation (InvalidNameWin PackageDescription
pkg) =
    String
"The package name '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ PackageName -> String
forall a. Pretty a => a -> String
prettyShow (PackageDescription -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName PackageDescription
pkg) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' is "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"invalid on Windows. Many tools need to convert package names to "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"file names so using this name would cause problems."
ppExplanation CheckExplanation
ZPrefix =
    String
"Package names with the prefix 'z-' are reserved by Cabal and "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"cannot be used."
ppExplanation CheckExplanation
NoBuildType =
    String
"No 'build-type' specified. If you do not need a custom Setup.hs or "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"./configure script then use 'build-type: Simple'."
ppExplanation CheckExplanation
NoCustomSetup =
    String
"Ignoring the 'custom-setup' section because the 'build-type' is "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"not 'Custom'. Use 'build-type: Custom' if you need to use a "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"custom Setup.hs script."
ppExplanation (UnknownCompilers [String]
unknownCompilers) =
    String
"Unknown compiler " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep (ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
quote [String]
unknownCompilers)
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" in 'tested-with' field."
ppExplanation (UnknownLanguages [String]
unknownLanguages) =
    String
"Unknown languages: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep [String]
unknownLanguages
ppExplanation (UnknownExtensions [String]
unknownExtensions) =
    String
"Unknown extensions: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep [String]
unknownExtensions
ppExplanation (LanguagesAsExtension [String]
languagesUsedAsExtensions) =
    String
"Languages listed as extensions: "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep [String]
languagesUsedAsExtensions
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
". Languages must be specified in either the 'default-language' "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" or the 'other-languages' field."
ppExplanation (DeprecatedExtensions [(Extension, Maybe Extension)]
ourDeprecatedExtensions) =
    String
"Deprecated extensions: "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep (((Extension, Maybe Extension) -> String)
-> [(Extension, Maybe Extension)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (ShowS
quote ShowS
-> ((Extension, Maybe Extension) -> String)
-> (Extension, Maybe Extension)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Extension -> String
forall a. Pretty a => a -> String
prettyShow (Extension -> String)
-> ((Extension, Maybe Extension) -> Extension)
-> (Extension, Maybe Extension)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Extension, Maybe Extension) -> Extension
forall a b. (a, b) -> a
fst) [(Extension, Maybe Extension)]
ourDeprecatedExtensions)
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
". " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords
           [ String
"Instead of '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Extension -> String
forall a. Pretty a => a -> String
prettyShow Extension
ext
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' use '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Extension -> String
forall a. Pretty a => a -> String
prettyShow Extension
replacement String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'."
           | (Extension
ext, Just Extension
replacement) <- [(Extension, Maybe Extension)]
ourDeprecatedExtensions ]
ppExplanation (MissingField CEField
cef) =
    String
"No '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ CEField -> String
ppCEField CEField
cef String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' field."
ppExplanation CheckExplanation
SynopsisTooLong =
    String
"The 'synopsis' field is rather long (max 80 chars is recommended)."
ppExplanation CheckExplanation
ShortDesc =
    String
"The 'description' field should be longer than the 'synopsis' field. "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"It's useful to provide an informative 'description' to allow "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Haskell programmers who have never heard about your package to "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"understand the purpose of your package. "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"The 'description' field content is typically shown by tooling "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(e.g. 'cabal info', Haddock, Hackage) below the 'synopsis' which "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"serves as a headline. "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Please refer to <https://cabal.readthedocs.io/en/stable/"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"cabal-package.html#package-properties> for more details."
ppExplanation (InvalidTestWith [Dependency]
testedWithImpossibleRanges) =
    String
"Invalid 'tested-with' version range: "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep ((Dependency -> String) -> [Dependency] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Dependency -> String
forall a. Pretty a => a -> String
prettyShow [Dependency]
testedWithImpossibleRanges)
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
". To indicate that you have tested a package with multiple "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"different versions of the same compiler use multiple entries, "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"for example 'tested-with: GHC==6.10.4, GHC==6.12.3' and not "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'tested-with: GHC==6.10.4 && ==6.12.3'."
ppExplanation (ImpossibleInternalDep [Dependency]
depInternalLibWithImpossibleVersion) =
    String
"The package has an impossible version range for a dependency on an "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"internal library: "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep ((Dependency -> String) -> [Dependency] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Dependency -> String
forall a. Pretty a => a -> String
prettyShow [Dependency]
depInternalLibWithImpossibleVersion)
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
". This version range does not include the current package, and must "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"be removed as the current package's library will always be used."
ppExplanation (ImpossibleInternalExe [ExeDependency]
depInternalExecWithImpossibleVersion) =
    String
"The package has an impossible version range for a dependency on an "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"internal executable: "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep ((ExeDependency -> String) -> [ExeDependency] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ExeDependency -> String
forall a. Pretty a => a -> String
prettyShow [ExeDependency]
depInternalExecWithImpossibleVersion)
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
". This version range does not include the current package, and must "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"be removed as the current package's executable will always be used."
ppExplanation (MissingInternalExe [ExeDependency]
depInternalExeWithImpossibleVersion) =
    String
"The package depends on a missing internal executable: "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep ((ExeDependency -> String) -> [ExeDependency] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ExeDependency -> String
forall a. Pretty a => a -> String
prettyShow [ExeDependency]
depInternalExeWithImpossibleVersion)
ppExplanation CheckExplanation
NONELicense = String
"The 'license' field is missing or is NONE."
ppExplanation CheckExplanation
NoLicense = String
"The 'license' field is missing."
ppExplanation CheckExplanation
AllRightsReservedLicense =
    String
"The 'license' is AllRightsReserved. Is that really what you want?"
ppExplanation (LicenseMessParse PackageDescription
pkg) =
    String
"Unfortunately the license " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
quote (License -> String
forall a. Pretty a => a -> String
prettyShow (PackageDescription -> License
license PackageDescription
pkg))
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" messes up the parser in earlier Cabal versions so you need to "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"specify 'cabal-version: >= 1.4'. Alternatively if you require "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"compatibility with earlier Cabal versions then use 'OtherLicense'."
ppExplanation (UnrecognisedLicense String
l) =
    ShowS
quote (String
"license: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
l) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is not a recognised license. The "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"known licenses are: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep ((License -> String) -> [License] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map License -> String
forall a. Pretty a => a -> String
prettyShow [License]
knownLicenses)
ppExplanation CheckExplanation
UncommonBSD4 =
    String
"Using 'license: BSD4' is almost always a misunderstanding. 'BSD4' "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"refers to the old 4-clause BSD license with the advertising "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"clause. 'BSD3' refers the new 3-clause BSD license."
ppExplanation (UnknownLicenseVersion License
lic [Version]
known) =
    String
"'license: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ License -> String
forall a. Pretty a => a -> String
prettyShow License
lic String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' is not a known "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"version of that license. The known versions are "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep ((Version -> String) -> [Version] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Version -> String
forall a. Pretty a => a -> String
prettyShow [Version]
known)
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
". If this is not a mistake and you think it should be a known "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"version then please file a ticket."
ppExplanation CheckExplanation
NoLicenseFile = String
"A 'license-file' is not specified."
ppExplanation (UnrecognisedSourceRepo String
kind) =
    ShowS
quote String
kind String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is not a recognised kind of source-repository. "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"The repo kind is usually 'head' or 'this'"
ppExplanation CheckExplanation
MissingType =
    String
"The source-repository 'type' is a required field."
ppExplanation CheckExplanation
MissingLocation =
    String
"The source-repository 'location' is a required field."
ppExplanation CheckExplanation
MissingModule =
    String
"For a CVS source-repository, the 'module' is a required field."
ppExplanation CheckExplanation
MissingTag =
    String
"For the 'this' kind of source-repository, the 'tag' is a required "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"field. It should specify the tag corresponding to this version "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"or release of the package."
ppExplanation CheckExplanation
SubdirRelPath =
    String
"The 'subdir' field of a source-repository must be a relative path."
ppExplanation (SubdirGoodRelPath String
err) =
    String
"The 'subdir' field of a source-repository is not a good relative path: "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
err
ppExplanation (OptFasm String
fieldName) =
    String
"'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fieldName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": -fasm' is unnecessary and will not work on CPU "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"architectures other than x86, x86-64, ppc or sparc."
ppExplanation (OptViaC String
fieldName) =
    String
"'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fieldName String -> ShowS
forall a. [a] -> [a] -> [a]
++String
": -fvia-C' is usually unnecessary. If your package "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"needs -via-C for correctness rather than performance then it "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"is using the FFI incorrectly and will probably not work with GHC "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"6.10 or later."
ppExplanation (OptHpc String
fieldName) =
    String
"'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fieldName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": -fhpc' is not necessary. Use the configure flag "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" --enable-coverage instead."
ppExplanation (OptProf String
fieldName) =
    String
"'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fieldName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": -prof' is not necessary and will lead to problems "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"when used on a library. Use the configure flag "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"--enable-library-profiling and/or --enable-profiling."
ppExplanation (OptO String
fieldName) =
    String
"'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fieldName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": -o' is not needed. "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"The output files are named automatically."
ppExplanation (OptHide String
fieldName) =
    String
"'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fieldName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": -hide-package' is never needed. "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Cabal hides all packages."
ppExplanation (OptMake String
fieldName) =
    String
"'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fieldName
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": --make' is never needed. Cabal uses this automatically."
ppExplanation (OptONot String
fieldName) =
      String
"'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fieldName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": -O0' is not needed. "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Use the --disable-optimization configure flag."
ppExplanation (OptOOne String
fieldName) =
    String
"'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fieldName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": -O' is not needed. "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Cabal automatically adds the '-O' flag. "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Setting it yourself interferes with the --disable-optimization flag."
ppExplanation (OptOTwo String
fieldName) =
    String
"'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fieldName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": -O2' is rarely needed. "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Check that it is giving a real benefit "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"and not just imposing longer compile times on your users."
ppExplanation (OptSplitSections String
fieldName) =
    String
"'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fieldName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": -split-sections' is not needed. "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Use the --enable-split-sections configure flag."
ppExplanation (OptSplitObjs String
fieldName) =
    String
"'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fieldName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": -split-objs' is not needed. "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Use the --enable-split-objs configure flag."
ppExplanation (OptWls String
fieldName) =
    String
"'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fieldName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": -optl-Wl,-s' is not needed and is not portable to"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" all operating systems. Cabal 1.4 and later automatically strip"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" executables. Cabal also has a flag --disable-executable-stripping"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" which is necessary when building packages for some Linux"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" distributions and using '-optl-Wl,-s' prevents that from working."
ppExplanation (OptExts String
fieldName) =
    String
"Instead of '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fieldName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": -fglasgow-exts' it is preferable to use "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"the 'extensions' field."
ppExplanation (OptRts String
fieldName) =
    String
"'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fieldName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": -rtsopts' has no effect for libraries. It should "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"only be used for executables."
ppExplanation (OptWithRts String
fieldName) =
    String
"'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fieldName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": -with-rtsopts' has no effect for libraries. It "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"should only be used for executables."
ppExplanation (COptONumber String
prefix String
label) =
    String
"'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
prefix String -> ShowS
forall a. [a] -> [a] -> [a]
++String
": -O[n]' is generally not needed. When building with "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" optimisations Cabal automatically adds '-O2' for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
label
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" code. Setting it yourself interferes with the"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" --disable-optimization flag."
ppExplanation (COptCPP String
opt) =
    String
"'cpp-options: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
opt String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' is not a portable C-preprocessor flag."
ppExplanation (OptAlternatives String
badField String
goodField [(String, String)]
flags) =
    String
"Instead of " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
quote (String
badField String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
badFlags)
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" use " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
quote (String
goodField String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
goodFlags)
  where ([String]
badFlags, [String]
goodFlags) = [(String, String)] -> ([String], [String])
forall a b. [(a, b)] -> ([a], [b])
unzip [(String, String)]
flags
ppExplanation (RelativeOutside String
field String
path) =
    ShowS
quote (String
field String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
path)
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is a relative path outside of the source tree. "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"This will not work when generating a tarball with 'sdist'."
ppExplanation (AbsolutePath String
field String
path) =
    ShowS
quote (String
field String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
path) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" specifies an absolute path, but the "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
quote String
field String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" field must use relative paths."
ppExplanation (BadRelativePAth String
field String
path String
err) =
    ShowS
quote (String
field String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
path)
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is not a good relative path: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
err
ppExplanation (DistPoint Maybe String
mfield String
path) =
    String
incipit String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" points inside the 'dist' "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"directory. This is not reliable because the location of this "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"directory is configurable by the user (or package manager). In "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"addition the layout of the 'dist' directory is subject to change "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"in future versions of Cabal."
  where -- mfiled Nothing -> the path is inside `ghc-options`
        incipit :: String
incipit = String -> ShowS -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String
"'ghc-options' path " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
quote String
path)
                        (\String
field -> ShowS
quote (String
field String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
path))
                        Maybe String
mfield
ppExplanation (GlobSyntaxError String
field String
expl) =
    String
"In the '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
field String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' field: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
expl
ppExplanation (RecursiveGlobInRoot String
field String
glob) =
    String
"In the '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
field String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"': glob '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
glob
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' starts at project root directory, this might "
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"include `.git/`, ``dist-newstyle/``, or other large directories!"
ppExplanation (InvalidOnWin [String]
paths) =
    String
"The " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
quotes [String]
paths String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" invalid on Windows, which "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"would cause portability problems for this package. Windows file "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"names cannot contain any of the characters \":*?<>|\" and there "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"a few reserved names including \"aux\", \"nul\", \"con\", "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\"prn\", \"com1-9\", \"lpt1-9\" and \"clock$\"."
  where quotes :: [String] -> String
quotes [String
failed] = String
"path " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
quote String
failed String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is"
        quotes [String]
failed = String
"paths " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " (ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
quote [String]
failed)
                          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" are"
ppExplanation (FilePathTooLong String
path) =
         String
"The following file name is too long to store in a portable POSIX "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"format tar archive. The maximum length is 255 ASCII characters.\n"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"The file in question is:\n  " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
path
ppExplanation (FilePathNameTooLong String
path) =
    String
"The following file name is too long to store in a portable POSIX "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"format tar archive. The maximum length for the name part (including "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"extension) is 100 ASCII characters. The maximum length for any "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"individual directory component is 155.\n"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"The file in question is:\n  " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
path
ppExplanation (FilePathSplitTooLong String
path) =
    String
"The following file name is too long to store in a portable POSIX "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"format tar archive. While the total length is less than 255 ASCII "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"characters, there are unfortunately further restrictions. It has to "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"be possible to split the file path on a directory separator into "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"two parts such that the first part fits in 155 characters or less "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"and the second part fits in 100 characters or less. Basically you "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"have to make the file name or directory names shorter, or you could "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"split a long directory name into nested subdirectories with shorter "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"names.\nThe file in question is:\n  " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
path
ppExplanation CheckExplanation
FilePathEmpty =
    String
"Encountered a file with an empty name, something is very wrong! "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Files with an empty name cannot be stored in a tar archive or in "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"standard file systems."
ppExplanation CheckExplanation
CVTestSuite =
    String
"The 'test-suite' section is new in Cabal 1.10. "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Unfortunately it messes up the parser in older Cabal versions "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"so you must specify at least 'cabal-version: >= 1.8', but note "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"that only Cabal 1.10 and later can actually run such test suites."
ppExplanation CheckExplanation
CVDefaultLanguage =
    String
"To use the 'default-language' field the package needs to specify "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"at least 'cabal-version: >= 1.10'."
ppExplanation CheckExplanation
CVDefaultLanguageComponent =
    String
"Packages using 'cabal-version: >= 1.10' and before 'cabal-version: 3.4' "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"must specify the 'default-language' field for each component (e.g. "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Haskell98 or Haskell2010). If a component uses different languages "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"in different modules then list the other ones in the "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'other-languages' field."
ppExplanation CheckExplanation
CVExtraDocFiles =
    String
"To use the 'extra-doc-files' field the package needs to specify "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'cabal-version: 1.18' or higher."
ppExplanation CheckExplanation
CVMultiLib =
    String
"To use multiple 'library' sections or a named library section "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"the package needs to specify at least 'cabal-version: 2.0'."
ppExplanation CheckExplanation
CVReexported =
    String
"To use the 'reexported-module' field the package needs to specify "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'cabal-version: 1.22' or higher."
ppExplanation CheckExplanation
CVMixins =
    String
"To use the 'mixins' field the package needs to specify "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"at least 'cabal-version: 2.0'."
ppExplanation CheckExplanation
CVExtraFrameworkDirs =
    String
"To use the 'extra-framework-dirs' field the package needs to specify"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" 'cabal-version: 1.24' or higher."
ppExplanation CheckExplanation
CVDefaultExtensions =
    String
"To use the 'default-extensions' field the package needs to specify "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"at least 'cabal-version: >= 1.10'."
ppExplanation CheckExplanation
CVExtensionsDeprecated =
    String
"For packages using 'cabal-version: >= 1.10' the 'extensions' "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"field is deprecated. The new 'default-extensions' field lists "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"extensions that are used in all modules in the component, while "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"the 'other-extensions' field lists extensions that are used in "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"some modules, e.g. via the {-# LANGUAGE #-} pragma."
ppExplanation CheckExplanation
CVSources =
    String
"The use of 'asm-sources', 'cmm-sources', 'extra-bundled-libraries' "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" and 'extra-library-flavours' requires the package "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" to specify at least 'cabal-version: 3.0'."
ppExplanation (CVExtraDynamic [[String]]
flavs) =
    String
"The use of 'extra-dynamic-library-flavours' requires the package "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" to specify at least 'cabal-version: 3.0'. The flavours are: "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep ([[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String]]
flavs)
ppExplanation CheckExplanation
CVVirtualModules =
    String
"The use of 'virtual-modules' requires the package "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" to specify at least 'cabal-version: 2.2'."
ppExplanation CheckExplanation
CVSourceRepository =
    String
"The 'source-repository' section is new in Cabal 1.6. "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Unfortunately it messes up the parser in earlier Cabal versions "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"so you need to specify 'cabal-version: >= 1.6'."
ppExplanation (CVExtensions CabalSpecVersion
version [Extension]
extCab12) =
    String
"Unfortunately the language extensions "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep ((Extension -> String) -> [Extension] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (ShowS
quote ShowS -> (Extension -> String) -> Extension -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Extension -> String
forall a. Pretty a => a -> String
prettyShow) [Extension]
extCab12)
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" break the parser in earlier Cabal versions so you need to "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"specify 'cabal-version: >= " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CabalSpecVersion -> String
showCabalSpecVersion CabalSpecVersion
version
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'. Alternatively if you require compatibility with earlier "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Cabal versions then you may be able to use an equivalent "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"compiler-specific flag."
ppExplanation CheckExplanation
CVCustomSetup =
    String
"Packages using 'cabal-version: 1.24' or higher with 'build-type: Custom' "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"must use a 'custom-setup' section with a 'setup-depends' field "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"that specifies the dependencies of the Setup.hs script itself. "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"The 'setup-depends' field uses the same syntax as 'build-depends', "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"so a simple example would be 'setup-depends: base, Cabal'."
ppExplanation CheckExplanation
CVExpliticDepsCustomSetup =
    String
"From version 1.24 cabal supports specifying explicit dependencies "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"for Custom setup scripts. Consider using 'cabal-version: 1.24' or "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"higher and adding a 'custom-setup' section with a 'setup-depends' "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"field that specifies the dependencies of the Setup.hs script "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"itself. The 'setup-depends' field uses the same syntax as "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'build-depends', so a simple example would be 'setup-depends: base, "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Cabal'."
ppExplanation CheckExplanation
CVAutogenPaths =
    String
"Packages using 'cabal-version: 2.0' and the autogenerated "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"module Paths_* must include it also on the 'autogen-modules' field "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"besides 'exposed-modules' and 'other-modules'. This specifies that "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"the module does not come with the package and is generated on "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"setup. Modules built with a custom Setup.hs script also go here "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"to ensure that commands like sdist don't fail."
ppExplanation CheckExplanation
CVAutogenPackageInfo =
    String
"Packages using 'cabal-version: 2.0' and the autogenerated "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"module PackageInfo_* must include it in 'autogen-modules' as well as"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" 'exposed-modules' and 'other-modules'. This specifies that "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"the module does not come with the package and is generated on "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"setup. Modules built with a custom Setup.hs script also go here "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"to ensure that commands like sdist don't fail."
ppExplanation (GlobNoMatch String
field String
glob) =
    String
"In '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
field String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"': the pattern '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
glob String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' does not"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" match any files."
ppExplanation (GlobExactMatch String
field String
glob String
file) =
    String
"In '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
field String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"': the pattern '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
glob String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' does not"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" match the file '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
file String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' because the extensions do not"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" exactly match (e.g., foo.en.html does not exactly match *.html)."
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" To enable looser suffix-only matching, set 'cabal-version: 2.4' or"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" higher."
ppExplanation (GlobNoDir String
field String
glob String
dir) =
    String
"In '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
field String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"': the pattern '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
glob String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' attempts to"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" match files in the directory '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
dir String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"', but there is no"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" directory by that name."
ppExplanation (UnknownOS [String]
unknownOSs) =
    String
"Unknown operating system name " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep (ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
quote [String]
unknownOSs)
ppExplanation (UnknownArch [String]
unknownArches) =
    String
"Unknown architecture name " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep (ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
quote [String]
unknownArches)
ppExplanation (UnknownCompiler [String]
unknownImpls) =
    String
"Unknown compiler name " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep (ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
quote [String]
unknownImpls)
ppExplanation (MissingUpperBounds [PackageName]
names) =
    let separator :: String
separator = String
"\n  - "
    in
    String
"These packages miss upper bounds:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
separator
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
separator (PackageName -> String
unPackageName (PackageName -> String) -> [PackageName] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PackageName]
names)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++  String
"Please add them, using `cabal gen-bounds` for suggestions."
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" For more information see: "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" https://pvp.haskell.org/"
ppExplanation CheckExplanation
BaseNoUpperBounds =
    String
"The dependency 'build-depends: base' does not specify an upper "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"bound on the version number. Each major release of the 'base' "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"package changes the API in various ways and most packages will "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"need some changes to compile with it. The recommended practice "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"is to specify an upper bound on the version of the 'base' "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"package. This ensures your package will continue to build when a "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"new major version of the 'base' package is released. If you are "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"not sure what upper bound to use then use the next  major "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"version. For example if you have tested your package with 'base' "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"version 4.5 and 4.6 then use 'build-depends: base >= 4.5 && < 4.7'."
ppExplanation (SuspiciousFlagName [String]
invalidFlagNames) =
    String
"Suspicious flag names: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
invalidFlagNames String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
". "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"To avoid ambiguity in command line interfaces, flag shouldn't "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"start with a dash. Also for better compatibility, flag names "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"shouldn't contain non-ascii characters."
ppExplanation (DeclaredUsedFlags Set FlagName
declared Set FlagName
used) =
    String
"Declared and used flag sets differ: "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ Set FlagName -> String
s Set FlagName
declared String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" /= " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Set FlagName -> String
s Set FlagName
used String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
". "
  where s :: Set.Set FlagName -> String
        s :: Set FlagName -> String
s = [String] -> String
commaSep ([String] -> String)
-> (Set FlagName -> [String]) -> Set FlagName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FlagName -> String) -> [FlagName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map FlagName -> String
unFlagName ([FlagName] -> [String])
-> (Set FlagName -> [FlagName]) -> Set FlagName -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set FlagName -> [FlagName]
forall a. Set a -> [a]
Set.toList
ppExplanation (NonASCIICustomField [String]
nonAsciiXFields) =
    String
"Non ascii custom fields: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
nonAsciiXFields String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
". "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"For better compatibility, custom field names "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"shouldn't contain non-ascii characters."
ppExplanation CheckExplanation
RebindableClashPaths =
    String
"Packages using RebindableSyntax with OverloadedStrings or"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" OverloadedLists in default-extensions, in conjunction with the"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" autogenerated module Paths_*, are known to cause compile failures"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" with Cabal < 2.2. To use these default-extensions with a Paths_*"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" autogen module, specify at least 'cabal-version: 2.2'."
ppExplanation CheckExplanation
RebindableClashPackageInfo =
    String
"Packages using RebindableSyntax with OverloadedStrings or"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" OverloadedLists in default-extensions, in conjunction with the"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" autogenerated module PackageInfo_*, are known to cause compile failures"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" with Cabal < 2.2. To use these default-extensions with a PackageInfo_*"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" autogen module, specify at least 'cabal-version: 2.2'."
ppExplanation (WErrorUnneeded String
fieldName) = ShowS
addConditionalExp ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    String
"'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fieldName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": -Werror' makes the package easy to "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"break with future GHC versions because new GHC versions often "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"add new warnings."
ppExplanation (JUnneeded String
fieldName) = ShowS
addConditionalExp ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    String
"'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fieldName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": -j[N]' can make sense for specific user's setup,"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" but it is not appropriate for a distributed package."
ppExplanation (FDeferTypeErrorsUnneeded String
fieldName) = ShowS
addConditionalExp ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    String
"'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fieldName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": -fdefer-type-errors' is fine during development "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"but is not appropriate for a distributed package."
ppExplanation (DynamicUnneeded String
fieldName) = ShowS
addConditionalExp ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    String
"'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fieldName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": -d*' debug flags are not appropriate "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"for a distributed package."
ppExplanation (ProfilingUnneeded String
fieldName) = ShowS
addConditionalExp ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    String
"'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fieldName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": -fprof*' profiling flags are typically not "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"appropriate for a distributed library package. These flags are "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"useful to profile this package, but when profiling other packages "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"that use this one these flags clutter the profile output with "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"excessive detail. If you think other packages really want to see "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"cost centres from this package then use '-fprof-auto-exported' "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"which puts cost centres only on exported functions."
ppExplanation (UpperBoundSetup String
nm) =
    String
"The dependency 'setup-depends: '"String -> ShowS
forall a. [a] -> [a] -> [a]
++String
nmString -> ShowS
forall a. [a] -> [a] -> [a]
++String
"' does not specify an "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"upper bound on the version number. Each major release of the "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'"String -> ShowS
forall a. [a] -> [a] -> [a]
++String
nmString -> ShowS
forall a. [a] -> [a] -> [a]
++String
"' package changes the API in various ways and most "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"packages will need some changes to compile with it. If you are "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"not sure what upper bound to use then use the next major "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"version."
ppExplanation (DuplicateModule String
s [ModuleName]
dupLibsLax) =
    String
"Duplicate modules in " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep ((ModuleName -> String) -> [ModuleName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> String
forall a. Pretty a => a -> String
prettyShow [ModuleName]
dupLibsLax)
ppExplanation (PotentialDupModule String
s [ModuleName]
dupLibsStrict) =
    String
"Potential duplicate modules (subject to conditionals) in " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep ((ModuleName -> String) -> [ModuleName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> String
forall a. Pretty a => a -> String
prettyShow [ModuleName]
dupLibsStrict)
ppExplanation (BOMStart String
pdfile) =
    String
pdfile String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" starts with an Unicode byte order mark (BOM)."
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" This may cause problems with older cabal versions."
ppExplanation (NotPackageName String
pdfile String
expectedCabalname) =
    String
"The filename " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
quote String
pdfile String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" does not match package name "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(expected: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
quote String
expectedCabalname String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
ppExplanation CheckExplanation
NoDesc =
    String
"No cabal file found.\n"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Please create a package description file <pkgname>.cabal"
ppExplanation (MultiDesc [String]
multiple) =
    String
"Multiple cabal files found while checking.\n"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Please use only one of: "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String]
multiple
ppExplanation (UnknownFile String
fieldname SymbolicPath PackageDir LicenseFile
file) =
    String
"The '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fieldname String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' field refers to the file "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
quote (SymbolicPath PackageDir LicenseFile -> String
forall from to. SymbolicPath from to -> String
getSymbolicPath SymbolicPath PackageDir LicenseFile
file) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" which does not exist."
ppExplanation CheckExplanation
MissingSetupFile =
    String
"The package is missing a Setup.hs or Setup.lhs script."
ppExplanation CheckExplanation
MissingConfigureScript =
    String
"The 'build-type' is 'Configure' but there is no 'configure' script. "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"You probably need to run 'autoreconf -i' to generate it."
ppExplanation (UnknownDirectory String
kind String
dir) =
    ShowS
quote (String
kind String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
dir)
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" specifies a directory which does not exist."
ppExplanation CheckExplanation
MissingSourceControl =
    String
"When distributing packages it is encouraged to specify source "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"control information in the .cabal file using one or more "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'source-repository' sections. See the Cabal user guide for "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"details."
ppExplanation (MissingExpectedDocFiles Bool
extraDocFileSupport [String]
paths) =
    String
"Please consider including the " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
quotes [String]
paths
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" in the '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
targetField String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' section of the .cabal file "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"if it contains useful information for users of the package."
  where quotes :: [String] -> String
quotes [String
p] = String
"file " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
quote String
p
        quotes [String]
ps = String
"files " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " (ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
quote [String]
ps)
        targetField :: String
targetField = if Bool
extraDocFileSupport
                        then String
"extra-doc-files"
                        else String
"extra-source-files"
ppExplanation (WrongFieldForExpectedDocFiles Bool
extraDocFileSupport String
field [String]
paths) =
    String
"Please consider moving the " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
quotes [String]
paths
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" from the '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
field String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' section of the .cabal file "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"to the section '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
targetField String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'."
  where quotes :: [String] -> String
quotes [String
p] = String
"file " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
quote String
p
        quotes [String]
ps = String
"files " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " (ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
quote [String]
ps)
        targetField :: String
targetField = if Bool
extraDocFileSupport
                        then String
"extra-doc-files"
                        else String
"extra-source-files"


-- | Results of some kind of failed package check.
--
-- There are a range of severities, from merely dubious to totally insane.
-- All of them come with a human readable explanation. In future we may augment
-- them with more machine readable explanations, for example to help an IDE
-- suggest automatic corrections.
--
data PackageCheck =

       -- | This package description is no good. There's no way it's going to
       -- build sensibly. This should give an error at configure time.
       PackageBuildImpossible { PackageCheck -> CheckExplanation
explanation :: CheckExplanation }

       -- | A problem that is likely to affect building the package, or an
       -- issue that we'd like every package author to be aware of, even if
       -- the package is never distributed.
     | PackageBuildWarning { explanation :: CheckExplanation }

       -- | An issue that might not be a problem for the package author but
       -- might be annoying or detrimental when the package is distributed to
       -- users. We should encourage distributed packages to be free from these
       -- issues, but occasionally there are justifiable reasons so we cannot
       -- ban them entirely.
     | PackageDistSuspicious { explanation :: CheckExplanation }

       -- | Like PackageDistSuspicious but will only display warnings
       -- rather than causing abnormal exit when you run 'cabal check'.
     | PackageDistSuspiciousWarn { explanation :: CheckExplanation }

       -- | An issue that is OK in the author's environment but is almost
       -- certain to be a portability problem for other environments. We can
       -- quite legitimately refuse to publicly distribute packages with these
       -- problems.
     | PackageDistInexcusable { explanation :: CheckExplanation }
  deriving (PackageCheck -> PackageCheck -> Bool
(PackageCheck -> PackageCheck -> Bool)
-> (PackageCheck -> PackageCheck -> Bool) -> Eq PackageCheck
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PackageCheck -> PackageCheck -> Bool
== :: PackageCheck -> PackageCheck -> Bool
$c/= :: PackageCheck -> PackageCheck -> Bool
/= :: PackageCheck -> PackageCheck -> Bool
Eq, Eq PackageCheck
Eq PackageCheck =>
(PackageCheck -> PackageCheck -> Ordering)
-> (PackageCheck -> PackageCheck -> Bool)
-> (PackageCheck -> PackageCheck -> Bool)
-> (PackageCheck -> PackageCheck -> Bool)
-> (PackageCheck -> PackageCheck -> Bool)
-> (PackageCheck -> PackageCheck -> PackageCheck)
-> (PackageCheck -> PackageCheck -> PackageCheck)
-> Ord PackageCheck
PackageCheck -> PackageCheck -> Bool
PackageCheck -> PackageCheck -> Ordering
PackageCheck -> PackageCheck -> PackageCheck
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PackageCheck -> PackageCheck -> Ordering
compare :: PackageCheck -> PackageCheck -> Ordering
$c< :: PackageCheck -> PackageCheck -> Bool
< :: PackageCheck -> PackageCheck -> Bool
$c<= :: PackageCheck -> PackageCheck -> Bool
<= :: PackageCheck -> PackageCheck -> Bool
$c> :: PackageCheck -> PackageCheck -> Bool
> :: PackageCheck -> PackageCheck -> Bool
$c>= :: PackageCheck -> PackageCheck -> Bool
>= :: PackageCheck -> PackageCheck -> Bool
$cmax :: PackageCheck -> PackageCheck -> PackageCheck
max :: PackageCheck -> PackageCheck -> PackageCheck
$cmin :: PackageCheck -> PackageCheck -> PackageCheck
min :: PackageCheck -> PackageCheck -> PackageCheck
Ord)

-- | Pretty printing 'PackageCheck'.
--
ppPackageCheck :: PackageCheck -> String
ppPackageCheck :: PackageCheck -> String
ppPackageCheck PackageCheck
e = CheckExplanation -> String
ppExplanation (PackageCheck -> CheckExplanation
explanation PackageCheck
e)

instance Show PackageCheck where
    show :: PackageCheck -> String
show PackageCheck
notice = PackageCheck -> String
ppPackageCheck PackageCheck
notice

check :: Bool -> PackageCheck -> Maybe PackageCheck
check :: Bool -> PackageCheck -> Maybe PackageCheck
check Bool
False PackageCheck
_  = Maybe PackageCheck
forall a. Maybe a
Nothing
check Bool
True  PackageCheck
pc = PackageCheck -> Maybe PackageCheck
forall a. a -> Maybe a
Just PackageCheck
pc

checkSpecVersion :: PackageDescription -> CabalSpecVersion -> Bool -> PackageCheck
                 -> Maybe PackageCheck
checkSpecVersion :: PackageDescription
-> CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkSpecVersion PackageDescription
pkg CabalSpecVersion
specver Bool
cond PackageCheck
pc
  | PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
specver  = Maybe PackageCheck
forall a. Maybe a
Nothing
  | Bool
otherwise                   = Bool -> PackageCheck -> Maybe PackageCheck
check Bool
cond PackageCheck
pc

-- ------------------------------------------------------------
-- * Standard checks
-- ------------------------------------------------------------

-- | Check for common mistakes and problems in package descriptions.
--
-- This is the standard collection of checks covering all aspects except
-- for checks that require looking at files within the package. For those
-- see 'checkPackageFiles'.
--
-- It requires the 'GenericPackageDescription' and optionally a particular
-- configuration of that package. If you pass 'Nothing' then we just check
-- a version of the generic description using 'flattenPackageDescription'.
--
checkPackage :: GenericPackageDescription
             -> Maybe PackageDescription
             -> [PackageCheck]
checkPackage :: GenericPackageDescription
-> Maybe PackageDescription -> [PackageCheck]
checkPackage GenericPackageDescription
gpkg Maybe PackageDescription
mpkg =
     PackageDescription -> [PackageCheck]
checkConfiguredPackage PackageDescription
pkg
  [PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. [a] -> [a] -> [a]
++ GenericPackageDescription -> [PackageCheck]
checkConditionals GenericPackageDescription
gpkg
  [PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. [a] -> [a] -> [a]
++ GenericPackageDescription -> [PackageCheck]
checkPackageVersions GenericPackageDescription
gpkg
  [PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. [a] -> [a] -> [a]
++ GenericPackageDescription -> [PackageCheck]
checkDevelopmentOnlyFlags GenericPackageDescription
gpkg
  [PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. [a] -> [a] -> [a]
++ GenericPackageDescription -> [PackageCheck]
checkFlagNames GenericPackageDescription
gpkg
  [PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. [a] -> [a] -> [a]
++ GenericPackageDescription -> [PackageCheck]
checkUnusedFlags GenericPackageDescription
gpkg
  [PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. [a] -> [a] -> [a]
++ GenericPackageDescription -> [PackageCheck]
checkUnicodeXFields GenericPackageDescription
gpkg
  [PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. [a] -> [a] -> [a]
++ PackageDescription -> [PackageCheck]
checkPathsModuleExtensions PackageDescription
pkg
  [PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. [a] -> [a] -> [a]
++ PackageDescription -> [PackageCheck]
checkPackageInfoModuleExtensions PackageDescription
pkg
  [PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. [a] -> [a] -> [a]
++ GenericPackageDescription -> [PackageCheck]
checkSetupVersions GenericPackageDescription
gpkg
  [PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. [a] -> [a] -> [a]
++ GenericPackageDescription -> [PackageCheck]
checkDuplicateModules GenericPackageDescription
gpkg
  where
    pkg :: PackageDescription
pkg = PackageDescription
-> Maybe PackageDescription -> PackageDescription
forall a. a -> Maybe a -> a
fromMaybe (GenericPackageDescription -> PackageDescription
flattenPackageDescription GenericPackageDescription
gpkg) Maybe PackageDescription
mpkg

--TODO: make this variant go away
--      we should always know the GenericPackageDescription
checkConfiguredPackage :: PackageDescription -> [PackageCheck]
checkConfiguredPackage :: PackageDescription -> [PackageCheck]
checkConfiguredPackage PackageDescription
pkg =
    PackageDescription -> [PackageCheck]
checkSanity PackageDescription
pkg
 [PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. [a] -> [a] -> [a]
++ PackageDescription -> [PackageCheck]
checkFields PackageDescription
pkg
 [PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. [a] -> [a] -> [a]
++ PackageDescription -> [PackageCheck]
checkLicense PackageDescription
pkg
 [PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. [a] -> [a] -> [a]
++ PackageDescription -> [PackageCheck]
checkSourceRepos PackageDescription
pkg
 [PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. [a] -> [a] -> [a]
++ PackageDescription -> [PackageCheck]
checkAllGhcOptions PackageDescription
pkg
 [PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. [a] -> [a] -> [a]
++ PackageDescription -> [PackageCheck]
checkCCOptions PackageDescription
pkg
 [PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. [a] -> [a] -> [a]
++ PackageDescription -> [PackageCheck]
checkCxxOptions PackageDescription
pkg
 [PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. [a] -> [a] -> [a]
++ PackageDescription -> [PackageCheck]
checkCPPOptions PackageDescription
pkg
 [PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. [a] -> [a] -> [a]
++ PackageDescription -> [PackageCheck]
checkPaths PackageDescription
pkg
 [PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. [a] -> [a] -> [a]
++ PackageDescription -> [PackageCheck]
checkCabalVersion PackageDescription
pkg


-- ------------------------------------------------------------
-- * Basic sanity checks
-- ------------------------------------------------------------

-- | Check that this package description is sane.
--
checkSanity :: PackageDescription -> [PackageCheck]
checkSanity :: PackageDescription -> [PackageCheck]
checkSanity PackageDescription
pkg =
  [Maybe PackageCheck] -> [PackageCheck]
forall a. [Maybe a] -> [a]
catMaybes [

    Bool -> PackageCheck -> Maybe PackageCheck
check (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> Bool)
-> (PackageDescription -> String) -> PackageDescription -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> String
unPackageName (PackageName -> String)
-> (PackageDescription -> PackageName)
-> PackageDescription
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName (PackageDescription -> Bool) -> PackageDescription -> Bool
forall a b. (a -> b) -> a -> b
$ PackageDescription
pkg) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageBuildImpossible CheckExplanation
NoNameField

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Version
nullVersion Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== PackageDescription -> Version
forall pkg. Package pkg => pkg -> Version
packageVersion PackageDescription
pkg) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageBuildImpossible CheckExplanation
NoVersionField

  , Bool -> PackageCheck -> Maybe PackageCheck
check (((PackageDescription -> Bool) -> Bool)
-> [PackageDescription -> Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((PackageDescription -> Bool) -> PackageDescription -> Bool
forall a b. (a -> b) -> a -> b
$ PackageDescription
pkg) [ [Executable] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Executable] -> Bool)
-> (PackageDescription -> [Executable])
-> PackageDescription
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> [Executable]
executables
                       , [TestSuite] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([TestSuite] -> Bool)
-> (PackageDescription -> [TestSuite])
-> PackageDescription
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> [TestSuite]
testSuites
                       , [Benchmark] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Benchmark] -> Bool)
-> (PackageDescription -> [Benchmark])
-> PackageDescription
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> [Benchmark]
benchmarks
                       , [Library] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Library] -> Bool)
-> (PackageDescription -> [Library]) -> PackageDescription -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> [Library]
allLibraries
                       , [ForeignLib] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([ForeignLib] -> Bool)
-> (PackageDescription -> [ForeignLib])
-> PackageDescription
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> [ForeignLib]
foreignLibs ]) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageBuildImpossible CheckExplanation
NoTarget

  , Bool -> PackageCheck -> Maybe PackageCheck
check ((LibraryName -> Bool) -> [LibraryName] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (LibraryName -> LibraryName -> Bool
forall a. Eq a => a -> a -> Bool
== LibraryName
LMainLibName) ((Library -> LibraryName) -> [Library] -> [LibraryName]
forall a b. (a -> b) -> [a] -> [b]
map Library -> LibraryName
libName ([Library] -> [LibraryName]) -> [Library] -> [LibraryName]
forall a b. (a -> b) -> a -> b
$ PackageDescription -> [Library]
subLibraries PackageDescription
pkg)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageBuildImpossible CheckExplanation
UnnamedInternal

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not ([UnqualComponentName] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [UnqualComponentName]
duplicateNames)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageBuildImpossible ([UnqualComponentName] -> CheckExplanation
DuplicateSections [UnqualComponentName]
duplicateNames)

  -- NB: but it's OK for executables to have the same name!
  -- TODO shouldn't need to compare on the string level
  , Bool -> PackageCheck -> Maybe PackageCheck
check ((String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== PackageName -> String
forall a. Pretty a => a -> String
prettyShow (PackageDescription -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName PackageDescription
pkg))
               (UnqualComponentName -> String
forall a. Pretty a => a -> String
prettyShow (UnqualComponentName -> String)
-> [UnqualComponentName] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [UnqualComponentName]
subLibNames)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageBuildImpossible (PackageDescription -> CheckExplanation
IllegalLibraryName PackageDescription
pkg)
  ]
  --TODO: check for name clashes case insensitively: windows file systems cannot
  --cope.

  [PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. [a] -> [a] -> [a]
++ (Library -> [PackageCheck]) -> [Library] -> [PackageCheck]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (PackageDescription -> Library -> [PackageCheck]
checkLibrary    PackageDescription
pkg) (PackageDescription -> [Library]
allLibraries PackageDescription
pkg)
  [PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. [a] -> [a] -> [a]
++ (Executable -> [PackageCheck]) -> [Executable] -> [PackageCheck]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (PackageDescription -> Executable -> [PackageCheck]
checkExecutable PackageDescription
pkg) (PackageDescription -> [Executable]
executables PackageDescription
pkg)
  [PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. [a] -> [a] -> [a]
++ (TestSuite -> [PackageCheck]) -> [TestSuite] -> [PackageCheck]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (PackageDescription -> TestSuite -> [PackageCheck]
checkTestSuite  PackageDescription
pkg) (PackageDescription -> [TestSuite]
testSuites PackageDescription
pkg)
  [PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. [a] -> [a] -> [a]
++ (Benchmark -> [PackageCheck]) -> [Benchmark] -> [PackageCheck]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (PackageDescription -> Benchmark -> [PackageCheck]
checkBenchmark  PackageDescription
pkg) (PackageDescription -> [Benchmark]
benchmarks PackageDescription
pkg)

  where
    -- The public 'library' gets special dispensation, because it
    -- is common practice to export a library and name the executable
    -- the same as the package.
    subLibNames :: [UnqualComponentName]
subLibNames = (Library -> Maybe UnqualComponentName)
-> [Library] -> [UnqualComponentName]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (LibraryName -> Maybe UnqualComponentName
libraryNameString (LibraryName -> Maybe UnqualComponentName)
-> (Library -> LibraryName) -> Library -> Maybe UnqualComponentName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library -> LibraryName
libName) ([Library] -> [UnqualComponentName])
-> [Library] -> [UnqualComponentName]
forall a b. (a -> b) -> a -> b
$ PackageDescription -> [Library]
subLibraries PackageDescription
pkg
    exeNames :: [UnqualComponentName]
exeNames = (Executable -> UnqualComponentName)
-> [Executable] -> [UnqualComponentName]
forall a b. (a -> b) -> [a] -> [b]
map Executable -> UnqualComponentName
exeName ([Executable] -> [UnqualComponentName])
-> [Executable] -> [UnqualComponentName]
forall a b. (a -> b) -> a -> b
$ PackageDescription -> [Executable]
executables PackageDescription
pkg
    testNames :: [UnqualComponentName]
testNames = (TestSuite -> UnqualComponentName)
-> [TestSuite] -> [UnqualComponentName]
forall a b. (a -> b) -> [a] -> [b]
map TestSuite -> UnqualComponentName
testName ([TestSuite] -> [UnqualComponentName])
-> [TestSuite] -> [UnqualComponentName]
forall a b. (a -> b) -> a -> b
$ PackageDescription -> [TestSuite]
testSuites PackageDescription
pkg
    bmNames :: [UnqualComponentName]
bmNames = (Benchmark -> UnqualComponentName)
-> [Benchmark] -> [UnqualComponentName]
forall a b. (a -> b) -> [a] -> [b]
map Benchmark -> UnqualComponentName
benchmarkName ([Benchmark] -> [UnqualComponentName])
-> [Benchmark] -> [UnqualComponentName]
forall a b. (a -> b) -> a -> b
$ PackageDescription -> [Benchmark]
benchmarks PackageDescription
pkg
    duplicateNames :: [UnqualComponentName]
duplicateNames = [UnqualComponentName] -> [UnqualComponentName]
forall a. Ord a => [a] -> [a]
dups ([UnqualComponentName] -> [UnqualComponentName])
-> [UnqualComponentName] -> [UnqualComponentName]
forall a b. (a -> b) -> a -> b
$ [UnqualComponentName]
subLibNames [UnqualComponentName]
-> [UnqualComponentName] -> [UnqualComponentName]
forall a. [a] -> [a] -> [a]
++ [UnqualComponentName]
exeNames [UnqualComponentName]
-> [UnqualComponentName] -> [UnqualComponentName]
forall a. [a] -> [a] -> [a]
++ [UnqualComponentName]
testNames [UnqualComponentName]
-> [UnqualComponentName] -> [UnqualComponentName]
forall a. [a] -> [a] -> [a]
++ [UnqualComponentName]
bmNames

checkLibrary :: PackageDescription -> Library -> [PackageCheck]
checkLibrary :: PackageDescription -> Library -> [PackageCheck]
checkLibrary PackageDescription
pkg Library
lib =
  [Maybe PackageCheck] -> [PackageCheck]
forall a. [Maybe a] -> [a]
catMaybes [

  -- TODO: This check is bogus if a required-signature was passed through
    Bool -> PackageCheck -> Maybe PackageCheck
check ([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 (Library -> [ModuleReexport]
reexportedModules Library
lib)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistSuspiciousWarn (Library -> CheckExplanation
NoModulesExposed Library
lib)

    -- check use of signatures sections
  , CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkVersion CabalSpecVersion
CabalSpecV2_0 (Bool -> Bool
not ([ModuleName] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Library -> [ModuleName]
signatures Library
lib))) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistInexcusable CheckExplanation
SignaturesCabal2

    -- check that all autogen-modules appear on other-modules or exposed-modules
  , Bool -> PackageCheck -> Maybe PackageCheck
check
      (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (ModuleName -> Bool) -> [ModuleName] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map ((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)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageBuildImpossible CheckExplanation
AutogenNotExposed

    -- check that all autogen-includes appear on includes or install-includes
  , Bool -> PackageCheck -> Maybe PackageCheck
check
      (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> [String] -> Bool) -> [String] -> String -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (Library -> [String]
forall a. HasBuildInfo a => a -> [String]
allExplicitIncludes Library
lib)) (Getting [String] Library [String] -> Library -> [String]
forall a s. Getting a s a -> s -> a
view Getting [String] Library [String]
forall a. HasBuildInfo a => Lens' a [String]
Lens' Library [String]
L.autogenIncludes Library
lib)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageBuildImpossible CheckExplanation
AutogenIncludesNotIncluded
  ]

  where
    checkVersion :: CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
    checkVersion :: CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkVersion CabalSpecVersion
ver Bool
cond PackageCheck
pc
      | PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
ver = Maybe PackageCheck
forall a. Maybe a
Nothing
      | Bool
otherwise              = Bool -> PackageCheck -> Maybe PackageCheck
check Bool
cond PackageCheck
pc

allExplicitIncludes :: L.HasBuildInfo a => a -> [FilePath]
allExplicitIncludes :: forall a. HasBuildInfo a => a -> [String]
allExplicitIncludes a
x = Getting [String] a [String] -> a -> [String]
forall a s. Getting a s a -> s -> a
view Getting [String] a [String]
forall a. HasBuildInfo a => Lens' a [String]
Lens' a [String]
L.includes a
x [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ Getting [String] a [String] -> a -> [String]
forall a s. Getting a s a -> s -> a
view Getting [String] a [String]
forall a. HasBuildInfo a => Lens' a [String]
Lens' a [String]
L.installIncludes a
x

checkExecutable :: PackageDescription -> Executable -> [PackageCheck]
checkExecutable :: PackageDescription -> Executable -> [PackageCheck]
checkExecutable PackageDescription
pkg Executable
exe =
  [Maybe PackageCheck] -> [PackageCheck]
forall a. [Maybe a] -> [a]
catMaybes [

    Bool -> PackageCheck -> Maybe PackageCheck
check (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Executable -> String
modulePath Executable
exe)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageBuildImpossible (Executable -> CheckExplanation
NoMainIs Executable
exe)

  -- This check does not apply to scripts.
  , Bool -> PackageCheck -> Maybe PackageCheck
check (PackageDescription -> PackageIdentifier
package PackageDescription
pkg PackageIdentifier -> PackageIdentifier -> Bool
forall a. Eq a => a -> a -> Bool
/= PackageIdentifier
fakePackageId
       Bool -> Bool -> Bool
&& Bool -> Bool
not (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Executable -> String
modulePath Executable
exe))
       Bool -> Bool -> Bool
&& Bool -> Bool
not (String -> Bool
fileExtensionSupportedLanguage (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ Executable -> String
modulePath Executable
exe)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageBuildImpossible CheckExplanation
NoHsLhsMain

  , PackageDescription
-> CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkSpecVersion PackageDescription
pkg CabalSpecVersion
CabalSpecV1_18
          (String -> Bool
fileExtensionSupportedLanguage (Executable -> String
modulePath Executable
exe)
        Bool -> Bool -> Bool
&& ShowS
takeExtension (Executable -> String
modulePath Executable
exe) String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String
".hs", String
".lhs"]) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistInexcusable CheckExplanation
MainCCabal1_18

    -- check that all autogen-modules appear on other-modules
  , Bool -> PackageCheck -> Maybe PackageCheck
check
      (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (ModuleName -> Bool) -> [ModuleName] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map ((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 (Executable -> [ModuleName]
exeModules Executable
exe)) (Executable -> [ModuleName]
exeModulesAutogen Executable
exe)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageBuildImpossible (CEType -> UnqualComponentName -> CheckExplanation
AutogenNoOther CEType
CETExecutable (Executable -> UnqualComponentName
exeName Executable
exe))

    -- check that all autogen-includes appear on includes
  , Bool -> PackageCheck -> Maybe PackageCheck
check
      (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> [String] -> Bool) -> [String] -> String -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (Getting [String] Executable [String] -> Executable -> [String]
forall a s. Getting a s a -> s -> a
view Getting [String] Executable [String]
forall a. HasBuildInfo a => Lens' a [String]
Lens' Executable [String]
L.includes Executable
exe)) (Getting [String] Executable [String] -> Executable -> [String]
forall a s. Getting a s a -> s -> a
view Getting [String] Executable [String]
forall a. HasBuildInfo a => Lens' a [String]
Lens' Executable [String]
L.autogenIncludes Executable
exe)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageBuildImpossible CheckExplanation
AutogenIncludesNotIncludedExe
  ]

checkTestSuite :: PackageDescription -> TestSuite -> [PackageCheck]
checkTestSuite :: PackageDescription -> TestSuite -> [PackageCheck]
checkTestSuite PackageDescription
pkg TestSuite
test =
  [Maybe PackageCheck] -> [PackageCheck]
forall a. [Maybe a] -> [a]
catMaybes [

    case TestSuite -> TestSuiteInterface
testInterface TestSuite
test of
      TestSuiteUnsupported tt :: TestType
tt@(TestTypeUnknown String
_ Version
_) -> PackageCheck -> Maybe PackageCheck
forall a. a -> Maybe a
Just (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
        CheckExplanation -> PackageCheck
PackageBuildWarning (TestType -> CheckExplanation
TestsuiteTypeNotKnown TestType
tt)

      TestSuiteUnsupported TestType
tt -> PackageCheck -> Maybe PackageCheck
forall a. a -> Maybe a
Just (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
        CheckExplanation -> PackageCheck
PackageBuildWarning (TestType -> CheckExplanation
TestsuiteNotSupported TestType
tt)
      TestSuiteInterface
_ -> Maybe PackageCheck
forall a. Maybe a
Nothing

  , Bool -> PackageCheck -> Maybe PackageCheck
check Bool
mainIsWrongExt (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageBuildImpossible CheckExplanation
NoHsLhsMain

  , PackageDescription
-> CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkSpecVersion PackageDescription
pkg CabalSpecVersion
CabalSpecV1_18 (Bool
mainIsNotHsExt Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
mainIsWrongExt) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistInexcusable CheckExplanation
MainCCabal1_18

    -- check that all autogen-modules appear on other-modules
  , Bool -> PackageCheck -> Maybe PackageCheck
check
      (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (ModuleName -> Bool) -> [ModuleName] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map ((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
test)) (TestSuite -> [ModuleName]
testModulesAutogen TestSuite
test)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageBuildImpossible (CEType -> UnqualComponentName -> CheckExplanation
AutogenNoOther CEType
CETTest (TestSuite -> UnqualComponentName
testName TestSuite
test))

    -- check that all autogen-includes appear on includes
  , Bool -> PackageCheck -> Maybe PackageCheck
check
      (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> [String] -> Bool) -> [String] -> String -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (Getting [String] TestSuite [String] -> TestSuite -> [String]
forall a s. Getting a s a -> s -> a
view Getting [String] TestSuite [String]
forall a. HasBuildInfo a => Lens' a [String]
Lens' TestSuite [String]
L.includes TestSuite
test)) (Getting [String] TestSuite [String] -> TestSuite -> [String]
forall a s. Getting a s a -> s -> a
view Getting [String] TestSuite [String]
forall a. HasBuildInfo a => Lens' a [String]
Lens' TestSuite [String]
L.autogenIncludes TestSuite
test)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageBuildImpossible CheckExplanation
AutogenIncludesNotIncludedExe
  ]
  where
    mainIsWrongExt :: Bool
mainIsWrongExt = case TestSuite -> TestSuiteInterface
testInterface TestSuite
test of
      TestSuiteExeV10 Version
_ String
f -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ String -> Bool
fileExtensionSupportedLanguage String
f
      TestSuiteInterface
_                   -> Bool
False

    mainIsNotHsExt :: Bool
mainIsNotHsExt = case TestSuite -> TestSuiteInterface
testInterface TestSuite
test of
      TestSuiteExeV10 Version
_ String
f -> ShowS
takeExtension String
f String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String
".hs", String
".lhs"]
      TestSuiteInterface
_                   -> Bool
False

checkBenchmark :: PackageDescription -> Benchmark -> [PackageCheck]
checkBenchmark :: PackageDescription -> Benchmark -> [PackageCheck]
checkBenchmark PackageDescription
_pkg Benchmark
bm =
  [Maybe PackageCheck] -> [PackageCheck]
forall a. [Maybe a] -> [a]
catMaybes [

    case Benchmark -> BenchmarkInterface
benchmarkInterface Benchmark
bm of
      BenchmarkUnsupported tt :: BenchmarkType
tt@(BenchmarkTypeUnknown String
_ Version
_) -> PackageCheck -> Maybe PackageCheck
forall a. a -> Maybe a
Just (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
        CheckExplanation -> PackageCheck
PackageBuildWarning (BenchmarkType -> CheckExplanation
BenchmarkTypeNotKnown BenchmarkType
tt)

      BenchmarkUnsupported BenchmarkType
tt -> PackageCheck -> Maybe PackageCheck
forall a. a -> Maybe a
Just (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
        CheckExplanation -> PackageCheck
PackageBuildWarning (BenchmarkType -> CheckExplanation
BenchmarkNotSupported BenchmarkType
tt)
      BenchmarkInterface
_ -> Maybe PackageCheck
forall a. Maybe a
Nothing

  , Bool -> PackageCheck -> Maybe PackageCheck
check Bool
mainIsWrongExt (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageBuildImpossible CheckExplanation
NoHsLhsMainBench

    -- check that all autogen-modules appear on other-modules
  , Bool -> PackageCheck -> Maybe PackageCheck
check
      (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (ModuleName -> Bool) -> [ModuleName] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map ((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)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageBuildImpossible (CEType -> UnqualComponentName -> CheckExplanation
AutogenNoOther CEType
CETBenchmark (Benchmark -> UnqualComponentName
benchmarkName Benchmark
bm))

    -- check that all autogen-includes appear on includes
  , Bool -> PackageCheck -> Maybe PackageCheck
check
      (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> [String] -> Bool) -> [String] -> String -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (Getting [String] Benchmark [String] -> Benchmark -> [String]
forall a s. Getting a s a -> s -> a
view Getting [String] Benchmark [String]
forall a. HasBuildInfo a => Lens' a [String]
Lens' Benchmark [String]
L.includes Benchmark
bm)) (Getting [String] Benchmark [String] -> Benchmark -> [String]
forall a s. Getting a s a -> s -> a
view Getting [String] Benchmark [String]
forall a. HasBuildInfo a => Lens' a [String]
Lens' Benchmark [String]
L.autogenIncludes Benchmark
bm)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageBuildImpossible CheckExplanation
AutogenIncludesNotIncludedExe
  ]
  where
    mainIsWrongExt :: Bool
mainIsWrongExt = case Benchmark -> BenchmarkInterface
benchmarkInterface Benchmark
bm of
      BenchmarkExeV10 Version
_ String
f -> ShowS
takeExtension String
f String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String
".hs", String
".lhs"]
      BenchmarkInterface
_                   -> Bool
False

-- ------------------------------------------------------------
-- * Additional pure checks
-- ------------------------------------------------------------

checkFields :: PackageDescription -> [PackageCheck]
checkFields :: PackageDescription -> [PackageCheck]
checkFields PackageDescription
pkg =
  [Maybe PackageCheck] -> [PackageCheck]
forall a. [Maybe a] -> [a]
catMaybes [

    Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not (Bool -> Bool)
-> (PackageDescription -> Bool) -> PackageDescription -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
FilePath.Windows.isValid (String -> Bool)
-> (PackageDescription -> String) -> PackageDescription -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> String
forall a. Pretty a => a -> String
prettyShow (PackageName -> String)
-> (PackageDescription -> PackageName)
-> PackageDescription
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName (PackageDescription -> Bool) -> PackageDescription -> Bool
forall a b. (a -> b) -> a -> b
$ PackageDescription
pkg) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistInexcusable (PackageDescription -> CheckExplanation
InvalidNameWin PackageDescription
pkg)

  , Bool -> PackageCheck -> Maybe PackageCheck
check (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"z-" (String -> Bool)
-> (PackageDescription -> String) -> PackageDescription -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> String
forall a. Pretty a => a -> String
prettyShow (PackageName -> String)
-> (PackageDescription -> PackageName)
-> PackageDescription
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName (PackageDescription -> Bool) -> PackageDescription -> Bool
forall a b. (a -> b) -> a -> b
$ PackageDescription
pkg) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistInexcusable CheckExplanation
ZPrefix

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Maybe BuildType -> Bool
forall a. Maybe a -> Bool
isNothing (PackageDescription -> Maybe BuildType
buildTypeRaw PackageDescription
pkg) Bool -> Bool -> Bool
&& PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
< CabalSpecVersion
CabalSpecV2_2) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageBuildWarning CheckExplanation
NoBuildType

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Maybe SetupBuildInfo -> Bool
forall a. Maybe a -> Bool
isJust (PackageDescription -> Maybe SetupBuildInfo
setupBuildInfo PackageDescription
pkg) Bool -> Bool -> Bool
&& PackageDescription -> BuildType
buildType PackageDescription
pkg BuildType -> BuildType -> Bool
forall a. Eq a => a -> a -> Bool
/= BuildType
Custom) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageBuildWarning CheckExplanation
NoCustomSetup

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not ([String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
unknownCompilers)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageBuildWarning ([String] -> CheckExplanation
UnknownCompilers [String]
unknownCompilers)

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not ([String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
unknownLanguages)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageBuildWarning ([String] -> CheckExplanation
UnknownLanguages [String]
unknownLanguages)

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not ([String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
unknownExtensions)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageBuildWarning ([String] -> CheckExplanation
UnknownExtensions [String]
unknownExtensions)

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not ([String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
languagesUsedAsExtensions)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageBuildWarning ([String] -> CheckExplanation
LanguagesAsExtension [String]
languagesUsedAsExtensions)

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not ([(Extension, Maybe Extension)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Extension, Maybe Extension)]
ourDeprecatedExtensions)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistSuspicious ([(Extension, Maybe Extension)] -> CheckExplanation
DeprecatedExtensions [(Extension, Maybe Extension)]
ourDeprecatedExtensions)

  , Bool -> PackageCheck -> Maybe PackageCheck
check (ShortText -> Bool
ShortText.null (PackageDescription -> ShortText
category PackageDescription
pkg)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistSuspicious (CEField -> CheckExplanation
MissingField CEField
CEFCategory)

  , Bool -> PackageCheck -> Maybe PackageCheck
check (ShortText -> Bool
ShortText.null (PackageDescription -> ShortText
maintainer PackageDescription
pkg)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistSuspicious (CEField -> CheckExplanation
MissingField CEField
CEFMaintainer)

  , Bool -> PackageCheck -> Maybe PackageCheck
check (ShortText -> Bool
ShortText.null (PackageDescription -> ShortText
synopsis PackageDescription
pkg) Bool -> Bool -> Bool
&& ShortText -> Bool
ShortText.null (PackageDescription -> ShortText
description PackageDescription
pkg)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistInexcusable (CEField -> CheckExplanation
MissingField CEField
CEFSynOrDesc)

  , Bool -> PackageCheck -> Maybe PackageCheck
check (ShortText -> Bool
ShortText.null (PackageDescription -> ShortText
description PackageDescription
pkg) Bool -> Bool -> Bool
&& Bool -> Bool
not (ShortText -> Bool
ShortText.null (PackageDescription -> ShortText
synopsis PackageDescription
pkg))) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistSuspicious (CEField -> CheckExplanation
MissingField CEField
CEFDescription)

  , Bool -> PackageCheck -> Maybe PackageCheck
check (ShortText -> Bool
ShortText.null (PackageDescription -> ShortText
synopsis PackageDescription
pkg) Bool -> Bool -> Bool
&& Bool -> Bool
not (ShortText -> Bool
ShortText.null (PackageDescription -> ShortText
description PackageDescription
pkg))) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistSuspicious (CEField -> CheckExplanation
MissingField CEField
CEFSynopsis)

    --TODO: recommend the bug reports URL, author and homepage fields
    --TODO: recommend not using the stability field
    --TODO: recommend specifying a source repo

  , Bool -> PackageCheck -> Maybe PackageCheck
check (ShortText -> Int
ShortText.length (PackageDescription -> ShortText
synopsis PackageDescription
pkg) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
80) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistSuspicious CheckExplanation
SynopsisTooLong

    -- See also https://github.com/haskell/cabal/pull/3479
  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not (ShortText -> Bool
ShortText.null (PackageDescription -> ShortText
description PackageDescription
pkg))
           Bool -> Bool -> Bool
&& ShortText -> Int
ShortText.length (PackageDescription -> ShortText
description PackageDescription
pkg) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= ShortText -> Int
ShortText.length (PackageDescription -> ShortText
synopsis PackageDescription
pkg)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistSuspicious CheckExplanation
ShortDesc

    -- check use of impossible constraints "tested-with: GHC== 6.10 && ==6.12"
  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not ([Dependency] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Dependency]
testedWithImpossibleRanges)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistInexcusable ([Dependency] -> CheckExplanation
InvalidTestWith [Dependency]
testedWithImpossibleRanges)

  -- for more details on why the following was commented out,
  -- check https://github.com/haskell/cabal/pull/7470#issuecomment-875878507
  -- , check (not (null depInternalLibraryWithExtraVersion)) $
  --     PackageBuildWarning $
  --          "The package has an extraneous version range for a dependency on an "
  --       ++ "internal library: "
  --       ++ commaSep (map prettyShow depInternalLibraryWithExtraVersion)
  --       ++ ". This version range includes the current package but isn't needed "
  --       ++ "as the current package's library will always be used."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not ([Dependency] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Dependency]
depInternalLibraryWithImpossibleVersion)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageBuildImpossible
        ([Dependency] -> CheckExplanation
ImpossibleInternalDep [Dependency]
depInternalLibraryWithImpossibleVersion)

  -- , check (not (null depInternalExecutableWithExtraVersion)) $
  --     PackageBuildWarning $
  --          "The package has an extraneous version range for a dependency on an "
  --       ++ "internal executable: "
  --       ++ commaSep (map prettyShow depInternalExecutableWithExtraVersion)
  --       ++ ". This version range includes the current package but isn't needed "
  --       ++ "as the current package's executable will always be used."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not ([ExeDependency] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ExeDependency]
depInternalExecutableWithImpossibleVersion)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageBuildImpossible
        ([ExeDependency] -> CheckExplanation
ImpossibleInternalExe [ExeDependency]
depInternalExecutableWithImpossibleVersion)

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not ([ExeDependency] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ExeDependency]
depMissingInternalExecutable)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageBuildImpossible ([ExeDependency] -> CheckExplanation
MissingInternalExe [ExeDependency]
depMissingInternalExecutable)
  ]
  where
    unknownCompilers :: [String]
unknownCompilers  = [ String
name | (OtherCompiler String
name, VersionRange
_) <- PackageDescription -> [(CompilerFlavor, VersionRange)]
testedWith PackageDescription
pkg ]
    unknownLanguages :: [String]
unknownLanguages  = [ String
name | BuildInfo
bi <- PackageDescription -> [BuildInfo]
allBuildInfo PackageDescription
pkg
                               , UnknownLanguage String
name <- BuildInfo -> [Language]
allLanguages BuildInfo
bi ]
    unknownExtensions :: [String]
unknownExtensions = [ String
name | BuildInfo
bi <- PackageDescription -> [BuildInfo]
allBuildInfo PackageDescription
pkg
                               , UnknownExtension String
name <- BuildInfo -> [Extension]
allExtensions BuildInfo
bi
                               , String
name String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (Language -> String) -> [Language] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Language -> String
forall a. Pretty a => a -> String
prettyShow [Language]
knownLanguages ]
    ourDeprecatedExtensions :: [(Extension, Maybe Extension)]
ourDeprecatedExtensions = [(Extension, Maybe Extension)] -> [(Extension, Maybe Extension)]
forall a. Eq a => [a] -> [a]
nub ([(Extension, Maybe Extension)] -> [(Extension, Maybe Extension)])
-> [(Extension, Maybe Extension)] -> [(Extension, Maybe Extension)]
forall a b. (a -> b) -> a -> b
$ [Maybe (Extension, Maybe Extension)]
-> [(Extension, Maybe Extension)]
forall a. [Maybe a] -> [a]
catMaybes
      [ ((Extension, Maybe Extension) -> Bool)
-> [(Extension, Maybe Extension)]
-> Maybe (Extension, Maybe Extension)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Extension -> Extension -> Bool
forall a. Eq a => a -> a -> Bool
==Extension
ext) (Extension -> Bool)
-> ((Extension, Maybe Extension) -> Extension)
-> (Extension, Maybe Extension)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Extension, Maybe Extension) -> Extension
forall a b. (a, b) -> a
fst) [(Extension, Maybe Extension)]
deprecatedExtensions
      | BuildInfo
bi <- PackageDescription -> [BuildInfo]
allBuildInfo PackageDescription
pkg
      , Extension
ext <- BuildInfo -> [Extension]
allExtensions BuildInfo
bi ]
    languagesUsedAsExtensions :: [String]
languagesUsedAsExtensions =
      [ String
name | BuildInfo
bi <- PackageDescription -> [BuildInfo]
allBuildInfo PackageDescription
pkg
             , UnknownExtension String
name <- BuildInfo -> [Extension]
allExtensions BuildInfo
bi
             , String
name String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Language -> String) -> [Language] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Language -> String
forall a. Pretty a => a -> String
prettyShow [Language]
knownLanguages ]

    testedWithImpossibleRanges :: [Dependency]
testedWithImpossibleRanges =
      [ PackageName
-> VersionRange -> NonEmptySet LibraryName -> Dependency
Dependency (String -> PackageName
mkPackageName (CompilerFlavor -> String
forall a. Pretty a => a -> String
prettyShow CompilerFlavor
compiler)) VersionRange
vr NonEmptySet LibraryName
mainLibSet
      | (CompilerFlavor
compiler, VersionRange
vr) <- PackageDescription -> [(CompilerFlavor, VersionRange)]
testedWith PackageDescription
pkg
      , VersionRange -> Bool
isNoVersion VersionRange
vr ]

    internalLibraries :: [PackageName]
internalLibraries =
        (Library -> PackageName) -> [Library] -> [PackageName]
forall a b. (a -> b) -> [a] -> [b]
map (PackageName
-> (UnqualComponentName -> PackageName)
-> Maybe UnqualComponentName
-> PackageName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (PackageDescription -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName PackageDescription
pkg) UnqualComponentName -> PackageName
unqualComponentNameToPackageName (Maybe UnqualComponentName -> PackageName)
-> (Library -> Maybe UnqualComponentName) -> Library -> PackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LibraryName -> Maybe UnqualComponentName
libraryNameString (LibraryName -> Maybe UnqualComponentName)
-> (Library -> LibraryName) -> Library -> Maybe UnqualComponentName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library -> LibraryName
libName)
            (PackageDescription -> [Library]
allLibraries PackageDescription
pkg)

    internalExecutables :: [UnqualComponentName]
internalExecutables = (Executable -> UnqualComponentName)
-> [Executable] -> [UnqualComponentName]
forall a b. (a -> b) -> [a] -> [b]
map Executable -> UnqualComponentName
exeName ([Executable] -> [UnqualComponentName])
-> [Executable] -> [UnqualComponentName]
forall a b. (a -> b) -> a -> b
$ PackageDescription -> [Executable]
executables PackageDescription
pkg

    internalLibDeps :: [Dependency]
internalLibDeps =
      [ Dependency
dep
      | BuildInfo
bi <- PackageDescription -> [BuildInfo]
allBuildInfo PackageDescription
pkg
      , dep :: Dependency
dep@(Dependency PackageName
name VersionRange
_ NonEmptySet LibraryName
_) <- BuildInfo -> [Dependency]
targetBuildDepends BuildInfo
bi
      , PackageName
name PackageName -> [PackageName] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PackageName]
internalLibraries
      ]

    internalExeDeps :: [ExeDependency]
internalExeDeps =
      [ ExeDependency
dep
      | BuildInfo
bi <- PackageDescription -> [BuildInfo]
allBuildInfo PackageDescription
pkg
      , ExeDependency
dep <- PackageDescription -> BuildInfo -> [ExeDependency]
getAllToolDependencies PackageDescription
pkg BuildInfo
bi
      , PackageDescription -> ExeDependency -> Bool
isInternal PackageDescription
pkg ExeDependency
dep
      ]

    -- depInternalLibraryWithExtraVersion =
    --   [ dep
    --   | dep@(Dependency _ versionRange _) <- internalLibDeps
    --   , not $ isAnyVersion versionRange
    --   , packageVersion pkg `withinRange` versionRange
    --   ]

    depInternalLibraryWithImpossibleVersion :: [Dependency]
depInternalLibraryWithImpossibleVersion =
      [ Dependency
dep
      | dep :: Dependency
dep@(Dependency PackageName
_ VersionRange
versionRange NonEmptySet LibraryName
_) <- [Dependency]
internalLibDeps
      , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ PackageDescription -> Version
forall pkg. Package pkg => pkg -> Version
packageVersion PackageDescription
pkg Version -> VersionRange -> Bool
`withinRange` VersionRange
versionRange
      ]

    -- depInternalExecutableWithExtraVersion =
    --   [ dep
    --   | dep@(ExeDependency _ _ versionRange) <- internalExeDeps
    --   , not $ isAnyVersion versionRange
    --   , packageVersion pkg `withinRange` versionRange
    --   ]

    depInternalExecutableWithImpossibleVersion :: [ExeDependency]
depInternalExecutableWithImpossibleVersion =
      [ ExeDependency
dep
      | dep :: ExeDependency
dep@(ExeDependency PackageName
_ UnqualComponentName
_ VersionRange
versionRange) <- [ExeDependency]
internalExeDeps
      , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ PackageDescription -> Version
forall pkg. Package pkg => pkg -> Version
packageVersion PackageDescription
pkg Version -> VersionRange -> Bool
`withinRange` VersionRange
versionRange
      ]

    depMissingInternalExecutable :: [ExeDependency]
depMissingInternalExecutable =
      [ ExeDependency
dep
      | dep :: ExeDependency
dep@(ExeDependency PackageName
_ UnqualComponentName
eName VersionRange
_) <- [ExeDependency]
internalExeDeps
      , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ UnqualComponentName
eName UnqualComponentName -> [UnqualComponentName] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [UnqualComponentName]
internalExecutables
      ]

checkLicense :: PackageDescription -> [PackageCheck]
checkLicense :: PackageDescription -> [PackageCheck]
checkLicense PackageDescription
pkg = case PackageDescription -> Either License License
licenseRaw PackageDescription
pkg of
    Right License
l -> PackageDescription -> License -> [PackageCheck]
checkOldLicense PackageDescription
pkg License
l
    Left  License
l -> PackageDescription -> License -> [PackageCheck]
checkNewLicense PackageDescription
pkg License
l

checkNewLicense :: PackageDescription -> SPDX.License -> [PackageCheck]
checkNewLicense :: PackageDescription -> License -> [PackageCheck]
checkNewLicense PackageDescription
_pkg License
lic = [Maybe PackageCheck] -> [PackageCheck]
forall a. [Maybe a] -> [a]
catMaybes
    [ Bool -> PackageCheck -> Maybe PackageCheck
check (License
lic License -> License -> Bool
forall a. Eq a => a -> a -> Bool
== License
SPDX.NONE) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
        CheckExplanation -> PackageCheck
PackageDistInexcusable CheckExplanation
NONELicense ]

checkOldLicense :: PackageDescription -> License -> [PackageCheck]
checkOldLicense :: PackageDescription -> License -> [PackageCheck]
checkOldLicense PackageDescription
pkg License
lic = [Maybe PackageCheck] -> [PackageCheck]
forall a. [Maybe a] -> [a]
catMaybes
  [ Bool -> PackageCheck -> Maybe PackageCheck
check (License
lic License -> License -> Bool
forall a. Eq a => a -> a -> Bool
== License
UnspecifiedLicense) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistInexcusable CheckExplanation
NoLicense

  , Bool -> PackageCheck -> Maybe PackageCheck
check (License
lic License -> License -> Bool
forall a. Eq a => a -> a -> Bool
== License
AllRightsReserved) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistSuspicious CheckExplanation
AllRightsReservedLicense

  , CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkVersion CabalSpecVersion
CabalSpecV1_4 (License
lic License -> [License] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [License]
compatLicenses) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistInexcusable (PackageDescription -> CheckExplanation
LicenseMessParse PackageDescription
pkg)

  , case License
lic of
      UnknownLicense String
l -> PackageCheck -> Maybe PackageCheck
forall a. a -> Maybe a
Just (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$ CheckExplanation -> PackageCheck
PackageBuildWarning (String -> CheckExplanation
UnrecognisedLicense String
l)
      License
_ -> Maybe PackageCheck
forall a. Maybe a
Nothing

  , Bool -> PackageCheck -> Maybe PackageCheck
check (License
lic License -> License -> Bool
forall a. Eq a => a -> a -> Bool
== License
BSD4) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistSuspicious CheckExplanation
UncommonBSD4

  , case License -> Maybe [Version]
unknownLicenseVersion License
lic of
      Just [Version]
knownVersions -> PackageCheck -> Maybe PackageCheck
forall a. a -> Maybe a
Just (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
        CheckExplanation -> PackageCheck
PackageDistSuspicious (License -> [Version] -> CheckExplanation
UnknownLicenseVersion License
lic [Version]
knownVersions)
      Maybe [Version]
_ -> Maybe PackageCheck
forall a. Maybe a
Nothing

  , Bool -> PackageCheck -> Maybe PackageCheck
check (License
lic License -> [License] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [ License
AllRightsReserved
                                 , License
UnspecifiedLicense, License
PublicDomain]
           -- AllRightsReserved and PublicDomain are not strictly
           -- licenses so don't need license files.
        Bool -> Bool -> Bool
&& [SymbolicPath PackageDir LicenseFile] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (PackageDescription -> [SymbolicPath PackageDir LicenseFile]
licenseFiles PackageDescription
pkg)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistSuspicious CheckExplanation
NoLicenseFile
  ]
  where
    unknownLicenseVersion :: License -> Maybe [Version]
unknownLicenseVersion (GPL  (Just Version
v))
      | Version
v Version -> [Version] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Version]
knownVersions = [Version] -> Maybe [Version]
forall a. a -> Maybe a
Just [Version]
knownVersions
      where knownVersions :: [Version]
knownVersions = [ Version
v' | GPL  (Just Version
v') <- [License]
knownLicenses ]
    unknownLicenseVersion (LGPL (Just Version
v))
      | Version
v Version -> [Version] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Version]
knownVersions = [Version] -> Maybe [Version]
forall a. a -> Maybe a
Just [Version]
knownVersions
      where knownVersions :: [Version]
knownVersions = [ Version
v' | LGPL (Just Version
v') <- [License]
knownLicenses ]
    unknownLicenseVersion (AGPL (Just Version
v))
      | Version
v Version -> [Version] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Version]
knownVersions = [Version] -> Maybe [Version]
forall a. a -> Maybe a
Just [Version]
knownVersions
      where knownVersions :: [Version]
knownVersions = [ Version
v' | AGPL (Just Version
v') <- [License]
knownLicenses ]
    unknownLicenseVersion (Apache  (Just Version
v))
      | Version
v Version -> [Version] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Version]
knownVersions = [Version] -> Maybe [Version]
forall a. a -> Maybe a
Just [Version]
knownVersions
      where knownVersions :: [Version]
knownVersions = [ Version
v' | Apache  (Just Version
v') <- [License]
knownLicenses ]
    unknownLicenseVersion License
_ = Maybe [Version]
forall a. Maybe a
Nothing

    checkVersion :: CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
    checkVersion :: CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkVersion CabalSpecVersion
ver Bool
cond PackageCheck
pc
      | PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
ver  = Maybe PackageCheck
forall a. Maybe a
Nothing
      | Bool
otherwise               = Bool -> PackageCheck -> Maybe PackageCheck
check Bool
cond PackageCheck
pc

    compatLicenses :: [License]
compatLicenses = [ Maybe Version -> License
GPL Maybe Version
forall a. Maybe a
Nothing, Maybe Version -> License
LGPL Maybe Version
forall a. Maybe a
Nothing, Maybe Version -> License
AGPL Maybe Version
forall a. Maybe a
Nothing, License
BSD3, License
BSD4
                     , License
PublicDomain, License
AllRightsReserved
                     , License
UnspecifiedLicense, License
OtherLicense ]

checkSourceRepos :: PackageDescription -> [PackageCheck]
checkSourceRepos :: PackageDescription -> [PackageCheck]
checkSourceRepos PackageDescription
pkg =
  [Maybe PackageCheck] -> [PackageCheck]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe PackageCheck] -> [PackageCheck])
-> [Maybe PackageCheck] -> [PackageCheck]
forall a b. (a -> b) -> a -> b
$ [[Maybe PackageCheck]] -> [Maybe PackageCheck]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[

    case SourceRepo -> RepoKind
repoKind SourceRepo
repo of
      RepoKindUnknown String
kind -> PackageCheck -> Maybe PackageCheck
forall a. a -> Maybe a
Just (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$ CheckExplanation -> PackageCheck
PackageDistInexcusable (CheckExplanation -> PackageCheck)
-> CheckExplanation -> PackageCheck
forall a b. (a -> b) -> a -> b
$
        String -> CheckExplanation
UnrecognisedSourceRepo String
kind
      RepoKind
_ -> Maybe PackageCheck
forall a. Maybe a
Nothing

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Maybe RepoType -> Bool
forall a. Maybe a -> Bool
isNothing (SourceRepo -> Maybe RepoType
repoType SourceRepo
repo)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistInexcusable CheckExplanation
MissingType

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing (SourceRepo -> Maybe String
repoLocation SourceRepo
repo)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistInexcusable CheckExplanation
MissingLocation

  , Bool -> PackageCheck -> Maybe PackageCheck
check (SourceRepo -> Maybe RepoType
repoType SourceRepo
repo Maybe RepoType -> Maybe RepoType -> Bool
forall a. Eq a => a -> a -> Bool
== RepoType -> Maybe RepoType
forall a. a -> Maybe a
Just (KnownRepoType -> RepoType
KnownRepoType KnownRepoType
CVS) Bool -> Bool -> Bool
&& Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing (SourceRepo -> Maybe String
repoModule SourceRepo
repo)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistInexcusable CheckExplanation
MissingModule

  , Bool -> PackageCheck -> Maybe PackageCheck
check (SourceRepo -> RepoKind
repoKind SourceRepo
repo RepoKind -> RepoKind -> Bool
forall a. Eq a => a -> a -> Bool
== RepoKind
RepoThis Bool -> Bool -> Bool
&& Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing (SourceRepo -> Maybe String
repoTag SourceRepo
repo)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistInexcusable CheckExplanation
MissingTag

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> (String -> Bool) -> Maybe String -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False String -> Bool
isAbsoluteOnAnyPlatform (SourceRepo -> Maybe String
repoSubdir SourceRepo
repo)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistInexcusable CheckExplanation
SubdirRelPath

  , do
      String
subdir <- SourceRepo -> Maybe String
repoSubdir SourceRepo
repo
      String
err    <- String -> Maybe String
isGoodRelativeDirectoryPath String
subdir
      PackageCheck -> Maybe PackageCheck
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$ CheckExplanation -> PackageCheck
PackageDistInexcusable (String -> CheckExplanation
SubdirGoodRelPath String
err)
  ]
  | SourceRepo
repo <- PackageDescription -> [SourceRepo]
sourceRepos PackageDescription
pkg ]

--TODO: check location looks like a URL for some repo types.

-- | Checks GHC options from all ghc-*-options fields in the given
-- PackageDescription and reports commonly misused or non-portable flags
checkAllGhcOptions :: PackageDescription -> [PackageCheck]
checkAllGhcOptions :: PackageDescription -> [PackageCheck]
checkAllGhcOptions PackageDescription
pkg =
    String
-> (BuildInfo -> [String]) -> PackageDescription -> [PackageCheck]
checkGhcOptions String
"ghc-options" (CompilerFlavor -> BuildInfo -> [String]
hcOptions CompilerFlavor
GHC) PackageDescription
pkg
 [PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. [a] -> [a] -> [a]
++ String
-> (BuildInfo -> [String]) -> PackageDescription -> [PackageCheck]
checkGhcOptions String
"ghc-prof-options" (CompilerFlavor -> BuildInfo -> [String]
hcProfOptions CompilerFlavor
GHC) PackageDescription
pkg
 [PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. [a] -> [a] -> [a]
++ String
-> (BuildInfo -> [String]) -> PackageDescription -> [PackageCheck]
checkGhcOptions String
"ghc-shared-options" (CompilerFlavor -> BuildInfo -> [String]
hcSharedOptions CompilerFlavor
GHC) PackageDescription
pkg

-- | Extracts GHC options belonging to the given field from the given
-- PackageDescription using given function and checks them for commonly misused
-- or non-portable flags
checkGhcOptions :: String -> (BuildInfo -> [String]) -> PackageDescription -> [PackageCheck]
checkGhcOptions :: String
-> (BuildInfo -> [String]) -> PackageDescription -> [PackageCheck]
checkGhcOptions String
fieldName BuildInfo -> [String]
getOptions PackageDescription
pkg =
  [Maybe PackageCheck] -> [PackageCheck]
forall a. [Maybe a] -> [a]
catMaybes [

    [String] -> PackageCheck -> Maybe PackageCheck
checkFlags [String
"-fasm"] (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistInexcusable (String -> CheckExplanation
OptFasm String
fieldName)

  , [String] -> PackageCheck -> Maybe PackageCheck
checkFlags [String
"-fvia-C"] (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistSuspicious (String -> CheckExplanation
OptViaC String
fieldName)

  , [String] -> PackageCheck -> Maybe PackageCheck
checkFlags [String
"-fhpc"] (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistInexcusable (String -> CheckExplanation
OptHpc String
fieldName)

  , [String] -> PackageCheck -> Maybe PackageCheck
checkFlags [String
"-prof"] (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageBuildWarning (String -> CheckExplanation
OptProf String
fieldName)

  , [String] -> PackageCheck -> Maybe PackageCheck
checkFlags [String
"-o"] (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageBuildWarning (String -> CheckExplanation
OptO String
fieldName)

  , [String] -> PackageCheck -> Maybe PackageCheck
checkFlags [String
"-hide-package"] (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageBuildWarning (String -> CheckExplanation
OptHide String
fieldName)

  , [String] -> PackageCheck -> Maybe PackageCheck
checkFlags [String
"--make"] (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageBuildWarning (String -> CheckExplanation
OptMake String
fieldName)

  , [String] -> PackageCheck -> Maybe PackageCheck
checkNonTestAndBenchmarkFlags [String
"-O0", String
"-Onot"] (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistSuspicious (String -> CheckExplanation
OptONot String
fieldName)

  , [String] -> PackageCheck -> Maybe PackageCheck
checkTestAndBenchmarkFlags [String
"-O0", String
"-Onot"] (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistSuspiciousWarn (String -> CheckExplanation
OptONot String
fieldName)

  , [String] -> PackageCheck -> Maybe PackageCheck
checkFlags [ String
"-O", String
"-O1"] (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistInexcusable (String -> CheckExplanation
OptOOne String
fieldName)

  , [String] -> PackageCheck -> Maybe PackageCheck
checkFlags [String
"-O2"] (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistSuspiciousWarn (String -> CheckExplanation
OptOTwo String
fieldName)

  , [String] -> PackageCheck -> Maybe PackageCheck
checkFlags [String
"-split-sections"] (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageBuildWarning (String -> CheckExplanation
OptSplitSections String
fieldName)

  , [String] -> PackageCheck -> Maybe PackageCheck
checkFlags [String
"-split-objs"] (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageBuildWarning (String -> CheckExplanation
OptSplitObjs String
fieldName)

  , [String] -> PackageCheck -> Maybe PackageCheck
checkFlags [String
"-optl-Wl,-s", String
"-optl-s"] (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistInexcusable (String -> CheckExplanation
OptWls String
fieldName)

  , [String] -> PackageCheck -> Maybe PackageCheck
checkFlags [String
"-fglasgow-exts"] (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistSuspicious (String -> CheckExplanation
OptExts String
fieldName)

  , Bool -> PackageCheck -> Maybe PackageCheck
check (String
"-rtsopts" String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
lib_ghc_options) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageBuildWarning (String -> CheckExplanation
OptRts String
fieldName)

  , Bool -> PackageCheck -> Maybe PackageCheck
check ((String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\String
opt -> String
"-with-rtsopts" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
opt) [String]
lib_ghc_options) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageBuildWarning (String -> CheckExplanation
OptWithRts String
fieldName)

  , String -> String -> [(String, String)] -> Maybe PackageCheck
checkAlternatives String
fieldName String
"extensions"
      [ (String
flag, Extension -> String
forall a. Pretty a => a -> String
prettyShow Extension
extension) | String
flag <- [String]
ghc_options_no_rtsopts
                                  , Just Extension
extension <- [String -> Maybe Extension
ghcExtension String
flag] ]

  , String -> String -> [(String, String)] -> Maybe PackageCheck
checkAlternatives String
fieldName String
"extensions"
      [ (String
flag, String
extension) | flag :: String
flag@(Char
'-':Char
'X':String
extension) <- [String]
ghc_options_no_rtsopts ]

  , String -> String -> [(String, String)] -> Maybe PackageCheck
checkAlternatives String
fieldName String
"cpp-options" ([(String, String)] -> Maybe PackageCheck)
-> [(String, String)] -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
         [ (String
flag, String
flag) | flag :: String
flag@(Char
'-':Char
'D':String
_) <- [String]
ghc_options_no_rtsopts ]
      [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++ [ (String
flag, String
flag) | flag :: String
flag@(Char
'-':Char
'U':String
_) <- [String]
ghc_options_no_rtsopts ]

  , String -> String -> [(String, String)] -> Maybe PackageCheck
checkAlternatives String
fieldName String
"include-dirs"
      [ (String
flag, String
dir) | flag :: String
flag@(Char
'-':Char
'I':String
dir) <- [String]
ghc_options_no_rtsopts ]

  , String -> String -> [(String, String)] -> Maybe PackageCheck
checkAlternatives String
fieldName String
"extra-libraries"
      [ (String
flag, String
lib) | flag :: String
flag@(Char
'-':Char
'l':String
lib) <- [String]
ghc_options_no_rtsopts ]

  , String -> String -> [(String, String)] -> Maybe PackageCheck
checkAlternatives String
fieldName String
"extra-libraries-static"
      [ (String
flag, String
lib) | flag :: String
flag@(Char
'-':Char
'l':String
lib) <- [String]
ghc_options_no_rtsopts ]

  , String -> String -> [(String, String)] -> Maybe PackageCheck
checkAlternatives String
fieldName String
"extra-lib-dirs"
      [ (String
flag, String
dir) | flag :: String
flag@(Char
'-':Char
'L':String
dir) <- [String]
ghc_options_no_rtsopts ]

  , String -> String -> [(String, String)] -> Maybe PackageCheck
checkAlternatives String
fieldName String
"extra-lib-dirs-static"
      [ (String
flag, String
dir) | flag :: String
flag@(Char
'-':Char
'L':String
dir) <- [String]
ghc_options_no_rtsopts ]

  , String -> String -> [(String, String)] -> Maybe PackageCheck
checkAlternatives String
fieldName String
"frameworks"
      [ (String
flag, String
fmwk) | (flag :: String
flag@String
"-framework", String
fmwk) <-
           [String] -> [String] -> [(String, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
ghc_options_no_rtsopts ([String] -> [String]
forall a. [a] -> [a]
safeTail [String]
ghc_options_no_rtsopts) ]

  , String -> String -> [(String, String)] -> Maybe PackageCheck
checkAlternatives String
fieldName String
"extra-framework-dirs"
      [ (String
flag, String
dir) | (flag :: String
flag@String
"-framework-path", String
dir) <-
           [String] -> [String] -> [(String, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
ghc_options_no_rtsopts ([String] -> [String]
forall a. [a] -> [a]
safeTail [String]
ghc_options_no_rtsopts) ]
  ]

  where
    all_ghc_options :: [String]
all_ghc_options    = (BuildInfo -> [String]) -> [BuildInfo] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap BuildInfo -> [String]
getOptions (PackageDescription -> [BuildInfo]
allBuildInfo PackageDescription
pkg)
    ghc_options_no_rtsopts :: [String]
ghc_options_no_rtsopts = [String] -> [String]
rmRtsOpts [String]
all_ghc_options
    lib_ghc_options :: [String]
lib_ghc_options    = (Library -> [String]) -> [Library] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (BuildInfo -> [String]
getOptions (BuildInfo -> [String])
-> (Library -> BuildInfo) -> Library -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library -> BuildInfo
libBuildInfo)
                         (PackageDescription -> [Library]
allLibraries PackageDescription
pkg)
    test_ghc_options :: [String]
test_ghc_options      = (TestSuite -> [String]) -> [TestSuite] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (BuildInfo -> [String]
getOptions (BuildInfo -> [String])
-> (TestSuite -> BuildInfo) -> TestSuite -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestSuite -> BuildInfo
testBuildInfo)
                            (PackageDescription -> [TestSuite]
testSuites PackageDescription
pkg)
    benchmark_ghc_options :: [String]
benchmark_ghc_options = (Benchmark -> [String]) -> [Benchmark] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (BuildInfo -> [String]
getOptions (BuildInfo -> [String])
-> (Benchmark -> BuildInfo) -> Benchmark -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Benchmark -> BuildInfo
benchmarkBuildInfo)
                            (PackageDescription -> [Benchmark]
benchmarks PackageDescription
pkg)
    test_and_benchmark_ghc_options :: [String]
test_and_benchmark_ghc_options     = [String]
test_ghc_options [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
                                         [String]
benchmark_ghc_options
    non_test_and_benchmark_ghc_options :: [String]
non_test_and_benchmark_ghc_options = (BuildInfo -> [String]) -> [BuildInfo] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap BuildInfo -> [String]
getOptions
                                         (PackageDescription -> [BuildInfo]
allBuildInfo (PackageDescription
pkg { testSuites = []
                                                            , benchmarks = []
                                                            }))

    checkFlags :: [String] -> PackageCheck -> Maybe PackageCheck
    checkFlags :: [String] -> PackageCheck -> Maybe PackageCheck
checkFlags [String]
flags = Bool -> PackageCheck -> Maybe PackageCheck
check ((String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
flags) [String]
all_ghc_options)

    checkTestAndBenchmarkFlags :: [String] -> PackageCheck -> Maybe PackageCheck
    checkTestAndBenchmarkFlags :: [String] -> PackageCheck -> Maybe PackageCheck
checkTestAndBenchmarkFlags [String]
flags = Bool -> PackageCheck -> Maybe PackageCheck
check ((String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
flags) [String]
test_and_benchmark_ghc_options)

    checkNonTestAndBenchmarkFlags :: [String] -> PackageCheck -> Maybe PackageCheck
    checkNonTestAndBenchmarkFlags :: [String] -> PackageCheck -> Maybe PackageCheck
checkNonTestAndBenchmarkFlags [String]
flags = Bool -> PackageCheck -> Maybe PackageCheck
check ((String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
flags) [String]
non_test_and_benchmark_ghc_options)

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


checkCCOptions :: PackageDescription -> [PackageCheck]
checkCCOptions :: PackageDescription -> [PackageCheck]
checkCCOptions = String
-> String
-> (BuildInfo -> [String])
-> PackageDescription
-> [PackageCheck]
checkCLikeOptions String
"C" String
"cc-options" BuildInfo -> [String]
ccOptions

checkCxxOptions :: PackageDescription -> [PackageCheck]
checkCxxOptions :: PackageDescription -> [PackageCheck]
checkCxxOptions = String
-> String
-> (BuildInfo -> [String])
-> PackageDescription
-> [PackageCheck]
checkCLikeOptions String
"C++" String
"cxx-options" BuildInfo -> [String]
cxxOptions

checkCLikeOptions :: String -> String -> (BuildInfo -> [String]) -> PackageDescription -> [PackageCheck]
checkCLikeOptions :: String
-> String
-> (BuildInfo -> [String])
-> PackageDescription
-> [PackageCheck]
checkCLikeOptions String
label String
prefix BuildInfo -> [String]
accessor PackageDescription
pkg =
  [Maybe PackageCheck] -> [PackageCheck]
forall a. [Maybe a] -> [a]
catMaybes [

    String -> String -> [(String, String)] -> Maybe PackageCheck
checkAlternatives String
prefix String
"include-dirs"
      [ (String
flag, String
dir) | flag :: String
flag@(Char
'-':Char
'I':String
dir) <- [String]
all_cLikeOptions ]

  , String -> String -> [(String, String)] -> Maybe PackageCheck
checkAlternatives String
prefix String
"extra-libraries"
      [ (String
flag, String
lib) | flag :: String
flag@(Char
'-':Char
'l':String
lib) <- [String]
all_cLikeOptions ]

  , String -> String -> [(String, String)] -> Maybe PackageCheck
checkAlternatives String
prefix String
"extra-lib-dirs"
      [ (String
flag, String
dir) | flag :: String
flag@(Char
'-':Char
'L':String
dir) <- [String]
all_cLikeOptions ]

  , String -> String -> [(String, String)] -> Maybe PackageCheck
checkAlternatives String
"ld-options" String
"extra-libraries"
      [ (String
flag, String
lib) | flag :: String
flag@(Char
'-':Char
'l':String
lib) <- [String]
all_ldOptions ]

  , String -> String -> [(String, String)] -> Maybe PackageCheck
checkAlternatives String
"ld-options" String
"extra-lib-dirs"
      [ (String
flag, String
dir) | flag :: String
flag@(Char
'-':Char
'L':String
dir) <- [String]
all_ldOptions ]

  , [String] -> PackageCheck -> Maybe PackageCheck
checkCCFlags [ String
"-O", String
"-Os", String
"-O0", String
"-O1", String
"-O2", String
"-O3" ] (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistSuspicious (String -> String -> CheckExplanation
COptONumber String
prefix String
label)
  ]

  where all_cLikeOptions :: [String]
all_cLikeOptions = [ String
opts | BuildInfo
bi <- PackageDescription -> [BuildInfo]
allBuildInfo PackageDescription
pkg
                                  , String
opts <- BuildInfo -> [String]
accessor BuildInfo
bi ]
        all_ldOptions :: [String]
all_ldOptions = [ String
opts | BuildInfo
bi <- PackageDescription -> [BuildInfo]
allBuildInfo PackageDescription
pkg
                               , String
opts <- BuildInfo -> [String]
ldOptions BuildInfo
bi ]

        checkCCFlags :: [String] -> PackageCheck -> Maybe PackageCheck
        checkCCFlags :: [String] -> PackageCheck -> Maybe PackageCheck
checkCCFlags [String]
flags = Bool -> PackageCheck -> Maybe PackageCheck
check ((String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
flags) [String]
all_cLikeOptions)

checkCPPOptions :: PackageDescription -> [PackageCheck]
checkCPPOptions :: PackageDescription -> [PackageCheck]
checkCPPOptions PackageDescription
pkg = [Maybe PackageCheck] -> [PackageCheck]
forall a. [Maybe a] -> [a]
catMaybes
    [ String -> String -> [(String, String)] -> Maybe PackageCheck
checkAlternatives String
"cpp-options" String
"include-dirs"
      [ (String
flag, String
dir) | flag :: String
flag@(Char
'-':Char
'I':String
dir) <- [String]
all_cppOptions ]
    ]
    [PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. [a] -> [a] -> [a]
++
    [ CheckExplanation -> PackageCheck
PackageBuildWarning (String -> CheckExplanation
COptCPP String
opt)
    | String
opt <- [String]
all_cppOptions
    -- "-I" is handled above, we allow only -DNEWSTUFF and -UOLDSTUFF
    , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
opt) [String
"-D", String
"-U", String
"-I" ]
    ]
  where
    all_cppOptions :: [String]
all_cppOptions = [ String
opts | BuildInfo
bi <- PackageDescription -> [BuildInfo]
allBuildInfo PackageDescription
pkg, String
opts <- BuildInfo -> [String]
cppOptions BuildInfo
bi ]

checkAlternatives :: String -> String -> [(String, String)]
                  -> Maybe PackageCheck
checkAlternatives :: String -> String -> [(String, String)] -> Maybe PackageCheck
checkAlternatives String
badField String
goodField [(String, String)]
flags =
  Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not ([String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
badFlags)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
    CheckExplanation -> PackageCheck
PackageBuildWarning (String -> String -> [(String, String)] -> CheckExplanation
OptAlternatives String
badField String
goodField [(String, String)]
flags)
  where ([String]
badFlags, [String]
_) = [(String, String)] -> ([String], [String])
forall a b. [(a, b)] -> ([a], [b])
unzip [(String, String)]
flags

data PathKind
    = PathKindFile
    | PathKindDirectory
    | PathKindGlob
  deriving (PathKind -> PathKind -> Bool
(PathKind -> PathKind -> Bool)
-> (PathKind -> PathKind -> Bool) -> Eq PathKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PathKind -> PathKind -> Bool
== :: PathKind -> PathKind -> Bool
$c/= :: PathKind -> PathKind -> Bool
/= :: PathKind -> PathKind -> Bool
Eq)

checkPaths :: PackageDescription -> [PackageCheck]
checkPaths :: PackageDescription -> [PackageCheck]
checkPaths PackageDescription
pkg =
  [(Bool, String)] -> [PackageCheck]
checkPackageFileNamesWithGlob
  [ (PathKind
kind PathKind -> PathKind -> Bool
forall a. Eq a => a -> a -> Bool
== PathKind
PathKindGlob, String
path)
  | (String
path, String
_, PathKind
kind) <- [(String, String, PathKind)]
relPaths [(String, String, PathKind)]
-> [(String, String, PathKind)] -> [(String, String, PathKind)]
forall a. [a] -> [a] -> [a]
++ [(String, String, PathKind)]
absPaths
  ]
  [PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. [a] -> [a] -> [a]
++
  [ CheckExplanation -> PackageCheck
PackageBuildWarning (String -> String -> CheckExplanation
RelativeOutside String
field String
path)
  | (String
path, String
field, PathKind
_) <- [(String, String, PathKind)]
relPaths [(String, String, PathKind)]
-> [(String, String, PathKind)] -> [(String, String, PathKind)]
forall a. [a] -> [a] -> [a]
++ [(String, String, PathKind)]
absPaths
  , String -> Bool
isOutsideTree String
path ]
  [PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. [a] -> [a] -> [a]
++
  [ CheckExplanation -> PackageCheck
PackageDistInexcusable (String -> String -> CheckExplanation
AbsolutePath String
field String
path)
  | (String
path, String
field, PathKind
_) <- [(String, String, PathKind)]
relPaths
  , String -> Bool
isAbsoluteOnAnyPlatform String
path ]
  [PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. [a] -> [a] -> [a]
++
  [ CheckExplanation -> PackageCheck
PackageDistInexcusable (String -> String -> String -> CheckExplanation
BadRelativePAth String
field String
path String
err)
  | (String
path, String
field, PathKind
kind) <- [(String, String, PathKind)]
relPaths
  -- these are not paths, but globs...
  , String
err <- Maybe String -> [String]
forall a. Maybe a -> [a]
maybeToList (Maybe String -> [String]) -> Maybe String -> [String]
forall a b. (a -> b) -> a -> b
$ case PathKind
kind of
      PathKind
PathKindFile      -> String -> Maybe String
isGoodRelativeFilePath String
path
      PathKind
PathKindGlob      -> String -> Maybe String
isGoodRelativeGlob String
path
      PathKind
PathKindDirectory -> String -> Maybe String
isGoodRelativeDirectoryPath String
path
  ]
  [PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. [a] -> [a] -> [a]
++
  [ CheckExplanation -> PackageCheck
PackageDistInexcusable (CheckExplanation -> PackageCheck)
-> CheckExplanation -> PackageCheck
forall a b. (a -> b) -> a -> b
$ Maybe String -> String -> CheckExplanation
DistPoint (String -> Maybe String
forall a. a -> Maybe a
Just String
field) String
path
  | (String
path, String
field, PathKind
_) <- [(String, String, PathKind)]
relPaths [(String, String, PathKind)]
-> [(String, String, PathKind)] -> [(String, String, PathKind)]
forall a. [a] -> [a] -> [a]
++ [(String, String, PathKind)]
absPaths
  , String -> Bool
isInsideDist String
path ]
  [PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. [a] -> [a] -> [a]
++
  [ CheckExplanation -> PackageCheck
PackageDistInexcusable (Maybe String -> String -> CheckExplanation
DistPoint Maybe String
forall a. Maybe a
Nothing String
path)
  | BuildInfo
bi <- PackageDescription -> [BuildInfo]
allBuildInfo PackageDescription
pkg
  , (CompilerFlavor
GHC, [String]
flags) <- PerCompilerFlavor [String] -> [(CompilerFlavor, [String])]
forall v. PerCompilerFlavor v -> [(CompilerFlavor, v)]
perCompilerFlavorToList (PerCompilerFlavor [String] -> [(CompilerFlavor, [String])])
-> PerCompilerFlavor [String] -> [(CompilerFlavor, [String])]
forall a b. (a -> b) -> a -> b
$ BuildInfo -> PerCompilerFlavor [String]
options BuildInfo
bi
  , String
path <- [String]
flags
  , String -> Bool
isInsideDist String
path ]
  [PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. [a] -> [a] -> [a]
++
  [ CheckExplanation -> PackageCheck
PackageDistInexcusable (CheckExplanation -> PackageCheck)
-> CheckExplanation -> PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> String -> CheckExplanation
GlobSyntaxError String
"data-files" (String -> GlobSyntaxError -> String
explainGlobSyntaxError String
pat GlobSyntaxError
err)
  | (Left GlobSyntaxError
err, String
pat) <- [Either GlobSyntaxError Glob]
-> [String] -> [(Either GlobSyntaxError Glob, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Either GlobSyntaxError Glob]
globsDataFiles ([String] -> [(Either GlobSyntaxError Glob, String)])
-> [String] -> [(Either GlobSyntaxError Glob, String)]
forall a b. (a -> b) -> a -> b
$ PackageDescription -> [String]
dataFiles PackageDescription
pkg