-----------------------------------------------------------------------------
-- |
-- 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CEType -> CEType -> Bool
$c/= :: CEType -> CEType -> Bool
== :: CEType -> CEType -> Bool
$c== :: CEType -> CEType -> Bool
Eq, Eq 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
min :: CEType -> CEType -> CEType
$cmin :: CEType -> CEType -> CEType
max :: CEType -> CEType -> CEType
$cmax :: CEType -> CEType -> CEType
>= :: CEType -> CEType -> Bool
$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
compare :: CEType -> CEType -> Ordering
$ccompare :: CEType -> CEType -> Ordering
Ord, Int -> CEType -> ShowS
[CEType] -> ShowS
CEType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CEType] -> ShowS
$cshowList :: [CEType] -> ShowS
show :: CEType -> String
$cshow :: CEType -> String
showsPrec :: Int -> CEType -> ShowS
$cshowsPrec :: Int -> 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CEField -> CEField -> Bool
$c/= :: CEField -> CEField -> Bool
== :: CEField -> CEField -> Bool
$c== :: CEField -> CEField -> Bool
Eq, Eq 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
min :: CEField -> CEField -> CEField
$cmin :: CEField -> CEField -> CEField
max :: CEField -> CEField -> CEField
$cmax :: CEField -> CEField -> CEField
>= :: CEField -> CEField -> Bool
$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
compare :: CEField -> CEField -> Ordering
$ccompare :: CEField -> CEField -> Ordering
Ord, Int -> CEField -> ShowS
[CEField] -> ShowS
CEField -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CEField] -> ShowS
$cshowList :: [CEField] -> ShowS
show :: CEField -> String
$cshow :: CEField -> String
showsPrec :: Int -> CEField -> ShowS
$cshowsPrec :: Int -> 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CheckExplanation -> CheckExplanation -> Bool
$c/= :: CheckExplanation -> CheckExplanation -> Bool
== :: CheckExplanation -> CheckExplanation -> Bool
$c== :: CheckExplanation -> CheckExplanation -> Bool
Eq, Eq 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
min :: CheckExplanation -> CheckExplanation -> CheckExplanation
$cmin :: CheckExplanation -> CheckExplanation -> CheckExplanation
max :: CheckExplanation -> CheckExplanation -> CheckExplanation
$cmax :: CheckExplanation -> CheckExplanation -> CheckExplanation
>= :: CheckExplanation -> CheckExplanation -> Bool
$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
compare :: CheckExplanation -> CheckExplanation -> Ordering
$ccompare :: CheckExplanation -> CheckExplanation -> Ordering
Ord, Int -> CheckExplanation -> ShowS
[CheckExplanation] -> ShowS
CheckExplanation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CheckExplanation] -> ShowS
$cshowList :: [CheckExplanation] -> ShowS
show :: CheckExplanation -> String
$cshow :: CheckExplanation -> String
showsPrec :: Int -> CheckExplanation -> ShowS
$cshowsPrec :: Int -> 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"
      forall a. [a] -> [a] -> [a]
++ String
" library can have the same name as the package."
ppExplanation (DuplicateSections [UnqualComponentName]
duplicateNames) =
    String
"Duplicate sections: "
      forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep (forall a b. (a -> b) -> [a] -> [b]
map UnqualComponentName -> String
unUnqualComponentName [UnqualComponentName]
duplicateNames)
      forall a. [a] -> [a] -> [a]
++ String
". The name of every library, executable, test suite,"
      forall a. [a] -> [a] -> [a]
++ String
" and benchmark section in the package must be unique."
ppExplanation (IllegalLibraryName PackageDescription
pkg) =
    String
"Illegal internal library name "
      forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow (forall pkg. Package pkg => pkg -> PackageName
packageName PackageDescription
pkg)
      forall a. [a] -> [a] -> [a]
++ String
". Internal libraries cannot have the same name as the package."
      forall a. [a] -> [a] -> [a]
++ String
" Maybe you wanted a non-internal library?"
      forall a. [a] -> [a] -> [a]
++ String
" If so, rewrite the section stanza"
      forall a. [a] -> [a] -> [a]
++ String
" from 'library: '" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow (forall pkg. Package pkg => pkg -> PackageName
packageName PackageDescription
pkg)
      forall a. [a] -> [a] -> [a]
++ String
"' to 'library'."
ppExplanation (NoModulesExposed Library
lib) =
    LibraryName -> String
showLibraryName (Library -> LibraryName
libName Library
lib) 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 "
      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 "
       forall a. [a] -> [a] -> [a]
++ String
"'install-includes'."
ppExplanation (NoMainIs Executable
exe) =
    String
"No 'main-is' field found for executable " forall a. [a] -> [a] -> [a]
++ 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 "
      forall a. [a] -> [a] -> [a]
++ String
"(even if it is generated by a preprocessor), "
      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. "
      forall a. [a] -> [a] -> [a]
++ String
"To use this feature you need to specify 'cabal-version: 1.18' or"
      forall a. [a] -> [a] -> [a]
++ String
" higher."
ppExplanation (AutogenNoOther CEType
ct UnqualComponentName
ucn) =
    String
"On " forall a. [a] -> [a] -> [a]
++ CEType -> String
ppCE CEType
ct forall a. [a] -> [a] -> [a]
++ String
" '" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow UnqualComponentName
ucn forall a. [a] -> [a] -> [a]
++ String
"' an 'autogen-module'"
      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 (forall a. Pretty a => a -> String
prettyShow TestType
tt) forall a. [a] -> [a] -> [a]
++ String
" is not a known type of test suite. "
      forall a. [a] -> [a] -> [a]
++ String
"Either remove the 'type' field or use a known type. "
      forall a. [a] -> [a] -> [a]
++ String
"The known test suite types are: "
      forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> String
prettyShow [TestType]
knownTestTypes)
ppExplanation (TestsuiteNotSupported TestType
tt) =
    ShowS
quote (forall a. Pretty a => a -> String
prettyShow TestType
tt) forall a. [a] -> [a] -> [a]
++ String
" is not a supported test suite version. "
      forall a. [a] -> [a] -> [a]
++ String
"Either remove the 'type' field or use a known type. "
      forall a. [a] -> [a] -> [a]
++ String
"The known test suite types are: "
      forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> String
prettyShow [TestType]
knownTestTypes)
ppExplanation (BenchmarkTypeNotKnown BenchmarkType
tt) =
    ShowS
quote (forall a. Pretty a => a -> String
prettyShow BenchmarkType
tt) forall a. [a] -> [a] -> [a]
++ String
" is not a known type of benchmark. "
      forall a. [a] -> [a] -> [a]
++ String
"Either remove the 'type' field or use a known type. "
      forall a. [a] -> [a] -> [a]
++ String
"The known benchmark types are: "
      forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> String
prettyShow [BenchmarkType]
knownBenchmarkTypes)
ppExplanation (BenchmarkNotSupported BenchmarkType
tt) =
    ShowS
quote (forall a. Pretty a => a -> String
prettyShow BenchmarkType
tt) forall a. [a] -> [a] -> [a]
++ String
" is not a supported benchmark version. "
      forall a. [a] -> [a] -> [a]
++ String
"Either remove the 'type' field or use a known type. "
      forall a. [a] -> [a] -> [a]
++ String
"The known benchmark types are: "
      forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> String
prettyShow [BenchmarkType]
knownBenchmarkTypes)
ppExplanation CheckExplanation
NoHsLhsMainBench =
    String
"The 'main-is' field must specify a '.hs' or '.lhs' file "
      forall a. [a] -> [a] -> [a]
++ String
"(even if it is generated by a preprocessor)."
ppExplanation (InvalidNameWin PackageDescription
pkg) =
    String
"The package name '" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow (forall pkg. Package pkg => pkg -> PackageName
packageName PackageDescription
pkg) forall a. [a] -> [a] -> [a]
++ String
"' is "
      forall a. [a] -> [a] -> [a]
++ String
"invalid on Windows. Many tools need to convert package names to "
      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 "
      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 "
      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 "
      forall a. [a] -> [a] -> [a]
++ String
"not 'Custom'. Use 'build-type: Custom' if you need to use a "
      forall a. [a] -> [a] -> [a]
++ String
"custom Setup.hs script."
ppExplanation (UnknownCompilers [String]
unknownCompilers) =
    String
"Unknown compiler " forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep (forall a b. (a -> b) -> [a] -> [b]
map ShowS
quote [String]
unknownCompilers)
      forall a. [a] -> [a] -> [a]
++ String
" in 'tested-with' field."
ppExplanation (UnknownLanguages [String]
unknownLanguages) =
    String
"Unknown languages: " forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep [String]
unknownLanguages
ppExplanation (UnknownExtensions [String]
unknownExtensions) =
    String
"Unknown extensions: " forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep [String]
unknownExtensions
ppExplanation (LanguagesAsExtension [String]
languagesUsedAsExtensions) =
    String
"Languages listed as extensions: "
      forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep [String]
languagesUsedAsExtensions
      forall a. [a] -> [a] -> [a]
++ String
". Languages must be specified in either the 'default-language' "
      forall a. [a] -> [a] -> [a]
++ String
" or the 'other-languages' field."
ppExplanation (DeprecatedExtensions [(Extension, Maybe Extension)]
ourDeprecatedExtensions) =
    String
"Deprecated extensions: "
      forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep (forall a b. (a -> b) -> [a] -> [b]
map (ShowS
quote forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> String
prettyShow forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Extension, Maybe Extension)]
ourDeprecatedExtensions)
      forall a. [a] -> [a] -> [a]
++ String
". " forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords
           [ String
"Instead of '" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow Extension
ext
          forall a. [a] -> [a] -> [a]
++ String
"' use '" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow Extension
replacement forall a. [a] -> [a] -> [a]
++ String
"'."
           | (Extension
ext, Just Extension
replacement) <- [(Extension, Maybe Extension)]
ourDeprecatedExtensions ]
ppExplanation (MissingField CEField
cef) =
    String
"No '" forall a. [a] -> [a] -> [a]
++ CEField -> String
ppCEField CEField
cef 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. "
      forall a. [a] -> [a] -> [a]
++ String
"It's useful to provide an informative 'description' to allow "
      forall a. [a] -> [a] -> [a]
++ String
"Haskell programmers who have never heard about your package to "
      forall a. [a] -> [a] -> [a]
++ String
"understand the purpose of your package. "
      forall a. [a] -> [a] -> [a]
++ String
"The 'description' field content is typically shown by tooling "
      forall a. [a] -> [a] -> [a]
++ String
"(e.g. 'cabal info', Haddock, Hackage) below the 'synopsis' which "
      forall a. [a] -> [a] -> [a]
++ String
"serves as a headline. "
      forall a. [a] -> [a] -> [a]
++ String
"Please refer to <https://cabal.readthedocs.io/en/stable/"
      forall a. [a] -> [a] -> [a]
++ String
"cabal-package.html#package-properties> for more details."
ppExplanation (InvalidTestWith [Dependency]
testedWithImpossibleRanges) =
    String
"Invalid 'tested-with' version range: "
      forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> String
prettyShow [Dependency]
testedWithImpossibleRanges)
      forall a. [a] -> [a] -> [a]
++ String
". To indicate that you have tested a package with multiple "
      forall a. [a] -> [a] -> [a]
++ String
"different versions of the same compiler use multiple entries, "
      forall a. [a] -> [a] -> [a]
++ String
"for example 'tested-with: GHC==6.10.4, GHC==6.12.3' and not "
      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 "
      forall a. [a] -> [a] -> [a]
++ String
"internal library: "
      forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> String
prettyShow [Dependency]
depInternalLibWithImpossibleVersion)
      forall a. [a] -> [a] -> [a]
++ String
". This version range does not include the current package, and must "
      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 "
      forall a. [a] -> [a] -> [a]
++ String
"internal executable: "
      forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> String
prettyShow [ExeDependency]
depInternalExecWithImpossibleVersion)
      forall a. [a] -> [a] -> [a]
++ String
". This version range does not include the current package, and must "
      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: "
      forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep (forall a b. (a -> b) -> [a] -> [b]
map 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 " forall a. [a] -> [a] -> [a]
++ ShowS
quote (forall a. Pretty a => a -> String
prettyShow (PackageDescription -> License
license PackageDescription
pkg))
      forall a. [a] -> [a] -> [a]
++ String
" messes up the parser in earlier Cabal versions so you need to "
      forall a. [a] -> [a] -> [a]
++ String
"specify 'cabal-version: >= 1.4'. Alternatively if you require "
      forall a. [a] -> [a] -> [a]
++ String
"compatibility with earlier Cabal versions then use 'OtherLicense'."
ppExplanation (UnrecognisedLicense String
l) =
    ShowS
quote (String
"license: " forall a. [a] -> [a] -> [a]
++ String
l) forall a. [a] -> [a] -> [a]
++ String
" is not a recognised license. The "
      forall a. [a] -> [a] -> [a]
++ String
"known licenses are: " forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> String
prettyShow [License]
knownLicenses)
ppExplanation CheckExplanation
UncommonBSD4 =
    String
"Using 'license: BSD4' is almost always a misunderstanding. 'BSD4' "
      forall a. [a] -> [a] -> [a]
++ String
"refers to the old 4-clause BSD license with the advertising "
      forall a. [a] -> [a] -> [a]
++ String
"clause. 'BSD3' refers the new 3-clause BSD license."
ppExplanation (UnknownLicenseVersion License
lic [Version]
known) =
    String
"'license: " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow License
lic forall a. [a] -> [a] -> [a]
++ String
"' is not a known "
      forall a. [a] -> [a] -> [a]
++ String
"version of that license. The known versions are "
      forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> String
prettyShow [Version]
known)
      forall a. [a] -> [a] -> [a]
++ String
". If this is not a mistake and you think it should be a known "
      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 forall a. [a] -> [a] -> [a]
++ String
" is not a recognised kind of source-repository. "
      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 "
      forall a. [a] -> [a] -> [a]
++ String
"field. It should specify the tag corresponding to this version "
      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: "
      forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
err
ppExplanation (OptFasm String
fieldName) =
    String
"'" forall a. [a] -> [a] -> [a]
++ String
fieldName forall a. [a] -> [a] -> [a]
++ String
": -fasm' is unnecessary and will not work on CPU "
      forall a. [a] -> [a] -> [a]
++ String
"architectures other than x86, x86-64, ppc or sparc."
ppExplanation (OptViaC String
fieldName) =
    String
"'" forall a. [a] -> [a] -> [a]
++ String
fieldName forall a. [a] -> [a] -> [a]
++String
": -fvia-C' is usually unnecessary. If your package "
      forall a. [a] -> [a] -> [a]
++ String
"needs -via-C for correctness rather than performance then it "
      forall a. [a] -> [a] -> [a]
++ String
"is using the FFI incorrectly and will probably not work with GHC "
      forall a. [a] -> [a] -> [a]
++ String
"6.10 or later."
ppExplanation (OptHpc String
fieldName) =
    String
"'" forall a. [a] -> [a] -> [a]
++ String
fieldName forall a. [a] -> [a] -> [a]
++ String
": -fhpc' is not necessary. Use the configure flag "
      forall a. [a] -> [a] -> [a]
++ String
" --enable-coverage instead."
ppExplanation (OptProf String
fieldName) =
    String
"'" forall a. [a] -> [a] -> [a]
++ String
fieldName forall a. [a] -> [a] -> [a]
++ String
": -prof' is not necessary and will lead to problems "
      forall a. [a] -> [a] -> [a]
++ String
"when used on a library. Use the configure flag "
      forall a. [a] -> [a] -> [a]
++ String
"--enable-library-profiling and/or --enable-profiling."
ppExplanation (OptO String
fieldName) =
    String
"'" forall a. [a] -> [a] -> [a]
++ String
fieldName forall a. [a] -> [a] -> [a]
++ String
": -o' is not needed. "
      forall a. [a] -> [a] -> [a]
++ String
"The output files are named automatically."
ppExplanation (OptHide String
fieldName) =
    String
"'" forall a. [a] -> [a] -> [a]
++ String
fieldName forall a. [a] -> [a] -> [a]
++ String
": -hide-package' is never needed. "
      forall a. [a] -> [a] -> [a]
++ String
"Cabal hides all packages."
ppExplanation (OptMake String
fieldName) =
    String
"'" forall a. [a] -> [a] -> [a]
++ String
fieldName
      forall a. [a] -> [a] -> [a]
++ String
": --make' is never needed. Cabal uses this automatically."
ppExplanation (OptONot String
fieldName) =
      String
"'" forall a. [a] -> [a] -> [a]
++ String
fieldName forall a. [a] -> [a] -> [a]
++ String
": -O0' is not needed. "
      forall a. [a] -> [a] -> [a]
++ String
"Use the --disable-optimization configure flag."
ppExplanation (OptOOne String
fieldName) =
    String
"'" forall a. [a] -> [a] -> [a]
++ String
fieldName forall a. [a] -> [a] -> [a]
++ String
": -O' is not needed. "
      forall a. [a] -> [a] -> [a]
++ String
"Cabal automatically adds the '-O' flag. "
      forall a. [a] -> [a] -> [a]
++ String
"Setting it yourself interferes with the --disable-optimization flag."
ppExplanation (OptOTwo String
fieldName) =
    String
"'" forall a. [a] -> [a] -> [a]
++ String
fieldName forall a. [a] -> [a] -> [a]
++ String
": -O2' is rarely needed. "
      forall a. [a] -> [a] -> [a]
++ String
"Check that it is giving a real benefit "
      forall a. [a] -> [a] -> [a]
++ String
"and not just imposing longer compile times on your users."
ppExplanation (OptSplitSections String
fieldName) =
    String
"'" forall a. [a] -> [a] -> [a]
++ String
fieldName forall a. [a] -> [a] -> [a]
++ String
": -split-sections' is not needed. "
      forall a. [a] -> [a] -> [a]
++ String
"Use the --enable-split-sections configure flag."
ppExplanation (OptSplitObjs String
fieldName) =
    String
"'" forall a. [a] -> [a] -> [a]
++ String
fieldName forall a. [a] -> [a] -> [a]
++ String
": -split-objs' is not needed. "
      forall a. [a] -> [a] -> [a]
++ String
"Use the --enable-split-objs configure flag."
ppExplanation (OptWls String
fieldName) =
    String
"'" forall a. [a] -> [a] -> [a]
++ String
fieldName forall a. [a] -> [a] -> [a]
++ String
": -optl-Wl,-s' is not needed and is not portable to"
      forall a. [a] -> [a] -> [a]
++ String
" all operating systems. Cabal 1.4 and later automatically strip"
      forall a. [a] -> [a] -> [a]
++ String
" executables. Cabal also has a flag --disable-executable-stripping"
      forall a. [a] -> [a] -> [a]
++ String
" which is necessary when building packages for some Linux"
      forall a. [a] -> [a] -> [a]
++ String
" distributions and using '-optl-Wl,-s' prevents that from working."
ppExplanation (OptExts String
fieldName) =
    String
"Instead of '" forall a. [a] -> [a] -> [a]
++ String
fieldName forall a. [a] -> [a] -> [a]
++ String
": -fglasgow-exts' it is preferable to use "
      forall a. [a] -> [a] -> [a]
++ String
"the 'extensions' field."
ppExplanation (OptRts String
fieldName) =
    String
"'" forall a. [a] -> [a] -> [a]
++ String
fieldName forall a. [a] -> [a] -> [a]
++ String
": -rtsopts' has no effect for libraries. It should "
      forall a. [a] -> [a] -> [a]
++ String
"only be used for executables."
ppExplanation (OptWithRts String
fieldName) =
    String
"'" forall a. [a] -> [a] -> [a]
++ String
fieldName forall a. [a] -> [a] -> [a]
++ String
": -with-rtsopts' has no effect for libraries. It "
      forall a. [a] -> [a] -> [a]
++ String
"should only be used for executables."
ppExplanation (COptONumber String
prefix String
label) =
    String
"'" forall a. [a] -> [a] -> [a]
++ String
prefix forall a. [a] -> [a] -> [a]
++String
": -O[n]' is generally not needed. When building with "
      forall a. [a] -> [a] -> [a]
++ String
" optimisations Cabal automatically adds '-O2' for " forall a. [a] -> [a] -> [a]
++ String
label
      forall a. [a] -> [a] -> [a]
++ String
" code. Setting it yourself interferes with the"
      forall a. [a] -> [a] -> [a]
++ String
" --disable-optimization flag."
ppExplanation (COptCPP String
opt) =
    String
"'cpp-options: " forall a. [a] -> [a] -> [a]
++ String
opt 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 " forall a. [a] -> [a] -> [a]
++ ShowS
quote (String
badField forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
badFlags)
      forall a. [a] -> [a] -> [a]
++ String
" use " forall a. [a] -> [a] -> [a]
++ ShowS
quote (String
goodField forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
goodFlags)
  where ([String]
badFlags, [String]
goodFlags) = forall a b. [(a, b)] -> ([a], [b])
unzip [(String, String)]
flags
ppExplanation (RelativeOutside String
field String
path) =
    ShowS
quote (String
field forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ String
path)
      forall a. [a] -> [a] -> [a]
++ String
" is a relative path outside of the source tree. "
      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 forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ String
path) forall a. [a] -> [a] -> [a]
++ String
" specifies an absolute path, but the "
      forall a. [a] -> [a] -> [a]
++ ShowS
quote String
field forall a. [a] -> [a] -> [a]
++ String
" field must use relative paths."
ppExplanation (BadRelativePAth String
field String
path String
err) =
    ShowS
quote (String
field forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ String
path)
      forall a. [a] -> [a] -> [a]
++ String
" is not a good relative path: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
err
ppExplanation (DistPoint Maybe String
mfield String
path) =
    String
incipit forall a. [a] -> [a] -> [a]
++ String
" points inside the 'dist' "
      forall a. [a] -> [a] -> [a]
++ String
"directory. This is not reliable because the location of this "
      forall a. [a] -> [a] -> [a]
++ String
"directory is configurable by the user (or package manager). In "
      forall a. [a] -> [a] -> [a]
++ String
"addition the layout of the 'dist' directory is subject to change "
      forall a. [a] -> [a] -> [a]
++ String
"in future versions of Cabal."
  where -- mfiled Nothing -> the path is inside `ghc-options`
        incipit :: String
incipit = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String
"'ghc-options' path " forall a. [a] -> [a] -> [a]
++ ShowS
quote String
path)
                        (\String
field -> ShowS
quote (String
field forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ String
path))
                        Maybe String
mfield
ppExplanation (GlobSyntaxError String
field String
expl) =
    String
"In the '" forall a. [a] -> [a] -> [a]
++ String
field forall a. [a] -> [a] -> [a]
++ String
"' field: " forall a. [a] -> [a] -> [a]
++ String
expl
ppExplanation (RecursiveGlobInRoot String
field String
glob) =
    String
"In the '" forall a. [a] -> [a] -> [a]
++ String
field forall a. [a] -> [a] -> [a]
++ String
"': glob '" forall a. [a] -> [a] -> [a]
++ String
glob
    forall a. [a] -> [a] -> [a]
++ String
"' starts at project root directory, this might "
    forall a. [a] -> [a] -> [a]
++ String
"include `.git/`, ``dist-newstyle/``, or other large directories!"
ppExplanation (InvalidOnWin [String]
paths) =
    String
"The " forall a. [a] -> [a] -> [a]
++ [String] -> String
quotes [String]
paths forall a. [a] -> [a] -> [a]
++ String
" invalid on Windows, which "
      forall a. [a] -> [a] -> [a]
++ String
"would cause portability problems for this package. Windows file "
      forall a. [a] -> [a] -> [a]
++ String
"names cannot contain any of the characters \":*?<>|\" and there "
      forall a. [a] -> [a] -> [a]
++ String
"a few reserved names including \"aux\", \"nul\", \"con\", "
      forall a. [a] -> [a] -> [a]
++ String
"\"prn\", \"com1-9\", \"lpt1-9\" and \"clock$\"."
  where quotes :: [String] -> String
quotes [String
failed] = String
"path " forall a. [a] -> [a] -> [a]
++ ShowS
quote String
failed forall a. [a] -> [a] -> [a]
++ String
" is"
        quotes [String]
failed = String
"paths " forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map ShowS
quote [String]
failed)
                          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 "
      forall a. [a] -> [a] -> [a]
++ String
"format tar archive. The maximum length is 255 ASCII characters.\n"
      forall a. [a] -> [a] -> [a]
++ String
"The file in question is:\n  " 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 "
      forall a. [a] -> [a] -> [a]
++ String
"format tar archive. The maximum length for the name part (including "
      forall a. [a] -> [a] -> [a]
++ String
"extension) is 100 ASCII characters. The maximum length for any "
      forall a. [a] -> [a] -> [a]
++ String
"individual directory component is 155.\n"
      forall a. [a] -> [a] -> [a]
++ String
"The file in question is:\n  " 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 "
      forall a. [a] -> [a] -> [a]
++ String
"format tar archive. While the total length is less than 255 ASCII "
      forall a. [a] -> [a] -> [a]
++ String
"characters, there are unfortunately further restrictions. It has to "
      forall a. [a] -> [a] -> [a]
++ String
"be possible to split the file path on a directory separator into "
      forall a. [a] -> [a] -> [a]
++ String
"two parts such that the first part fits in 155 characters or less "
      forall a. [a] -> [a] -> [a]
++ String
"and the second part fits in 100 characters or less. Basically you "
      forall a. [a] -> [a] -> [a]
++ String
"have to make the file name or directory names shorter, or you could "
      forall a. [a] -> [a] -> [a]
++ String
"split a long directory name into nested subdirectories with shorter "
      forall a. [a] -> [a] -> [a]
++ String
"names.\nThe file in question is:\n  " forall a. [a] -> [a] -> [a]
++ String
path
ppExplanation CheckExplanation
FilePathEmpty =
    String
"Encountered a file with an empty name, something is very wrong! "
      forall a. [a] -> [a] -> [a]
++ String
"Files with an empty name cannot be stored in a tar archive or in "
      forall a. [a] -> [a] -> [a]
++ String
"standard file systems."
ppExplanation CheckExplanation
CVTestSuite =
    String
"The 'test-suite' section is new in Cabal 1.10. "
      forall a. [a] -> [a] -> [a]
++ String
"Unfortunately it messes up the parser in older Cabal versions "
      forall a. [a] -> [a] -> [a]
++ String
"so you must specify at least 'cabal-version: >= 1.8', but note "
      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 "
      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' "
      forall a. [a] -> [a] -> [a]
++ String
"must specify the 'default-language' field for each component (e.g. "
      forall a. [a] -> [a] -> [a]
++ String
"Haskell98 or Haskell2010). If a component uses different languages "
      forall a. [a] -> [a] -> [a]
++ String
"in different modules then list the other ones in the "
      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 "
      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 "
      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 "
      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 "
      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"
      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 "
      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' "
      forall a. [a] -> [a] -> [a]
++ String
"field is deprecated. The new 'default-extensions' field lists "
      forall a. [a] -> [a] -> [a]
++ String
"extensions that are used in all modules in the component, while "
      forall a. [a] -> [a] -> [a]
++ String
"the 'other-extensions' field lists extensions that are used in "
      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' "
      forall a. [a] -> [a] -> [a]
++ String
" and 'extra-library-flavours' requires the package "
      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 "
      forall a. [a] -> [a] -> [a]
++ String
" to specify at least 'cabal-version: 3.0'. The flavours are: "
      forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String]]
flavs)
ppExplanation CheckExplanation
CVVirtualModules =
    String
"The use of 'virtual-modules' requires the package "
      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. "
      forall a. [a] -> [a] -> [a]
++ String
"Unfortunately it messes up the parser in earlier Cabal versions "
      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 "
      forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep (forall a b. (a -> b) -> [a] -> [b]
map (ShowS
quote forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> String
prettyShow) [Extension]
extCab12)
      forall a. [a] -> [a] -> [a]
++ String
" break the parser in earlier Cabal versions so you need to "
      forall a. [a] -> [a] -> [a]
++ String
"specify 'cabal-version: >= " forall a. [a] -> [a] -> [a]
++ CabalSpecVersion -> String
showCabalSpecVersion CabalSpecVersion
version
      forall a. [a] -> [a] -> [a]
++ String
"'. Alternatively if you require compatibility with earlier "
      forall a. [a] -> [a] -> [a]
++ String
"Cabal versions then you may be able to use an equivalent "
      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' "
      forall a. [a] -> [a] -> [a]
++ String
"must use a 'custom-setup' section with a 'setup-depends' field "
      forall a. [a] -> [a] -> [a]
++ String
"that specifies the dependencies of the Setup.hs script itself. "
      forall a. [a] -> [a] -> [a]
++ String
"The 'setup-depends' field uses the same syntax as 'build-depends', "
      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 "
      forall a. [a] -> [a] -> [a]
++ String
"for Custom setup scripts. Consider using 'cabal-version: 1.24' or "
      forall a. [a] -> [a] -> [a]
++ String
"higher and adding a 'custom-setup' section with a 'setup-depends' "
      forall a. [a] -> [a] -> [a]
++ String
"field that specifies the dependencies of the Setup.hs script "
      forall a. [a] -> [a] -> [a]
++ String
"itself. The 'setup-depends' field uses the same syntax as "
      forall a. [a] -> [a] -> [a]
++ String
"'build-depends', so a simple example would be 'setup-depends: base, "
      forall a. [a] -> [a] -> [a]
++ String
"Cabal'."
ppExplanation CheckExplanation
CVAutogenPaths =
    String
"Packages using 'cabal-version: 2.0' and the autogenerated "
      forall a. [a] -> [a] -> [a]
++ String
"module Paths_* must include it also on the 'autogen-modules' field "
      forall a. [a] -> [a] -> [a]
++ String
"besides 'exposed-modules' and 'other-modules'. This specifies that "
      forall a. [a] -> [a] -> [a]
++ String
"the module does not come with the package and is generated on "
      forall a. [a] -> [a] -> [a]
++ String
"setup. Modules built with a custom Setup.hs script also go here "
      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 "
      forall a. [a] -> [a] -> [a]
++ String
"module PackageInfo_* must include it in 'autogen-modules' as well as"
      forall a. [a] -> [a] -> [a]
++ String
" 'exposed-modules' and 'other-modules'. This specifies that "
      forall a. [a] -> [a] -> [a]
++ String
"the module does not come with the package and is generated on "
      forall a. [a] -> [a] -> [a]
++ String
"setup. Modules built with a custom Setup.hs script also go here "
      forall a. [a] -> [a] -> [a]
++ String
"to ensure that commands like sdist don't fail."
ppExplanation (GlobNoMatch String
field String
glob) =
    String
"In '" forall a. [a] -> [a] -> [a]
++ String
field forall a. [a] -> [a] -> [a]
++ String
"': the pattern '" forall a. [a] -> [a] -> [a]
++ String
glob forall a. [a] -> [a] -> [a]
++ String
"' does not"
      forall a. [a] -> [a] -> [a]
++ String
" match any files."
ppExplanation (GlobExactMatch String
field String
glob String
file) =
    String
"In '" forall a. [a] -> [a] -> [a]
++ String
field forall a. [a] -> [a] -> [a]
++ String
"': the pattern '" forall a. [a] -> [a] -> [a]
++ String
glob forall a. [a] -> [a] -> [a]
++ String
"' does not"
      forall a. [a] -> [a] -> [a]
++ String
" match the file '" forall a. [a] -> [a] -> [a]
++ String
file forall a. [a] -> [a] -> [a]
++ String
"' because the extensions do not"
      forall a. [a] -> [a] -> [a]
++ String
" exactly match (e.g., foo.en.html does not exactly match *.html)."
      forall a. [a] -> [a] -> [a]
++ String
" To enable looser suffix-only matching, set 'cabal-version: 2.4' or"
      forall a. [a] -> [a] -> [a]
++ String
" higher."
ppExplanation (GlobNoDir String
field String
glob String
dir) =
    String
"In '" forall a. [a] -> [a] -> [a]
++ String
field forall a. [a] -> [a] -> [a]
++ String
"': the pattern '" forall a. [a] -> [a] -> [a]
++ String
glob forall a. [a] -> [a] -> [a]
++ String
"' attempts to"
      forall a. [a] -> [a] -> [a]
++ String
" match files in the directory '" forall a. [a] -> [a] -> [a]
++ String
dir forall a. [a] -> [a] -> [a]
++ String
"', but there is no"
      forall a. [a] -> [a] -> [a]
++ String
" directory by that name."
ppExplanation (UnknownOS [String]
unknownOSs) =
    String
"Unknown operating system name " forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep (forall a b. (a -> b) -> [a] -> [b]
map ShowS
quote [String]
unknownOSs)
ppExplanation (UnknownArch [String]
unknownArches) =
    String
"Unknown architecture name " forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep (forall a b. (a -> b) -> [a] -> [b]
map ShowS
quote [String]
unknownArches)
ppExplanation (UnknownCompiler [String]
unknownImpls) =
    String
"Unknown compiler name " forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep (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:" forall a. [a] -> [a] -> [a]
++ String
separator
      forall a. [a] -> [a] -> [a]
++ (forall a. [a] -> [[a]] -> [a]
intercalate String
separator (PackageName -> String
unPackageName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PackageName]
names)) forall a. [a] -> [a] -> [a]
++ String
"\n"
      forall a. [a] -> [a] -> [a]
++  String
"Please add them, using `cabal gen-bounds` for suggestions."
      forall a. [a] -> [a] -> [a]
++ String
" For more information see: "
      forall a. [a] -> [a] -> [a]
++ String
" https://pvp.haskell.org/"
ppExplanation CheckExplanation
BaseNoUpperBounds =
    String
"The dependency 'build-depends: base' does not specify an upper "
      forall a. [a] -> [a] -> [a]
++ String
"bound on the version number. Each major release of the 'base' "
      forall a. [a] -> [a] -> [a]
++ String
"package changes the API in various ways and most packages will "
      forall a. [a] -> [a] -> [a]
++ String
"need some changes to compile with it. The recommended practice "
      forall a. [a] -> [a] -> [a]
++ String
"is to specify an upper bound on the version of the 'base' "
      forall a. [a] -> [a] -> [a]
++ String
"package. This ensures your package will continue to build when a "
      forall a. [a] -> [a] -> [a]
++ String
"new major version of the 'base' package is released. If you are "
      forall a. [a] -> [a] -> [a]
++ String
"not sure what upper bound to use then use the next  major "
      forall a. [a] -> [a] -> [a]
++ String
"version. For example if you have tested your package with 'base' "
      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: " forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
invalidFlagNames forall a. [a] -> [a] -> [a]
++ String
". "
      forall a. [a] -> [a] -> [a]
++ String
"To avoid ambiguity in command line interfaces, flag shouldn't "
      forall a. [a] -> [a] -> [a]
++ String
"start with a dash. Also for better compatibility, flag names "
      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: "
      forall a. [a] -> [a] -> [a]
++ Set FlagName -> String
s Set FlagName
declared forall a. [a] -> [a] -> [a]
++ String
" /= " forall a. [a] -> [a] -> [a]
++ Set FlagName -> String
s Set FlagName
used forall a. [a] -> [a] -> [a]
++ String
". "
  where s :: Set.Set FlagName -> String
        s :: Set FlagName -> String
s = [String] -> String
commaSep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map FlagName -> String
unFlagName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> [a]
Set.toList
ppExplanation (NonASCIICustomField [String]
nonAsciiXFields) =
    String
"Non ascii custom fields: " forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
nonAsciiXFields forall a. [a] -> [a] -> [a]
++ String
". "
      forall a. [a] -> [a] -> [a]
++ String
"For better compatibility, custom field names "
      forall a. [a] -> [a] -> [a]
++ String
"shouldn't contain non-ascii characters."
ppExplanation CheckExplanation
RebindableClashPaths =
    String
"Packages using RebindableSyntax with OverloadedStrings or"
      forall a. [a] -> [a] -> [a]
++ String
" OverloadedLists in default-extensions, in conjunction with the"
      forall a. [a] -> [a] -> [a]
++ String
" autogenerated module Paths_*, are known to cause compile failures"
      forall a. [a] -> [a] -> [a]
++ String
" with Cabal < 2.2. To use these default-extensions with a Paths_*"
      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"
      forall a. [a] -> [a] -> [a]
++ String
" OverloadedLists in default-extensions, in conjunction with the"
      forall a. [a] -> [a] -> [a]
++ String
" autogenerated module PackageInfo_*, are known to cause compile failures"
      forall a. [a] -> [a] -> [a]
++ String
" with Cabal < 2.2. To use these default-extensions with a PackageInfo_*"
      forall a. [a] -> [a] -> [a]
++ String
" autogen module, specify at least 'cabal-version: 2.2'."
ppExplanation (WErrorUnneeded String
fieldName) = ShowS
addConditionalExp forall a b. (a -> b) -> a -> b
$
    String
"'" forall a. [a] -> [a] -> [a]
++ String
fieldName forall a. [a] -> [a] -> [a]
++ String
": -Werror' makes the package easy to "
      forall a. [a] -> [a] -> [a]
++ String
"break with future GHC versions because new GHC versions often "
      forall a. [a] -> [a] -> [a]
++ String
"add new warnings."
ppExplanation (JUnneeded String
fieldName) = ShowS
addConditionalExp forall a b. (a -> b) -> a -> b
$
    String
"'" forall a. [a] -> [a] -> [a]
++ String
fieldName forall a. [a] -> [a] -> [a]
++ String
": -j[N]' can make sense for specific user's setup,"
      forall a. [a] -> [a] -> [a]
++ String
" but it is not appropriate for a distributed package."
ppExplanation (FDeferTypeErrorsUnneeded String
fieldName) = ShowS
addConditionalExp forall a b. (a -> b) -> a -> b
$
    String
"'" forall a. [a] -> [a] -> [a]
++ String
fieldName forall a. [a] -> [a] -> [a]
++ String
": -fdefer-type-errors' is fine during development "
      forall a. [a] -> [a] -> [a]
++ String
"but is not appropriate for a distributed package."
ppExplanation (DynamicUnneeded String
fieldName) = ShowS
addConditionalExp forall a b. (a -> b) -> a -> b
$
    String
"'" forall a. [a] -> [a] -> [a]
++ String
fieldName forall a. [a] -> [a] -> [a]
++ String
": -d*' debug flags are not appropriate "
      forall a. [a] -> [a] -> [a]
++ String
"for a distributed package."
ppExplanation (ProfilingUnneeded String
fieldName) = ShowS
addConditionalExp forall a b. (a -> b) -> a -> b
$
    String
"'" forall a. [a] -> [a] -> [a]
++ String
fieldName forall a. [a] -> [a] -> [a]
++ String
": -fprof*' profiling flags are typically not "
      forall a. [a] -> [a] -> [a]
++ String
"appropriate for a distributed library package. These flags are "
      forall a. [a] -> [a] -> [a]
++ String
"useful to profile this package, but when profiling other packages "
      forall a. [a] -> [a] -> [a]
++ String
"that use this one these flags clutter the profile output with "
      forall a. [a] -> [a] -> [a]
++ String
"excessive detail. If you think other packages really want to see "
      forall a. [a] -> [a] -> [a]
++ String
"cost centres from this package then use '-fprof-auto-exported' "
      forall a. [a] -> [a] -> [a]
++ String
"which puts cost centres only on exported functions."
ppExplanation (UpperBoundSetup String
nm) =
    String
"The dependency 'setup-depends: '"forall a. [a] -> [a] -> [a]
++String
nmforall a. [a] -> [a] -> [a]
++String
"' does not specify an "
      forall a. [a] -> [a] -> [a]
++ String
"upper bound on the version number. Each major release of the "
      forall a. [a] -> [a] -> [a]
++ String
"'"forall a. [a] -> [a] -> [a]
++String
nmforall a. [a] -> [a] -> [a]
++String
"' package changes the API in various ways and most "
      forall a. [a] -> [a] -> [a]
++ String
"packages will need some changes to compile with it. If you are "
      forall a. [a] -> [a] -> [a]
++ String
"not sure what upper bound to use then use the next major "
      forall a. [a] -> [a] -> [a]
++ String
"version."
ppExplanation (DuplicateModule String
s [ModuleName]
dupLibsLax) =
    String
"Duplicate modules in " forall a. [a] -> [a] -> [a]
++ String
s forall a. [a] -> [a] -> [a]
++ String
": "
      forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> String
prettyShow [ModuleName]
dupLibsLax)
ppExplanation (PotentialDupModule String
s [ModuleName]
dupLibsStrict) =
    String
"Potential duplicate modules (subject to conditionals) in " forall a. [a] -> [a] -> [a]
++ String
s
      forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> String
prettyShow [ModuleName]
dupLibsStrict)
ppExplanation (BOMStart String
pdfile) =
    String
pdfile forall a. [a] -> [a] -> [a]
++ String
" starts with an Unicode byte order mark (BOM)."
      forall a. [a] -> [a] -> [a]
++ String
" This may cause problems with older cabal versions."
ppExplanation (NotPackageName String
pdfile String
expectedCabalname) =
    String
"The filename " forall a. [a] -> [a] -> [a]
++ ShowS
quote String
pdfile forall a. [a] -> [a] -> [a]
++ String
" does not match package name "
      forall a. [a] -> [a] -> [a]
++ String
"(expected: " forall a. [a] -> [a] -> [a]
++ ShowS
quote String
expectedCabalname forall a. [a] -> [a] -> [a]
++ String
")"
ppExplanation CheckExplanation
NoDesc =
    String
"No cabal file found.\n"
      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"
      forall a. [a] -> [a] -> [a]
++ String
"Please use only one of: "
      forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String]
multiple
ppExplanation (UnknownFile String
fieldname SymbolicPath PackageDir LicenseFile
file) =
    String
"The '" forall a. [a] -> [a] -> [a]
++ String
fieldname forall a. [a] -> [a] -> [a]
++ String
"' field refers to the file "
      forall a. [a] -> [a] -> [a]
++ ShowS
quote (forall from to. SymbolicPath from to -> String
getSymbolicPath SymbolicPath PackageDir LicenseFile
file) 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. "
      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 forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ String
dir)
      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 "
      forall a. [a] -> [a] -> [a]
++ String
"control information in the .cabal file using one or more "
      forall a. [a] -> [a] -> [a]
++ String
"'source-repository' sections. See the Cabal user guide for "
      forall a. [a] -> [a] -> [a]
++ String
"details."
ppExplanation (MissingExpectedDocFiles Bool
extraDocFileSupport [String]
paths) =
    String
"Please consider including the " forall a. [a] -> [a] -> [a]
++ [String] -> String
quotes [String]
paths
      forall a. [a] -> [a] -> [a]
++ String
" in the '" forall a. [a] -> [a] -> [a]
++ String
targetField forall a. [a] -> [a] -> [a]
++ String
"' section of the .cabal file "
      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 " forall a. [a] -> [a] -> [a]
++ ShowS
quote String
p
        quotes [String]
ps = String
"files " forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate 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 " forall a. [a] -> [a] -> [a]
++ [String] -> String
quotes [String]
paths
      forall a. [a] -> [a] -> [a]
++ String
" from the '" forall a. [a] -> [a] -> [a]
++ String
field forall a. [a] -> [a] -> [a]
++ String
"' section of the .cabal file "
      forall a. [a] -> [a] -> [a]
++ String
"to the section '" forall a. [a] -> [a] -> [a]
++ String
targetField forall a. [a] -> [a] -> [a]
++ String
"'."
  where quotes :: [String] -> String
quotes [String
p] = String
"file " forall a. [a] -> [a] -> [a]
++ ShowS
quote String
p
        quotes [String]
ps = String
"files " forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PackageCheck -> PackageCheck -> Bool
$c/= :: PackageCheck -> PackageCheck -> Bool
== :: PackageCheck -> PackageCheck -> Bool
$c== :: PackageCheck -> PackageCheck -> Bool
Eq, Eq 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
min :: PackageCheck -> PackageCheck -> PackageCheck
$cmin :: PackageCheck -> PackageCheck -> PackageCheck
max :: PackageCheck -> PackageCheck -> PackageCheck
$cmax :: PackageCheck -> PackageCheck -> PackageCheck
>= :: PackageCheck -> PackageCheck -> Bool
$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
compare :: PackageCheck -> PackageCheck -> Ordering
$ccompare :: PackageCheck -> PackageCheck -> Ordering
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
_  = forall a. Maybe a
Nothing
check Bool
True  PackageCheck
pc = 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 forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
specver  = 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
  forall a. [a] -> [a] -> [a]
++ GenericPackageDescription -> [PackageCheck]
checkConditionals GenericPackageDescription
gpkg
  forall a. [a] -> [a] -> [a]
++ GenericPackageDescription -> [PackageCheck]
checkPackageVersions GenericPackageDescription
gpkg
  forall a. [a] -> [a] -> [a]
++ GenericPackageDescription -> [PackageCheck]
checkDevelopmentOnlyFlags GenericPackageDescription
gpkg
  forall a. [a] -> [a] -> [a]
++ GenericPackageDescription -> [PackageCheck]
checkFlagNames GenericPackageDescription
gpkg
  forall a. [a] -> [a] -> [a]
++ GenericPackageDescription -> [PackageCheck]
checkUnusedFlags GenericPackageDescription
gpkg
  forall a. [a] -> [a] -> [a]
++ GenericPackageDescription -> [PackageCheck]
checkUnicodeXFields GenericPackageDescription
gpkg
  forall a. [a] -> [a] -> [a]
++ PackageDescription -> [PackageCheck]
checkPathsModuleExtensions PackageDescription
pkg
  forall a. [a] -> [a] -> [a]
++ PackageDescription -> [PackageCheck]
checkPackageInfoModuleExtensions PackageDescription
pkg
  forall a. [a] -> [a] -> [a]
++ GenericPackageDescription -> [PackageCheck]
checkSetupVersions GenericPackageDescription
gpkg
  forall a. [a] -> [a] -> [a]
++ GenericPackageDescription -> [PackageCheck]
checkDuplicateModules GenericPackageDescription
gpkg
  where
    pkg :: PackageDescription
pkg = 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
 forall a. [a] -> [a] -> [a]
++ PackageDescription -> [PackageCheck]
checkFields PackageDescription
pkg
 forall a. [a] -> [a] -> [a]
++ PackageDescription -> [PackageCheck]
checkLicense PackageDescription
pkg
 forall a. [a] -> [a] -> [a]
++ PackageDescription -> [PackageCheck]
checkSourceRepos PackageDescription
pkg
 forall a. [a] -> [a] -> [a]
++ PackageDescription -> [PackageCheck]
checkAllGhcOptions PackageDescription
pkg
 forall a. [a] -> [a] -> [a]
++ PackageDescription -> [PackageCheck]
checkCCOptions PackageDescription
pkg
 forall a. [a] -> [a] -> [a]
++ PackageDescription -> [PackageCheck]
checkCxxOptions PackageDescription
pkg
 forall a. [a] -> [a] -> [a]
++ PackageDescription -> [PackageCheck]
checkCPPOptions PackageDescription
pkg
 forall a. [a] -> [a] -> [a]
++ PackageDescription -> [PackageCheck]
checkPaths PackageDescription
pkg
 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 =
  forall a. [Maybe a] -> [a]
catMaybes [

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

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

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

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

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [UnqualComponentName]
duplicateNames)) 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 (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => a -> a -> Bool
== forall a. Pretty a => a -> String
prettyShow (forall pkg. Package pkg => pkg -> PackageName
packageName PackageDescription
pkg))
               (forall a. Pretty a => a -> String
prettyShow forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [UnqualComponentName]
subLibNames)) 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.

  forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (PackageDescription -> Library -> [PackageCheck]
checkLibrary    PackageDescription
pkg) (PackageDescription -> [Library]
allLibraries PackageDescription
pkg)
  forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (PackageDescription -> Executable -> [PackageCheck]
checkExecutable PackageDescription
pkg) (PackageDescription -> [Executable]
executables PackageDescription
pkg)
  forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (PackageDescription -> TestSuite -> [PackageCheck]
checkTestSuite  PackageDescription
pkg) (PackageDescription -> [TestSuite]
testSuites PackageDescription
pkg)
  forall a. [a] -> [a] -> [a]
++ 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 = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (LibraryName -> Maybe UnqualComponentName
libraryNameString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library -> LibraryName
libName) forall a b. (a -> b) -> a -> b
$ PackageDescription -> [Library]
subLibraries PackageDescription
pkg
    exeNames :: [UnqualComponentName]
exeNames = forall a b. (a -> b) -> [a] -> [b]
map Executable -> UnqualComponentName
exeName forall a b. (a -> b) -> a -> b
$ PackageDescription -> [Executable]
executables PackageDescription
pkg
    testNames :: [UnqualComponentName]
testNames = forall a b. (a -> b) -> [a] -> [b]
map TestSuite -> UnqualComponentName
testName forall a b. (a -> b) -> a -> b
$ PackageDescription -> [TestSuite]
testSuites PackageDescription
pkg
    bmNames :: [UnqualComponentName]
bmNames = forall a b. (a -> b) -> [a] -> [b]
map Benchmark -> UnqualComponentName
benchmarkName forall a b. (a -> b) -> a -> b
$ PackageDescription -> [Benchmark]
benchmarks PackageDescription
pkg
    duplicateNames :: [UnqualComponentName]
duplicateNames = forall a. Ord a => [a] -> [a]
dups forall a b. (a -> b) -> a -> b
$ [UnqualComponentName]
subLibNames forall a. [a] -> [a] -> [a]
++ [UnqualComponentName]
exeNames forall a. [a] -> [a] -> [a]
++ [UnqualComponentName]
testNames forall a. [a] -> [a] -> [a]
++ [UnqualComponentName]
bmNames

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

  -- TODO: This check is bogus if a required-signature was passed through
    Bool -> PackageCheck -> Maybe PackageCheck
check (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Library -> [ModuleName]
explicitLibModules Library
lib) Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Library -> [ModuleReexport]
reexportedModules Library
lib)) 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 (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Library -> [ModuleName]
signatures Library
lib))) 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 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *). Foldable t => t Bool -> Bool
and forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (Library -> [ModuleName]
explicitLibModules Library
lib)) (Library -> [ModuleName]
libModulesAutogen Library
lib)) 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 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *). Foldable t => t Bool -> Bool
and forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (forall a. HasBuildInfo a => a -> [String]
allExplicitIncludes Library
lib)) (forall a s. Getting a s a -> s -> a
view forall a. HasBuildInfo a => Lens' a [String]
L.autogenIncludes Library
lib)) 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 forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
ver = 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 = forall a s. Getting a s a -> s -> a
view forall a. HasBuildInfo a => Lens' a [String]
L.includes a
x forall a. [a] -> [a] -> [a]
++ forall a s. Getting a s a -> s -> a
view forall a. HasBuildInfo a => Lens' a [String]
L.installIncludes a
x

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

    Bool -> PackageCheck -> Maybe PackageCheck
check (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Executable -> String
modulePath Executable
exe)) 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 forall a. Eq a => a -> a -> Bool
/= PackageIdentifier
fakePackageId
       Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Executable -> String
modulePath Executable
exe))
       Bool -> Bool -> Bool
&& Bool -> Bool
not (String -> Bool
fileExtensionSupportedLanguage forall a b. (a -> b) -> a -> b
$ Executable -> String
modulePath Executable
exe)) 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) forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String
".hs", String
".lhs"]) 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 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *). Foldable t => t Bool -> Bool
and forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (Executable -> [ModuleName]
exeModules Executable
exe)) (Executable -> [ModuleName]
exeModulesAutogen Executable
exe)) 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 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *). Foldable t => t Bool -> Bool
and forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (forall a s. Getting a s a -> s -> a
view forall a. HasBuildInfo a => Lens' a [String]
L.includes Executable
exe)) (forall a s. Getting a s a -> s -> a
view forall a. HasBuildInfo a => Lens' a [String]
L.autogenIncludes Executable
exe)) 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 =
  forall a. [Maybe a] -> [a]
catMaybes [

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

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

  , Bool -> PackageCheck -> Maybe PackageCheck
check Bool
mainIsWrongExt 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) 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 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *). Foldable t => t Bool -> Bool
and forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (TestSuite -> [ModuleName]
testModules TestSuite
test)) (TestSuite -> [ModuleName]
testModulesAutogen TestSuite
test)) 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 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *). Foldable t => t Bool -> Bool
and forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (forall a s. Getting a s a -> s -> a
view forall a. HasBuildInfo a => Lens' a [String]
L.includes TestSuite
test)) (forall a s. Getting a s a -> s -> a
view forall a. HasBuildInfo a => Lens' a [String]
L.autogenIncludes TestSuite
test)) 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 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 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 =
  forall a. [Maybe a] -> [a]
catMaybes [

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

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

  , Bool -> PackageCheck -> Maybe PackageCheck
check Bool
mainIsWrongExt 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 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *). Foldable t => t Bool -> Bool
and forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (Benchmark -> [ModuleName]
benchmarkModules Benchmark
bm)) (Benchmark -> [ModuleName]
benchmarkModulesAutogen Benchmark
bm)) 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 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *). Foldable t => t Bool -> Bool
and forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (forall a s. Getting a s a -> s -> a
view forall a. HasBuildInfo a => Lens' a [String]
L.includes Benchmark
bm)) (forall a s. Getting a s a -> s -> a
view forall a. HasBuildInfo a => Lens' a [String]
L.autogenIncludes Benchmark
bm)) 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 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 =
  forall a. [Maybe a] -> [a]
catMaybes [

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

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

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

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

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

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

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

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

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Extension, Maybe Extension)]
ourDeprecatedExtensions)) 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)) 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)) 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)) 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))) 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))) 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) forall a. Ord a => a -> a -> Bool
> Int
80) 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) forall a. Ord a => a -> a -> Bool
<= ShortText -> Int
ShortText.length (PackageDescription -> ShortText
synopsis PackageDescription
pkg)) 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 (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Dependency]
testedWithImpossibleRanges)) 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 (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Dependency]
depInternalLibraryWithImpossibleVersion)) 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 (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ExeDependency]
depInternalExecutableWithImpossibleVersion)) forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageBuildImpossible
        ([ExeDependency] -> CheckExplanation
ImpossibleInternalExe [ExeDependency]
depInternalExecutableWithImpossibleVersion)

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ExeDependency]
depMissingInternalExecutable)) 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> String
prettyShow [Language]
knownLanguages ]
    ourDeprecatedExtensions :: [(Extension, Maybe Extension)]
ourDeprecatedExtensions = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes
      [ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Eq a => a -> a -> Bool
==Extension
ext) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> String
prettyShow [Language]
knownLanguages ]

    testedWithImpossibleRanges :: [Dependency]
testedWithImpossibleRanges =
      [ PackageName
-> VersionRange -> NonEmptySet LibraryName -> Dependency
Dependency (String -> PackageName
mkPackageName (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 =
        forall a b. (a -> b) -> [a] -> [b]
map (forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall pkg. Package pkg => pkg -> PackageName
packageName PackageDescription
pkg) UnqualComponentName -> PackageName
unqualComponentNameToPackageName forall b c a. (b -> c) -> (a -> b) -> a -> c
. LibraryName -> Maybe UnqualComponentName
libraryNameString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library -> LibraryName
libName)
            (PackageDescription -> [Library]
allLibraries PackageDescription
pkg)

    internalExecutables :: [UnqualComponentName]
internalExecutables = forall a b. (a -> b) -> [a] -> [b]
map Executable -> UnqualComponentName
exeName 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 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 forall a b. (a -> b) -> a -> b
$ 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 forall a b. (a -> b) -> a -> b
$ 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 forall a b. (a -> b) -> a -> b
$ UnqualComponentName
eName 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 = forall a. [Maybe a] -> [a]
catMaybes
    [ Bool -> PackageCheck -> Maybe PackageCheck
check (License
lic forall a. Eq a => a -> a -> Bool
== License
SPDX.NONE) 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 = forall a. [Maybe a] -> [a]
catMaybes
  [ Bool -> PackageCheck -> Maybe PackageCheck
check (License
lic forall a. Eq a => a -> a -> Bool
== License
UnspecifiedLicense) forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistInexcusable CheckExplanation
NoLicense

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

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

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

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

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

  , Bool -> PackageCheck -> Maybe PackageCheck
check (License
lic 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
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null (PackageDescription -> [SymbolicPath PackageDir LicenseFile]
licenseFiles PackageDescription
pkg)) forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistSuspicious CheckExplanation
NoLicenseFile
  ]
  where
    unknownLicenseVersion :: License -> Maybe [Version]
unknownLicenseVersion (GPL  (Just Version
v))
      | Version
v forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Version]
knownVersions = 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Version]
knownVersions = 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Version]
knownVersions = 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Version]
knownVersions = forall a. a -> Maybe a
Just [Version]
knownVersions
      where knownVersions :: [Version]
knownVersions = [ Version
v' | Apache  (Just Version
v') <- [License]
knownLicenses ]
    unknownLicenseVersion License
_ = 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 forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
ver  = forall a. Maybe a
Nothing
      | Bool
otherwise               = Bool -> PackageCheck -> Maybe PackageCheck
check Bool
cond PackageCheck
pc

    compatLicenses :: [License]
compatLicenses = [ Maybe Version -> License
GPL forall a. Maybe a
Nothing, Maybe Version -> License
LGPL forall a. Maybe a
Nothing, Maybe Version -> License
AGPL 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 =
  forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[

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

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

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

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

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

  , Bool -> PackageCheck -> Maybe PackageCheck
check (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False String -> Bool
isAbsoluteOnAnyPlatform (SourceRepo -> Maybe String
repoSubdir SourceRepo
repo)) 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
      forall (m :: * -> *) a. Monad m => a -> m a
return 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
 forall a. [a] -> [a] -> [a]
++ String
-> (BuildInfo -> [String]) -> PackageDescription -> [PackageCheck]
checkGhcOptions String
"ghc-prof-options" (CompilerFlavor -> BuildInfo -> [String]
hcProfOptions CompilerFlavor
GHC) PackageDescription
pkg
 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 =
  forall a. [Maybe a] -> [a]
catMaybes [

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

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

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

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

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

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

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

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

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

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

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

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

  , [String] -> PackageCheck -> Maybe PackageCheck
checkFlags [String
"-split-objs"] 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"] forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistInexcusable (String -> CheckExplanation
OptWls String
fieldName)

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

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

  , Bool -> PackageCheck -> Maybe PackageCheck
check (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\String
opt -> String
"-with-rtsopts" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
opt) [String]
lib_ghc_options) 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, 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" forall a b. (a -> b) -> a -> b
$
         [ (String
flag, String
flag) | flag :: String
flag@(Char
'-':Char
'D':String
_) <- [String]
ghc_options_no_rtsopts ]
      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) <-
           forall a b. [a] -> [b] -> [(a, b)]
zip [String]
ghc_options_no_rtsopts (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) <-
           forall a b. [a] -> [b] -> [(a, b)]
zip [String]
ghc_options_no_rtsopts (forall a. [a] -> [a]
safeTail [String]
ghc_options_no_rtsopts) ]
  ]

  where
    all_ghc_options :: [String]
all_ghc_options    = 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    = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (BuildInfo -> [String]
getOptions 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      = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (BuildInfo -> [String]
getOptions 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 = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (BuildInfo -> [String]
getOptions 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 forall a. [a] -> [a] -> [a]
++
                                         [String]
benchmark_ghc_options
    non_test_and_benchmark_ghc_options :: [String]
non_test_and_benchmark_ghc_options = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap BuildInfo -> [String]
getOptions
                                         (PackageDescription -> [BuildInfo]
allBuildInfo (PackageDescription
pkg { testSuites :: [TestSuite]
testSuites = []
                                                            , benchmarks :: [Benchmark]
benchmarks = []
                                                            }))

    checkFlags :: [String] -> PackageCheck -> Maybe PackageCheck
    checkFlags :: [String] -> PackageCheck -> Maybe PackageCheck
checkFlags [String]
flags = Bool -> PackageCheck -> Maybe PackageCheck
check (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (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 (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (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 (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (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
_                                -> forall a. Maybe a
Nothing
    ghcExtension String
"-cpp"             = KnownExtension -> Maybe Extension
enable KnownExtension
CPP
    ghcExtension String
_                  = forall a. Maybe a
Nothing

    enable :: KnownExtension -> Maybe Extension
enable  KnownExtension
e = forall a. a -> Maybe a
Just (KnownExtension -> Extension
EnableExtension KnownExtension
e)
    disable :: KnownExtension -> Maybe Extension
disable KnownExtension
e = 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 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 =
  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" ] 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 (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (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 = 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 ]
    ]
    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 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (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 (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
badFlags)) 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]
_) = forall a b. [(a, b)] -> ([a], [b])
unzip [(String, String)]
flags

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

checkPaths :: PackageDescription -> [PackageCheck]
checkPaths :: PackageDescription -> [PackageCheck]
checkPaths PackageDescription
pkg =
  [(Bool, String)] -> [PackageCheck]
checkPackageFileNamesWithGlob
  [ (PathKind
kind forall a. Eq a => a -> a -> Bool
== PathKind
PathKindGlob, String
path)
  | (String
path, String
_, PathKind
kind) <- [(String, String, PathKind)]
relPaths forall a. [a] -> [a] -> [a]
++ [(String, String, PathKind)]
absPaths
  ]
  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 forall a. [a] -> [a] -> [a]
++ [(String, String, PathKind)]
absPaths
  , String -> Bool
isOutsideTree String
path ]
  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 ]
  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 <- forall a. Maybe a -> [a]
maybeToList 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
  ]
  forall a. [a] -> [a] -> [a]
++
  [ CheckExplanation -> PackageCheck
PackageDistInexcusable forall a b. (a -> b) -> a -> b
$ Maybe String -> String -> CheckExplanation
DistPoint (forall a. a -> Maybe a
Just String
field) String
path
  | (String
path, String
field, PathKind
_) <- [(String, String, PathKind)]
relPaths forall a. [a] -> [a] -> [a]
++ [(String, String, PathKind)]
absPaths
  , String -> Bool
isInsideDist String
path ]
  forall a. [a] -> [a] -> [a]
++
  [ CheckExplanation -> PackageCheck
PackageDistInexcusable (Maybe String -> String -> CheckExplanation
DistPoint forall a. Maybe a
Nothing String
path)
  | BuildInfo
bi <- PackageDescription -> [BuildInfo]
allBuildInfo PackageDescription
pkg
  , (CompilerFlavor
GHC, [String]
flags) <- forall v. PerCompilerFlavor v -> [(CompilerFlavor, v)]
perCompilerFlavorToList forall a b. (a -> b) -> a -> b
$ BuildInfo -> PerCompilerFlavor [String]
options BuildInfo
bi
  , String
path <- [String]
flags
  , String -> Bool
isInsideDist String
path ]
  forall a. [a] -> [a] -> [a]
++
  [ CheckExplanation -> PackageCheck
PackageDistInexcusable 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) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Either GlobSyntaxError Glob]
globsDataFiles forall a b. (a -> b) -> a -> b
$ PackageDescription -> [String]
dataFiles PackageDescription
pkg
  ]
  forall a. [a] -> [a] -> [a]
++
  [ CheckExplanation -> PackageCheck
PackageDistInexcusable
      (String -> String -> CheckExplanation
GlobSyntaxError String
"extra-source-files" (String -> GlobSyntaxError -> String
explainGlobSyntaxError String
pat GlobSyntaxError
err))
  | (Left GlobSyntaxError
err, String
pat) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Either GlobSyntaxError Glob]
globsExtraSrcFiles forall a b. (a -> b) -> a -> b
$ PackageDescription -> [String]
extraSrcFiles PackageDescription
pkg
  ]
  forall a. [a] -> [a] -> [a]
++
  [ CheckExplanation -> PackageCheck
PackageDistInexcusable forall a b. (a -> b) -> a -> b
$
      String -> String -> CheckExplanation
GlobSyntaxError String
"extra-doc-files" (String -> GlobSyntaxError -> String
explainGlobSyntaxError String
pat GlobSyntaxError
err)
  | (Left GlobSyntaxError
err, String
pat) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Either GlobSyntaxError Glob]
globsExtraDocFiles forall a b. (a -> b) -> a -> b
$ PackageDescription -> [String]
extraDocFiles PackageDescription
pkg
  ]
  forall a. [a] -> [a] -> [a]
++
  [ CheckExplanation -> PackageCheck
PackageDistSuspiciousWarn forall a b. (a -> b) -> a -> b
$
      String -> String -> CheckExplanation
RecursiveGlobInRoot String
"data-files" String
pat
  | (Right Glob
glob, String
pat) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Either GlobSyntaxError Glob]
globsDataFiles forall a b. (a -> b) -> a -> b
$ PackageDescription -> [String]
dataFiles PackageDescription
pkg
  , Glob -> Bool
isRecursiveInRoot Glob
glob
  ]
  forall a. [a] -> [a] -> [a]
++
  [ CheckExplanation -> PackageCheck
PackageDistSuspiciousWarn forall a b. (a -> b) -> a -> b
$
      String -> String -> CheckExplanation
RecursiveGlobInRoot String
"extra-source-files" String
pat
  | (Right Glob
glob, String
pat) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Either GlobSyntaxError Glob]
globsExtraSrcFiles forall a b. (a -> b) -> a -> b
$ PackageDescription -> [String]
extraSrcFiles PackageDescription
pkg
  , Glob -> Bool
isRecursiveInRoot Glob
glob
  ]
  forall a. [a] -> [a] -> [a]
++
  [ CheckExplanation -> PackageCheck
PackageDistSuspiciousWarn forall a b. (a -> b) -> a -> b
$
      String -> String -> CheckExplanation
RecursiveGlobInRoot String
"extra-doc-files" String
pat
  | (Right Glob
glob, String
pat) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Either GlobSyntaxError Glob]
globsExtraDocFiles forall a b. (a -> b) -> a -> b
$ PackageDescription -> [String]
extraDocFiles PackageDescription
pkg
  , Glob -> Bool
isRecursiveInRoot Glob
glob
  ]
  where
    isOutsideTree :: String -> Bool
isOutsideTree String
path = case String -> [String]
splitDirectories String
path of
      String
"..":[String]
_     -> Bool
True
      String
".":String
"..":[String]
_ -> Bool
True
      [String]
_          -> Bool
False
    isInsideDist :: String -> Bool
isInsideDist String
path = case forall a b. (a -> b) -> [a] -> [b]
map ShowS
lowercase (String -> [String]
splitDirectories String
path) of
      String
"dist"    :[String]
_ -> Bool
True
      String
".":String
"dist":[String]
_ -> Bool
True
      [String]
_            -> Bool
False

    -- paths that must be relative
    relPaths :: [(FilePath, String, PathKind)]
    relPaths :: [(String, String, PathKind)]
relPaths =
      [ (String
path, String
"extra-source-files", PathKind
PathKindGlob)      | String
path <- PackageDescription -> [String]
extraSrcFiles PackageDescription
pkg ] forall a. [a] -> [a] -> [a]
++
      [ (String
path, String
"extra-tmp-files",    PathKind
PathKindFile)      | String
path <- PackageDescription -> [String]
extraTmpFiles PackageDescription
pkg ] forall a. [a] -> [a] -> [a]
++
      [ (String
path, String
"extra-doc-files",    PathKind
PathKindGlob)      | String
path <- PackageDescription -> [String]
extraDocFiles PackageDescription
pkg ] forall a. [a] -> [a] -> [a]
++
      [ (String
path, String
"data-files",         PathKind
PathKindGlob)      | String
path <- PackageDescription -> [String]
dataFiles     PackageDescription
pkg ] forall a. [a] -> [a] -> [a]
++
      [ (String
path, String
"data-dir",           PathKind
PathKindDirectory) | String
path <- [PackageDescription -> String
dataDir      PackageDescription
pkg]] forall a. [a] -> [a] -> [a]
++
      [ (String
path, String
"license-file",       PathKind
PathKindFile)      | String
path <- forall a b. (a -> b) -> [a] -> [b]
map forall from to. SymbolicPath from to -> String
getSymbolicPath forall a b. (a -> b) -> a -> b
$ PackageDescription -> [SymbolicPath PackageDir LicenseFile]
licenseFiles  PackageDescription
pkg ] forall a. [a] -> [a] -> [a]
++
      forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ [ (String
path, String
"asm-sources",      PathKind
PathKindFile)      | String
path <- BuildInfo -> [String]
asmSources      BuildInfo
bi ] forall a. [a] -> [a] -> [a]
++
          [ (String
path, String
"cmm-sources",      PathKind
PathKindFile)      | String
path <- BuildInfo -> [String]
cmmSources      BuildInfo
bi ] forall a. [a] -> [a] -> [a]
++
          [ (String
path, String
"c-sources",        PathKind
PathKindFile)      | String
path <- BuildInfo -> [String]
cSources        BuildInfo
bi ] forall a. [a] -> [a] -> [a]
++
          [ (String
path, String
"cxx-sources",      PathKind
PathKindFile)      | String
path <- BuildInfo -> [String]
cxxSources      BuildInfo
bi ] forall a. [a] -> [a] -> [a]
++
          [ (String
path, String
"js-sources",       PathKind
PathKindFile)      | String
path <- BuildInfo -> [String]
jsSources       BuildInfo
bi ] forall a. [a] -> [a] -> [a]
++
          [ (String
path, String
"install-includes", PathKind
PathKindFile)      | String
path <- BuildInfo -> [String]
installIncludes BuildInfo
bi ] forall a. [a] -> [a] -> [a]
++
          [ (String
path, String
"hs-source-dirs",   PathKind
PathKindDirectory) | String
path <- forall a b. (a -> b) -> [a] -> [b]
map forall from to. SymbolicPath from to -> String
getSymbolicPath forall a b. (a -> b) -> a -> b
$ BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
bi ]
        | BuildInfo
bi <- PackageDescription -> [BuildInfo]
allBuildInfo PackageDescription
pkg
        ]

    -- paths that are allowed to be absolute
    absPaths :: [(FilePath, String, PathKind)]
    absPaths :: [(String, String, PathKind)]
absPaths = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [ [ (String
path, String
"includes",       PathKind
PathKindFile)      | String
path <- BuildInfo -> [String]
includes     BuildInfo
bi ] forall a. [a] -> [a] -> [a]
++
        [ (String
path, String
"include-dirs",   PathKind
PathKindDirectory) | String
path <- BuildInfo -> [String]
includeDirs  BuildInfo
bi ] forall a. [a] -> [a] -> [a]
++
        [ (String
path, String
"extra-lib-dirs", PathKind
PathKindDirectory) | String
path <- BuildInfo -> [String]
extraLibDirs BuildInfo
bi ] forall a. [a] -> [a] -> [a]
++
        [ (String
path, String
"extra-lib-dirs-static", PathKind
PathKindDirectory) | String
path <- BuildInfo -> [String]
extraLibDirsStatic BuildInfo
bi ]
      | BuildInfo
bi <- PackageDescription -> [BuildInfo]
allBuildInfo PackageDescription
pkg
      ]
    globsDataFiles :: [Either GlobSyntaxError Glob]
    globsDataFiles :: [Either GlobSyntaxError Glob]
globsDataFiles =  CabalSpecVersion -> String -> Either GlobSyntaxError Glob
parseFileGlob (PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackageDescription -> [String]
dataFiles PackageDescription
pkg
    globsExtraSrcFiles :: [Either GlobSyntaxError Glob]
    globsExtraSrcFiles :: [Either GlobSyntaxError Glob]
globsExtraSrcFiles =  CabalSpecVersion -> String -> Either GlobSyntaxError Glob
parseFileGlob (PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackageDescription -> [String]
extraSrcFiles PackageDescription
pkg
    globsExtraDocFiles :: [Either GlobSyntaxError Glob]
    globsExtraDocFiles :: [Either GlobSyntaxError Glob]
globsExtraDocFiles =  CabalSpecVersion -> String -> Either GlobSyntaxError Glob
parseFileGlob (PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackageDescription -> [String]
extraDocFiles PackageDescription
pkg

--TODO: check sets of paths that would be interpreted differently between Unix
-- and windows, ie case-sensitive or insensitive. Things that might clash, or
-- conversely be distinguished.

--TODO: use the tar path checks on all the above paths

-- | Check that the package declares the version in the @\"cabal-version\"@
-- field correctly.
--
checkCabalVersion :: PackageDescription -> [PackageCheck]
checkCabalVersion :: PackageDescription -> [PackageCheck]
checkCabalVersion PackageDescription
pkg =
  forall a. [Maybe a] -> [a]
catMaybes [

    -- check use of test suite sections
    CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkVersion CabalSpecVersion
CabalSpecV1_8 (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ PackageDescription -> [TestSuite]
testSuites PackageDescription
pkg)) forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistInexcusable CheckExplanation
CVTestSuite

    -- check use of default-language field
    -- note that we do not need to do an equivalent check for the
    -- other-language field since that one does not change behaviour
  , CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkVersion CabalSpecVersion
CabalSpecV1_10 (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall a. Maybe a -> Bool
isJust (forall {b}. (BuildInfo -> b) -> [b]
buildInfoField BuildInfo -> Maybe Language
defaultLanguage)) forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageBuildWarning CheckExplanation
CVDefaultLanguage

  , Bool -> PackageCheck -> Maybe PackageCheck
check (PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecV1_10 Bool -> Bool -> Bool
&& PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg forall a. Ord a => a -> a -> Bool
< CabalSpecVersion
CabalSpecV3_4
           Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall a. Maybe a -> Bool
isNothing (forall {b}. (BuildInfo -> b) -> [b]
buildInfoField BuildInfo -> Maybe Language
defaultLanguage)) forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageBuildWarning CheckExplanation
CVDefaultLanguageComponent

  , CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkVersion CabalSpecVersion
CabalSpecV1_18
    (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ PackageDescription -> [String]
extraDocFiles PackageDescription
pkg) forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistInexcusable CheckExplanation
CVExtraDocFiles

  , CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkVersion CabalSpecVersion
CabalSpecV2_0
    (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (PackageDescription -> [Library]
subLibraries PackageDescription
pkg))) forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistInexcusable CheckExplanation
CVMultiLib

    -- check use of reexported-modules sections
  , CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkVersion CabalSpecVersion
CabalSpecV1_22
    (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
notforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (t :: * -> *) a. Foldable t => t a -> Bool
nullforall b c a. (b -> c) -> (a -> b) -> a -> c
.Library -> [ModuleReexport]
reexportedModules) (PackageDescription -> [Library]
allLibraries PackageDescription
pkg)) forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistInexcusable CheckExplanation
CVReexported

    -- check use of thinning and renaming
  , CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkVersion CabalSpecVersion
CabalSpecV2_0 Bool
usesBackpackIncludes forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistInexcusable CheckExplanation
CVMixins

    -- check use of 'extra-framework-dirs' field
  , CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkVersion CabalSpecVersion
CabalSpecV1_24 (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) (forall {b}. (BuildInfo -> b) -> [b]
buildInfoField BuildInfo -> [String]
extraFrameworkDirs)) forall a b. (a -> b) -> a -> b
$
      -- Just a warning, because this won't break on old Cabal versions.
      CheckExplanation -> PackageCheck
PackageDistSuspiciousWarn CheckExplanation
CVExtraFrameworkDirs

    -- check use of default-extensions field
    -- don't need to do the equivalent check for other-extensions
  , CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkVersion CabalSpecVersion
CabalSpecV1_10 (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) (forall {b}. (BuildInfo -> b) -> [b]
buildInfoField BuildInfo -> [Extension]
defaultExtensions)) forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageBuildWarning CheckExplanation
CVDefaultExtensions

    -- check use of extensions field
  , Bool -> PackageCheck -> Maybe PackageCheck
check (PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecV1_10
           Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) (forall {b}. (BuildInfo -> b) -> [b]
buildInfoField BuildInfo -> [Extension]
oldExtensions)) forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageBuildWarning CheckExplanation
CVExtensionsDeprecated

  , CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkVersion CabalSpecVersion
CabalSpecV3_0 (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null)
                        (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {b}. (BuildInfo -> b) -> [b]
buildInfoField
                         [ BuildInfo -> [String]
asmSources
                         , BuildInfo -> [String]
cmmSources
                         , BuildInfo -> [String]
extraBundledLibs
                         , BuildInfo -> [String]
extraLibFlavours ])) forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistInexcusable CheckExplanation
CVSources

  , CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkVersion CabalSpecVersion
CabalSpecV3_0 (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) forall a b. (a -> b) -> a -> b
$ forall {b}. (BuildInfo -> b) -> [b]
buildInfoField BuildInfo -> [String]
extraDynLibFlavours) forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistInexcusable
        ([[String]] -> CheckExplanation
CVExtraDynamic forall a b. (a -> b) -> a -> b
$ forall {b}. (BuildInfo -> b) -> [b]
buildInfoField BuildInfo -> [String]
extraDynLibFlavours)

  , CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkVersion CabalSpecVersion
CabalSpecV2_2 (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null)
                        (forall {b}. (BuildInfo -> b) -> [b]
buildInfoField BuildInfo -> [ModuleName]
virtualModules)) forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistInexcusable CheckExplanation
CVVirtualModules

    -- check use of "source-repository" section
  , CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkVersion CabalSpecVersion
CabalSpecV1_6 (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (PackageDescription -> [SourceRepo]
sourceRepos PackageDescription
pkg))) forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistInexcusable CheckExplanation
CVSourceRepository

    -- check for new language extensions
  , CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkVersion CabalSpecVersion
CabalSpecV1_2 (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Extension]
mentionedExtensionsThatNeedCabal12)) forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistInexcusable
        (CabalSpecVersion -> [Extension] -> CheckExplanation
CVExtensions CabalSpecVersion
CabalSpecV1_2 [Extension]
mentionedExtensionsThatNeedCabal12)

  , CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkVersion CabalSpecVersion
CabalSpecV1_4 (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Extension]
mentionedExtensionsThatNeedCabal14)) forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistInexcusable
        (CabalSpecVersion -> [Extension] -> CheckExplanation
CVExtensions CabalSpecVersion
CabalSpecV1_4 [Extension]
mentionedExtensionsThatNeedCabal14)

  , Bool -> PackageCheck -> Maybe PackageCheck
check (PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecV1_24
           Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isNothing (PackageDescription -> Maybe SetupBuildInfo
setupBuildInfo PackageDescription
pkg)
           Bool -> Bool -> Bool
&& PackageDescription -> BuildType
buildType PackageDescription
pkg forall a. Eq a => a -> a -> Bool
== BuildType
Custom) forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageBuildWarning CheckExplanation
CVCustomSetup

  , Bool -> PackageCheck -> Maybe PackageCheck
check (PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg forall a. Ord a => a -> a -> Bool
< CabalSpecVersion
CabalSpecV1_24
           Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isNothing (PackageDescription -> Maybe SetupBuildInfo
setupBuildInfo PackageDescription
pkg)
           Bool -> Bool -> Bool
&& PackageDescription -> BuildType
buildType PackageDescription
pkg forall a. Eq a => a -> a -> Bool
== BuildType
Custom) forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistSuspiciousWarn CheckExplanation
CVExpliticDepsCustomSetup

  , Bool -> PackageCheck -> Maybe PackageCheck
check (PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecV2_0
           Bool -> Bool -> Bool
&& forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (PackageDescription -> ModuleName
autogenPathsModuleName PackageDescription
pkg) [ModuleName]
allModuleNames
           Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (PackageDescription -> ModuleName
autogenPathsModuleName PackageDescription
pkg) [ModuleName]
allModuleNamesAutogen) ) forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistInexcusable CheckExplanation
CVAutogenPaths

  , Bool -> PackageCheck -> Maybe PackageCheck
check (PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecV2_0
           Bool -> Bool -> Bool
&& forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (PackageDescription -> ModuleName
autogenPackageInfoModuleName PackageDescription
pkg) [ModuleName]
allModuleNames
           Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (PackageDescription -> ModuleName
autogenPackageInfoModuleName PackageDescription
pkg) [ModuleName]
allModuleNamesAutogen) ) forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistInexcusable CheckExplanation
CVAutogenPackageInfo

  ]
  where
    -- Perform a check on packages that use a version of the spec less than
    -- the version given. This is for cases where a new Cabal version adds
    -- a new feature and we want to check that it is not used prior to that
    -- version.
    checkVersion :: CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
    checkVersion :: CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkVersion CabalSpecVersion
ver Bool
cond PackageCheck
pc
      | PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
ver = forall a. Maybe a
Nothing
      | Bool
otherwise              = Bool -> PackageCheck -> Maybe PackageCheck
check Bool
cond PackageCheck
pc

    buildInfoField :: (BuildInfo -> b) -> [b]
buildInfoField BuildInfo -> b
field         = forall a b. (a -> b) -> [a] -> [b]
map BuildInfo -> b
field (PackageDescription -> [BuildInfo]
allBuildInfo PackageDescription
pkg)

    usesBackpackIncludes :: Bool
usesBackpackIncludes = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildInfo -> [Mixin]
mixins) (PackageDescription -> [BuildInfo]
allBuildInfo PackageDescription
pkg)

    mentionedExtensions :: [Extension]
mentionedExtensions = [ Extension
ext | BuildInfo
bi <- PackageDescription -> [BuildInfo]
allBuildInfo PackageDescription
pkg
                                , Extension
ext <- BuildInfo -> [Extension]
allExtensions BuildInfo
bi ]
    mentionedExtensionsThatNeedCabal12 :: [Extension]
mentionedExtensionsThatNeedCabal12 =
      forall a. Eq a => [a] -> [a]
nub (forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Extension]
compatExtensionsExtra) [Extension]
mentionedExtensions)

    -- As of Cabal-1.4 we can add new extensions without worrying about
    -- breaking old versions of cabal.
    mentionedExtensionsThatNeedCabal14 :: [Extension]
mentionedExtensionsThatNeedCabal14 =
      forall a. Eq a => [a] -> [a]
nub (forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Extension]
compatExtensions) [Extension]
mentionedExtensions)

    -- The known extensions in Cabal-1.2.3
    compatExtensions :: [Extension]
compatExtensions =
      forall a b. (a -> b) -> [a] -> [b]
map KnownExtension -> Extension
EnableExtension
      [ KnownExtension
OverlappingInstances, KnownExtension
UndecidableInstances, KnownExtension
IncoherentInstances
      , KnownExtension
RecursiveDo, KnownExtension
ParallelListComp, KnownExtension
MultiParamTypeClasses
      , KnownExtension
FunctionalDependencies, KnownExtension
Rank2Types
      , KnownExtension
RankNTypes, KnownExtension
PolymorphicComponents, KnownExtension
ExistentialQuantification
      , KnownExtension
ScopedTypeVariables, KnownExtension
ImplicitParams, KnownExtension
FlexibleContexts
      , KnownExtension
FlexibleInstances, KnownExtension
EmptyDataDecls, KnownExtension
CPP, KnownExtension
BangPatterns
      , KnownExtension
TypeSynonymInstances, KnownExtension
TemplateHaskell, KnownExtension
ForeignFunctionInterface
      , KnownExtension
Arrows, KnownExtension
Generics, KnownExtension
NamedFieldPuns, KnownExtension
PatternGuards
      , KnownExtension
GeneralizedNewtypeDeriving, KnownExtension
ExtensibleRecords, KnownExtension
RestrictedTypeSynonyms
      , KnownExtension
HereDocuments] forall a. [a] -> [a] -> [a]
++
      forall a b. (a -> b) -> [a] -> [b]
map KnownExtension -> Extension
DisableExtension
      [KnownExtension
MonomorphismRestriction, KnownExtension
ImplicitPrelude] forall a. [a] -> [a] -> [a]
++
      [Extension]
compatExtensionsExtra

    -- The extra known extensions in Cabal-1.2.3 vs Cabal-1.1.6
    -- (Cabal-1.1.6 came with ghc-6.6. Cabal-1.2 came with ghc-6.8)
    compatExtensionsExtra :: [Extension]
compatExtensionsExtra =
      forall a b. (a -> b) -> [a] -> [b]
map KnownExtension -> Extension
EnableExtension
      [ KnownExtension
KindSignatures, KnownExtension
MagicHash, KnownExtension
TypeFamilies, KnownExtension
StandaloneDeriving
      , KnownExtension
UnicodeSyntax, KnownExtension
PatternSignatures, KnownExtension
UnliftedFFITypes, KnownExtension
LiberalTypeSynonyms
      , KnownExtension
TypeOperators, KnownExtension
RecordWildCards, KnownExtension
RecordPuns, KnownExtension
DisambiguateRecordFields
      , KnownExtension
OverloadedStrings, KnownExtension
GADTs, KnownExtension
RelaxedPolyRec
      , KnownExtension
ExtendedDefaultRules, KnownExtension
UnboxedTuples, KnownExtension
DeriveDataTypeable
      , KnownExtension
ConstrainedClassMethods
      ] forall a. [a] -> [a] -> [a]
++
      forall a b. (a -> b) -> [a] -> [b]
map KnownExtension -> Extension
DisableExtension
      [KnownExtension
MonoPatBinds]

    allModuleNames :: [ModuleName]
allModuleNames =
         (case PackageDescription -> Maybe Library
library PackageDescription
pkg of
           Maybe Library
Nothing -> []
           (Just Library
lib) -> Library -> [ModuleName]
explicitLibModules Library
lib
         )
      forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap BuildInfo -> [ModuleName]
otherModules (PackageDescription -> [BuildInfo]
allBuildInfo PackageDescription
pkg)

    allModuleNamesAutogen :: [ModuleName]
allModuleNamesAutogen = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap BuildInfo -> [ModuleName]
autogenModules (PackageDescription -> [BuildInfo]
allBuildInfo PackageDescription
pkg)

-- ------------------------------------------------------------
-- * Checks on the GenericPackageDescription
-- ------------------------------------------------------------

-- | Check the build-depends fields for any weirdness or bad practice.
--
checkPackageVersions :: GenericPackageDescription -> [PackageCheck]
checkPackageVersions :: GenericPackageDescription -> [PackageCheck]
checkPackageVersions GenericPackageDescription
pkg =
  -- if others is empty,
  -- the error will still fire but listing no dependencies.
  -- so we have to check
  if forall (t :: * -> *) a. Foldable t => t a -> Int
length [PackageName]
others forall a. Ord a => a -> a -> Bool
> Int
0
  then
    CheckExplanation -> PackageCheck
PackageDistSuspiciousWarn ([PackageName] -> CheckExplanation
MissingUpperBounds [PackageName]
others) forall a. a -> [a] -> [a]
: [PackageCheck]
baseErrors
  else
    [PackageCheck]
baseErrors
  where
    baseErrors :: [PackageCheck]
baseErrors = CheckExplanation -> PackageCheck
PackageDistInexcusable CheckExplanation
BaseNoUpperBounds forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [PackageName]
bases
    deps :: Map PackageName VersionRange
deps = (PackageDescription -> [Dependency])
-> GenericPackageDescription -> Map PackageName VersionRange
toDependencyVersionsMap PackageDescription -> [Dependency]
allBuildDepends GenericPackageDescription
pkg
    -- base gets special treatment (it's more critical)
    ([PackageName]
bases, [PackageName]
others) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((String
"base" forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> String
unPackageName) forall a b. (a -> b) -> a -> b
$
      [ PackageName
name
      | (PackageName
name, VersionRange
vr) <- forall k a. Map k a -> [(k, a)]
Map.toList Map PackageName VersionRange
deps
      , Bool -> Bool
not (VersionRange -> Bool
hasUpperBound VersionRange
vr)
      ]

checkConditionals :: GenericPackageDescription -> [PackageCheck]
checkConditionals :: GenericPackageDescription -> [PackageCheck]
checkConditionals GenericPackageDescription
pkg =
  forall a. [Maybe a] -> [a]
catMaybes [

    Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
unknownOSs) forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistInexcusable ([String] -> CheckExplanation
UnknownOS [String]
unknownOSs)

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

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
unknownImpls) forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistInexcusable ([String] -> CheckExplanation
UnknownCompiler [String]
unknownImpls)
  ]
  where
    unknownOSs :: [String]
unknownOSs    = [ String
os   | OS   (OtherOS String
os)           <- [ConfVar]
conditions ]
    unknownArches :: [String]
unknownArches = [ String
arch | Arch (OtherArch String
arch)       <- [ConfVar]
conditions ]
    unknownImpls :: [String]
unknownImpls  = [ String
impl | Impl (OtherCompiler String
impl) VersionRange
_ <- [ConfVar]
conditions ]
    conditions :: [ConfVar]
conditions = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {b} {c} {a}. CondTree b c a -> [b]
fvs (forall a. Maybe a -> [a]
maybeToList (GenericPackageDescription
-> Maybe (CondTree ConfVar [Dependency] Library)
condLibrary GenericPackageDescription
pkg))
              forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall {b} {c} {a}. CondTree b c a -> [b]
fvs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
condSubLibraries GenericPackageDescription
pkg)
              forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall {b} {c} {a}. CondTree b c a -> [b]
fvs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (GenericPackageDescription
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] ForeignLib)]
condForeignLibs GenericPackageDescription
pkg)
              forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall {b} {c} {a}. CondTree b c a -> [b]
fvs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (GenericPackageDescription
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
condExecutables GenericPackageDescription
pkg)
              forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall {b} {c} {a}. CondTree b c a -> [b]
fvs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
condTestSuites GenericPackageDescription
pkg)
              forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall {b} {c} {a}. CondTree b c a -> [b]
fvs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
condBenchmarks GenericPackageDescription
pkg)
    fvs :: CondTree b c a -> [b]
fvs (CondNode a
_ c
_ [CondBranch b c a]
ifs) = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap CondBranch b c a -> [b]
compfv [CondBranch b c a]
ifs -- free variables
    compfv :: CondBranch b c a -> [b]
compfv (CondBranch Condition b
c CondTree b c a
ct Maybe (CondTree b c a)
mct) = forall {a}. Condition a -> [a]
condfv Condition b
c forall a. [a] -> [a] -> [a]
++ CondTree b c a -> [b]
fvs CondTree b c a
ct forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] CondTree b c a -> [b]
fvs Maybe (CondTree b c a)
mct
    condfv :: Condition a -> [a]
condfv Condition a
c = case Condition a
c of
      Var a
v      -> [a
v]
      Lit Bool
_      -> []
      CNot Condition a
c1    -> Condition a -> [a]
condfv Condition a
c1
      COr  Condition a
c1 Condition a
c2 -> Condition a -> [a]
condfv Condition a
c1 forall a. [a] -> [a] -> [a]
++ Condition a -> [a]
condfv Condition a
c2
      CAnd Condition a
c1 Condition a
c2 -> Condition a -> [a]
condfv Condition a
c1 forall a. [a] -> [a] -> [a]
++ Condition a -> [a]
condfv Condition a
c2

checkFlagNames :: GenericPackageDescription -> [PackageCheck]
checkFlagNames :: GenericPackageDescription -> [PackageCheck]
checkFlagNames GenericPackageDescription
gpd
    | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
invalidFlagNames = []
    | Bool
otherwise             =
        [ CheckExplanation -> PackageCheck
PackageDistInexcusable ([String] -> CheckExplanation
SuspiciousFlagName [String]
invalidFlagNames) ]
  where
    invalidFlagNames :: [String]
invalidFlagNames =
        [ String
fn
        | PackageFlag
flag <- GenericPackageDescription -> [PackageFlag]
genPackageFlags GenericPackageDescription
gpd
        , let fn :: String
fn = FlagName -> String
unFlagName (PackageFlag -> FlagName
flagName PackageFlag
flag)
        , String -> Bool
invalidFlagName String
fn
        ]
    -- starts with dash
    invalidFlagName :: String -> Bool
invalidFlagName (Char
'-':String
_) = Bool
True
    -- mon ascii letter
    invalidFlagName String
cs = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isAscii) String
cs

checkUnusedFlags :: GenericPackageDescription -> [PackageCheck]
checkUnusedFlags :: GenericPackageDescription -> [PackageCheck]
checkUnusedFlags GenericPackageDescription
gpd
    | Set FlagName
declared forall a. Eq a => a -> a -> Bool
== Set FlagName
used = []
    | Bool
otherwise        =
        [ CheckExplanation -> PackageCheck
PackageDistSuspicious (Set FlagName -> Set FlagName -> CheckExplanation
DeclaredUsedFlags Set FlagName
declared Set FlagName
used) ]
  where
    declared :: Set.Set FlagName
    declared :: Set FlagName
declared = forall a s. Getting (Set a) s a -> s -> Set a
toSetOf (Lens' GenericPackageDescription [PackageFlag]
L.genPackageFlags forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' PackageFlag FlagName
L.flagName) GenericPackageDescription
gpd

    used :: Set.Set FlagName
    used :: Set FlagName
used = forall a. Monoid a => [a] -> a
mconcat
        [ forall a s. Getting (Set a) s a -> s -> Set a
toSetOf (Lens'
  GenericPackageDescription
  (Maybe (CondTree ConfVar [Dependency] Library))
L.condLibrary      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v c a w. Traversal (CondTree v c a) (CondTree w c a) v w
traverseCondTreeV forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traversal' ConfVar FlagName
L._PackageFlag) GenericPackageDescription
gpd
        , forall a s. Getting (Set a) s a -> s -> Set a
toSetOf (Lens'
  GenericPackageDescription
  [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
L.condSubLibraries forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c a b. Lens (c, a) (c, b) a b
_2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v c a w. Traversal (CondTree v c a) (CondTree w c a) v w
traverseCondTreeV forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traversal' ConfVar FlagName
L._PackageFlag) GenericPackageDescription
gpd
        , forall a s. Getting (Set a) s a -> s -> Set a
toSetOf (Lens'
  GenericPackageDescription
  [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
L.condForeignLibs  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c a b. Lens (c, a) (c, b) a b
_2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v c a w. Traversal (CondTree v c a) (CondTree w c a) v w
traverseCondTreeV forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traversal' ConfVar FlagName
L._PackageFlag) GenericPackageDescription
gpd
        , forall a s. Getting (Set a) s a -> s -> Set a
toSetOf (Lens'
  GenericPackageDescription
  [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
L.condExecutables  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c a b. Lens (c, a) (c, b) a b
_2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v c a w. Traversal (CondTree v c a) (CondTree w c a) v w
traverseCondTreeV forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traversal' ConfVar FlagName
L._PackageFlag) GenericPackageDescription
gpd
        , forall a s. Getting (Set a) s a -> s -> Set a
toSetOf (Lens'
  GenericPackageDescription
  [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
L.condTestSuites   forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c a b. Lens (c, a) (c, b) a b
_2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v c a w. Traversal (CondTree v c a) (CondTree w c a) v w
traverseCondTreeV forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traversal' ConfVar FlagName
L._PackageFlag) GenericPackageDescription
gpd
        , forall a s. Getting (Set a) s a -> s -> Set a
toSetOf (Lens'
  GenericPackageDescription
  [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
L.condBenchmarks   forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c a b. Lens (c, a) (c, b) a b
_2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v c a w. Traversal (CondTree v c a) (CondTree w c a) v w
traverseCondTreeV forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traversal' ConfVar FlagName
L._PackageFlag) GenericPackageDescription
gpd
        ]

checkUnicodeXFields :: GenericPackageDescription -> [PackageCheck]
checkUnicodeXFields :: GenericPackageDescription -> [PackageCheck]
checkUnicodeXFields GenericPackageDescription
gpd
    | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
nonAsciiXFields = []
    | Bool
otherwise            =
        [ CheckExplanation -> PackageCheck
PackageDistInexcusable ([String] -> CheckExplanation
NonASCIICustomField [String]
nonAsciiXFields) ]
  where
    nonAsciiXFields :: [String]
    nonAsciiXFields :: [String]
nonAsciiXFields = [ String
n | (String
n, String
_) <- [(String, String)]
xfields, forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isAscii) String
n ]

    xfields :: [(String,String)]
    xfields :: [(String, String)]
xfields = forall a. DList a -> [a]
DList.runDList forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
        [ forall a s. Getting (DList a) s a -> s -> DList a
toDListOf (Lens' GenericPackageDescription PackageDescription
L.packageDescription forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' PackageDescription [(String, String)]
L.customFieldsPD forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse) GenericPackageDescription
gpd
        , forall a s. Getting (DList a) s a -> s -> DList a
toDListOf (forall a. HasBuildInfos a => Traversal' a BuildInfo
L.traverseBuildInfos forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasBuildInfo a => Lens' a [(String, String)]
L.customFieldsBI forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse) GenericPackageDescription
gpd
        ]

-- | cabal-version <2.2 + Paths_module + default-extensions: doesn't build.
checkPathsModuleExtensions :: PackageDescription -> [PackageCheck]
checkPathsModuleExtensions :: PackageDescription -> [PackageCheck]
checkPathsModuleExtensions = (PackageDescription -> ModuleName)
-> CheckExplanation -> PackageDescription -> [PackageCheck]
checkAutogenModuleExtensions PackageDescription -> ModuleName
autogenPathsModuleName CheckExplanation
RebindableClashPaths

-- | cabal-version <2.2 + PackageInfo_module + default-extensions: doesn't build.
checkPackageInfoModuleExtensions :: PackageDescription -> [PackageCheck]
checkPackageInfoModuleExtensions :: PackageDescription -> [PackageCheck]
checkPackageInfoModuleExtensions = (PackageDescription -> ModuleName)
-> CheckExplanation -> PackageDescription -> [PackageCheck]
checkAutogenModuleExtensions PackageDescription -> ModuleName
autogenPackageInfoModuleName CheckExplanation
RebindableClashPackageInfo

-- | cabal-version <2.2 + *_module + default-extensions: doesn't build.
checkAutogenModuleExtensions ::
  (PackageDescription -> ModuleName) ->
  CheckExplanation ->
  PackageDescription ->
  [PackageCheck]
checkAutogenModuleExtensions :: (PackageDescription -> ModuleName)
-> CheckExplanation -> PackageDescription -> [PackageCheck]
checkAutogenModuleExtensions PackageDescription -> ModuleName
autogenModuleName CheckExplanation
rebindableClashExplanation PackageDescription
pd
    | PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pd forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecV2_2 = []
    | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any BuildInfo -> Bool
checkBI (PackageDescription -> [BuildInfo]
allBuildInfo PackageDescription
pd) Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Library -> Bool
checkLib (PackageDescription -> [Library]
allLibraries PackageDescription
pd)
        = forall (m :: * -> *) a. Monad m => a -> m a
return (CheckExplanation -> PackageCheck
PackageBuildImpossible CheckExplanation
rebindableClashExplanation)
    | Bool
otherwise = []
  where
    mn :: ModuleName
mn = PackageDescription -> ModuleName
autogenModuleName PackageDescription
pd

    checkLib :: Library -> Bool
    checkLib :: Library -> Bool
checkLib Library
l = ModuleName
mn forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Library -> [ModuleName]
exposedModules Library
l Bool -> Bool -> Bool
&& forall {t :: * -> *}. Foldable t => t Extension -> Bool
checkExts (Library
l forall s a. s -> Getting a s a -> a
^. forall a. HasBuildInfo a => Lens' a [Extension]
L.defaultExtensions)

    checkBI :: BuildInfo -> Bool
    checkBI :: BuildInfo -> Bool
checkBI BuildInfo
bi =
        (ModuleName
mn forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` BuildInfo -> [ModuleName]
otherModules BuildInfo
bi Bool -> Bool -> Bool
|| ModuleName
mn forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` BuildInfo -> [ModuleName]
autogenModules BuildInfo
bi) Bool -> Bool -> Bool
&&
        forall {t :: * -> *}. Foldable t => t Extension -> Bool
checkExts (BuildInfo
bi forall s a. s -> Getting a s a -> a
^. forall a. HasBuildInfo a => Lens' a [Extension]
L.defaultExtensions)

    checkExts :: t Extension -> Bool
checkExts t Extension
exts = Extension
rebind forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t Extension
exts Bool -> Bool -> Bool
&& (Extension
strings forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t Extension
exts Bool -> Bool -> Bool
|| Extension
lists forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t Extension
exts)
      where
        rebind :: Extension
rebind  = KnownExtension -> Extension
EnableExtension KnownExtension
RebindableSyntax
        strings :: Extension
strings = KnownExtension -> Extension
EnableExtension KnownExtension
OverloadedStrings
        lists :: Extension
lists   = KnownExtension -> Extension
EnableExtension KnownExtension
OverloadedLists

-- | Checks GHC options from all ghc-*-options fields from the given BuildInfo
-- and reports flags that are OK during development process, but are
-- unacceptable in a distributed package
checkDevelopmentOnlyFlagsBuildInfo :: BuildInfo -> [PackageCheck]
checkDevelopmentOnlyFlagsBuildInfo :: BuildInfo -> [PackageCheck]
checkDevelopmentOnlyFlagsBuildInfo BuildInfo
bi =
    String -> [String] -> [PackageCheck]
checkDevelopmentOnlyFlagsOptions String
"ghc-options" (CompilerFlavor -> BuildInfo -> [String]
hcOptions CompilerFlavor
GHC BuildInfo
bi)
 forall a. [a] -> [a] -> [a]
++ String -> [String] -> [PackageCheck]
checkDevelopmentOnlyFlagsOptions String
"ghc-prof-options" (CompilerFlavor -> BuildInfo -> [String]
hcProfOptions CompilerFlavor
GHC BuildInfo
bi)
 forall a. [a] -> [a] -> [a]
++ String -> [String] -> [PackageCheck]
checkDevelopmentOnlyFlagsOptions String
"ghc-shared-options" (CompilerFlavor -> BuildInfo -> [String]
hcSharedOptions CompilerFlavor
GHC BuildInfo
bi)

-- | Checks the given list of flags belonging to the given field and reports
-- flags that are OK during development process, but are unacceptable in a
-- distributed package
checkDevelopmentOnlyFlagsOptions :: String -> [String] -> [PackageCheck]
checkDevelopmentOnlyFlagsOptions :: String -> [String] -> [PackageCheck]
checkDevelopmentOnlyFlagsOptions String
fieldName [String]
ghcOptions =
  forall a. [Maybe a] -> [a]
catMaybes [

    Bool -> PackageCheck -> Maybe PackageCheck
check Bool
has_Werror forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistInexcusable (String -> CheckExplanation
WErrorUnneeded String
fieldName)

  , Bool -> PackageCheck -> Maybe PackageCheck
check Bool
has_J forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistInexcusable (String -> CheckExplanation
JUnneeded String
fieldName)

  , [String] -> PackageCheck -> Maybe PackageCheck
checkFlags [String
"-fdefer-type-errors"] forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistInexcusable (String -> CheckExplanation
FDeferTypeErrorsUnneeded String
fieldName)

    -- -dynamic is not a debug flag
  , Bool -> PackageCheck -> Maybe PackageCheck
check (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\String
opt -> String
"-d" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
opt Bool -> Bool -> Bool
&& String
opt forall a. Eq a => a -> a -> Bool
/= String
"-dynamic")
           [String]
ghcOptions) forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistInexcusable (String -> CheckExplanation
DynamicUnneeded String
fieldName)

  , [String] -> PackageCheck -> Maybe PackageCheck
checkFlags [String
"-fprof-auto", String
"-fprof-auto-top", String
"-fprof-auto-calls",
               String
"-fprof-cafs", String
"-fno-prof-count-entries",
               String
"-auto-all", String
"-auto", String
"-caf-all"] forall a b. (a -> b) -> a -> b
$
      CheckExplanation -> PackageCheck
PackageDistSuspicious (String -> CheckExplanation
ProfilingUnneeded String
fieldName)
  ]
  where

    has_Werror :: Bool
has_Werror       = String
"-Werror" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
ghcOptions
    has_J :: Bool
has_J            = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any
                         (\String
o -> case String
o of
                           String
"-j"                -> Bool
True
                           (Char
'-' : Char
'j' : Char
d : String
_) -> Char -> Bool
isDigit Char
d
                           String
_                   -> Bool
False
                         )
                         [String]
ghcOptions
    checkFlags :: [String] -> PackageCheck -> Maybe PackageCheck
    checkFlags :: [String] -> PackageCheck -> Maybe PackageCheck
checkFlags [String]
flags = Bool -> PackageCheck -> Maybe PackageCheck
check (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
flags) [String]
ghcOptions)

checkDevelopmentOnlyFlags :: GenericPackageDescription -> [PackageCheck]
checkDevelopmentOnlyFlags :: GenericPackageDescription -> [PackageCheck]
checkDevelopmentOnlyFlags GenericPackageDescription
pkg =
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap BuildInfo -> [PackageCheck]
checkDevelopmentOnlyFlagsBuildInfo
              [ BuildInfo
bi
              | ([Condition ConfVar]
conditions, BuildInfo
bi) <- [([Condition ConfVar], BuildInfo)]
allConditionalBuildInfo
              , Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Condition ConfVar -> Bool
guardedByManualFlag [Condition ConfVar]
conditions) ]
  where
    guardedByManualFlag :: Condition ConfVar -> Bool
guardedByManualFlag = Condition ConfVar -> Bool
definitelyFalse

    -- We've basically got three-values logic here: True, False or unknown
    -- hence this pattern to propagate the unknown cases properly.
    definitelyFalse :: Condition ConfVar -> Bool
definitelyFalse (Var (PackageFlag FlagName
n)) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Bool -> Bool
not (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FlagName
n Map FlagName Bool
manualFlags)
    definitelyFalse (Var ConfVar
_)        = Bool
False
    definitelyFalse (Lit  Bool
b)       = Bool -> Bool
not Bool
b
    definitelyFalse (CNot Condition ConfVar
c)       = Condition ConfVar -> Bool
definitelyTrue Condition ConfVar
c
    definitelyFalse (COr  Condition ConfVar
c1 Condition ConfVar
c2)   = Condition ConfVar -> Bool
definitelyFalse Condition ConfVar
c1 Bool -> Bool -> Bool
&& Condition ConfVar -> Bool
definitelyFalse Condition ConfVar
c2
    definitelyFalse (CAnd Condition ConfVar
c1 Condition ConfVar
c2)   = Condition ConfVar -> Bool
definitelyFalse Condition ConfVar
c1 Bool -> Bool -> Bool
|| Condition ConfVar -> Bool
definitelyFalse Condition ConfVar
c2

    definitelyTrue :: Condition ConfVar -> Bool
definitelyTrue (Var (PackageFlag FlagName
n)) = forall a. a -> Maybe a -> a
fromMaybe Bool
False (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FlagName
n Map FlagName Bool
manualFlags)
    definitelyTrue (Var ConfVar
_)        = Bool
False
    definitelyTrue (Lit  Bool
b)       = Bool
b
    definitelyTrue (CNot Condition ConfVar
c)       = Condition ConfVar -> Bool
definitelyFalse Condition ConfVar
c
    definitelyTrue (COr  Condition ConfVar
c1 Condition ConfVar
c2)   = Condition ConfVar -> Bool
definitelyTrue Condition ConfVar
c1 Bool -> Bool -> Bool
|| Condition ConfVar -> Bool
definitelyTrue Condition ConfVar
c2
    definitelyTrue (CAnd Condition ConfVar
c1 Condition ConfVar
c2)   = Condition ConfVar -> Bool
definitelyTrue Condition ConfVar
c1 Bool -> Bool -> Bool
&& Condition ConfVar -> Bool
definitelyTrue Condition ConfVar
c2

    manualFlags :: Map FlagName Bool
manualFlags = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                    [ (PackageFlag -> FlagName
flagName PackageFlag
flag, PackageFlag -> Bool
flagDefault PackageFlag
flag)
                    | PackageFlag
flag <- GenericPackageDescription -> [PackageFlag]
genPackageFlags GenericPackageDescription
pkg
                    , PackageFlag -> Bool
flagManual PackageFlag
flag ]

    allConditionalBuildInfo :: [([Condition ConfVar], BuildInfo)]
    allConditionalBuildInfo :: [([Condition ConfVar], BuildInfo)]
allConditionalBuildInfo =
        forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b v c. (a -> b) -> CondTree v c a -> [([Condition v], b)]
collectCondTreePaths Library -> BuildInfo
libBuildInfo)
                  (forall a. Maybe a -> [a]
maybeToList (GenericPackageDescription
-> Maybe (CondTree ConfVar [Dependency] Library)
condLibrary GenericPackageDescription
pkg))

     forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b v c. (a -> b) -> CondTree v c a -> [([Condition v], b)]
collectCondTreePaths Library -> BuildInfo
libBuildInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
                  (GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
condSubLibraries GenericPackageDescription
pkg)

     forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b v c. (a -> b) -> CondTree v c a -> [([Condition v], b)]
collectCondTreePaths Executable -> BuildInfo
buildInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
                  (GenericPackageDescription
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
condExecutables GenericPackageDescription
pkg)

     forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b v c. (a -> b) -> CondTree v c a -> [([Condition v], b)]
collectCondTreePaths TestSuite -> BuildInfo
testBuildInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
                  (GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
condTestSuites GenericPackageDescription
pkg)

     forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b v c. (a -> b) -> CondTree v c a -> [([Condition v], b)]
collectCondTreePaths Benchmark -> BuildInfo
benchmarkBuildInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
                  (GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
condBenchmarks GenericPackageDescription
pkg)

    -- get all the leaf BuildInfo, paired up with the path (in the tree sense)
    -- of if-conditions that guard it
    collectCondTreePaths :: (a -> b)
                         -> CondTree v c a
                         -> [([Condition v], b)]
    collectCondTreePaths :: forall a b v c. (a -> b) -> CondTree v c a -> [([Condition v], b)]
collectCondTreePaths a -> b
mapData = forall {v} {c}.
[Condition v] -> CondTree v c a -> [([Condition v], b)]
go []
      where
        go :: [Condition v] -> CondTree v c a -> [([Condition v], b)]
go [Condition v]
conditions CondTree v c a
condNode =
            -- the data at this level in the tree:
            (forall a. [a] -> [a]
reverse [Condition v]
conditions, a -> b
mapData (forall v c a. CondTree v c a -> a
condTreeData CondTree v c a
condNode))

          forall a. a -> [a] -> [a]
: forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ [Condition v] -> CondTree v c a -> [([Condition v], b)]
go (Condition v
conditionforall a. a -> [a] -> [a]
:[Condition v]
conditions) CondTree v c a
ifThen
            | (CondBranch Condition v
condition CondTree v c a
ifThen Maybe (CondTree v c a)
_) <- forall v c a. CondTree v c a -> [CondBranch v c a]
condTreeComponents CondTree v c a
condNode ]

         forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ [Condition v] -> CondTree v c a -> [([Condition v], b)]
go (Condition v
conditionforall a. a -> [a] -> [a]
:[Condition v]
conditions) CondTree v c a
elseThen
            | (CondBranch Condition v
condition CondTree v c a
_ (Just CondTree v c a
elseThen)) <- forall v c a. CondTree v c a -> [CondBranch v c a]
condTreeComponents CondTree v c a
condNode ]


-- ------------------------------------------------------------
-- * Checks involving files in the package
-- ------------------------------------------------------------

-- | Sanity check things that requires IO. It looks at the files in the
-- package and expects to find the package unpacked in at the given file path.
--
checkPackageFiles :: Verbosity -> PackageDescription -> FilePath -> IO [PackageCheck]
checkPackageFiles :: Verbosity -> PackageDescription -> String -> IO [PackageCheck]
checkPackageFiles Verbosity
verbosity PackageDescription
pkg String
root = do
  [PackageCheck]
contentChecks <- forall (m :: * -> *).
(Monad m, Applicative m) =>
CheckPackageContentOps m -> PackageDescription -> m [PackageCheck]
checkPackageContent CheckPackageContentOps IO
checkFilesIO PackageDescription
pkg
  [PackageCheck]
preDistributionChecks <- Verbosity -> PackageDescription -> String -> IO [PackageCheck]
checkPackageFilesPreDistribution Verbosity
verbosity PackageDescription
pkg String
root
  -- Sort because different platforms will provide files from
  -- `getDirectoryContents` in different orders, and we'd like to be
  -- stable for test output.
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Ord a => [a] -> [a]
sort [PackageCheck]
contentChecks forall a. [a] -> [a] -> [a]
++ forall a. Ord a => [a] -> [a]
sort [PackageCheck]
preDistributionChecks)
  where
    checkFilesIO :: CheckPackageContentOps IO
checkFilesIO = CheckPackageContentOps {
      doesFileExist :: String -> IO Bool
doesFileExist        = String -> IO Bool
System.doesFileExist                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
relative,
      doesDirectoryExist :: String -> IO Bool
doesDirectoryExist   = String -> IO Bool
System.doesDirectoryExist             forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
relative,
      getDirectoryContents :: String -> IO [String]
getDirectoryContents = String -> IO [String]
System.Directory.getDirectoryContents forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
relative,
      getFileContents :: String -> IO ByteString
getFileContents      = String -> IO ByteString
BS.readFile                           forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
relative
    }
    relative :: ShowS
relative String
path = String
root String -> ShowS
</> String
path

-- | A record of operations needed to check the contents of packages.
-- Used by 'checkPackageContent'.
--
data CheckPackageContentOps m = CheckPackageContentOps {
    forall (m :: * -> *). CheckPackageContentOps m -> String -> m Bool
doesFileExist        :: FilePath -> m Bool,
    forall (m :: * -> *). CheckPackageContentOps m -> String -> m Bool
doesDirectoryExist   :: FilePath -> m Bool,
    forall (m :: * -> *).
CheckPackageContentOps m -> String -> m [String]
getDirectoryContents :: FilePath -> m [FilePath],
    forall (m :: * -> *).
CheckPackageContentOps m -> String -> m ByteString
getFileContents      :: FilePath -> m BS.ByteString
  }

-- | Sanity check things that requires looking at files in the package.
-- This is a generalised version of 'checkPackageFiles' that can work in any
-- monad for which you can provide 'CheckPackageContentOps' operations.
--
-- The point of this extra generality is to allow doing checks in some virtual
-- file system, for example a tarball in memory.
--
checkPackageContent :: (Monad m, Applicative m)
                    => CheckPackageContentOps m
                    -> PackageDescription
                    -> m [PackageCheck]
checkPackageContent :: forall (m :: * -> *).
(Monad m, Applicative m) =>
CheckPackageContentOps m -> PackageDescription -> m [PackageCheck]
checkPackageContent CheckPackageContentOps m
ops PackageDescription
pkg = do
  Maybe PackageCheck
cabalBomError   <- forall (m :: * -> *).
Monad m =>
CheckPackageContentOps m -> m (Maybe PackageCheck)
checkCabalFileBOM    CheckPackageContentOps m
ops
  Maybe PackageCheck
cabalNameError  <- forall (m :: * -> *).
Monad m =>
CheckPackageContentOps m
-> PackageDescription -> m (Maybe PackageCheck)
checkCabalFileName   CheckPackageContentOps m
ops PackageDescription
pkg
  [PackageCheck]
licenseErrors   <- forall (m :: * -> *).
(Monad m, Applicative m) =>
CheckPackageContentOps m -> PackageDescription -> m [PackageCheck]
checkLicensesExist   CheckPackageContentOps m
ops PackageDescription
pkg
  Maybe PackageCheck
setupError      <- forall (m :: * -> *).
Monad m =>
CheckPackageContentOps m
-> PackageDescription -> m (Maybe PackageCheck)
checkSetupExists     CheckPackageContentOps m
ops PackageDescription
pkg
  Maybe PackageCheck
configureError  <- forall (m :: * -> *).
Monad m =>
CheckPackageContentOps m
-> PackageDescription -> m (Maybe PackageCheck)
checkConfigureExists CheckPackageContentOps m
ops PackageDescription
pkg
  [PackageCheck]
localPathErrors <- forall (m :: * -> *).
Monad m =>
CheckPackageContentOps m -> PackageDescription -> m [PackageCheck]
checkLocalPathsExist CheckPackageContentOps m
ops PackageDescription
pkg
  [PackageCheck]
vcsLocation     <- forall (m :: * -> *).
(Monad m, Applicative m) =>
CheckPackageContentOps m -> PackageDescription -> m [PackageCheck]
checkMissingVcsInfo  CheckPackageContentOps m
ops PackageDescription
pkg

  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [PackageCheck]
licenseErrors
        forall a. [a] -> [a] -> [a]
++ forall a. [Maybe a] -> [a]
catMaybes [Maybe PackageCheck
cabalBomError, Maybe PackageCheck
cabalNameError, Maybe PackageCheck
setupError, Maybe PackageCheck
configureError]
        forall a. [a] -> [a] -> [a]
++ [PackageCheck]
localPathErrors
        forall a. [a] -> [a] -> [a]
++ [PackageCheck]
vcsLocation

checkCabalFileBOM :: Monad m => CheckPackageContentOps m
                  -> m (Maybe PackageCheck)
checkCabalFileBOM :: forall (m :: * -> *).
Monad m =>
CheckPackageContentOps m -> m (Maybe PackageCheck)
checkCabalFileBOM CheckPackageContentOps m
ops = do
  Either PackageCheck String
epdfile <- forall (m :: * -> *).
Monad m =>
CheckPackageContentOps m -> m (Either PackageCheck String)
findPackageDesc CheckPackageContentOps m
ops
  case Either PackageCheck String
epdfile of
    -- MASSIVE HACK.  If the Cabal file doesn't exist, that is
    -- a very strange situation to be in, because the driver code
    -- in 'Distribution.Setup' ought to have noticed already!
    -- But this can be an issue, see #3552 and also when
    -- --cabal-file is specified.  So if you can't find the file,
    -- just don't bother with this check.
    Left PackageCheck
_       -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    Right String
pdfile -> (forall a b c. (a -> b -> c) -> b -> a -> c
flip Bool -> PackageCheck -> Maybe PackageCheck
check PackageCheck
pc forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> Bool
BS.isPrefixOf ByteString
bomUtf8)
                    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall (m :: * -> *).
CheckPackageContentOps m -> String -> m ByteString
getFileContents CheckPackageContentOps m
ops String
pdfile
      where pc :: PackageCheck
pc = CheckExplanation -> PackageCheck
PackageDistInexcusable (String -> CheckExplanation
BOMStart String
pdfile)

  where
    bomUtf8 :: BS.ByteString
    bomUtf8 :: ByteString
bomUtf8 = [Word8] -> ByteString
BS.pack [Word8
0xef,Word8
0xbb,Word8
0xbf] -- U+FEFF encoded as UTF8

checkCabalFileName :: Monad m => CheckPackageContentOps m
                 -> PackageDescription
                 -> m (Maybe PackageCheck)
checkCabalFileName :: forall (m :: * -> *).
Monad m =>
CheckPackageContentOps m
-> PackageDescription -> m (Maybe PackageCheck)
checkCabalFileName CheckPackageContentOps m
ops PackageDescription
pkg = do
  -- findPackageDesc already takes care to detect missing/multiple
  -- .cabal files; we don't include this check in 'findPackageDesc' in
  -- order not to short-cut other checks which call 'findPackageDesc'
  Either PackageCheck String
epdfile <- forall (m :: * -> *).
Monad m =>
CheckPackageContentOps m -> m (Either PackageCheck String)
findPackageDesc CheckPackageContentOps m
ops
  case Either PackageCheck String
epdfile of
    -- see "MASSIVE HACK" note in 'checkCabalFileBOM'
    Left PackageCheck
_       -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    Right String
pdfile
      | ShowS
takeFileName String
pdfile forall a. Eq a => a -> a -> Bool
== String
expectedCabalname -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
      | Bool
otherwise -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ CheckExplanation -> PackageCheck
PackageDistInexcusable
                       (String -> String -> CheckExplanation
NotPackageName String
pdfile String
expectedCabalname)
  where
    pkgname :: String
pkgname = PackageName -> String
unPackageName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pkg. Package pkg => pkg -> PackageName
packageName forall a b. (a -> b) -> a -> b
$ PackageDescription
pkg
    expectedCabalname :: String
expectedCabalname = String
pkgname String -> ShowS
<.> String
"cabal"


-- |Find a package description file in the given directory.  Looks for
-- @.cabal@ files.  Like 'Distribution.Simple.Utils.findPackageDesc',
-- but generalized over monads.
findPackageDesc :: Monad m => CheckPackageContentOps m
                 -> m (Either PackageCheck FilePath) -- ^<pkgname>.cabal
findPackageDesc :: forall (m :: * -> *).
Monad m =>
CheckPackageContentOps m -> m (Either PackageCheck String)
findPackageDesc CheckPackageContentOps m
ops
 = do let dir :: String
dir = String
"."
      [String]
files <- forall (m :: * -> *).
CheckPackageContentOps m -> String -> m [String]
getDirectoryContents CheckPackageContentOps m
ops String
dir
      -- to make sure we do not mistake a ~/.cabal/ dir for a <pkgname>.cabal
      -- file we filter to exclude dirs and null base file names:
      [String]
cabalFiles <- forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (forall (m :: * -> *). CheckPackageContentOps m -> String -> m Bool
doesFileExist CheckPackageContentOps m
ops)
                       [ String
dir String -> ShowS
</> String
file
                       | String
file <- [String]
files
                       , let (String
name, String
ext) = String -> (String, String)
splitExtension String
file
                       , Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
name) Bool -> Bool -> Bool
&& String
ext forall a. Eq a => a -> a -> Bool
== String
".cabal" ]
      case [String]
cabalFiles of
        []          -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ CheckExplanation -> PackageCheck
PackageBuildImpossible CheckExplanation
NoDesc)
        [String
cabalFile] -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right String
cabalFile)
        [String]
multiple    -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ CheckExplanation -> PackageCheck
PackageBuildImpossible
                                ([String] -> CheckExplanation
MultiDesc [String]
multiple))

checkLicensesExist :: (Monad m, Applicative m)
                   => CheckPackageContentOps m
                   -> PackageDescription
                   -> m [PackageCheck]
checkLicensesExist :: forall (m :: * -> *).
(Monad m, Applicative m) =>
CheckPackageContentOps m -> PackageDescription -> m [PackageCheck]
checkLicensesExist CheckPackageContentOps m
ops PackageDescription
pkg = do
    [Bool]
exists <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *). CheckPackageContentOps m -> String -> m Bool
doesFileExist CheckPackageContentOps m
ops forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall from to. SymbolicPath from to -> String
getSymbolicPath) (PackageDescription -> [SymbolicPath PackageDir LicenseFile]
licenseFiles PackageDescription
pkg)
    forall (m :: * -> *) a. Monad m => a -> m a
return
      [ CheckExplanation -> PackageCheck
PackageBuildWarning (String -> SymbolicPath PackageDir LicenseFile -> CheckExplanation
UnknownFile String
fieldname SymbolicPath PackageDir LicenseFile
file)
      | (SymbolicPath PackageDir LicenseFile
file, Bool
False) <- forall a b. [a] -> [b] -> [(a, b)]
zip (PackageDescription -> [SymbolicPath PackageDir LicenseFile]
licenseFiles PackageDescription
pkg) [Bool]
exists ]
  where
    fieldname :: String
fieldname | forall (t :: * -> *) a. Foldable t => t a -> Int
length (PackageDescription -> [SymbolicPath PackageDir LicenseFile]
licenseFiles PackageDescription
pkg) forall a. Eq a => a -> a -> Bool
== Int
1 = String
"license-file"
              | Bool
otherwise                      = String
"license-files"

checkSetupExists :: Monad m => CheckPackageContentOps m
                 -> PackageDescription
                 -> m (Maybe PackageCheck)
checkSetupExists :: forall (m :: * -> *).
Monad m =>
CheckPackageContentOps m
-> PackageDescription -> m (Maybe PackageCheck)
checkSetupExists CheckPackageContentOps m
ops PackageDescription
pkg = do
  let simpleBuild :: Bool
simpleBuild = PackageDescription -> BuildType
buildType PackageDescription
pkg forall a. Eq a => a -> a -> Bool
== BuildType
Simple
  Bool
hsexists  <- forall (m :: * -> *). CheckPackageContentOps m -> String -> m Bool
doesFileExist CheckPackageContentOps m
ops String
"Setup.hs"
  Bool
lhsexists <- forall (m :: * -> *). CheckPackageContentOps m -> String -> m Bool
doesFileExist CheckPackageContentOps m
ops String
"Setup.lhs"
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not Bool
simpleBuild Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
hsexists Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
lhsexists) forall a b. (a -> b) -> a -> b
$
    CheckExplanation -> PackageCheck
PackageDistInexcusable CheckExplanation
MissingSetupFile

checkConfigureExists :: Monad m => CheckPackageContentOps m
                     -> PackageDescription
                     -> m (Maybe PackageCheck)
checkConfigureExists :: forall (m :: * -> *).
Monad m =>
CheckPackageContentOps m
-> PackageDescription -> m (Maybe PackageCheck)
checkConfigureExists CheckPackageContentOps m
ops PackageDescription
pd
  | PackageDescription -> BuildType
buildType PackageDescription
pd forall a. Eq a => a -> a -> Bool
== BuildType
Configure = do
      Bool
exists <- forall (m :: * -> *). CheckPackageContentOps m -> String -> m Bool
doesFileExist CheckPackageContentOps m
ops String
"configure"
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not Bool
exists) forall a b. (a -> b) -> a -> b
$
        CheckExplanation -> PackageCheck
PackageBuildWarning CheckExplanation
MissingConfigureScript
  | Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

checkLocalPathsExist :: Monad m => CheckPackageContentOps m
                     -> PackageDescription
                     -> m [PackageCheck]
checkLocalPathsExist :: forall (m :: * -> *).
Monad m =>
CheckPackageContentOps m -> PackageDescription -> m [PackageCheck]
checkLocalPathsExist CheckPackageContentOps m
ops PackageDescription
pkg = do
  let dirs :: [(String, String)]
dirs = [ (String
dir, String
kind)
             | BuildInfo
bi <- PackageDescription -> [BuildInfo]
allBuildInfo PackageDescription
pkg
             , (String
dir, String
kind) <-
                  [ (String
dir, String
"extra-lib-dirs") | String
dir <- BuildInfo -> [String]
extraLibDirs BuildInfo
bi ]
               forall a. [a] -> [a] -> [a]
++ [ (String
dir, String
"extra-lib-dirs-static") | String
dir <- BuildInfo -> [String]
extraLibDirsStatic BuildInfo
bi ]
               forall a. [a] -> [a] -> [a]
++ [ (String
dir, String
"extra-framework-dirs")
                  | String
dir <- BuildInfo -> [String]
extraFrameworkDirs  BuildInfo
bi ]
               forall a. [a] -> [a] -> [a]
++ [ (String
dir, String
"include-dirs")   | String
dir <- BuildInfo -> [String]
includeDirs  BuildInfo
bi ]
               forall a. [a] -> [a] -> [a]
++ [ (forall from to. SymbolicPath from to -> String
getSymbolicPath SymbolicPath PackageDir SourceDir
dir, String
"hs-source-dirs") | SymbolicPath PackageDir SourceDir
dir <- BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
bi ]
             , String -> Bool
isRelativeOnAnyPlatform String
dir ]
  [(String, String)]
missing <- forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). CheckPackageContentOps m -> String -> m Bool
doesDirectoryExist CheckPackageContentOps m
ops forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(String, String)]
dirs
  forall (m :: * -> *) a. Monad m => a -> m a
return [ CheckExplanation -> PackageCheck
PackageBuildWarning (String -> String -> CheckExplanation
UnknownDirectory String
kind String
dir)
         | (String
dir, String
kind) <- [(String, String)]
missing ]

checkMissingVcsInfo :: (Monad m, Applicative m)
                    => CheckPackageContentOps m
                    -> PackageDescription
                    -> m [PackageCheck]
checkMissingVcsInfo :: forall (m :: * -> *).
(Monad m, Applicative m) =>
CheckPackageContentOps m -> PackageDescription -> m [PackageCheck]
checkMissingVcsInfo CheckPackageContentOps m
ops PackageDescription
pkg | forall (t :: * -> *) a. Foldable t => t a -> Bool
null (PackageDescription -> [SourceRepo]
sourceRepos PackageDescription
pkg) = do
    Bool
vcsInUse <- forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall (t :: * -> *). Foldable t => t Bool -> Bool
or forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *). CheckPackageContentOps m -> String -> m Bool
doesDirectoryExist CheckPackageContentOps m
ops) [String]
repoDirnames
    if Bool
vcsInUse
      then forall (m :: * -> *) a. Monad m => a -> m a
return [ CheckExplanation -> PackageCheck
PackageDistSuspicious CheckExplanation
MissingSourceControl ]
      else forall (m :: * -> *) a. Monad m => a -> m a
return []
  where
    repoDirnames :: [String]
repoDirnames = [ String
dirname | KnownRepoType
repo    <- [KnownRepoType]
knownRepoTypes
                             , String
dirname <- KnownRepoType -> [String]
repoTypeDirname KnownRepoType
repo]

checkMissingVcsInfo CheckPackageContentOps m
_ PackageDescription
_ = forall (m :: * -> *) a. Monad m => a -> m a
return []

repoTypeDirname :: KnownRepoType -> [FilePath]
repoTypeDirname :: KnownRepoType -> [String]
repoTypeDirname KnownRepoType
Darcs     = [String
"_darcs"]
repoTypeDirname KnownRepoType
Git       = [String
".git"]
repoTypeDirname KnownRepoType
SVN       = [String
".svn"]
repoTypeDirname KnownRepoType
CVS       = [String
"CVS"]
repoTypeDirname KnownRepoType
Mercurial = [String
".hg"]
repoTypeDirname KnownRepoType
GnuArch   = [String
".arch-params"]
repoTypeDirname KnownRepoType
Bazaar    = [String
".bzr"]
repoTypeDirname KnownRepoType
Monotone  = [String
"_MTN"]
repoTypeDirname KnownRepoType
Pijul     = [String
".pijul"]

-- ------------------------------------------------------------
-- * Checks involving files in the package
-- ------------------------------------------------------------

-- | Check the names of all files in a package for portability problems. This
-- should be done for example when creating or validating a package tarball.
--
checkPackageFileNames :: [FilePath] -> [PackageCheck]
checkPackageFileNames :: [String] -> [PackageCheck]
checkPackageFileNames = [(Bool, String)] -> [PackageCheck]
checkPackageFileNamesWithGlob forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. a -> [a]
repeat Bool
True)

checkPackageFileNamesWithGlob :: [(Bool, FilePath)] -> [PackageCheck]
checkPackageFileNamesWithGlob :: [(Bool, String)] -> [PackageCheck]
checkPackageFileNamesWithGlob [(Bool, String)]
files =
  forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$
    [(Bool, String)] -> Maybe PackageCheck
checkWindowsPaths [(Bool, String)]
files
    forall a. a -> [a] -> [a]
:
    [ String -> Maybe PackageCheck
checkTarPath String
file
    | (Bool
_, String
file) <- [(Bool, String)]
files
    ]

checkWindowsPaths :: [(Bool, FilePath)] -> Maybe PackageCheck
checkWindowsPaths :: [(Bool, String)] -> Maybe PackageCheck
checkWindowsPaths [(Bool, String)]
paths =
    case forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
FilePath.Windows.isValid forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool, String) -> String
escape) [(Bool, String)]
paths of
      [] -> forall a. Maybe a
Nothing
      [(Bool, String)]
ps -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
        CheckExplanation -> PackageCheck
PackageDistInexcusable ([String] -> CheckExplanation
InvalidOnWin forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Bool, String)]
ps)
  where
    -- force a relative name to catch invalid file names like "f:oo" which
    -- otherwise parse as file "oo" in the current directory on the 'f' drive.
    escape :: (Bool, String) -> String
escape (Bool
isGlob, String
path) = (String
".\\" forall a. [a] -> [a] -> [a]
++)
        -- glob paths will be expanded before being dereferenced, so asterisks
        -- shouldn't count against them.
      forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\Char
c -> if Char
c forall a. Eq a => a -> a -> Bool
== Char
'*' Bool -> Bool -> Bool
&& Bool
isGlob then Char
'x' else Char
c) String
path

-- | Check a file name is valid for the portable POSIX tar format.
--
-- The POSIX tar format has a restriction on the length of file names. It is
-- unfortunately not a simple restriction like a maximum length. The exact
-- restriction is that either the whole path be 100 characters or less, or it
-- be possible to split the path on a directory separator such that the first
-- part is 155 characters or less and the second part 100 characters or less.
--
checkTarPath :: FilePath -> Maybe PackageCheck
checkTarPath :: String -> Maybe PackageCheck
checkTarPath String
path
  | forall (t :: * -> *) a. Foldable t => t a -> Int
length String
path forall a. Ord a => a -> a -> Bool
> Int
255   = forall a. a -> Maybe a
Just PackageCheck
longPath
  | Bool
otherwise = case forall {t :: * -> *} {a}.
Foldable t =>
Int -> [t a] -> Either PackageCheck [t a]
pack Int
nameMax (forall a. [a] -> [a]
reverse (String -> [String]
splitPath String
path)) of
    Left PackageCheck
err           -> forall a. a -> Maybe a
Just PackageCheck
err
    Right []           -> forall a. Maybe a
Nothing
    Right (String
h:[String]
rest) -> case forall {t :: * -> *} {a}.
Foldable t =>
Int -> [t a] -> Either PackageCheck [t a]
pack Int
prefixMax [String]
remainder of
      Left PackageCheck
err         -> forall a. a -> Maybe a
Just PackageCheck
err
      Right []         -> forall a. Maybe a
Nothing
      Right (String
_:[String]
_)      -> forall a. a -> Maybe a
Just PackageCheck
noSplit
     where
        -- drop the '/' between the name and prefix:
        remainder :: [String]
remainder = forall a. [a] -> [a]
safeInit String
h forall a. a -> [a] -> [a]
: [String]
rest

  where
    nameMax, prefixMax :: Int
    nameMax :: Int
nameMax   = Int
100
    prefixMax :: Int
prefixMax = Int
155

    pack :: Int -> [t a] -> Either PackageCheck [t a]
pack Int
_   []     = forall a b. a -> Either a b
Left PackageCheck
emptyName
    pack Int
maxLen (t a
c:[t a]
cs)
      | Int
n forall a. Ord a => a -> a -> Bool
> Int
maxLen  = forall a b. a -> Either a b
Left PackageCheck
longName
      | Bool
otherwise   = forall a b. b -> Either a b
Right (forall {t :: * -> *} {a}.
Foldable t =>
Int -> Int -> [t a] -> [t a]
pack' Int
maxLen Int
n [t a]
cs)
      where n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
c

    pack' :: Int -> Int -> [t a] -> [t a]
pack' Int
maxLen Int
n (t a
c:[t a]
cs)
      | Int
n' forall a. Ord a => a -> a -> Bool
<= Int
maxLen = Int -> Int -> [t a] -> [t a]
pack' Int
maxLen Int
n' [t a]
cs
      where n' :: Int
n' = Int
n forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
c
    pack' Int
_     Int
_ [t a]
cs = [t a]
cs

    longPath :: PackageCheck
longPath = CheckExplanation -> PackageCheck
PackageDistInexcusable (String -> CheckExplanation
FilePathTooLong String
path)
    longName :: PackageCheck
longName = CheckExplanation -> PackageCheck
PackageDistInexcusable (String -> CheckExplanation
FilePathNameTooLong String
path)
    noSplit :: PackageCheck
noSplit = CheckExplanation -> PackageCheck
PackageDistInexcusable (String -> CheckExplanation
FilePathSplitTooLong String
path)
    emptyName :: PackageCheck
emptyName = CheckExplanation -> PackageCheck
PackageDistInexcusable CheckExplanation
FilePathEmpty

-- --------------------------------------------------------------
-- * Checks for missing content and other pre-distribution checks
-- --------------------------------------------------------------

-- | Similar to 'checkPackageContent', 'checkPackageFilesPreDistribution'
-- inspects the files included in the package, but is primarily looking for
-- files in the working tree that may have been missed or other similar
-- problems that can only be detected pre-distribution.
--
-- Because Hackage necessarily checks the uploaded tarball, it is too late to
-- check these on the server; these checks only make sense in the development
-- and package-creation environment. Hence we can use IO, rather than needing
-- to pass a 'CheckPackageContentOps' dictionary around.
checkPackageFilesPreDistribution :: Verbosity -> PackageDescription -> FilePath -> IO [PackageCheck]
-- Note: this really shouldn't return any 'Inexcusable' warnings,
-- because that will make us say that Hackage would reject the package.
-- But, because Hackage doesn't run these tests, that will be a lie!
checkPackageFilesPreDistribution :: Verbosity -> PackageDescription -> String -> IO [PackageCheck]
checkPackageFilesPreDistribution = Verbosity -> PackageDescription -> String -> IO [PackageCheck]
checkGlobFiles

-- | Discover problems with the package's wildcards.
checkGlobFiles :: Verbosity
               -> PackageDescription
               -> FilePath
               -> IO [PackageCheck]
checkGlobFiles :: Verbosity -> PackageDescription -> String -> IO [PackageCheck]
checkGlobFiles Verbosity
verbosity PackageDescription
pkg String
root = do
  -- Get the desirable doc files from package’s directory
  [String]
rootContents <- String -> IO [String]
System.Directory.getDirectoryContents String
root
  [String]
docFiles0 <- forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM String -> IO Bool
System.doesFileExist
                       [ String
file
                       | String
file <- [String]
rootContents
                       , ([String], [String]) -> String -> Bool
isDesirableExtraDocFile ([String], [String])
desirableDocFiles String
file
                       ]
  -- Check the globs
  ([PackageCheck]
warnings, [String]
unlisted) <- forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
foldrM (String, Bool, String, String)
-> ([PackageCheck], [String]) -> IO ([PackageCheck], [String])
checkGlob ([], [String]
docFiles0) [(String, Bool, String, String)]
allGlobs

  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
unlisted
    -- No missing desirable file
    then [PackageCheck]
warnings
    -- Some missing desirable files
    else [PackageCheck]
warnings forall a. [a] -> [a] -> [a]
++
         let unlisted' :: [String]
unlisted' = (String
root String -> ShowS
</>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
unlisted
         in [ CheckExplanation -> PackageCheck
PackageDistSuspiciousWarn
                (Bool -> [String] -> CheckExplanation
MissingExpectedDocFiles Bool
extraDocFilesSupport [String]
unlisted')
            ]
  where
    -- `extra-doc-files` is supported only from version 1.18
    extraDocFilesSupport :: Bool
extraDocFilesSupport = PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecV1_18
    adjustedDataDir :: String
adjustedDataDir = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null (PackageDescription -> String
dataDir PackageDescription
pkg) then String
root else String
root String -> ShowS
</> PackageDescription -> String
dataDir PackageDescription
pkg
    -- Cabal fields with globs
    allGlobs :: [(String, Bool, FilePath, FilePath)]
    allGlobs :: [(String, Bool, String, String)]
allGlobs = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [ (,,,) String
"extra-source-files" (Bool -> Bool
not Bool
extraDocFilesSupport) String
root forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        PackageDescription -> [String]
extraSrcFiles PackageDescription
pkg
      , (,,,) String
"extra-doc-files" Bool
True String
root forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackageDescription -> [String]
extraDocFiles PackageDescription
pkg
      , (,,,) String
"data-files" Bool
False String
adjustedDataDir forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackageDescription -> [String]
dataFiles PackageDescription
pkg
      ]

    -- For each field with globs (see allGlobs), look for:
    -- • errors (missing directory, no match)
    -- • omitted documentation files (changelog)
    checkGlob :: (String, Bool, FilePath, FilePath)
              -> ([PackageCheck], [FilePath])
              -> IO ([PackageCheck], [FilePath])
    checkGlob :: (String, Bool, String, String)
-> ([PackageCheck], [String]) -> IO ([PackageCheck], [String])
checkGlob (String
field, Bool
isDocField, String
dir, String
glob) acc :: ([PackageCheck], [String])
acc@([PackageCheck]
warnings, [String]
docFiles1) =
      -- Note: we just skip over parse errors here; they're reported elsewhere.
      case CabalSpecVersion -> String -> Either GlobSyntaxError Glob
parseFileGlob (PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg) String
glob of
        Left GlobSyntaxError
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ([PackageCheck], [String])
acc
        Right Glob
parsedGlob -> do
          [GlobResult String]
results <- Verbosity -> String -> Glob -> IO [GlobResult String]
runDirFileGlob Verbosity
verbosity (String
root String -> ShowS
</> String
dir) Glob
parsedGlob
          let acc0 :: ([PackageCheck], Bool, [String], [a])
acc0 = ([PackageCheck]
warnings, Bool
True, [String]
docFiles1, [])
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr GlobResult String
-> ([PackageCheck], Bool, [String], [String])
-> ([PackageCheck], Bool, [String], [String])
checkGlobResult forall {a}. ([PackageCheck], Bool, [String], [a])
acc0 [GlobResult String]
results of
            ([PackageCheck]
individualWarn, Bool
noMatchesWarn, [String]
docFiles1', [String]
wrongPaths) ->
              let wrongFieldWarnings :: [PackageCheck]
wrongFieldWarnings = [ CheckExplanation -> PackageCheck
PackageDistSuspiciousWarn
                                          (Bool -> String -> [String] -> CheckExplanation
WrongFieldForExpectedDocFiles
                                            Bool
extraDocFilesSupport
                                            String
field [String]
wrongPaths)
                                       | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
wrongPaths) ]
              in
                ( if Bool
noMatchesWarn
                    then [CheckExplanation -> PackageCheck
PackageDistSuspiciousWarn (String -> String -> CheckExplanation
GlobNoMatch String
field String
glob)] forall a. [a] -> [a] -> [a]
++
                         [PackageCheck]
individualWarn forall a. [a] -> [a] -> [a]
++
                         [PackageCheck]
wrongFieldWarnings
                    else [PackageCheck]
individualWarn forall a. [a] -> [a] -> [a]
++ [PackageCheck]
wrongFieldWarnings
                , [String]
docFiles1'
                )
          where
            checkGlobResult :: GlobResult FilePath
                            -> ([PackageCheck], Bool, [FilePath], [FilePath])
                            -> ([PackageCheck], Bool, [FilePath], [FilePath])
            checkGlobResult :: GlobResult String
-> ([PackageCheck], Bool, [String], [String])
-> ([PackageCheck], Bool, [String], [String])
checkGlobResult GlobResult String
result ([PackageCheck]
ws, Bool
noMatchesWarn, [String]
docFiles2, [String]
wrongPaths) =
              let noMatchesWarn' :: Bool
noMatchesWarn' = Bool
noMatchesWarn Bool -> Bool -> Bool
&&
                                   Bool -> Bool
not (forall {a}. GlobResult a -> Bool
suppressesNoMatchesWarning GlobResult String
result)
              in case String -> String -> GlobResult String -> Either PackageCheck String
getWarning String
field String
glob GlobResult String
result of
                -- No match: add warning and do no further check
                Left PackageCheck
w ->
                  ( PackageCheck
w forall a. a -> [a] -> [a]
: [PackageCheck]
ws
                  , Bool
noMatchesWarn'
                  , [String]
docFiles2
                  , [String]
wrongPaths
                  )
                -- Match: check doc files
                Right String
path ->
                  let path' :: String
path' = String -> ShowS
makeRelative String
root (ShowS
normalise String
path)
                      ([String]
docFiles2', [String]
wrongPaths') = Bool -> String -> [String] -> [String] -> ([String], [String])
checkDoc Bool
isDocField
                                                           String
path'
                                                           [String]
docFiles2
                                                           [String]
wrongPaths
                  in
                    ( [PackageCheck]
ws
                    , Bool
noMatchesWarn'
                    , [String]
docFiles2'
                    , [String]
wrongPaths'
                    )

    -- Check whether a path is a desirable doc: if so, check if it is in the
    -- field "extra-doc-files".
    checkDoc :: Bool                     -- Is it "extra-doc-files" ?
             -> FilePath                 -- Path to test
             -> [FilePath]               -- Pending doc files to check
             -> [FilePath]               -- Previous wrong paths
             -> ([FilePath], [FilePath]) -- Updated paths
    checkDoc :: Bool -> String -> [String] -> [String] -> ([String], [String])
checkDoc Bool
isDocField String
path [String]
docFiles [String]
wrongFieldPaths =
      if String
path forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
docFiles
        -- Found desirable doc file
        then
          ( forall a. Eq a => a -> [a] -> [a]
delete String
path [String]
docFiles
          , if Bool
isDocField then [String]
wrongFieldPaths else String
path forall a. a -> [a] -> [a]
: [String]
wrongFieldPaths
          )
        -- Not a desirable doc file
        else
          ( [String]
docFiles
          , [String]
wrongFieldPaths
          )

    -- Predicate for desirable documentation file on Hackage server
    isDesirableExtraDocFile :: ([FilePath], [FilePath]) -> FilePath -> Bool
    isDesirableExtraDocFile :: ([String], [String]) -> String -> Bool
isDesirableExtraDocFile ([String]
basenames, [String]
extensions) String
path =
      String
basename forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
basenames Bool -> Bool -> Bool
&& String
ext forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
extensions
      where
        (String
basename, String
ext) = String -> (String, String)
splitExtension (forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
path)

    -- Changelog patterns (basenames & extensions)
    -- Source: hackage-server/src/Distribution/Server/Packages/ChangeLog.hs
    desirableChangeLog :: [String]
desirableChangeLog =
      [ String
"news"
      , String
"changelog"
      , String
"change_log"
      , String
"changes"
      ]
    desirableChangeLogExtensions :: [String]
desirableChangeLogExtensions = [String
"", String
".txt", String
".md", String
".markdown", String
".rst"]
    -- [TODO] Check readme. Observations:
    --        • Readme is not necessary if package description is good.
    --        • Some readmes exists only for repository browsing.
    --        • There is currently no reliable way to check what a good
    --          description is; there will be complains if the criterion is
    --          based on the length or number of words (can of worms).
    -- -- Readme patterns
    -- -- Source: hackage-server/src/Distribution/Server/Packages/Readme.hs
    -- desirableReadme = ["readme"]
    desirableDocFiles :: ([String], [String])
desirableDocFiles = ([String]
desirableChangeLog, [String]
desirableChangeLogExtensions)

    -- If there's a missing directory in play, since our globs don't
    -- (currently) support disjunction, that will always mean there are no
    -- matches. The no matches error in this case is strictly less informative
    -- than the missing directory error, so sit on it.
    suppressesNoMatchesWarning :: GlobResult a -> Bool
suppressesNoMatchesWarning (GlobMatch a
_) = Bool
True
    suppressesNoMatchesWarning (GlobWarnMultiDot a
_) = Bool
False
    suppressesNoMatchesWarning (GlobMissingDirectory String
_) = Bool
True

    getWarning :: String
               -> FilePath
               -> GlobResult FilePath
               -> Either PackageCheck FilePath
    getWarning :: String -> String -> GlobResult String -> Either PackageCheck String
getWarning String
_ String
_ (GlobMatch String
path) =
      forall a b. b -> Either a b
Right String
path
    -- Before Cabal 2.4, the extensions of globs had to match the file
    -- exactly. This has been relaxed in 2.4 to allow matching only the
    -- suffix. This warning detects when pre-2.4 package descriptions are
    -- omitting files purely because of the stricter check.
    getWarning String
field String
glob (GlobWarnMultiDot String
file) =
      forall a b. a -> Either a b
Left (CheckExplanation -> PackageCheck
PackageDistSuspiciousWarn (String -> String -> String -> CheckExplanation
GlobExactMatch String
field String
glob String
file))
    getWarning String
field String
glob (GlobMissingDirectory String
dir) =
      forall a b. a -> Either a b
Left (CheckExplanation -> PackageCheck
PackageDistSuspiciousWarn (String -> String -> String -> CheckExplanation
GlobNoDir String
field String
glob String
dir))

-- | Check that setup dependencies, have proper bounds.
-- In particular, @base@ and @Cabal@ upper bounds are mandatory.
checkSetupVersions :: GenericPackageDescription -> [PackageCheck]
checkSetupVersions :: GenericPackageDescription -> [PackageCheck]
checkSetupVersions GenericPackageDescription
pkg =
    [ String -> PackageCheck
emitError String
nameStr
    | (PackageName
name, VersionRange
vr) <- forall k a. Map k a -> [(k, a)]
Map.toList Map PackageName VersionRange
deps
    , Bool -> Bool
not (VersionRange -> Bool
hasUpperBound VersionRange
vr)
    , let nameStr :: String
nameStr = PackageName -> String
unPackageName PackageName
name
    , String
nameStr forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
criticalPkgs
    ]
  where
    criticalPkgs :: [String]
criticalPkgs = [String
"Cabal", String
"base"]
    deps :: Map PackageName VersionRange
deps = (PackageDescription -> [Dependency])
-> GenericPackageDescription -> Map PackageName VersionRange
toDependencyVersionsMap (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap SetupBuildInfo -> [Dependency]
setupDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> Maybe SetupBuildInfo
setupBuildInfo) GenericPackageDescription
pkg
    emitError :: String -> PackageCheck
emitError String
nm =
      CheckExplanation -> PackageCheck
PackageDistInexcusable (String -> CheckExplanation
UpperBoundSetup String
nm)

checkDuplicateModules :: GenericPackageDescription -> [PackageCheck]
checkDuplicateModules :: GenericPackageDescription -> [PackageCheck]
checkDuplicateModules GenericPackageDescription
pkg =
       forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {v} {c}. CondTree v c Library -> [PackageCheck]
checkLib   (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (:) (GenericPackageDescription
-> Maybe (CondTree ConfVar [Dependency] Library)
condLibrary GenericPackageDescription
pkg) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
condSubLibraries GenericPackageDescription
pkg)
    forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {v} {c}. CondTree v c Executable -> [PackageCheck]
checkExe   (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ GenericPackageDescription
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
condExecutables GenericPackageDescription
pkg)
    forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {v} {c}. CondTree v c TestSuite -> [PackageCheck]
checkTest  (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
condTestSuites  GenericPackageDescription
pkg)
    forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {v} {c}. CondTree v c Benchmark -> [PackageCheck]
checkBench (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
condBenchmarks  GenericPackageDescription
pkg)
  where
    -- the duplicate modules check is has not been thoroughly vetted for backpack
    checkLib :: CondTree v c Library -> [PackageCheck]
checkLib   = forall {t} {v} {c}.
String -> (t -> [ModuleName]) -> CondTree v c t -> [PackageCheck]
checkDups String
"library" (\Library
l -> Library -> [ModuleName]
explicitLibModules Library
l forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map ModuleReexport -> ModuleName
moduleReexportName (Library -> [ModuleReexport]
reexportedModules Library
l))
    checkExe :: CondTree v c Executable -> [PackageCheck]
checkExe   = forall {t} {v} {c}.
String -> (t -> [ModuleName]) -> CondTree v c t -> [PackageCheck]
checkDups String
"executable" Executable -> [ModuleName]
exeModules
    checkTest :: CondTree v c TestSuite -> [PackageCheck]
checkTest  = forall {t} {v} {c}.
String -> (t -> [ModuleName]) -> CondTree v c t -> [PackageCheck]
checkDups String
"test suite" TestSuite -> [ModuleName]
testModules
    checkBench :: CondTree v c Benchmark -> [PackageCheck]
checkBench = forall {t} {v} {c}.
String -> (t -> [ModuleName]) -> CondTree v c t -> [PackageCheck]
checkDups String
"benchmark"  Benchmark -> [ModuleName]
benchmarkModules
    checkDups :: String -> (t -> [ModuleName]) -> CondTree v c t -> [PackageCheck]
checkDups String
s t -> [ModuleName]
getModules CondTree v c t
t =
               let sumPair :: (Int, Int) -> (Int, Int) -> (Int, Int)
sumPair (Int
x,Int
x') (Int
y,Int
y') = (Int
x forall a. Num a => a -> a -> a
+ Int
x' :: Int, Int
y forall a. Num a => a -> a -> a
+ Int
y' :: Int)
                   mergePair :: (a, a) -> (b, b) -> (a, b)
mergePair (a
x, a
x') (b
y, b
y') = (a
x forall a. Num a => a -> a -> a
+ a
x', forall a. Ord a => a -> a -> a
max b
y b
y')
                   maxPair :: (a, a) -> (b, b) -> (a, b)
maxPair (a
x, a
x') (b
y, b
y') = (forall a. Ord a => a -> a -> a
max a
x a
x', forall a. Ord a => a -> a -> a
max b
y b
y')
                   libMap :: Map ModuleName (Int, Int)
libMap = forall b c a v.
b
-> ((c, a) -> b)
-> (b -> b -> b)
-> (b -> b -> b)
-> CondTree v c a
-> b
foldCondTree forall k a. Map k a
Map.empty
                                         (\(c
_,t
v) -> forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith (Int, Int) -> (Int, Int) -> (Int, Int)
sumPair forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\ModuleName
x -> (ModuleName
x,(Int
1, Int
1))) forall a b. (a -> b) -> a -> b
$ t -> [ModuleName]
getModules t
v )
                                         (forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith forall {a} {b}. (Num a, Ord b) => (a, a) -> (b, b) -> (a, b)
mergePair) -- if a module may occur in nonexclusive branches count it twice strictly and once loosely.
                                         (forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith forall {a} {b}. (Ord a, Ord b) => (a, a) -> (b, b) -> (a, b)
maxPair) -- a module occurs the max of times it might appear in exclusive branches
                                         CondTree v c t
t
                   dupLibsStrict :: [ModuleName]
dupLibsStrict = forall k a. Map k a -> [k]
Map.keys forall a b. (a -> b) -> a -> b
$ forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter ((forall a. Ord a => a -> a -> Bool
>Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) Map ModuleName (Int, Int)
libMap
                   dupLibsLax :: [ModuleName]
dupLibsLax = forall k a. Map k a -> [k]
Map.keys forall a b. (a -> b) -> a -> b
$ forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter ((forall a. Ord a => a -> a -> Bool
>Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) Map ModuleName (Int, Int)
libMap
               in if Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ModuleName]
dupLibsLax)
                      then [CheckExplanation -> PackageCheck
PackageBuildImpossible
                             (String -> [ModuleName] -> CheckExplanation
DuplicateModule String
s [ModuleName]
dupLibsLax)]
                      else if Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ModuleName]
dupLibsStrict)
                           then [CheckExplanation -> PackageCheck
PackageDistSuspicious
                                   (String -> [ModuleName] -> CheckExplanation
PotentialDupModule String
s [ModuleName]
dupLibsStrict)]
                           else []

-- ------------------------------------------------------------
-- * Utils
-- ------------------------------------------------------------

toDependencyVersionsMap :: (PackageDescription -> [Dependency]) -> GenericPackageDescription -> Map PackageName VersionRange
toDependencyVersionsMap :: (PackageDescription -> [Dependency])
-> GenericPackageDescription -> Map PackageName VersionRange
toDependencyVersionsMap PackageDescription -> [Dependency]
selectDependencies GenericPackageDescription
pkg = case GenericPackageDescription
-> Either [Dependency] (PackageDescription, FlagAssignment)
typicalPkg GenericPackageDescription
pkg of
      Right (PackageDescription
pkgs', FlagAssignment
_) ->
        let
          self :: PackageName
          self :: PackageName
self = PackageIdentifier -> PackageName
pkgName forall a b. (a -> b) -> a -> b
$ PackageDescription -> PackageIdentifier
package PackageDescription
pkgs'
        in
        forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith VersionRange -> VersionRange -> VersionRange
intersectVersionRanges forall a b. (a -> b) -> a -> b
$
          [ (PackageName
pname, VersionRange
vr)
          | Dependency PackageName
pname VersionRange
vr NonEmptySet LibraryName
_ <- PackageDescription -> [Dependency]
selectDependencies PackageDescription
pkgs'
          , PackageName
pname forall a. Eq a => a -> a -> Bool
/= PackageName
self
          ]
      -- Just in case finalizePD fails for any reason,
      -- or if the package doesn't depend on the base package at all,
      -- no deps is no checks.
      Either [Dependency] (PackageDescription, FlagAssignment)
_ -> forall k a. Map k a
Map.empty


quote :: String -> String
quote :: ShowS
quote String
s = String
"'" forall a. [a] -> [a] -> [a]
++ String
s forall a. [a] -> [a] -> [a]
++ String
"'"

commaSep :: [String] -> String
commaSep :: [String] -> String
commaSep = forall a. [a] -> [[a]] -> [a]
intercalate String
", "

dups :: Ord a => [a] -> [a]
dups :: forall a. Ord a => [a] -> [a]
dups [a]
xs = [ a
x | (a
x:a
_:[a]
_) <- forall a. Eq a => [a] -> [[a]]
group (forall a. Ord a => [a] -> [a]
sort [a]
xs) ]

fileExtensionSupportedLanguage :: FilePath -> Bool
fileExtensionSupportedLanguage :: String -> Bool
fileExtensionSupportedLanguage String
path =
    Bool
isHaskell Bool -> Bool -> Bool
|| Bool
isC
  where
    extension :: String
extension = ShowS
takeExtension String
path
    isHaskell :: Bool
isHaskell = String
extension forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
".hs", String
".lhs"]
    isC :: Bool
isC       = forall a. Maybe a -> Bool
isJust (String -> Maybe (CDialect, Bool)
filenameCDialect String
extension)

-- | Whether a path is a good relative path.  We aren't worried about perfect
-- cross-platform compatibility here; this function just checks the paths in
-- the (local) @.cabal@ file, while only Hackage needs the portability.
--
-- >>> let test fp = putStrLn $ show (isGoodRelativeDirectoryPath fp) ++ "; " ++ show (isGoodRelativeFilePath fp)
--
-- Note that "foo./bar.hs" would be invalid on Windows.
--
-- >>> traverse_ test ["foo/bar/quu", "a/b.hs", "foo./bar.hs"]
-- Nothing; Nothing
-- Nothing; Nothing
-- Nothing; Nothing
--
-- Trailing slash is not allowed for files, for directories it is ok.
--
-- >>> test "foo/"
-- Nothing; Just "trailing slash"
--
-- Leading @./@ is fine, but @.@ and @./@ are not valid files.
--
-- >>> traverse_ test [".", "./", "./foo/bar"]
-- Nothing; Just "trailing dot segment"
-- Nothing; Just "trailing slash"
-- Nothing; Nothing
--
-- Lastly, not good file nor directory cases:
--
-- >>> traverse_ test ["", "/tmp/src", "foo//bar", "foo/.", "foo/./bar", "foo/../bar"]
-- Just "empty path"; Just "empty path"
-- Just "posix absolute path"; Just "posix absolute path"
-- Just "empty path segment"; Just "empty path segment"
-- Just "trailing same directory segment: ."; Just "trailing same directory segment: ."
-- Just "same directory segment: ."; Just "same directory segment: ."
-- Just "parent directory segment: .."; Just "parent directory segment: .."
--
-- For the last case, 'isGoodRelativeGlob' doesn't warn:
--
-- >>> traverse_ (print . isGoodRelativeGlob) ["foo/../bar"]
-- Just "parent directory segment: .."
--
isGoodRelativeFilePath :: FilePath -> Maybe String
isGoodRelativeFilePath :: String -> Maybe String
isGoodRelativeFilePath = String -> Maybe String
state0
  where
    -- initial state
    state0 :: String -> Maybe String
state0 []                    = forall a. a -> Maybe a
Just String
"empty path"
    state0 (Char
c:String
cs) | Char
c forall a. Eq a => a -> a -> Bool
== Char
'.'     = String -> Maybe String
state1 String
cs
                  | Char
c forall a. Eq a => a -> a -> Bool
== Char
'/'     = forall a. a -> Maybe a
Just String
"posix absolute path"
                  | Bool
otherwise    = String -> Maybe String
state5 String
cs

    -- after initial .
    state1 :: String -> Maybe String
state1 []                    = forall a. a -> Maybe a
Just String
"trailing dot segment"
    state1 (Char
c:String
cs) | Char
c forall a. Eq a => a -> a -> Bool
== Char
'.'     = String -> Maybe String
state4 String
cs
                  | Char
c forall a. Eq a => a -> a -> Bool
== Char
'/'     = String -> Maybe String
state2 String
cs
                  | Bool
otherwise    = String -> Maybe String
state5 String
cs

    -- after ./ or after / between segments
    state2 :: String -> Maybe String
state2 []                    = forall a. a -> Maybe a
Just String
"trailing slash"
    state2 (Char
c:String
cs) | Char
c forall a. Eq a => a -> a -> Bool
== Char
'.'     = String -> Maybe String
state3 String
cs
                  | Char
c forall a. Eq a => a -> a -> Bool
== Char
'/'     = forall a. a -> Maybe a
Just String
"empty path segment"
                  | Bool
otherwise    = String -> Maybe String
state5 String
cs

    -- after non-first segment's .
    state3 :: String -> Maybe String
state3 []                    = forall a. a -> Maybe a
Just String
"trailing same directory segment: ."
    state3 (Char
c:String
cs) | Char
c forall a. Eq a => a -> a -> Bool
== Char
'.'     = String -> Maybe String
state4 String
cs
                  | Char
c forall a. Eq a => a -> a -> Bool
== Char
'/'     = forall a. a -> Maybe a
Just String
"same directory segment: ."
                  | Bool
otherwise    = String -> Maybe String
state5 String
cs

    -- after ..
    state4 :: String -> Maybe String
state4 []                    = forall a. a -> Maybe a
Just String
"trailing parent directory segment: .."
    state4 (Char
c:String
cs) | Char
c forall a. Eq a => a -> a -> Bool
== Char
'.'     = String -> Maybe String
state5 String
cs
                  | Char
c forall a. Eq a => a -> a -> Bool
== Char
'/'     = forall a. a -> Maybe a
Just String
"parent directory segment: .."
                  | Bool
otherwise    = String -> Maybe String
state5 String
cs

    -- in a segment which is ok.
    state5 :: String -> Maybe String
state5 []                    = forall a. Maybe a
Nothing
    state5 (Char
c:String
cs) | Char
c forall a. Eq a => a -> a -> Bool
== Char
'.'     = String -> Maybe String
state5 String
cs
                  | Char
c forall a. Eq a => a -> a -> Bool
== Char
'/'     = String -> Maybe String
state2 String
cs
                  | Bool
otherwise    = String -> Maybe String
state5 String
cs

-- | See 'isGoodRelativeFilePath'.
--
-- This is barebones function. We check whether the glob is a valid file
-- by replacing stars @*@ with @x@ses.
isGoodRelativeGlob :: FilePath -> Maybe String
isGoodRelativeGlob :: String -> Maybe String
isGoodRelativeGlob = String -> Maybe String
isGoodRelativeFilePath forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
f where
    f :: Char -> Char
f Char
'*' = Char
'x'
    f Char
c   = Char
c

-- | See 'isGoodRelativeFilePath'.
isGoodRelativeDirectoryPath :: FilePath -> Maybe String
isGoodRelativeDirectoryPath :: String -> Maybe String
isGoodRelativeDirectoryPath = String -> Maybe String
state0
  where
    -- initial state
    state0 :: String -> Maybe String
state0 []                    = forall a. a -> Maybe a
Just String
"empty path"
    state0 (Char
c:String
cs) | Char
c forall a. Eq a => a -> a -> Bool
== Char
'.'     = String -> Maybe String
state5 String
cs
                  | Char
c forall a. Eq a => a -> a -> Bool
== Char
'/'     = forall a. a -> Maybe a
Just String
"posix absolute path"
                  | Bool
otherwise    = String -> Maybe String
state4 String
cs

    -- after initial ./ or after / between segments
    state1 :: String -> Maybe String
state1 []                    = forall a. Maybe a
Nothing
    state1 (Char
c:String
cs) | Char
c forall a. Eq a => a -> a -> Bool
== Char
'.'     = String -> Maybe String
state2 String
cs
                  | Char
c forall a. Eq a => a -> a -> Bool
== Char
'/'     = forall a. a -> Maybe a
Just String
"empty path segment"
                  | Bool
otherwise    = String -> Maybe String
state4 String
cs

    -- after non-first setgment's .
    state2 :: String -> Maybe String
state2 []                    = forall a. a -> Maybe a
Just String
"trailing same directory segment: ."
    state2 (Char
c:String
cs) | Char
c forall a. Eq a => a -> a -> Bool
== Char
'.'     = String -> Maybe String
state3 String
cs
                  | Char
c forall a. Eq a => a -> a -> Bool
== Char
'/'     = forall a. a -> Maybe a
Just String
"same directory segment: ."
                  | Bool
otherwise    = String -> Maybe String
state4 String
cs

    -- after ..
    state3 :: String -> Maybe String
state3 []                    = forall a. a -> Maybe a
Just String
"trailing parent directory segment: .."
    state3 (Char
c:String
cs) | Char
c forall a. Eq a => a -> a -> Bool
== Char
'.'     = String -> Maybe String
state4 String
cs
                  | Char
c forall a. Eq a => a -> a -> Bool
== Char
'/'     = forall a. a -> Maybe a
Just String
"parent directory segment: .."
                  | Bool
otherwise    = String -> Maybe String
state4 String
cs

    -- in a segment which is ok.
    state4 :: String -> Maybe String
state4 []                    = forall a. Maybe a
Nothing
    state4 (Char
c:String
cs) | Char
c forall a. Eq a => a -> a -> Bool
== Char
'.'     = String -> Maybe String
state4 String
cs
                  | Char
c forall a. Eq a => a -> a -> Bool
== Char
'/'     = String -> Maybe String
state1 String
cs
                  | Bool
otherwise    = String -> Maybe String
state4 String
cs

    -- after initial .
    state5 :: String -> Maybe String
state5 []                    = forall a. Maybe a
Nothing -- "."
    state5 (Char
c:String
cs) | Char
c forall a. Eq a => a -> a -> Bool
== Char
'.'     = String -> Maybe String
state3 String
cs
                  | Char
c forall a. Eq a => a -> a -> Bool
== Char
'/'     = String -> Maybe String
state1 String
cs
                  | Bool
otherwise    = String -> Maybe String
state4 String
cs

-- [Note: Good relative paths]
--
-- Using @kleene@ we can define an extended regex:
--
-- @
-- import Algebra.Lattice
-- import Kleene
-- import Kleene.ERE (ERE (..), intersections)
--
-- data C = CDot | CSlash | CChar
--   deriving (Eq, Ord, Enum, Bounded, Show)
--
-- reservedR :: ERE C
-- reservedR = notChar CSlash
--
-- pathPieceR :: ERE C
-- pathPieceR = intersections
--     [ plus reservedR
--     , ERENot (string [CDot])
--     , ERENot (string [CDot,CDot])
--     ]
--
-- filePathR :: ERE C
-- filePathR = optional (string [CDot, CSlash]) <> pathPieceR <> star (char CSlash <> pathPieceR)
--
-- dirPathR :: ERE C
-- dirPathR = (char CDot \/ filePathR) <> optional (char CSlash)
--
-- plus :: ERE C -> ERE C
-- plus r = r <> star r
--
-- optional :: ERE C -> ERE C
-- optional r = mempty \/ r
-- @
--
-- Results in following state machine for @filePathR@
--
-- @
-- 0 -> \x -> if
--     | x <= CDot           -> 1
--     | otherwise           -> 5
-- 1 -> \x -> if
--     | x <= CDot           -> 4
--     | x <= CSlash         -> 2
--     | otherwise           -> 5
-- 2 -> \x -> if
--     | x <= CDot           -> 3
--     | otherwise           -> 5
-- 3 -> \x -> if
--     | x <= CDot           -> 4
--     | otherwise           -> 5
-- 4 -> \x -> if
--     | x <= CDot           -> 5
--     | otherwise           -> 5
-- 5+ -> \x -> if
--     | x <= CDot           -> 5
--     | x <= CSlash         -> 2
--     | otherwise           -> 5
-- @
--
-- and @dirPathR@:
--
-- @
-- 0 -> \x -> if
--     | x <= CDot           -> 5
--     | otherwise           -> 4
-- 1+ -> \x -> if
--     | x <= CDot           -> 2
--     | otherwise           -> 4
-- 2 -> \x -> if
--     | x <= CDot           -> 3
--     | otherwise           -> 4
-- 3 -> \x -> if
--     | x <= CDot           -> 4
--     | otherwise           -> 4
-- 4+ -> \x -> if
--     | x <= CDot           -> 4
--     | x <= CSlash         -> 1
--     | otherwise           -> 4
-- 5+ -> \x -> if
--     | x <= CDot           -> 3
--     | x <= CSlash         -> 1
--     | otherwise           -> 4
-- @

--
-- TODO: What we really want to do is test if there exists any
-- configuration in which the base version is unbounded above.
-- However that's a bit tricky because there are many possible
-- configurations. As a cheap easy and safe approximation we will
-- pick a single "typical" configuration and check if that has an
-- open upper bound. To get a typical configuration we finalise
-- using no package index and the current platform.
typicalPkg :: GenericPackageDescription
           -> Either [Dependency] (PackageDescription, FlagAssignment)
typicalPkg :: GenericPackageDescription
-> Either [Dependency] (PackageDescription, FlagAssignment)
typicalPkg = FlagAssignment
-> ComponentRequestedSpec
-> (Dependency -> Bool)
-> Platform
-> CompilerInfo
-> [PackageVersionConstraint]
-> GenericPackageDescription
-> Either [Dependency] (PackageDescription, FlagAssignment)
finalizePD
  forall a. Monoid a => a
mempty ComponentRequestedSpec
defaultComponentRequestedSpec (forall a b. a -> b -> a
const Bool
True)
  Platform
buildPlatform
  (CompilerId -> AbiTag -> CompilerInfo
unknownCompilerInfo
    (CompilerFlavor -> Version -> CompilerId
CompilerId CompilerFlavor
buildCompilerFlavor Version
nullVersion)
      AbiTag
NoAbiTag)
  []

addConditionalExp :: String -> String
addConditionalExp :: ShowS
addConditionalExp String
expl = String
expl forall a. [a] -> [a] -> [a]
++
         String
" Alternatively, if you want to use this, make it conditional based "
      forall a. [a] -> [a] -> [a]
++ String
"on a Cabal configuration flag (with 'manual: True' and 'default: "
      forall a. [a] -> [a] -> [a]
++ String
"False') and enable that flag during development."