-----------------------------------------------------------------------------
-- |
-- 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 check so we can see which ones are appropriate to report
-- in different situations. This code gets uses when configuring a package when
-- we consider only basic problems. The higher standard is uses 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
        PackageCheck(..),
        checkPackage,
        checkConfiguredPackage,

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

import Distribution.Compat.Prelude
import Prelude ()

import Data.List                                     (group)
import Distribution.CabalSpecVersion
import Distribution.Compat.Lens
import Distribution.Compiler
import Distribution.License
import Distribution.Package
import Distribution.PackageDescription
import Distribution.PackageDescription.Configuration
import Distribution.Pretty                           (prettyShow)
import Distribution.Simple.BuildPaths                (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.ModuleReexport
import Distribution.Utils.Generic                    (isAscii)
import Distribution.Verbosity
import Distribution.Version
import Language.Haskell.Extension
import System.FilePath
       (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 ((&&&))

-- | 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 -> String
explanation :: String }

       -- | 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 :: String }

       -- | 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 :: String }

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

       -- | 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 :: String }
  deriving (PackageCheck -> PackageCheck -> Bool
(PackageCheck -> PackageCheck -> Bool)
-> (PackageCheck -> PackageCheck -> Bool) -> Eq PackageCheck
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
Eq PackageCheck
-> (PackageCheck -> PackageCheck -> Ordering)
-> (PackageCheck -> PackageCheck -> Bool)
-> (PackageCheck -> PackageCheck -> Bool)
-> (PackageCheck -> PackageCheck -> Bool)
-> (PackageCheck -> PackageCheck -> Bool)
-> (PackageCheck -> PackageCheck -> PackageCheck)
-> (PackageCheck -> PackageCheck -> PackageCheck)
-> Ord PackageCheck
PackageCheck -> PackageCheck -> Bool
PackageCheck -> PackageCheck -> Ordering
PackageCheck -> PackageCheck -> PackageCheck
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
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
$cp1Ord :: Eq PackageCheck
Ord)

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

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

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

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

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

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


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

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

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

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Version
nullVersion Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== PackageDescription -> Version
forall pkg. Package pkg => pkg -> Version
packageVersion PackageDescription
pkg) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildImpossible String
"No 'version' field."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (((PackageDescription -> Bool) -> Bool)
-> [PackageDescription -> Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((PackageDescription -> Bool) -> PackageDescription -> Bool
forall a b. (a -> b) -> a -> b
$ PackageDescription
pkg) [ [Executable] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Executable] -> Bool)
-> (PackageDescription -> [Executable])
-> PackageDescription
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> [Executable]
executables
                       , [TestSuite] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([TestSuite] -> Bool)
-> (PackageDescription -> [TestSuite])
-> PackageDescription
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> [TestSuite]
testSuites
                       , [Benchmark] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Benchmark] -> Bool)
-> (PackageDescription -> [Benchmark])
-> PackageDescription
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> [Benchmark]
benchmarks
                       , [Library] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Library] -> Bool)
-> (PackageDescription -> [Library]) -> PackageDescription -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> [Library]
allLibraries
                       , [ForeignLib] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([ForeignLib] -> Bool)
-> (PackageDescription -> [ForeignLib])
-> PackageDescription
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> [ForeignLib]
foreignLibs ]) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildImpossible
        String
"No executables, libraries, tests, or benchmarks found. Nothing to do."

  , Bool -> PackageCheck -> Maybe PackageCheck
check ((LibraryName -> Bool) -> [LibraryName] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (LibraryName -> LibraryName -> Bool
forall a. Eq a => a -> a -> Bool
== LibraryName
LMainLibName) ((Library -> LibraryName) -> [Library] -> [LibraryName]
forall a b. (a -> b) -> [a] -> [b]
map Library -> LibraryName
libName ([Library] -> [LibraryName]) -> [Library] -> [LibraryName]
forall a b. (a -> b) -> a -> b
$ PackageDescription -> [Library]
subLibraries PackageDescription
pkg)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildImpossible (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$ String
"Found one or more unnamed internal libraries. "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Only the non-internal library can have the same name as the package."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not ([UnqualComponentName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [UnqualComponentName]
duplicateNames)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildImpossible (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$ String
"Duplicate sections: "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep ((UnqualComponentName -> String)
-> [UnqualComponentName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map UnqualComponentName -> String
unUnqualComponentName [UnqualComponentName]
duplicateNames)
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
". The name of every library, executable, test suite,"
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" and benchmark section in"
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" the package must be unique."

  -- NB: but it's OK for executables to have the same name!
  -- TODO shouldn't need to compare on the string level
  , Bool -> PackageCheck -> Maybe PackageCheck
check ((String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== PackageName -> String
forall a. Pretty a => a -> String
prettyShow (PackageDescription -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName PackageDescription
pkg)) (UnqualComponentName -> String
forall a. Pretty a => a -> String
prettyShow (UnqualComponentName -> String)
-> [UnqualComponentName] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [UnqualComponentName]
subLibNames)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildImpossible (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$ String
"Illegal internal library name "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ PackageName -> String
forall a. Pretty a => a -> String
prettyShow (PackageDescription -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName PackageDescription
pkg)
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
". Internal libraries cannot have the same name as the package."
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" Maybe you wanted a non-internal library?"
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" If so, rewrite the section stanza"
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" from 'library: '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ PackageName -> String
forall a. Pretty a => a -> String
prettyShow (PackageDescription -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName PackageDescription
pkg) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' to 'library'."
  ]
  --TODO: check for name clashes case insensitively: windows file systems cannot
  --cope.

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

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

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

    Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not ([ModuleName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ModuleName]
moduleDuplicates)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
       String -> PackageCheck
PackageBuildImpossible (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
            String
"Duplicate modules in library: "
         String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep ((ModuleName -> String) -> [ModuleName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> String
forall a. Pretty a => a -> String
prettyShow [ModuleName]
moduleDuplicates)

  -- TODO: This check is bogus if a required-signature was passed through
  , Bool -> PackageCheck -> Maybe PackageCheck
check ([ModuleName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Library -> [ModuleName]
explicitLibModules Library
lib) Bool -> Bool -> Bool
&& [ModuleReexport] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Library -> [ModuleReexport]
reexportedModules Library
lib)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistSuspiciousWarn (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           LibraryName -> String
showLibraryName (Library -> LibraryName
libName Library
lib) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" does not expose any modules"

    -- check use of signatures sections
  , CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkVersion CabalSpecVersion
CabalSpecV2_0 (Bool -> Bool
not ([ModuleName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Library -> [ModuleName]
signatures Library
lib))) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"To use the 'signatures' field the package needs to specify "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"at least 'cabal-version: 2.0'."

    -- check that all autogen-modules appear on other-modules or exposed-modules
  , Bool -> PackageCheck -> Maybe PackageCheck
check
      (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (ModuleName -> Bool) -> [ModuleName] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map ((ModuleName -> [ModuleName] -> Bool)
-> [ModuleName] -> ModuleName -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip ModuleName -> [ModuleName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (Library -> [ModuleName]
explicitLibModules Library
lib)) (Library -> [ModuleName]
libModulesAutogen Library
lib)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildImpossible (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"An 'autogen-module' is neither on 'exposed-modules' or "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'other-modules'."

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

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

    -- TODO: not sure if this check is always right in Backpack
    moduleDuplicates :: [ModuleName]
moduleDuplicates = [ModuleName] -> [ModuleName]
forall a. Ord a => [a] -> [a]
dups (Library -> [ModuleName]
explicitLibModules Library
lib [ModuleName] -> [ModuleName] -> [ModuleName]
forall a. [a] -> [a] -> [a]
++
                             (ModuleReexport -> ModuleName) -> [ModuleReexport] -> [ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map ModuleReexport -> ModuleName
moduleReexportName (Library -> [ModuleReexport]
reexportedModules Library
lib))

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

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

    Bool -> PackageCheck -> Maybe PackageCheck
check (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Executable -> String
modulePath Executable
exe)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildImpossible (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
        String
"No 'main-is' field found for executable " String -> ShowS
forall a. [a] -> [a] -> [a]
++ UnqualComponentName -> String
forall a. Pretty a => a -> String
prettyShow (Executable -> UnqualComponentName
exeName Executable
exe)

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Executable -> String
modulePath Executable
exe))
       Bool -> Bool -> Bool
&& (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ String -> Bool
fileExtensionSupportedLanguage (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ Executable -> String
modulePath Executable
exe)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildImpossible (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"The 'main-is' field must specify a '.hs' or '.lhs' file "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(even if it is generated by a preprocessor), "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"or it may specify a C/C++/obj-C source file."

  , PackageDescription
-> CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkSpecVersion PackageDescription
pkg CabalSpecVersion
CabalSpecV1_18
          (String -> Bool
fileExtensionSupportedLanguage (Executable -> String
modulePath Executable
exe)
        Bool -> Bool -> Bool
&& ShowS
takeExtension (Executable -> String
modulePath Executable
exe) String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String
".hs", String
".lhs"]) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"The package uses a C/C++/obj-C source file for the 'main-is' field. "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"To use this feature you must specify 'cabal-version: >= 1.18'."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not ([ModuleName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ModuleName]
moduleDuplicates)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
       String -> PackageCheck
PackageBuildImpossible (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
            String
"Duplicate modules in executable '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ UnqualComponentName -> String
forall a. Pretty a => a -> String
prettyShow (Executable -> UnqualComponentName
exeName Executable
exe) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"': "
         String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep ((ModuleName -> String) -> [ModuleName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> String
forall a. Pretty a => a -> String
prettyShow [ModuleName]
moduleDuplicates)

    -- check that all autogen-modules appear on other-modules
  , Bool -> PackageCheck -> Maybe PackageCheck
check
      (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (ModuleName -> Bool) -> [ModuleName] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map ((ModuleName -> [ModuleName] -> Bool)
-> [ModuleName] -> ModuleName -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip ModuleName -> [ModuleName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (Executable -> [ModuleName]
exeModules Executable
exe)) (Executable -> [ModuleName]
exeModulesAutogen Executable
exe)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildImpossible (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"On executable '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ UnqualComponentName -> String
forall a. Pretty a => a -> String
prettyShow (Executable -> UnqualComponentName
exeName Executable
exe) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' an 'autogen-module' is not "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"on 'other-modules'"

    -- check that all autogen-includes appear on includes
  , Bool -> PackageCheck -> Maybe PackageCheck
check
      (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> [String] -> Bool) -> [String] -> String -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (Getting [String] Executable [String] -> Executable -> [String]
forall a s. Getting a s a -> s -> a
view Getting [String] Executable [String]
forall a. HasBuildInfo a => Lens' a [String]
L.includes Executable
exe)) (Getting [String] Executable [String] -> Executable -> [String]
forall a s. Getting a s a -> s -> a
view Getting [String] Executable [String]
forall a. HasBuildInfo a => Lens' a [String]
L.autogenIncludes Executable
exe)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildImpossible String
"An include in 'autogen-includes' is not in 'includes'."
  ]
  where
    moduleDuplicates :: [ModuleName]
moduleDuplicates = [ModuleName] -> [ModuleName]
forall a. Ord a => [a] -> [a]
dups (Executable -> [ModuleName]
exeModules Executable
exe)

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

    case TestSuite -> TestSuiteInterface
testInterface TestSuite
test of
      TestSuiteUnsupported tt :: TestType
tt@(TestTypeUnknown String
_ Version
_) -> PackageCheck -> Maybe PackageCheck
forall a. a -> Maybe a
Just (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
        String -> PackageCheck
PackageBuildWarning (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
             ShowS
quote (TestType -> String
forall a. Pretty a => a -> String
prettyShow TestType
tt) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is not a known type of test suite. "
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"The known test suite types are: "
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep ((TestType -> String) -> [TestType] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map TestType -> String
forall a. Pretty a => a -> String
prettyShow [TestType]
knownTestTypes)

      TestSuiteUnsupported TestType
tt -> PackageCheck -> Maybe PackageCheck
forall a. a -> Maybe a
Just (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
        String -> PackageCheck
PackageBuildWarning (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
             ShowS
quote (TestType -> String
forall a. Pretty a => a -> String
prettyShow TestType
tt) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is not a supported test suite version. "
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"The known test suite types are: "
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep ((TestType -> String) -> [TestType] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map TestType -> String
forall a. Pretty a => a -> String
prettyShow [TestType]
knownTestTypes)
      TestSuiteInterface
_ -> Maybe PackageCheck
forall a. Maybe a
Nothing

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [ModuleName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ModuleName]
moduleDuplicates) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildImpossible (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"Duplicate modules in test suite '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ UnqualComponentName -> String
forall a. Pretty a => a -> String
prettyShow (TestSuite -> UnqualComponentName
testName TestSuite
test) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"': "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep ((ModuleName -> String) -> [ModuleName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> String
forall a. Pretty a => a -> String
prettyShow [ModuleName]
moduleDuplicates)

  , Bool -> PackageCheck -> Maybe PackageCheck
check Bool
mainIsWrongExt (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildImpossible (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"The 'main-is' field must specify a '.hs' or '.lhs' file "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(even if it is generated by a preprocessor), "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"or it may specify a C/C++/obj-C source file."

  , PackageDescription
-> CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkSpecVersion PackageDescription
pkg CabalSpecVersion
CabalSpecV1_18 (Bool
mainIsNotHsExt Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
mainIsWrongExt) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"The package uses a C/C++/obj-C source file for the 'main-is' field. "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"To use this feature you must specify 'cabal-version: >= 1.18'."

    -- check that all autogen-modules appear on other-modules
  , Bool -> PackageCheck -> Maybe PackageCheck
check
      (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (ModuleName -> Bool) -> [ModuleName] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map ((ModuleName -> [ModuleName] -> Bool)
-> [ModuleName] -> ModuleName -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip ModuleName -> [ModuleName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (TestSuite -> [ModuleName]
testModules TestSuite
test)) (TestSuite -> [ModuleName]
testModulesAutogen TestSuite
test)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildImpossible (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"On test suite '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ UnqualComponentName -> String
forall a. Pretty a => a -> String
prettyShow (TestSuite -> UnqualComponentName
testName TestSuite
test) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' an 'autogen-module' is not "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"on 'other-modules'"

    -- check that all autogen-includes appear on includes
  , Bool -> PackageCheck -> Maybe PackageCheck
check
      (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> [String] -> Bool) -> [String] -> String -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (Getting [String] TestSuite [String] -> TestSuite -> [String]
forall a s. Getting a s a -> s -> a
view Getting [String] TestSuite [String]
forall a. HasBuildInfo a => Lens' a [String]
L.includes TestSuite
test)) (Getting [String] TestSuite [String] -> TestSuite -> [String]
forall a s. Getting a s a -> s -> a
view Getting [String] TestSuite [String]
forall a. HasBuildInfo a => Lens' a [String]
L.autogenIncludes TestSuite
test)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildImpossible String
"An include in 'autogen-includes' is not in 'includes'."
  ]
  where
    moduleDuplicates :: [ModuleName]
moduleDuplicates = [ModuleName] -> [ModuleName]
forall a. Ord a => [a] -> [a]
dups ([ModuleName] -> [ModuleName]) -> [ModuleName] -> [ModuleName]
forall a b. (a -> b) -> a -> b
$ TestSuite -> [ModuleName]
testModules TestSuite
test

    mainIsWrongExt :: Bool
mainIsWrongExt = case TestSuite -> TestSuiteInterface
testInterface TestSuite
test of
      TestSuiteExeV10 Version
_ String
f -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ String -> Bool
fileExtensionSupportedLanguage String
f
      TestSuiteInterface
_                   -> Bool
False

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

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

    case Benchmark -> BenchmarkInterface
benchmarkInterface Benchmark
bm of
      BenchmarkUnsupported tt :: BenchmarkType
tt@(BenchmarkTypeUnknown String
_ Version
_) -> PackageCheck -> Maybe PackageCheck
forall a. a -> Maybe a
Just (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
        String -> PackageCheck
PackageBuildWarning (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
             ShowS
quote (BenchmarkType -> String
forall a. Pretty a => a -> String
prettyShow BenchmarkType
tt) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is not a known type of benchmark. "
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"The known benchmark types are: "
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep ((BenchmarkType -> String) -> [BenchmarkType] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map BenchmarkType -> String
forall a. Pretty a => a -> String
prettyShow [BenchmarkType]
knownBenchmarkTypes)

      BenchmarkUnsupported BenchmarkType
tt -> PackageCheck -> Maybe PackageCheck
forall a. a -> Maybe a
Just (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
        String -> PackageCheck
PackageBuildWarning (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
             ShowS
quote (BenchmarkType -> String
forall a. Pretty a => a -> String
prettyShow BenchmarkType
tt) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is not a supported benchmark version. "
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"The known benchmark types are: "
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep ((BenchmarkType -> String) -> [BenchmarkType] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map BenchmarkType -> String
forall a. Pretty a => a -> String
prettyShow [BenchmarkType]
knownBenchmarkTypes)
      BenchmarkInterface
_ -> Maybe PackageCheck
forall a. Maybe a
Nothing

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [ModuleName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ModuleName]
moduleDuplicates) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildImpossible (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"Duplicate modules in benchmark '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ UnqualComponentName -> String
forall a. Pretty a => a -> String
prettyShow (Benchmark -> UnqualComponentName
benchmarkName Benchmark
bm) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"': "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep ((ModuleName -> String) -> [ModuleName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> String
forall a. Pretty a => a -> String
prettyShow [ModuleName]
moduleDuplicates)

  , Bool -> PackageCheck -> Maybe PackageCheck
check Bool
mainIsWrongExt (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildImpossible (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"The 'main-is' field must specify a '.hs' or '.lhs' file "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(even if it is generated by a preprocessor)."

    -- check that all autogen-modules appear on other-modules
  , Bool -> PackageCheck -> Maybe PackageCheck
check
      (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (ModuleName -> Bool) -> [ModuleName] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map ((ModuleName -> [ModuleName] -> Bool)
-> [ModuleName] -> ModuleName -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip ModuleName -> [ModuleName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (Benchmark -> [ModuleName]
benchmarkModules Benchmark
bm)) (Benchmark -> [ModuleName]
benchmarkModulesAutogen Benchmark
bm)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildImpossible (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
             String
"On benchmark '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ UnqualComponentName -> String
forall a. Pretty a => a -> String
prettyShow (Benchmark -> UnqualComponentName
benchmarkName Benchmark
bm) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' an 'autogen-module' is "
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"not on 'other-modules'"

    -- check that all autogen-includes appear on includes
  , Bool -> PackageCheck -> Maybe PackageCheck
check
      (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> [String] -> Bool) -> [String] -> String -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (Getting [String] Benchmark [String] -> Benchmark -> [String]
forall a s. Getting a s a -> s -> a
view Getting [String] Benchmark [String]
forall a. HasBuildInfo a => Lens' a [String]
L.includes Benchmark
bm)) (Getting [String] Benchmark [String] -> Benchmark -> [String]
forall a s. Getting a s a -> s -> a
view Getting [String] Benchmark [String]
forall a. HasBuildInfo a => Lens' a [String]
L.autogenIncludes Benchmark
bm)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildImpossible String
"An include in 'autogen-includes' is not in 'includes'."
  ]
  where
    moduleDuplicates :: [ModuleName]
moduleDuplicates = [ModuleName] -> [ModuleName]
forall a. Ord a => [a] -> [a]
dups ([ModuleName] -> [ModuleName]) -> [ModuleName] -> [ModuleName]
forall a b. (a -> b) -> a -> b
$ Benchmark -> [ModuleName]
benchmarkModules Benchmark
bm

    mainIsWrongExt :: Bool
mainIsWrongExt = case Benchmark -> BenchmarkInterface
benchmarkInterface Benchmark
bm of
      BenchmarkExeV10 Version
_ String
f -> ShowS
takeExtension String
f String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String
".hs", String
".lhs"]
      BenchmarkInterface
_                   -> Bool
False

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

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

    Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not (Bool -> Bool)
-> (PackageDescription -> Bool) -> PackageDescription -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
FilePath.Windows.isValid (String -> Bool)
-> (PackageDescription -> String) -> PackageDescription -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> String
forall a. Pretty a => a -> String
prettyShow (PackageName -> String)
-> (PackageDescription -> PackageName)
-> PackageDescription
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName (PackageDescription -> Bool) -> PackageDescription -> Bool
forall a b. (a -> b) -> a -> b
$ PackageDescription
pkg) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"Unfortunately, the package name '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ PackageName -> String
forall a. Pretty a => a -> String
prettyShow (PackageDescription -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName PackageDescription
pkg)
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' is one of the reserved system file names on Windows. Many tools "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"need to convert package names to file names so using this name "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"would cause problems."

  , Bool -> PackageCheck -> Maybe PackageCheck
check ((String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"z-") (String -> Bool)
-> (PackageDescription -> String) -> PackageDescription -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> String
forall a. Pretty a => a -> String
prettyShow (PackageName -> String)
-> (PackageDescription -> PackageName)
-> PackageDescription
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName (PackageDescription -> Bool) -> PackageDescription -> Bool
forall a b. (a -> b) -> a -> b
$ PackageDescription
pkg) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"Package names with the prefix 'z-' are reserved by Cabal and "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"cannot be used."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Maybe BuildType -> Bool
forall a. Maybe a -> Bool
isNothing (PackageDescription -> Maybe BuildType
buildTypeRaw PackageDescription
pkg) Bool -> Bool -> Bool
&& PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
< CabalSpecVersion
CabalSpecV2_2) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildWarning (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"No 'build-type' specified. If you do not need a custom Setup.hs or "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"./configure script then use 'build-type: Simple'."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Maybe SetupBuildInfo -> Bool
forall a. Maybe a -> Bool
isJust (PackageDescription -> Maybe SetupBuildInfo
setupBuildInfo PackageDescription
pkg) Bool -> Bool -> Bool
&& PackageDescription -> BuildType
buildType PackageDescription
pkg BuildType -> BuildType -> Bool
forall a. Eq a => a -> a -> Bool
/= BuildType
Custom) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildWarning (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"Ignoring the 'custom-setup' section because the 'build-type' is "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"not 'Custom'. Use 'build-type: Custom' if you need to use a "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"custom Setup.hs script."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not ([String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
unknownCompilers)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildWarning (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
        String
"Unknown compiler " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep (ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
quote [String]
unknownCompilers)
                            String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" in 'tested-with' field."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not ([String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
unknownLanguages)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildWarning (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
        String
"Unknown languages: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep [String]
unknownLanguages

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not ([String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
unknownExtensions)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildWarning (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
        String
"Unknown extensions: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep [String]
unknownExtensions

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not ([String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
languagesUsedAsExtensions)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildWarning (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"Languages listed as extensions: "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep [String]
languagesUsedAsExtensions
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
". Languages must be specified in either the 'default-language' "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" or the 'other-languages' field."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not ([(Extension, Maybe Extension)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Extension, Maybe Extension)]
ourDeprecatedExtensions)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistSuspicious (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"Deprecated extensions: "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep (((Extension, Maybe Extension) -> String)
-> [(Extension, Maybe Extension)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (ShowS
quote ShowS
-> ((Extension, Maybe Extension) -> String)
-> (Extension, Maybe Extension)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Extension -> String
forall a. Pretty a => a -> String
prettyShow (Extension -> String)
-> ((Extension, Maybe Extension) -> Extension)
-> (Extension, Maybe Extension)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Extension, Maybe Extension) -> Extension
forall a b. (a, b) -> a
fst) [(Extension, Maybe Extension)]
ourDeprecatedExtensions)
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
". " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords
             [ String
"Instead of '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Extension -> String
forall a. Pretty a => a -> String
prettyShow Extension
ext
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' use '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Extension -> String
forall a. Pretty a => a -> String
prettyShow Extension
replacement String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'."
             | (Extension
ext, Just Extension
replacement) <- [(Extension, Maybe Extension)]
ourDeprecatedExtensions ]

  , Bool -> PackageCheck -> Maybe PackageCheck
check (ShortText -> Bool
ShortText.null (PackageDescription -> ShortText
category PackageDescription
pkg)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistSuspicious String
"No 'category' field."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (ShortText -> Bool
ShortText.null (PackageDescription -> ShortText
maintainer PackageDescription
pkg)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistSuspicious String
"No 'maintainer' field."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (ShortText -> Bool
ShortText.null (PackageDescription -> ShortText
synopsis PackageDescription
pkg) Bool -> Bool -> Bool
&& ShortText -> Bool
ShortText.null (PackageDescription -> ShortText
description PackageDescription
pkg)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable String
"No 'synopsis' or 'description' field."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (ShortText -> Bool
ShortText.null (PackageDescription -> ShortText
description PackageDescription
pkg) Bool -> Bool -> Bool
&& Bool -> Bool
not (ShortText -> Bool
ShortText.null (PackageDescription -> ShortText
synopsis PackageDescription
pkg))) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistSuspicious String
"No 'description' field."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (ShortText -> Bool
ShortText.null (PackageDescription -> ShortText
synopsis PackageDescription
pkg) Bool -> Bool -> Bool
&& Bool -> Bool
not (ShortText -> Bool
ShortText.null (PackageDescription -> ShortText
description PackageDescription
pkg))) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistSuspicious String
"No 'synopsis' field."

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

  , Bool -> PackageCheck -> Maybe PackageCheck
check (ShortText -> Int
ShortText.length (PackageDescription -> ShortText
synopsis PackageDescription
pkg) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
80) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistSuspicious
        String
"The 'synopsis' field is rather long (max 80 chars is recommended)."

    -- See also https://github.com/haskell/cabal/pull/3479
  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not (ShortText -> Bool
ShortText.null (PackageDescription -> ShortText
description PackageDescription
pkg))
           Bool -> Bool -> Bool
&& ShortText -> Int
ShortText.length (PackageDescription -> ShortText
description PackageDescription
pkg) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= ShortText -> Int
ShortText.length (PackageDescription -> ShortText
synopsis PackageDescription
pkg)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistSuspicious (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"The 'description' field should be longer than the 'synopsis' "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"field. "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"It's useful to provide an informative 'description' to allow "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Haskell programmers who have never heard about your package to "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"understand the purpose of your package. "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"The 'description' field content is typically shown by tooling "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(e.g. 'cabal info', Haddock, Hackage) below the 'synopsis' which "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"serves as a headline. "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Please refer to <https://www.haskell.org/"
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"cabal/users-guide/developing-packages.html#package-properties>"
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" for more details."

    -- check use of impossible constraints "tested-with: GHC== 6.10 && ==6.12"
  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not ([Dependency] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Dependency]
testedWithImpossibleRanges)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"Invalid 'tested-with' version range: "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep ((Dependency -> String) -> [Dependency] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Dependency -> String
forall a. Pretty a => a -> String
prettyShow [Dependency]
testedWithImpossibleRanges)
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
". To indicate that you have tested a package with multiple "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"different versions of the same compiler use multiple entries, "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"for example 'tested-with: GHC==6.10.4, GHC==6.12.3' and not "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'tested-with: GHC==6.10.4 && ==6.12.3'."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not ([Dependency] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Dependency]
depInternalLibraryWithExtraVersion)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildWarning (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"The package has an extraneous version range for a dependency on an "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"internal library: "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep ((Dependency -> String) -> [Dependency] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Dependency -> String
forall a. Pretty a => a -> String
prettyShow [Dependency]
depInternalLibraryWithExtraVersion)
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
". This version range includes the current package but isn't needed "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"as the current package's library will always be used."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not ([Dependency] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Dependency]
depInternalLibraryWithImpossibleVersion)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildImpossible (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"The package has an impossible version range for a dependency on an "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"internal library: "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep ((Dependency -> String) -> [Dependency] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Dependency -> String
forall a. Pretty a => a -> String
prettyShow [Dependency]
depInternalLibraryWithImpossibleVersion)
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
". This version range does not include the current package, and must "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"be removed as the current package's library will always be used."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not ([ExeDependency] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ExeDependency]
depInternalExecutableWithExtraVersion)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildWarning (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"The package has an extraneous version range for a dependency on an "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"internal executable: "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep ((ExeDependency -> String) -> [ExeDependency] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ExeDependency -> String
forall a. Pretty a => a -> String
prettyShow [ExeDependency]
depInternalExecutableWithExtraVersion)
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
". This version range includes the current package but isn't needed "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"as the current package's executable will always be used."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not ([ExeDependency] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ExeDependency]
depInternalExecutableWithImpossibleVersion)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildImpossible (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"The package has an impossible version range for a dependency on an "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"internal executable: "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep ((ExeDependency -> String) -> [ExeDependency] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ExeDependency -> String
forall a. Pretty a => a -> String
prettyShow [ExeDependency]
depInternalExecutableWithImpossibleVersion)
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
". This version range does not include the current package, and must "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"be removed as the current package's executable will always be used."

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

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

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

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

    internalLibDeps :: [Dependency]
internalLibDeps =
      [ Dependency
dep
      | BuildInfo
bi <- PackageDescription -> [BuildInfo]
allBuildInfo PackageDescription
pkg
      , dep :: Dependency
dep@(Dependency PackageName
name VersionRange
_ NonEmptySet LibraryName
_) <- BuildInfo -> [Dependency]
targetBuildDepends BuildInfo
bi
      , PackageName
name PackageName -> [PackageName] -> Bool
forall (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 :: [Dependency]
depInternalLibraryWithExtraVersion =
      [ Dependency
dep
      | dep :: Dependency
dep@(Dependency PackageName
_ VersionRange
versionRange NonEmptySet LibraryName
_) <- [Dependency]
internalLibDeps
      , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ VersionRange -> Bool
isAnyVersion VersionRange
versionRange
      , PackageDescription -> Version
forall pkg. Package pkg => pkg -> Version
packageVersion PackageDescription
pkg Version -> VersionRange -> Bool
`withinRange` VersionRange
versionRange
      ]

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

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

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

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


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

checkNewLicense :: PackageDescription -> SPDX.License -> [PackageCheck]
checkNewLicense :: PackageDescription -> License -> [PackageCheck]
checkNewLicense PackageDescription
_pkg License
lic = [Maybe PackageCheck] -> [PackageCheck]
forall a. [Maybe a] -> [a]
catMaybes
    [ Bool -> PackageCheck -> Maybe PackageCheck
check (License
lic License -> License -> Bool
forall a. Eq a => a -> a -> Bool
== License
SPDX.NONE) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
        String -> PackageCheck
PackageDistInexcusable
            String
"The 'license' field is missing or is NONE."
    ]

checkOldLicense :: PackageDescription -> License -> [PackageCheck]
checkOldLicense :: PackageDescription -> License -> [PackageCheck]
checkOldLicense PackageDescription
pkg License
lic = [Maybe PackageCheck] -> [PackageCheck]
forall a. [Maybe a] -> [a]
catMaybes
  [ Bool -> PackageCheck -> Maybe PackageCheck
check (License
lic License -> License -> Bool
forall a. Eq a => a -> a -> Bool
== License
UnspecifiedLicense) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable
        String
"The 'license' field is missing."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (License
lic License -> License -> Bool
forall a. Eq a => a -> a -> Bool
== License
AllRightsReserved) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistSuspicious
        String
"The 'license' is AllRightsReserved. Is that really what you want?"

  , CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkVersion CabalSpecVersion
CabalSpecV1_4 (License
lic License -> [License] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [License]
compatLicenses) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"Unfortunately the license " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
quote (License -> String
forall a. Pretty a => a -> String
prettyShow (PackageDescription -> License
license PackageDescription
pkg))
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" messes up the parser in earlier Cabal versions so you need to "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"specify 'cabal-version: >= 1.4'. Alternatively if you require "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"compatibility with earlier Cabal versions then use 'OtherLicense'."

  , case License
lic of
      UnknownLicense String
l -> PackageCheck -> Maybe PackageCheck
forall a. a -> Maybe a
Just (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
        String -> PackageCheck
PackageBuildWarning (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
             ShowS
quote (String
"license: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
l) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is not a recognised license. The "
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"known licenses are: "
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep ((License -> String) -> [License] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map License -> String
forall a. Pretty a => a -> String
prettyShow [License]
knownLicenses)
      License
_ -> Maybe PackageCheck
forall a. Maybe a
Nothing

  , Bool -> PackageCheck -> Maybe PackageCheck
check (License
lic License -> License -> Bool
forall a. Eq a => a -> a -> Bool
== License
BSD4) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistSuspicious (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"Using 'license: BSD4' is almost always a misunderstanding. 'BSD4' "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"refers to the old 4-clause BSD license with the advertising "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"clause. 'BSD3' refers the new 3-clause BSD license."

  , case License -> Maybe [Version]
unknownLicenseVersion (License
lic) of
      Just [Version]
knownVersions -> PackageCheck -> Maybe PackageCheck
forall a. a -> Maybe a
Just (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
        String -> PackageCheck
PackageDistSuspicious (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
             String
"'license: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ License -> String
forall a. Pretty a => a -> String
prettyShow (License
lic) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' is not a known "
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"version of that license. The known versions are "
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep ((Version -> String) -> [Version] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Version -> String
forall a. Pretty a => a -> String
prettyShow [Version]
knownVersions)
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
". If this is not a mistake and you think it should be a known "
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"version then please file a ticket."
      Maybe [Version]
_ -> Maybe PackageCheck
forall a. Maybe a
Nothing

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

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

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

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

    case SourceRepo -> RepoKind
repoKind SourceRepo
repo of
      RepoKindUnknown String
kind -> PackageCheck -> Maybe PackageCheck
forall a. a -> Maybe a
Just (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$ String -> PackageCheck
PackageDistInexcusable (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
        ShowS
quote String
kind String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is not a recognised kind of source-repository. "
                   String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"The repo kind is usually 'head' or 'this'"
      RepoKind
_ -> Maybe PackageCheck
forall a. Maybe a
Nothing

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Maybe RepoType -> Bool
forall a. Maybe a -> Bool
isNothing (SourceRepo -> Maybe RepoType
repoType SourceRepo
repo)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable
        String
"The source-repository 'type' is a required field."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing (SourceRepo -> Maybe String
repoLocation SourceRepo
repo)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable
        String
"The source-repository 'location' is a required field."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (SourceRepo -> Maybe RepoType
repoType SourceRepo
repo Maybe RepoType -> Maybe RepoType -> Bool
forall a. Eq a => a -> a -> Bool
== RepoType -> Maybe RepoType
forall a. a -> Maybe a
Just (KnownRepoType -> RepoType
KnownRepoType KnownRepoType
CVS) Bool -> Bool -> Bool
&& Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing (SourceRepo -> Maybe String
repoModule SourceRepo
repo)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable
        String
"For a CVS source-repository, the 'module' is a required field."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (SourceRepo -> RepoKind
repoKind SourceRepo
repo RepoKind -> RepoKind -> Bool
forall a. Eq a => a -> a -> Bool
== RepoKind
RepoThis Bool -> Bool -> Bool
&& Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing (SourceRepo -> Maybe String
repoTag SourceRepo
repo)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"For the 'this' kind of source-repository, the 'tag' is a required "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"field. It should specify the tag corresponding to this version "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"or release of the package."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> (String -> Bool) -> Maybe String -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False String -> Bool
isAbsoluteOnAnyPlatform (SourceRepo -> Maybe String
repoSubdir SourceRepo
repo)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable
        String
"The 'subdir' field of a source-repository must be a relative path."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> (String -> Bool) -> Maybe String -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False String -> Bool
isAbsoluteOnAnyPlatform (SourceRepo -> Maybe String
repoSubdir SourceRepo
repo)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable
        String
"The 'subdir' field of a source-repository must be a relative path."

  , do
      String
subdir <- SourceRepo -> Maybe String
repoSubdir SourceRepo
repo
      String
err    <- String -> Maybe String
isGoodRelativeDirectoryPath String
subdir
      PackageCheck -> Maybe PackageCheck
forall (m :: * -> *) a. Monad m => a -> m a
return (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$ String -> PackageCheck
PackageDistInexcusable (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
        String
"The 'subdir' field of a source-repository is not a good relative path: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
err
  ]
  | SourceRepo
repo <- PackageDescription -> [SourceRepo]
sourceRepos PackageDescription
pkg ]

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

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

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

    [String] -> PackageCheck -> Maybe PackageCheck
checkFlags [String
"-fasm"] (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fieldName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": -fasm' is unnecessary and will not work on CPU "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"architectures other than x86, x86-64, ppc or sparc."

  , [String] -> PackageCheck -> Maybe PackageCheck
checkFlags [String
"-fvia-C"] (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistSuspicious (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fieldName String -> ShowS
forall a. [a] -> [a] -> [a]
++String
": -fvia-C' is usually unnecessary. If your package "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"needs -via-C for correctness rather than performance then it "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"is using the FFI incorrectly and will probably not work with GHC "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"6.10 or later."

  , [String] -> PackageCheck -> Maybe PackageCheck
checkFlags [String
"-fhpc"] (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fieldName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": -fhpc' is not necessary. Use the configure flag "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" --enable-coverage instead."

  , [String] -> PackageCheck -> Maybe PackageCheck
checkFlags [String
"-prof"] (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildWarning (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fieldName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": -prof' is not necessary and will lead to problems "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"when used on a library. Use the configure flag "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"--enable-library-profiling and/or --enable-profiling."

  , [String] -> PackageCheck -> Maybe PackageCheck
checkFlags [String
"-o"] (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildWarning (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fieldName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": -o' is not needed. "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"The output files are named automatically."

  , [String] -> PackageCheck -> Maybe PackageCheck
checkFlags [String
"-hide-package"] (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildWarning (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
      String
"'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fieldName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": -hide-package' is never needed. "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Cabal hides all packages."

  , [String] -> PackageCheck -> Maybe PackageCheck
checkFlags [String
"--make"] (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildWarning (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
      String
"'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fieldName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": --make' is never needed. Cabal uses this automatically."

  , [String] -> PackageCheck -> Maybe PackageCheck
checkFlags [String
"-main-is"] (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistSuspicious (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
      String
"'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fieldName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": -main-is' is not portable."

  , [String] -> PackageCheck -> Maybe PackageCheck
checkNonTestAndBenchmarkFlags [String
"-O0", String
"-Onot"] (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistSuspicious (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
      String
"'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fieldName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": -O0' is not needed. "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Use the --disable-optimization configure flag."

  , [String] -> PackageCheck -> Maybe PackageCheck
checkTestAndBenchmarkFlags [String
"-O0", String
"-Onot"] (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistSuspiciousWarn (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
      String
"'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fieldName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": -O0' is not needed. "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Use the --disable-optimization configure flag."

  , [String] -> PackageCheck -> Maybe PackageCheck
checkFlags [ String
"-O", String
"-O1"] (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
      String
"'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fieldName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": -O' is not needed. "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Cabal automatically adds the '-O' flag. "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Setting it yourself interferes with the --disable-optimization flag."

  , [String] -> PackageCheck -> Maybe PackageCheck
checkFlags [String
"-O2"] (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistSuspiciousWarn (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
      String
"'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fieldName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": -O2' is rarely needed. "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Check that it is giving a real benefit "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"and not just imposing longer compile times on your users."

  , [String] -> PackageCheck -> Maybe PackageCheck
checkFlags [String
"-split-sections"] (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildWarning (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
        String
"'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fieldName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": -split-sections' is not needed. "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Use the --enable-split-sections configure flag."

  , [String] -> PackageCheck -> Maybe PackageCheck
checkFlags [String
"-split-objs"] (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildWarning (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
        String
"'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fieldName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": -split-objs' is not needed. "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Use the --enable-split-objs configure flag."

  , [String] -> PackageCheck -> Maybe PackageCheck
checkFlags [String
"-optl-Wl,-s", String
"-optl-s"] (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fieldName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": -optl-Wl,-s' is not needed and is not portable to all"
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" operating systems. Cabal 1.4 and later automatically strip"
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" executables. Cabal also has a flag --disable-executable-stripping"
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" which is necessary when building packages for some Linux"
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" distributions and using '-optl-Wl,-s' prevents that from working."

  , [String] -> PackageCheck -> Maybe PackageCheck
checkFlags [String
"-fglasgow-exts"] (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistSuspicious (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
        String
"Instead of '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fieldName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": -fglasgow-exts' it is preferable to use "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"the 'extensions' field."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (String
"-threaded" String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
lib_ghc_options) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildWarning (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fieldName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": -threaded' has no effect for libraries. It should "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"only be used for executables."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (String
"-rtsopts" String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
lib_ghc_options) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildWarning (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fieldName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": -rtsopts' has no effect for libraries. It should "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"only be used for executables."

  , Bool -> PackageCheck -> Maybe PackageCheck
check ((String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\String
opt -> String
"-with-rtsopts" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
opt) [String]
lib_ghc_options) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildWarning (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fieldName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": -with-rtsopts' has no effect for libraries. It "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"should only be used for executables."

  , String -> String -> [(String, String)] -> Maybe PackageCheck
checkAlternatives String
fieldName String
"extensions"
      [ (String
flag, Extension -> String
forall a. Pretty a => a -> String
prettyShow Extension
extension) | String
flag <- [String]
all_ghc_options
                                  , 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]
all_ghc_options ]

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

  , 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]
all_ghc_options ]

  , 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]
all_ghc_options ]

  , 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]
all_ghc_options ]

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

  , [String] -> PackageCheck -> Maybe PackageCheck
checkCCFlags [ String
"-O", String
"-Os", String
"-O0", String
"-O1", String
"-O2", String
"-O3" ] (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistSuspicious (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"'"String -> ShowS
forall a. [a] -> [a] -> [a]
++String
prefixString -> ShowS
forall a. [a] -> [a] -> [a]
++String
": -O[n]' is generally not needed. When building with "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" optimisations Cabal automatically adds '-O2' for "String -> ShowS
forall a. [a] -> [a] -> [a]
++String
labelString -> ShowS
forall a. [a] -> [a] -> [a]
++String
" code. "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Setting it yourself interferes with the --disable-optimization flag."
  ]

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

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

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

checkAlternatives :: String -> String -> [(String, String)]
                  -> Maybe PackageCheck
checkAlternatives :: String -> String -> [(String, String)] -> Maybe PackageCheck
checkAlternatives String
badField String
goodField [(String, String)]
flags =
  Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not ([String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
badFlags)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
    String -> PackageCheck
PackageBuildWarning (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
         String
"Instead of " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
quote (String
badField String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
badFlags)
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" use " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
quote (String
goodField String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
goodFlags)

  where ([String]
badFlags, [String]
goodFlags) = [(String, String)] -> ([String], [String])
forall a b. [(a, b)] -> ([a], [b])
unzip [(String, String)]
flags

data PathKind
    = PathKindFile
    | PathKindDirectory
    | PathKindGlob

checkPaths :: PackageDescription -> [PackageCheck]
checkPaths :: PackageDescription -> [PackageCheck]
checkPaths PackageDescription
pkg =
  [ String -> PackageCheck
PackageBuildWarning (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
         ShowS
quote (String
field String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
path)
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is a relative path outside of the source tree. "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"This will not work when generating a tarball with 'sdist'."
  | (String
path, String
field, PathKind
_) <- [(String, String, PathKind)]
relPaths [(String, String, PathKind)]
-> [(String, String, PathKind)] -> [(String, String, PathKind)]
forall a. [a] -> [a] -> [a]
++ [(String, String, PathKind)]
absPaths
  , String -> Bool
isOutsideTree String
path ]
  [PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. [a] -> [a] -> [a]
++
  [ String -> PackageCheck
PackageDistInexcusable (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
      ShowS
quote (String
field String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
path) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is an absolute path."
  | (String
path, String
field, PathKind
_) <- [(String, String, PathKind)]
relPaths
  , String -> Bool
isAbsoluteOnAnyPlatform String
path ]
  [PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. [a] -> [a] -> [a]
++
  [ String -> PackageCheck
PackageDistInexcusable (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
      ShowS
quote (String
field String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
path) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is not good relative path: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
err
  | (String
path, String
field, PathKind
kind) <- [(String, String, PathKind)]
relPaths
  -- these are not paths, but globs...
  , String
err <- Maybe String -> [String]
forall a. Maybe a -> [a]
maybeToList (Maybe String -> [String]) -> Maybe String -> [String]
forall a b. (a -> b) -> a -> b
$ case PathKind
kind of
      PathKind
PathKindFile      -> String -> Maybe String
isGoodRelativeFilePath String
path
      PathKind
PathKindGlob      -> String -> Maybe String
isGoodRelativeGlob String
path
      PathKind
PathKindDirectory -> String -> Maybe String
isGoodRelativeDirectoryPath String
path
  ]
  [PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. [a] -> [a] -> [a]
++
  [ String -> PackageCheck
PackageDistInexcusable (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
         ShowS
quote (String
field String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
path) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" points inside the 'dist' "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"directory. This is not reliable because the location of this "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"directory is configurable by the user (or package manager). In "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"addition the layout of the 'dist' directory is subject to change "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"in future versions of Cabal."
  | (String
path, String
field, PathKind
_) <- [(String, String, PathKind)]
relPaths [(String, String, PathKind)]
-> [(String, String, PathKind)] -> [(String, String, PathKind)]
forall a. [a] -> [a] -> [a]
++ [(String, String, PathKind)]
absPaths
  , String -> Bool
isInsideDist String
path ]
  [PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. [a] -> [a] -> [a]
++
  [ String -> PackageCheck
PackageDistInexcusable (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
         String
"The 'ghc-options' contains the path '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
path String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' which points "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"inside the 'dist' directory. This is not reliable because the "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"location of this directory is configurable by the user (or package "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"manager). In addition the layout of the 'dist' directory is subject "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"to change in future versions of Cabal."
  | BuildInfo
bi <- PackageDescription -> [BuildInfo]
allBuildInfo PackageDescription
pkg
  , (CompilerFlavor
GHC, [String]
flags) <- PerCompilerFlavor [String] -> [(CompilerFlavor, [String])]
forall v. PerCompilerFlavor v -> [(CompilerFlavor, v)]
perCompilerFlavorToList (PerCompilerFlavor [String] -> [(CompilerFlavor, [String])])
-> PerCompilerFlavor [String] -> [(CompilerFlavor, [String])]
forall a b. (a -> b) -> a -> b
$ BuildInfo -> PerCompilerFlavor [String]
options BuildInfo
bi
  , String
path <- [String]
flags
  , String -> Bool
isInsideDist String
path ]
  [PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. [a] -> [a] -> [a]
++
  [ String -> PackageCheck
PackageDistInexcusable (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
        String
"In the 'data-files' field: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> GlobSyntaxError -> String
explainGlobSyntaxError String
pat GlobSyntaxError
err
  | String
pat <- PackageDescription -> [String]
dataFiles PackageDescription
pkg
  , Left GlobSyntaxError
err <- [CabalSpecVersion -> String -> Either GlobSyntaxError Glob
parseFileGlob (PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg) String
pat]
  ]
  [PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. [a] -> [a] -> [a]
++
  [ String -> PackageCheck
PackageDistInexcusable (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
        String
"In the 'extra-source-files' field: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> GlobSyntaxError -> String
explainGlobSyntaxError String
pat GlobSyntaxError
err
  | String
pat <- PackageDescription -> [String]
extraSrcFiles PackageDescription
pkg
  , Left GlobSyntaxError
err <- [CabalSpecVersion -> String -> Either GlobSyntaxError Glob
parseFileGlob (PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg) String
pat]
  ]
  [PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. [a] -> [a] -> [a]
++
  [ String -> PackageCheck
PackageDistInexcusable (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
        String
"In the 'extra-doc-files' field: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> GlobSyntaxError -> String
explainGlobSyntaxError String
pat GlobSyntaxError
err
  | String
pat <- PackageDescription -> [String]
extraDocFiles PackageDescription
pkg
  , Left GlobSyntaxError
err <- [CabalSpecVersion -> String -> Either GlobSyntaxError Glob
parseFileGlob (PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg) String
pat]
  ]
  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 ShowS -> [String] -> [String]
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 ] [(String, String, PathKind)]
-> [(String, String, PathKind)] -> [(String, String, PathKind)]
forall a. [a] -> [a] -> [a]
++
      [ (String
path, String
"extra-tmp-files",    PathKind
PathKindFile)      | String
path <- PackageDescription -> [String]
extraTmpFiles PackageDescription
pkg ] [(String, String, PathKind)]
-> [(String, String, PathKind)] -> [(String, String, PathKind)]
forall a. [a] -> [a] -> [a]
++
      [ (String
path, String
"extra-doc-files",    PathKind
PathKindGlob)      | String
path <- PackageDescription -> [String]
extraDocFiles PackageDescription
pkg ] [(String, String, PathKind)]
-> [(String, String, PathKind)] -> [(String, String, PathKind)]
forall a. [a] -> [a] -> [a]
++
      [ (String
path, String
"data-files",         PathKind
PathKindGlob)      | String
path <- PackageDescription -> [String]
dataFiles     PackageDescription
pkg ] [(String, String, PathKind)]
-> [(String, String, PathKind)] -> [(String, String, PathKind)]
forall a. [a] -> [a] -> [a]
++
      [ (String
path, String
"data-dir",           PathKind
PathKindDirectory) | String
path <- [PackageDescription -> String
dataDir      PackageDescription
pkg]] [(String, String, PathKind)]
-> [(String, String, PathKind)] -> [(String, String, PathKind)]
forall a. [a] -> [a] -> [a]
++
      [ (String
path, String
"license-file",       PathKind
PathKindFile)      | String
path <- PackageDescription -> [String]
licenseFiles  PackageDescription
pkg ] [(String, String, PathKind)]
-> [(String, String, PathKind)] -> [(String, String, PathKind)]
forall a. [a] -> [a] -> [a]
++
      [[(String, String, PathKind)]] -> [(String, String, PathKind)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ [ (String
path, String
"asm-sources",      PathKind
PathKindFile)      | String
path <- BuildInfo -> [String]
asmSources      BuildInfo
bi ] [(String, String, PathKind)]
-> [(String, String, PathKind)] -> [(String, String, PathKind)]
forall a. [a] -> [a] -> [a]
++
          [ (String
path, String
"cmm-sources",      PathKind
PathKindFile)      | String
path <- BuildInfo -> [String]
cmmSources      BuildInfo
bi ] [(String, String, PathKind)]
-> [(String, String, PathKind)] -> [(String, String, PathKind)]
forall a. [a] -> [a] -> [a]
++
          [ (String
path, String
"c-sources",        PathKind
PathKindFile)      | String
path <- BuildInfo -> [String]
cSources        BuildInfo
bi ] [(String, String, PathKind)]
-> [(String, String, PathKind)] -> [(String, String, PathKind)]
forall a. [a] -> [a] -> [a]
++
          [ (String
path, String
"cxx-sources",      PathKind
PathKindFile)      | String
path <- BuildInfo -> [String]
cxxSources      BuildInfo
bi ] [(String, String, PathKind)]
-> [(String, String, PathKind)] -> [(String, String, PathKind)]
forall a. [a] -> [a] -> [a]
++
          [ (String
path, String
"js-sources",       PathKind
PathKindFile)      | String
path <- BuildInfo -> [String]
jsSources       BuildInfo
bi ] [(String, String, PathKind)]
-> [(String, String, PathKind)] -> [(String, String, PathKind)]
forall a. [a] -> [a] -> [a]
++
          [ (String
path, String
"install-includes", PathKind
PathKindFile)      | String
path <- BuildInfo -> [String]
installIncludes BuildInfo
bi ] [(String, String, PathKind)]
-> [(String, String, PathKind)] -> [(String, String, PathKind)]
forall a. [a] -> [a] -> [a]
++
          [ (String
path, String
"hs-source-dirs",   PathKind
PathKindDirectory) | String
path <- BuildInfo -> [String]
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 = [[(String, String, PathKind)]] -> [(String, String, PathKind)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [ [ (String
path, String
"includes",       PathKind
PathKindFile)      | String
path <- BuildInfo -> [String]
includes     BuildInfo
bi ] [(String, String, PathKind)]
-> [(String, String, PathKind)] -> [(String, String, PathKind)]
forall a. [a] -> [a] -> [a]
++
        [ (String
path, String
"include-dirs",   PathKind
PathKindDirectory) | String
path <- BuildInfo -> [String]
includeDirs  BuildInfo
bi ] [(String, String, PathKind)]
-> [(String, String, PathKind)] -> [(String, String, PathKind)]
forall a. [a] -> [a] -> [a]
++
        [ (String
path, String
"extra-lib-dirs", PathKind
PathKindDirectory) | String
path <- BuildInfo -> [String]
extraLibDirs BuildInfo
bi ]
      | BuildInfo
bi <- PackageDescription -> [BuildInfo]
allBuildInfo 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 =
  [Maybe PackageCheck] -> [PackageCheck]
forall a. [Maybe a] -> [a]
catMaybes [

    -- check use of test suite sections
    CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkVersion CabalSpecVersion
CabalSpecV1_8 (Bool -> Bool
not ([TestSuite] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([TestSuite] -> Bool) -> [TestSuite] -> Bool
forall a b. (a -> b) -> a -> b
$ PackageDescription -> [TestSuite]
testSuites PackageDescription
pkg)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"The 'test-suite' section is new in Cabal 1.10. "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Unfortunately it messes up the parser in older Cabal versions "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"so you must specify at least 'cabal-version: >= 1.8', but note "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"that only Cabal 1.10 and later can actually run such test suites."

    -- 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 ((Maybe Language -> Bool) -> [Maybe Language] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Maybe Language -> Bool
forall a. Maybe a -> Bool
isJust ((BuildInfo -> Maybe Language) -> [Maybe Language]
forall b. (BuildInfo -> b) -> [b]
buildInfoField BuildInfo -> Maybe Language
defaultLanguage)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildWarning (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"To use the 'default-language' field the package needs to specify "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"at least 'cabal-version: >= 1.10'."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecV1_10 Bool -> Bool -> Bool
&& PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
< CabalSpecVersion
CabalSpecV3_4
           Bool -> Bool -> Bool
&& ((Maybe Language -> Bool) -> [Maybe Language] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Maybe Language -> Bool
forall a. Maybe a -> Bool
isNothing ((BuildInfo -> Maybe Language) -> [Maybe Language]
forall b. (BuildInfo -> b) -> [b]
buildInfoField BuildInfo -> Maybe Language
defaultLanguage))) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildWarning (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"Packages using 'cabal-version: >= 1.10' and before 'cabal-version: 3.4' must specify the "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'default-language' field for each component (e.g. Haskell98 or "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Haskell2010). If a component uses different languages in "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"different modules then list the other ones in the "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'other-languages' field."

  , CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkVersion CabalSpecVersion
CabalSpecV1_18
    (Bool -> Bool
not (Bool -> Bool) -> ([String] -> Bool) -> [String] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([String] -> Bool) -> [String] -> Bool
forall a b. (a -> b) -> a -> b
$ PackageDescription -> [String]
extraDocFiles PackageDescription
pkg) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"To use the 'extra-doc-files' field the package needs to specify "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"at least 'cabal-version: >= 1.18'."

  , CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkVersion CabalSpecVersion
CabalSpecV2_0
    (Bool -> Bool
not ([Library] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (PackageDescription -> [Library]
subLibraries PackageDescription
pkg))) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"To use multiple 'library' sections or a named library section "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"the package needs to specify at least 'cabal-version: 2.0'."

    -- check use of reexported-modules sections
  , CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkVersion CabalSpecVersion
CabalSpecV1_22
    ((Library -> Bool) -> [Library] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not(Bool -> Bool) -> (Library -> Bool) -> Library -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[ModuleReexport] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null([ModuleReexport] -> Bool)
-> (Library -> [ModuleReexport]) -> Library -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Library -> [ModuleReexport]
reexportedModules) (PackageDescription -> [Library]
allLibraries PackageDescription
pkg)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"To use the 'reexported-module' field the package needs to specify "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"at least 'cabal-version: >= 1.22'."

    -- check use of thinning and renaming
  , CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkVersion CabalSpecVersion
CabalSpecV2_0 Bool
usesBackpackIncludes (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"To use the 'mixins' field the package needs to specify "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"at least 'cabal-version: 2.0'."

    -- check use of 'extra-framework-dirs' field
  , CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkVersion CabalSpecVersion
CabalSpecV1_24 (([String] -> Bool) -> [[String]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not (Bool -> Bool) -> ([String] -> Bool) -> [String] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ((BuildInfo -> [String]) -> [[String]]
forall b. (BuildInfo -> b) -> [b]
buildInfoField BuildInfo -> [String]
extraFrameworkDirs)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      -- Just a warning, because this won't break on old Cabal versions.
      String -> PackageCheck
PackageDistSuspiciousWarn (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"To use the 'extra-framework-dirs' field the package needs to specify"
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" at least 'cabal-version: >= 1.24'."

    -- 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 (([Extension] -> Bool) -> [[Extension]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not (Bool -> Bool) -> ([Extension] -> Bool) -> [Extension] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Extension] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ((BuildInfo -> [Extension]) -> [[Extension]]
forall b. (BuildInfo -> b) -> [b]
buildInfoField BuildInfo -> [Extension]
defaultExtensions)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildWarning (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"To use the 'default-extensions' field the package needs to specify "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"at least 'cabal-version: >= 1.10'."

    -- check use of extensions field
  , Bool -> PackageCheck -> Maybe PackageCheck
check (PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecV1_10
           Bool -> Bool -> Bool
&& (([Extension] -> Bool) -> [[Extension]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not (Bool -> Bool) -> ([Extension] -> Bool) -> [Extension] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Extension] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ((BuildInfo -> [Extension]) -> [[Extension]]
forall b. (BuildInfo -> b) -> [b]
buildInfoField BuildInfo -> [Extension]
oldExtensions))) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildWarning (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"For packages using 'cabal-version: >= 1.10' the 'extensions' "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"field is deprecated. The new 'default-extensions' field lists "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"extensions that are used in all modules in the component, while "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"the 'other-extensions' field lists extensions that are used in "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"some modules, e.g. via the {-# LANGUAGE #-} pragma."

  , CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkVersion CabalSpecVersion
CabalSpecV3_0 (([String] -> Bool) -> [[String]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not (Bool -> Bool) -> ([String] -> Bool) -> [String] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null)
                        (((BuildInfo -> [String]) -> [[String]])
-> [BuildInfo -> [String]] -> [[String]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (BuildInfo -> [String]) -> [[String]]
forall b. (BuildInfo -> b) -> [b]
buildInfoField
                         [ BuildInfo -> [String]
asmSources
                         , BuildInfo -> [String]
cmmSources
                         , BuildInfo -> [String]
extraBundledLibs
                         , BuildInfo -> [String]
extraLibFlavours ])) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"The use of 'asm-sources', 'cmm-sources', 'extra-bundled-libraries' "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" and 'extra-library-flavours' requires the package "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" to specify at least 'cabal-version: 3.0'."

  , CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkVersion CabalSpecVersion
CabalSpecV3_0 (([String] -> Bool) -> [[String]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not (Bool -> Bool) -> ([String] -> Bool) -> [String] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([[String]] -> Bool) -> [[String]] -> Bool
forall a b. (a -> b) -> a -> b
$ (BuildInfo -> [String]) -> [[String]]
forall b. (BuildInfo -> b) -> [b]
buildInfoField BuildInfo -> [String]
extraDynLibFlavours) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"The use of 'extra-dynamic-library-flavours' requires the package "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" to specify at least 'cabal-version: 3.0'. The flavours are: "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep [ String
flav
                    | [String]
flavs <- (BuildInfo -> [String]) -> [[String]]
forall b. (BuildInfo -> b) -> [b]
buildInfoField BuildInfo -> [String]
extraDynLibFlavours
                    , String
flav <- [String]
flavs ]

  , CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkVersion CabalSpecVersion
CabalSpecV2_2 (([ModuleName] -> Bool) -> [[ModuleName]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not (Bool -> Bool) -> ([ModuleName] -> Bool) -> [ModuleName] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ModuleName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null)
                        ((BuildInfo -> [ModuleName]) -> [[ModuleName]]
forall b. (BuildInfo -> b) -> [b]
buildInfoField BuildInfo -> [ModuleName]
virtualModules)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"The use of 'virtual-modules' requires the package "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" to specify at least 'cabal-version: 2.2'."

    -- check use of "source-repository" section
  , CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkVersion CabalSpecVersion
CabalSpecV1_6 (Bool -> Bool
not ([SourceRepo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (PackageDescription -> [SourceRepo]
sourceRepos PackageDescription
pkg))) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"The 'source-repository' section is new in Cabal 1.6. "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Unfortunately it messes up the parser in earlier Cabal versions "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"so you need to specify 'cabal-version: >= 1.6'."

    -- check for new language extensions
  , CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkVersion CabalSpecVersion
CabalSpecV1_4 (Bool -> Bool
not ([Extension] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Extension]
mentionedExtensionsThatNeedCabal12)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"Unfortunately the language extensions "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep ((Extension -> String) -> [Extension] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (ShowS
quote ShowS -> (Extension -> String) -> Extension -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Extension -> String
forall a. Pretty a => a -> String
prettyShow) [Extension]
mentionedExtensionsThatNeedCabal12)
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" break the parser in earlier Cabal versions so you need to "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"specify 'cabal-version: >= 1.4'. Alternatively if you require "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"compatibility with earlier Cabal versions then you may be able to "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"use an equivalent compiler-specific flag."

  , CabalSpecVersion -> Bool -> PackageCheck -> Maybe PackageCheck
checkVersion CabalSpecVersion
CabalSpecV1_4 (Bool -> Bool
not ([Extension] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Extension]
mentionedExtensionsThatNeedCabal14)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"Unfortunately the language extensions "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep ((Extension -> String) -> [Extension] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (ShowS
quote ShowS -> (Extension -> String) -> Extension -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Extension -> String
forall a. Pretty a => a -> String
prettyShow) [Extension]
mentionedExtensionsThatNeedCabal14)
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" break the parser in earlier Cabal versions so you need to "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"specify 'cabal-version: >= 1.4'. Alternatively if you require "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"compatibility with earlier Cabal versions then you may be able to "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"use an equivalent compiler-specific flag."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecV1_24
           Bool -> Bool -> Bool
&& Maybe SetupBuildInfo -> Bool
forall a. Maybe a -> Bool
isNothing (PackageDescription -> Maybe SetupBuildInfo
setupBuildInfo PackageDescription
pkg)
           Bool -> Bool -> Bool
&& PackageDescription -> BuildType
buildType PackageDescription
pkg BuildType -> BuildType -> Bool
forall a. Eq a => a -> a -> Bool
== BuildType
Custom) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageBuildWarning (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"Packages using 'cabal-version: >= 1.24' with 'build-type: Custom' "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"must use a 'custom-setup' section with a 'setup-depends' field "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"that specifies the dependencies of the Setup.hs script itself. "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"The 'setup-depends' field uses the same syntax as 'build-depends', "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"so a simple example would be 'setup-depends: base, Cabal'."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
< CabalSpecVersion
CabalSpecV1_24
           Bool -> Bool -> Bool
&& Maybe SetupBuildInfo -> Bool
forall a. Maybe a -> Bool
isNothing (PackageDescription -> Maybe SetupBuildInfo
setupBuildInfo PackageDescription
pkg)
           Bool -> Bool -> Bool
&& PackageDescription -> BuildType
buildType PackageDescription
pkg BuildType -> BuildType -> Bool
forall a. Eq a => a -> a -> Bool
== BuildType
Custom) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistSuspiciousWarn (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"From version 1.24 cabal supports specifying explicit dependencies "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"for Custom setup scripts. Consider using cabal-version >= 1.24 and "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"adding a 'custom-setup' section with a 'setup-depends' field "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"that specifies the dependencies of the Setup.hs script itself. "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"The 'setup-depends' field uses the same syntax as 'build-depends', "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"so a simple example would be 'setup-depends: base, Cabal'."

  , Bool -> PackageCheck -> Maybe PackageCheck
check (PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecV2_0
           Bool -> Bool -> Bool
&& ModuleName -> [ModuleName] -> 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 (ModuleName -> [ModuleName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (PackageDescription -> ModuleName
autogenPathsModuleName PackageDescription
pkg) [ModuleName]
allModuleNamesAutogen) ) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"Packages using 'cabal-version: 2.0' and the autogenerated "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"module Paths_* must include it also on the 'autogen-modules' field "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"besides 'exposed-modules' and 'other-modules'. This specifies that "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"the module does not come with the package and is generated on "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"setup. Modules built with a custom Setup.hs script also go here "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"to ensure that commands like sdist don't fail."

  ]
  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 CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
ver = Maybe PackageCheck
forall a. Maybe a
Nothing
      | Bool
otherwise              = Bool -> PackageCheck -> Maybe PackageCheck
check Bool
cond PackageCheck
pc

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

    usesBackpackIncludes :: Bool
usesBackpackIncludes = (BuildInfo -> Bool) -> [BuildInfo] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not (Bool -> Bool) -> (BuildInfo -> Bool) -> BuildInfo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Mixin] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Mixin] -> Bool) -> (BuildInfo -> [Mixin]) -> BuildInfo -> Bool
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 =
      [Extension] -> [Extension]
forall a. Eq a => [a] -> [a]
nub ((Extension -> Bool) -> [Extension] -> [Extension]
forall a. (a -> Bool) -> [a] -> [a]
filter (Extension -> [Extension] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`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 =
      [Extension] -> [Extension]
forall a. Eq a => [a] -> [a]
nub ((Extension -> Bool) -> [Extension] -> [Extension]
forall a. (a -> Bool) -> [a] -> [a]
filter (Extension -> [Extension] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Extension]
compatExtensions) [Extension]
mentionedExtensions)

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

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

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

    allModuleNamesAutogen :: [ModuleName]
allModuleNamesAutogen = (BuildInfo -> [ModuleName]) -> [BuildInfo] -> [ModuleName]
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 =
  [Maybe PackageCheck] -> [PackageCheck]
forall a. [Maybe a] -> [a]
catMaybes [

    -- Check that the version of base is bounded above.
    -- For example this bans "build-depends: base >= 3".
    -- It should probably be "build-depends: base >= 3 && < 4"
    -- which is the same as  "build-depends: base == 3.*"
    Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not (VersionRange -> Bool
boundedAbove VersionRange
baseDependency)) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"The dependency 'build-depends: base' does not specify an upper "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"bound on the version number. Each major release of the 'base' "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"package changes the API in various ways and most packages will "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"need some changes to compile with it. The recommended practice "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"is to specify an upper bound on the version of the 'base' "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"package. This ensures your package will continue to build when a "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"new major version of the 'base' package is released. If you are "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"not sure what upper bound to use then use the next  major "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"version. For example if you have tested your package with 'base' "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"version 4.5 and 4.6 then use 'build-depends: base >= 4.5 && < 4.7'."

  ]
  where
    -- 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.
    finalised :: Either [Dependency] (PackageDescription, FlagAssignment)
finalised = FlagAssignment
-> ComponentRequestedSpec
-> (Dependency -> Bool)
-> Platform
-> CompilerInfo
-> [PackageVersionConstraint]
-> GenericPackageDescription
-> Either [Dependency] (PackageDescription, FlagAssignment)
finalizePD
                              FlagAssignment
forall a. Monoid a => a
mempty ComponentRequestedSpec
defaultComponentRequestedSpec (Bool -> Dependency -> Bool
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)
                              [] GenericPackageDescription
pkg
    baseDependency :: VersionRange
baseDependency = case Either [Dependency] (PackageDescription, FlagAssignment)
finalised of
      Right (PackageDescription
pkg', FlagAssignment
_) | Bool -> Bool
not ([VersionRange] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [VersionRange]
baseDeps) ->
          (VersionRange -> VersionRange -> VersionRange)
-> VersionRange -> [VersionRange] -> VersionRange
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr VersionRange -> VersionRange -> VersionRange
intersectVersionRanges VersionRange
anyVersion [VersionRange]
baseDeps
        where
          baseDeps :: [VersionRange]
baseDeps =
            [ VersionRange
vr | Dependency PackageName
pname VersionRange
vr NonEmptySet LibraryName
_ <- PackageDescription -> [Dependency]
allBuildDepends PackageDescription
pkg'
                 , PackageName
pname PackageName -> PackageName -> Bool
forall a. Eq a => a -> a -> Bool
== String -> PackageName
mkPackageName String
"base" ]

      -- Just in case finalizePD fails for any reason,
      -- or if the package doesn't depend on the base package at all,
      -- then we will just skip the check, since boundedAbove noVersion = True
      Either [Dependency] (PackageDescription, FlagAssignment)
_          -> VersionRange
noVersion

    boundedAbove :: VersionRange -> Bool
    boundedAbove :: VersionRange -> Bool
boundedAbove VersionRange
vr = case VersionRange -> [VersionInterval]
asVersionIntervals VersionRange
vr of
      []     -> Bool
True -- this is the inconsistent version range.
      (VersionInterval
x:[VersionInterval]
xs) -> case NonEmpty VersionInterval -> VersionInterval
forall a. NonEmpty a -> a
last (VersionInterval
xVersionInterval -> [VersionInterval] -> NonEmpty VersionInterval
forall a. a -> [a] -> NonEmpty a
:|[VersionInterval]
xs) of
        (LowerBound
_,   UpperBound Version
_ Bound
_) -> Bool
True
        (LowerBound
_, UpperBound
NoUpperBound    ) -> Bool
False


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

    Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
unknownOSs) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"Unknown operating system name "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep (ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
quote [String]
unknownOSs)

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
unknownArches) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"Unknown architecture name "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep (ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
quote [String]
unknownArches)

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
unknownImpls) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"Unknown compiler name "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
commaSep (ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
quote [String]
unknownImpls)
  ]
  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 = (CondTree ConfVar [Dependency] Library -> [ConfVar])
-> [CondTree ConfVar [Dependency] Library] -> [ConfVar]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap CondTree ConfVar [Dependency] Library -> [ConfVar]
forall a c a. CondTree a c a -> [a]
fvs (Maybe (CondTree ConfVar [Dependency] Library)
-> [CondTree ConfVar [Dependency] Library]
forall a. Maybe a -> [a]
maybeToList (GenericPackageDescription
-> Maybe (CondTree ConfVar [Dependency] Library)
condLibrary GenericPackageDescription
pkg))
              [ConfVar] -> [ConfVar] -> [ConfVar]
forall a. [a] -> [a] -> [a]
++ ((UnqualComponentName, CondTree ConfVar [Dependency] Library)
 -> [ConfVar])
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
-> [ConfVar]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (CondTree ConfVar [Dependency] Library -> [ConfVar]
forall a c a. CondTree a c a -> [a]
fvs (CondTree ConfVar [Dependency] Library -> [ConfVar])
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Library)
    -> CondTree ConfVar [Dependency] Library)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Library)
-> [ConfVar]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnqualComponentName, CondTree ConfVar [Dependency] Library)
-> CondTree ConfVar [Dependency] Library
forall a b. (a, b) -> b
snd) (GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
condSubLibraries GenericPackageDescription
pkg)
              [ConfVar] -> [ConfVar] -> [ConfVar]
forall a. [a] -> [a] -> [a]
++ ((UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
 -> [ConfVar])
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] ForeignLib)]
-> [ConfVar]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (CondTree ConfVar [Dependency] ForeignLib -> [ConfVar]
forall a c a. CondTree a c a -> [a]
fvs (CondTree ConfVar [Dependency] ForeignLib -> [ConfVar])
-> ((UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
    -> CondTree ConfVar [Dependency] ForeignLib)
-> (UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
-> [ConfVar]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
-> CondTree ConfVar [Dependency] ForeignLib
forall a b. (a, b) -> b
snd) (GenericPackageDescription
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] ForeignLib)]
condForeignLibs GenericPackageDescription
pkg)
              [ConfVar] -> [ConfVar] -> [ConfVar]
forall a. [a] -> [a] -> [a]
++ ((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
 -> [ConfVar])
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
-> [ConfVar]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (CondTree ConfVar [Dependency] Executable -> [ConfVar]
forall a c a. CondTree a c a -> [a]
fvs (CondTree ConfVar [Dependency] Executable -> [ConfVar])
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
    -> CondTree ConfVar [Dependency] Executable)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> [ConfVar]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> CondTree ConfVar [Dependency] Executable
forall a b. (a, b) -> b
snd) (GenericPackageDescription
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
condExecutables GenericPackageDescription
pkg)
              [ConfVar] -> [ConfVar] -> [ConfVar]
forall a. [a] -> [a] -> [a]
++ ((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
 -> [ConfVar])
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
-> [ConfVar]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (CondTree ConfVar [Dependency] TestSuite -> [ConfVar]
forall a c a. CondTree a c a -> [a]
fvs (CondTree ConfVar [Dependency] TestSuite -> [ConfVar])
-> ((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
    -> CondTree ConfVar [Dependency] TestSuite)
-> (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> [ConfVar]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> CondTree ConfVar [Dependency] TestSuite
forall a b. (a, b) -> b
snd) (GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
condTestSuites GenericPackageDescription
pkg)
              [ConfVar] -> [ConfVar] -> [ConfVar]
forall a. [a] -> [a] -> [a]
++ ((UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
 -> [ConfVar])
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
-> [ConfVar]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (CondTree ConfVar [Dependency] Benchmark -> [ConfVar]
forall a c a. CondTree a c a -> [a]
fvs (CondTree ConfVar [Dependency] Benchmark -> [ConfVar])
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
    -> CondTree ConfVar [Dependency] Benchmark)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> [ConfVar]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> CondTree ConfVar [Dependency] Benchmark
forall a b. (a, b) -> b
snd) (GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
condBenchmarks GenericPackageDescription
pkg)
    fvs :: CondTree a c a -> [a]
fvs (CondNode a
_ c
_ [CondBranch a c a]
ifs) = (CondBranch a c a -> [a]) -> [CondBranch a c a] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap CondBranch a c a -> [a]
compfv [CondBranch a c a]
ifs -- free variables
    compfv :: CondBranch a c a -> [a]
compfv (CondBranch Condition a
c CondTree a c a
ct Maybe (CondTree a c a)
mct) = Condition a -> [a]
forall a. Condition a -> [a]
condfv Condition a
c [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ CondTree a c a -> [a]
fvs CondTree a c a
ct [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a] -> (CondTree a c a -> [a]) -> Maybe (CondTree a c a) -> [a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] CondTree a c a -> [a]
fvs Maybe (CondTree a 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 [a] -> [a] -> [a]
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 [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Condition a -> [a]
condfv Condition a
c2

checkFlagNames :: GenericPackageDescription -> [PackageCheck]
checkFlagNames :: GenericPackageDescription -> [PackageCheck]
checkFlagNames GenericPackageDescription
gpd
    | [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
invalidFlagNames = []
    | Bool
otherwise             = [ String -> PackageCheck
PackageDistInexcusable
        (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$ String
"Suspicious flag names: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
invalidFlagNames String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
". "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"To avoid ambiguity in command line interfaces, flag shouldn't "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"start with a dash. Also for better compatibility, flag names "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"shouldn't contain non-ascii characters."
        ]
  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 = (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
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 Set FlagName -> Set FlagName -> Bool
forall a. Eq a => a -> a -> Bool
== Set FlagName
used = []
    | Bool
otherwise        = [ String -> PackageCheck
PackageDistSuspicious
        (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$ String
"Declared and used flag sets differ: "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ Set FlagName -> String
s Set FlagName
declared String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" /= " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Set FlagName -> String
s Set FlagName
used String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
". "
        ]
  where
    s :: Set.Set FlagName -> String
    s :: Set FlagName -> String
s = [String] -> String
commaSep ([String] -> String)
-> (Set FlagName -> [String]) -> Set FlagName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FlagName -> String) -> [FlagName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map FlagName -> String
unFlagName ([FlagName] -> [String])
-> (Set FlagName -> [FlagName]) -> Set FlagName -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set FlagName -> [FlagName]
forall a. Set a -> [a]
Set.toList

    declared :: Set.Set FlagName
    declared :: Set FlagName
declared = Getting (Set FlagName) GenericPackageDescription FlagName
-> GenericPackageDescription -> Set FlagName
forall a s. Getting (Set a) s a -> s -> Set a
toSetOf (LensLike
  (Const (Set FlagName))
  GenericPackageDescription
  GenericPackageDescription
  [PackageFlag]
  [PackageFlag]
Lens' GenericPackageDescription [PackageFlag]
L.genPackageFlags LensLike
  (Const (Set FlagName))
  GenericPackageDescription
  GenericPackageDescription
  [PackageFlag]
  [PackageFlag]
-> ((FlagName -> Const (Set FlagName) FlagName)
    -> [PackageFlag] -> Const (Set FlagName) [PackageFlag])
-> Getting (Set FlagName) GenericPackageDescription FlagName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PackageFlag -> Const (Set FlagName) PackageFlag)
-> [PackageFlag] -> Const (Set FlagName) [PackageFlag]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((PackageFlag -> Const (Set FlagName) PackageFlag)
 -> [PackageFlag] -> Const (Set FlagName) [PackageFlag])
-> ((FlagName -> Const (Set FlagName) FlagName)
    -> PackageFlag -> Const (Set FlagName) PackageFlag)
-> (FlagName -> Const (Set FlagName) FlagName)
-> [PackageFlag]
-> Const (Set FlagName) [PackageFlag]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FlagName -> Const (Set FlagName) FlagName)
-> PackageFlag -> Const (Set FlagName) PackageFlag
Lens' PackageFlag FlagName
L.flagName) GenericPackageDescription
gpd

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

checkUnicodeXFields :: GenericPackageDescription -> [PackageCheck]
checkUnicodeXFields :: GenericPackageDescription -> [PackageCheck]
checkUnicodeXFields GenericPackageDescription
gpd
    | [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
nonAsciiXFields = []
    | Bool
otherwise            = [ String -> PackageCheck
PackageDistInexcusable
        (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$ String
"Non ascii custom fields: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
nonAsciiXFields String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
". "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"For better compatibility, custom field names "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"shouldn't contain non-ascii characters."
        ]
  where
    nonAsciiXFields :: [String]
    nonAsciiXFields :: [String]
nonAsciiXFields = [ String
n | (String
n, String
_) <- [(String, String)]
xfields, (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isAscii) String
n ]

    xfields :: [(String,String)]
    xfields :: [(String, String)]
xfields = DList (String, String) -> [(String, String)]
forall a. DList a -> [a]
DList.runDList (DList (String, String) -> [(String, String)])
-> DList (String, String) -> [(String, String)]
forall a b. (a -> b) -> a -> b
$ [DList (String, String)] -> DList (String, String)
forall a. Monoid a => [a] -> a
mconcat
        [ Getting
  (DList (String, String)) GenericPackageDescription (String, String)
-> GenericPackageDescription -> DList (String, String)
forall a s. Getting (DList a) s a -> s -> DList a
toDListOf (LensLike
  (Const (DList (String, String)))
  GenericPackageDescription
  GenericPackageDescription
  PackageDescription
  PackageDescription
Lens' GenericPackageDescription PackageDescription
L.packageDescription LensLike
  (Const (DList (String, String)))
  GenericPackageDescription
  GenericPackageDescription
  PackageDescription
  PackageDescription
-> (((String, String)
     -> Const (DList (String, String)) (String, String))
    -> PackageDescription
    -> Const (DList (String, String)) PackageDescription)
-> Getting
     (DList (String, String)) GenericPackageDescription (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LensLike
  (Const (DList (String, String)))
  PackageDescription
  PackageDescription
  [(String, String)]
  [(String, String)]
Lens' PackageDescription [(String, String)]
L.customFieldsPD LensLike
  (Const (DList (String, String)))
  PackageDescription
  PackageDescription
  [(String, String)]
  [(String, String)]
-> (((String, String)
     -> Const (DList (String, String)) (String, String))
    -> [(String, String)]
    -> Const (DList (String, String)) [(String, String)])
-> ((String, String)
    -> Const (DList (String, String)) (String, String))
-> PackageDescription
-> Const (DList (String, String)) PackageDescription
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, String)
 -> Const (DList (String, String)) (String, String))
-> [(String, String)]
-> Const (DList (String, String)) [(String, String)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse) GenericPackageDescription
gpd
        , Getting
  (DList (String, String)) GenericPackageDescription (String, String)
-> GenericPackageDescription -> DList (String, String)
forall a s. Getting (DList a) s a -> s -> DList a
toDListOf (LensLike
  (Const (DList (String, String)))
  GenericPackageDescription
  GenericPackageDescription
  BuildInfo
  BuildInfo
forall a. HasBuildInfos a => Traversal' a BuildInfo
L.traverseBuildInfos LensLike
  (Const (DList (String, String)))
  GenericPackageDescription
  GenericPackageDescription
  BuildInfo
  BuildInfo
-> (((String, String)
     -> Const (DList (String, String)) (String, String))
    -> BuildInfo -> Const (DList (String, String)) BuildInfo)
-> Getting
     (DList (String, String)) GenericPackageDescription (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LensLike
  (Const (DList (String, String)))
  BuildInfo
  BuildInfo
  [(String, String)]
  [(String, String)]
forall a. HasBuildInfo a => Lens' a [(String, String)]
L.customFieldsBI LensLike
  (Const (DList (String, String)))
  BuildInfo
  BuildInfo
  [(String, String)]
  [(String, String)]
-> (((String, String)
     -> Const (DList (String, String)) (String, String))
    -> [(String, String)]
    -> Const (DList (String, String)) [(String, String)])
-> ((String, String)
    -> Const (DList (String, String)) (String, String))
-> BuildInfo
-> Const (DList (String, String)) BuildInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, String)
 -> Const (DList (String, String)) (String, String))
-> [(String, String)]
-> Const (DList (String, String)) [(String, String)]
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
pd
    | PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pd CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecV2_2 = []
    | (BuildInfo -> Bool) -> [BuildInfo] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any BuildInfo -> Bool
checkBI (PackageDescription -> [BuildInfo]
allBuildInfo PackageDescription
pd) Bool -> Bool -> Bool
|| (Library -> Bool) -> [Library] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Library -> Bool
checkLib (PackageDescription -> [Library]
allLibraries PackageDescription
pd)
        = PackageCheck -> [PackageCheck]
forall (m :: * -> *) a. Monad m => a -> m a
return (PackageCheck -> [PackageCheck]) -> PackageCheck -> [PackageCheck]
forall a b. (a -> b) -> a -> b
$ String -> PackageCheck
PackageBuildImpossible (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords
            [ String
"The package uses RebindableSyntax with OverloadedStrings or OverloadedLists"
            , String
"in default-extensions, and also Paths_ autogen module."
            , String
"That configuration is known to cause compile failures with Cabal < 2.2."
            , String
"To use these default-extensions with Paths_ autogen module"
            , String
"specify at least 'cabal-version: 2.2'."
            ]
    | Bool
otherwise = []
  where
    mn :: ModuleName
mn = PackageDescription -> ModuleName
autogenPathsModuleName PackageDescription
pd

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

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

    checkExts :: t Extension -> Bool
checkExts t Extension
exts = Extension
rebind Extension -> t Extension -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t Extension
exts Bool -> Bool -> Bool
&& (Extension
strings Extension -> t Extension -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t Extension
exts Bool -> Bool -> Bool
|| Extension
lists Extension -> t Extension -> Bool
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 distrubuted 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)
 [PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. [a] -> [a] -> [a]
++ String -> [String] -> [PackageCheck]
checkDevelopmentOnlyFlagsOptions String
"ghc-prof-options" (CompilerFlavor -> BuildInfo -> [String]
hcProfOptions CompilerFlavor
GHC BuildInfo
bi)
 [PackageCheck] -> [PackageCheck] -> [PackageCheck]
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 =
  [Maybe PackageCheck] -> [PackageCheck]
forall a. [Maybe a] -> [a]
catMaybes [

    Bool -> PackageCheck -> Maybe PackageCheck
check Bool
has_WerrorWall (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fieldName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": -Wall -Werror' makes the package very easy to "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"break with future GHC versions because new GHC versions often "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"add new warnings. Use just '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fieldName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": -Wall' instead."
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
extraExplanation

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not Bool
has_WerrorWall Bool -> Bool -> Bool
&& Bool
has_Werror) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fieldName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": -Werror' makes the package easy to "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"break with future GHC versions because new GHC versions often "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"add new warnings. "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
extraExplanation

  , Bool -> PackageCheck -> Maybe PackageCheck
check (Bool
has_J) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fieldName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": -j[N]' can make sense for specific user's setup,"
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" but it is not appropriate for a distributed package."
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
extraExplanation

  , [String] -> PackageCheck -> Maybe PackageCheck
checkFlags [String
"-fdefer-type-errors"] (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fieldName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": -fdefer-type-errors' is fine during development but "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"is not appropriate for a distributed package. "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
extraExplanation

    -- -dynamic is not a debug flag
  , Bool -> PackageCheck -> Maybe PackageCheck
check ((String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\String
opt -> String
"-d" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
opt Bool -> Bool -> Bool
&& String
opt String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"-dynamic")
           [String]
ghcOptions) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistInexcusable (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fieldName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": -d*' debug flags are not appropriate "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"for a distributed package. "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
extraExplanation

  , [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"] (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
      String -> PackageCheck
PackageDistSuspicious (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fieldName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": -fprof*' profiling flags are typically not "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"appropriate for a distributed library package. These flags are "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"useful to profile this package, but when profiling other packages "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"that use this one these flags clutter the profile output with "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"excessive detail. If you think other packages really want to see "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"cost centres from this package then use '-fprof-auto-exported' "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"which puts cost centres only on exported functions. "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
extraExplanation
  ]
  where
    extraExplanation :: String
extraExplanation =
         String
" Alternatively, if you want to use this, make it conditional based "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"on a Cabal configuration flag (with 'manual: True' and 'default: "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"False') and enable that flag during development."

    has_WerrorWall :: Bool
has_WerrorWall   = Bool
has_Werror Bool -> Bool -> Bool
&& ( Bool
has_Wall Bool -> Bool -> Bool
|| Bool
has_W )
    has_Werror :: Bool
has_Werror       = String
"-Werror" String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
ghcOptions
    has_Wall :: Bool
has_Wall         = String
"-Wall"   String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
ghcOptions
    has_W :: Bool
has_W            = String
"-W"      String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
ghcOptions
    has_J :: Bool
has_J            = (String -> Bool) -> [String] -> Bool
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 ((String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> [String] -> Bool
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 =
    (BuildInfo -> [PackageCheck]) -> [BuildInfo] -> [PackageCheck]
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 ((Condition ConfVar -> Bool) -> [Condition ConfVar] -> Bool
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)) = Bool -> (Bool -> Bool) -> Maybe Bool -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Bool -> Bool
not (FlagName -> Map FlagName Bool -> Maybe Bool
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)) = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (FlagName -> Map FlagName Bool -> Maybe Bool
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 = [(FlagName, Bool)] -> Map FlagName Bool
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 =
        (CondTree ConfVar [Dependency] Library
 -> [([Condition ConfVar], BuildInfo)])
-> [CondTree ConfVar [Dependency] Library]
-> [([Condition ConfVar], BuildInfo)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Library -> BuildInfo)
-> CondTree ConfVar [Dependency] Library
-> [([Condition ConfVar], BuildInfo)]
forall a b v c. (a -> b) -> CondTree v c a -> [([Condition v], b)]
collectCondTreePaths Library -> BuildInfo
libBuildInfo)
                  (Maybe (CondTree ConfVar [Dependency] Library)
-> [CondTree ConfVar [Dependency] Library]
forall a. Maybe a -> [a]
maybeToList (GenericPackageDescription
-> Maybe (CondTree ConfVar [Dependency] Library)
condLibrary GenericPackageDescription
pkg))

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

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

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

     [([Condition ConfVar], BuildInfo)]
-> [([Condition ConfVar], BuildInfo)]
-> [([Condition ConfVar], BuildInfo)]
forall a. [a] -> [a] -> [a]
++ ((UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
 -> [([Condition ConfVar], BuildInfo)])
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
-> [([Condition ConfVar], BuildInfo)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Benchmark -> BuildInfo)
-> CondTree ConfVar [Dependency] Benchmark
-> [([Condition ConfVar], BuildInfo)]
forall a b v c. (a -> b) -> CondTree v c a -> [([Condition v], b)]
collectCondTreePaths Benchmark -> BuildInfo
benchmarkBuildInfo (CondTree ConfVar [Dependency] Benchmark
 -> [([Condition ConfVar], BuildInfo)])
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
    -> CondTree ConfVar [Dependency] Benchmark)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> [([Condition ConfVar], BuildInfo)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> CondTree ConfVar [Dependency] Benchmark
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 :: (a -> b) -> CondTree v c a -> [([Condition v], b)]
collectCondTreePaths a -> b
mapData = [Condition v] -> CondTree v c a -> [([Condition v], b)]
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:
            ([Condition v] -> [Condition v]
forall a. [a] -> [a]
reverse [Condition v]
conditions, a -> b
mapData (CondTree v c a -> a
forall v c a. CondTree v c a -> a
condTreeData CondTree v c a
condNode))

          ([Condition v], b) -> [([Condition v], b)] -> [([Condition v], b)]
forall a. a -> [a] -> [a]
: [[([Condition v], b)]] -> [([Condition v], b)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ [Condition v] -> CondTree v c a -> [([Condition v], b)]
go (Condition v
conditionCondition v -> [Condition v] -> [Condition v]
forall 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)
_) <- CondTree v c a -> [CondBranch v c a]
forall v c a. CondTree v c a -> [CondBranch v c a]
condTreeComponents CondTree v c a
condNode ]

         [([Condition v], b)]
-> [([Condition v], b)] -> [([Condition v], b)]
forall a. [a] -> [a] -> [a]
++ [[([Condition v], b)]] -> [([Condition v], b)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ [Condition v] -> CondTree v c a -> [([Condition v], b)]
go (Condition v
conditionCondition v -> [Condition v] -> [Condition v]
forall 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)) <- CondTree v c a -> [CondBranch v c a]
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 <- CheckPackageContentOps IO
-> PackageDescription -> IO [PackageCheck]
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.
  [PackageCheck] -> IO [PackageCheck]
forall (m :: * -> *) a. Monad m => a -> m a
return ([PackageCheck] -> [PackageCheck]
forall a. Ord a => [a] -> [a]
sort [PackageCheck]
contentChecks [PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. [a] -> [a] -> [a]
++ [PackageCheck] -> [PackageCheck]
forall a. Ord a => [a] -> [a]
sort [PackageCheck]
preDistributionChecks)
  where
    checkFilesIO :: CheckPackageContentOps IO
checkFilesIO = CheckPackageContentOps :: forall (m :: * -> *).
(String -> m Bool)
-> (String -> m Bool)
-> (String -> m [String])
-> (String -> m ByteString)
-> CheckPackageContentOps m
CheckPackageContentOps {
      doesFileExist :: String -> IO Bool
doesFileExist        = String -> IO Bool
System.doesFileExist                  (String -> IO Bool) -> ShowS -> String -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
relative,
      doesDirectoryExist :: String -> IO Bool
doesDirectoryExist   = String -> IO Bool
System.doesDirectoryExist             (String -> IO Bool) -> ShowS -> String -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
relative,
      getDirectoryContents :: String -> IO [String]
getDirectoryContents = String -> IO [String]
System.Directory.getDirectoryContents (String -> IO [String]) -> ShowS -> String -> IO [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
relative,
      getFileContents :: String -> IO ByteString
getFileContents      = String -> IO ByteString
BS.readFile                           (String -> IO ByteString) -> ShowS -> String -> IO ByteString
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 {
    CheckPackageContentOps m -> String -> m Bool
doesFileExist        :: FilePath -> m Bool,
    CheckPackageContentOps m -> String -> m Bool
doesDirectoryExist   :: FilePath -> m Bool,
    CheckPackageContentOps m -> String -> m [String]
getDirectoryContents :: FilePath -> m [FilePath],
    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 :: CheckPackageContentOps m -> PackageDescription -> m [PackageCheck]
checkPackageContent CheckPackageContentOps m
ops PackageDescription
pkg = do
  Maybe PackageCheck
cabalBomError   <- CheckPackageContentOps m -> m (Maybe PackageCheck)
forall (m :: * -> *).
Monad m =>
CheckPackageContentOps m -> m (Maybe PackageCheck)
checkCabalFileBOM    CheckPackageContentOps m
ops
  Maybe PackageCheck
cabalNameError  <- CheckPackageContentOps m
-> PackageDescription -> m (Maybe PackageCheck)
forall (m :: * -> *).
Monad m =>
CheckPackageContentOps m
-> PackageDescription -> m (Maybe PackageCheck)
checkCabalFileName   CheckPackageContentOps m
ops PackageDescription
pkg
  [PackageCheck]
licenseErrors   <- CheckPackageContentOps m -> PackageDescription -> m [PackageCheck]
forall (m :: * -> *).
(Monad m, Applicative m) =>
CheckPackageContentOps m -> PackageDescription -> m [PackageCheck]
checkLicensesExist   CheckPackageContentOps m
ops PackageDescription
pkg
  Maybe PackageCheck
setupError      <- CheckPackageContentOps m
-> PackageDescription -> m (Maybe PackageCheck)
forall (m :: * -> *).
Monad m =>
CheckPackageContentOps m
-> PackageDescription -> m (Maybe PackageCheck)
checkSetupExists     CheckPackageContentOps m
ops PackageDescription
pkg
  Maybe PackageCheck
configureError  <- CheckPackageContentOps m
-> PackageDescription -> m (Maybe PackageCheck)
forall (m :: * -> *).
Monad m =>
CheckPackageContentOps m
-> PackageDescription -> m (Maybe PackageCheck)
checkConfigureExists CheckPackageContentOps m
ops PackageDescription
pkg
  [PackageCheck]
localPathErrors <- CheckPackageContentOps m -> PackageDescription -> m [PackageCheck]
forall (m :: * -> *).
Monad m =>
CheckPackageContentOps m -> PackageDescription -> m [PackageCheck]
checkLocalPathsExist CheckPackageContentOps m
ops PackageDescription
pkg
  [PackageCheck]
vcsLocation     <- CheckPackageContentOps m -> PackageDescription -> m [PackageCheck]
forall (m :: * -> *).
(Monad m, Applicative m) =>
CheckPackageContentOps m -> PackageDescription -> m [PackageCheck]
checkMissingVcsInfo  CheckPackageContentOps m
ops PackageDescription
pkg

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

checkCabalFileBOM :: Monad m => CheckPackageContentOps m
                  -> m (Maybe PackageCheck)
checkCabalFileBOM :: CheckPackageContentOps m -> m (Maybe PackageCheck)
checkCabalFileBOM CheckPackageContentOps m
ops = do
  Either PackageCheck String
epdfile <- CheckPackageContentOps m -> m (Either PackageCheck String)
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
_       -> Maybe PackageCheck -> m (Maybe PackageCheck)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe PackageCheck -> m (Maybe PackageCheck))
-> Maybe PackageCheck -> m (Maybe PackageCheck)
forall a b. (a -> b) -> a -> b
$ Maybe PackageCheck
forall a. Maybe a
Nothing
    Right String
pdfile -> ((Bool -> PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Bool -> Maybe PackageCheck
forall a b c. (a -> b -> c) -> b -> a -> c
flip Bool -> PackageCheck -> Maybe PackageCheck
check PackageCheck
pc (Bool -> Maybe PackageCheck)
-> (ByteString -> Bool) -> ByteString -> Maybe PackageCheck
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> Bool
BS.isPrefixOf ByteString
bomUtf8)
                    (ByteString -> Maybe PackageCheck)
-> m ByteString -> m (Maybe PackageCheck)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` (CheckPackageContentOps m -> String -> m ByteString
forall (m :: * -> *).
CheckPackageContentOps m -> String -> m ByteString
getFileContents CheckPackageContentOps m
ops String
pdfile)
      where pc :: PackageCheck
pc = String -> PackageCheck
PackageDistInexcusable (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
                 String
pdfile String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" starts with an Unicode byte order mark (BOM)."
                 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" This may cause problems with older cabal versions."

  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 :: 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 <- CheckPackageContentOps m -> m (Either PackageCheck String)
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
_       -> Maybe PackageCheck -> m (Maybe PackageCheck)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe PackageCheck
forall a. Maybe a
Nothing
    Right String
pdfile
      | ShowS
takeFileName String
pdfile String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
expectedCabalname -> Maybe PackageCheck -> m (Maybe PackageCheck)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe PackageCheck
forall a. Maybe a
Nothing
      | Bool
otherwise -> Maybe PackageCheck -> m (Maybe PackageCheck)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe PackageCheck -> m (Maybe PackageCheck))
-> Maybe PackageCheck -> m (Maybe PackageCheck)
forall a b. (a -> b) -> a -> b
$ PackageCheck -> Maybe PackageCheck
forall a. a -> Maybe a
Just (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$ String -> PackageCheck
PackageDistInexcusable (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
                 String
"The filename " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
pdfile String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" does not match package name " String -> ShowS
forall a. [a] -> [a] -> [a]
++
                 String
"(expected: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
expectedCabalname String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
  where
    pkgname :: String
pkgname = PackageName -> String
unPackageName (PackageName -> String)
-> (PackageDescription -> PackageName)
-> PackageDescription
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName (PackageDescription -> String) -> PackageDescription -> String
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 :: CheckPackageContentOps m -> m (Either PackageCheck String)
findPackageDesc CheckPackageContentOps m
ops
 = do let dir :: String
dir = String
"."
      [String]
files <- CheckPackageContentOps m -> String -> m [String]
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 <- (String -> m Bool) -> [String] -> m [String]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (CheckPackageContentOps m -> String -> m Bool
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 (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
name) Bool -> Bool -> Bool
&& String
ext String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".cabal" ]
      case [String]
cabalFiles of
        []          -> Either PackageCheck String -> m (Either PackageCheck String)
forall (m :: * -> *) a. Monad m => a -> m a
return (PackageCheck -> Either PackageCheck String
forall a b. a -> Either a b
Left (PackageCheck -> Either PackageCheck String)
-> PackageCheck -> Either PackageCheck String
forall a b. (a -> b) -> a -> b
$ String -> PackageCheck
PackageBuildImpossible String
noDesc)
        [String
cabalFile] -> Either PackageCheck String -> m (Either PackageCheck String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Either PackageCheck String
forall a b. b -> Either a b
Right String
cabalFile)
        [String]
multiple    -> Either PackageCheck String -> m (Either PackageCheck String)
forall (m :: * -> *) a. Monad m => a -> m a
return (PackageCheck -> Either PackageCheck String
forall a b. a -> Either a b
Left (PackageCheck -> Either PackageCheck String)
-> PackageCheck -> Either PackageCheck String
forall a b. (a -> b) -> a -> b
$ String -> PackageCheck
PackageBuildImpossible
                               (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$ [String] -> String
multiDesc [String]
multiple)

  where
    noDesc :: String
    noDesc :: String
noDesc = String
"No cabal file found.\n"
             String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Please create a package description file <pkgname>.cabal"

    multiDesc :: [String] -> String
    multiDesc :: [String] -> String
multiDesc [String]
l = String
"Multiple cabal files found while checking.\n"
                  String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Please use only one of: "
                  String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String]
l

checkLicensesExist :: (Monad m, Applicative m)
                   => CheckPackageContentOps m
                   -> PackageDescription
                   -> m [PackageCheck]
checkLicensesExist :: CheckPackageContentOps m -> PackageDescription -> m [PackageCheck]
checkLicensesExist CheckPackageContentOps m
ops PackageDescription
pkg = do
    [Bool]
exists <- (String -> m Bool) -> [String] -> m [Bool]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (CheckPackageContentOps m -> String -> m Bool
forall (m :: * -> *). CheckPackageContentOps m -> String -> m Bool
doesFileExist CheckPackageContentOps m
ops) (PackageDescription -> [String]
licenseFiles PackageDescription
pkg)
    [PackageCheck] -> m [PackageCheck]
forall (m :: * -> *) a. Monad m => a -> m a
return
      [ String -> PackageCheck
PackageBuildWarning (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
           String
"The '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fieldname String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' field refers to the file "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
quote String
file String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" which does not exist."
      | (String
file, Bool
False) <- [String] -> [Bool] -> [(String, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip (PackageDescription -> [String]
licenseFiles PackageDescription
pkg) [Bool]
exists ]
  where
    fieldname :: String
fieldname | [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (PackageDescription -> [String]
licenseFiles PackageDescription
pkg) Int -> Int -> Bool
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 :: CheckPackageContentOps m
-> PackageDescription -> m (Maybe PackageCheck)
checkSetupExists CheckPackageContentOps m
ops PackageDescription
pkg = do
  let simpleBuild :: Bool
simpleBuild = PackageDescription -> BuildType
buildType PackageDescription
pkg BuildType -> BuildType -> Bool
forall a. Eq a => a -> a -> Bool
== BuildType
Simple
  Bool
hsexists  <- CheckPackageContentOps m -> String -> m Bool
forall (m :: * -> *). CheckPackageContentOps m -> String -> m Bool
doesFileExist CheckPackageContentOps m
ops String
"Setup.hs"
  Bool
lhsexists <- CheckPackageContentOps m -> String -> m Bool
forall (m :: * -> *). CheckPackageContentOps m -> String -> m Bool
doesFileExist CheckPackageContentOps m
ops String
"Setup.lhs"
  Maybe PackageCheck -> m (Maybe PackageCheck)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe PackageCheck -> m (Maybe PackageCheck))
-> Maybe PackageCheck -> m (Maybe PackageCheck)
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) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
    String -> PackageCheck
PackageDistInexcusable (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
      String
"The package is missing a Setup.hs or Setup.lhs script."

checkConfigureExists :: Monad m => CheckPackageContentOps m
                     -> PackageDescription
                     -> m (Maybe PackageCheck)
checkConfigureExists :: CheckPackageContentOps m
-> PackageDescription -> m (Maybe PackageCheck)
checkConfigureExists CheckPackageContentOps m
ops PackageDescription
pd
  | PackageDescription -> BuildType
buildType PackageDescription
pd BuildType -> BuildType -> Bool
forall a. Eq a => a -> a -> Bool
== BuildType
Configure = do
      Bool
exists <- CheckPackageContentOps m -> String -> m Bool
forall (m :: * -> *). CheckPackageContentOps m -> String -> m Bool
doesFileExist CheckPackageContentOps m
ops String
"configure"
      Maybe PackageCheck -> m (Maybe PackageCheck)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe PackageCheck -> m (Maybe PackageCheck))
-> Maybe PackageCheck -> m (Maybe PackageCheck)
forall a b. (a -> b) -> a -> b
$ Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not Bool
exists) (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
        String -> PackageCheck
PackageBuildWarning (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
          String
"The 'build-type' is 'Configure' but there is no 'configure' script. "
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"You probably need to run 'autoreconf -i' to generate it."
  | Bool
otherwise = Maybe PackageCheck -> m (Maybe PackageCheck)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe PackageCheck
forall a. Maybe a
Nothing

checkLocalPathsExist :: Monad m => CheckPackageContentOps m
                     -> PackageDescription
                     -> m [PackageCheck]
checkLocalPathsExist :: 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 ]
               [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++ [ (String
dir, String
"extra-framework-dirs")
                  | String
dir <- BuildInfo -> [String]
extraFrameworkDirs  BuildInfo
bi ]
               [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++ [ (String
dir, String
"include-dirs")   | String
dir <- BuildInfo -> [String]
includeDirs  BuildInfo
bi ]
               [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++ [ (String
dir, String
"hs-source-dirs") | String
dir <- BuildInfo -> [String]
hsSourceDirs BuildInfo
bi ]
             , String -> Bool
isRelativeOnAnyPlatform String
dir ]
  [(String, String)]
missing <- ((String, String) -> m Bool)
-> [(String, String)] -> m [(String, String)]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM ((Bool -> Bool) -> m Bool -> m Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Bool -> Bool
not (m Bool -> m Bool)
-> ((String, String) -> m Bool) -> (String, String) -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CheckPackageContentOps m -> String -> m Bool
forall (m :: * -> *). CheckPackageContentOps m -> String -> m Bool
doesDirectoryExist CheckPackageContentOps m
ops (String -> m Bool)
-> ((String, String) -> String) -> (String, String) -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> a
fst) [(String, String)]
dirs
  [PackageCheck] -> m [PackageCheck]
forall (m :: * -> *) a. Monad m => a -> m a
return [ PackageBuildWarning :: String -> PackageCheck
PackageBuildWarning {
             explanation :: String
explanation = ShowS
quote (String
kind String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
dir)
                        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" directory does not exist."
           }
         | (String
dir, String
kind) <- [(String, String)]
missing ]

checkMissingVcsInfo :: (Monad m, Applicative m)
                    => CheckPackageContentOps m
                    -> PackageDescription
                    -> m [PackageCheck]
checkMissingVcsInfo :: CheckPackageContentOps m -> PackageDescription -> m [PackageCheck]
checkMissingVcsInfo CheckPackageContentOps m
ops PackageDescription
pkg | [SourceRepo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (PackageDescription -> [SourceRepo]
sourceRepos PackageDescription
pkg) = do
    Bool
vcsInUse <- ([Bool] -> Bool) -> m [Bool] -> m Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or (m [Bool] -> m Bool) -> m [Bool] -> m Bool
forall a b. (a -> b) -> a -> b
$ (String -> m Bool) -> [String] -> m [Bool]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (CheckPackageContentOps m -> String -> m Bool
forall (m :: * -> *). CheckPackageContentOps m -> String -> m Bool
doesDirectoryExist CheckPackageContentOps m
ops) [String]
repoDirnames
    if Bool
vcsInUse
      then [PackageCheck] -> m [PackageCheck]
forall (m :: * -> *) a. Monad m => a -> m a
return [ String -> PackageCheck
PackageDistSuspicious String
message ]
      else [PackageCheck] -> m [PackageCheck]
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]
    message :: String
message  = String
"When distributing packages it is encouraged to specify source "
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"control information in the .cabal file using one or more "
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'source-repository' sections. See the Cabal user guide for "
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"details."

checkMissingVcsInfo CheckPackageContentOps m
_ PackageDescription
_ = [PackageCheck] -> m [PackageCheck]
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 [String]
files =
     (Int -> [PackageCheck] -> [PackageCheck]
forall a. Int -> [a] -> [a]
take Int
1 ([PackageCheck] -> [PackageCheck])
-> ([String] -> [PackageCheck]) -> [String] -> [PackageCheck]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Maybe PackageCheck) -> [String] -> [PackageCheck]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe String -> Maybe PackageCheck
checkWindowsPath ([String] -> [PackageCheck]) -> [String] -> [PackageCheck]
forall a b. (a -> b) -> a -> b
$ [String]
files)
  [PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. [a] -> [a] -> [a]
++ (Int -> [PackageCheck] -> [PackageCheck]
forall a. Int -> [a] -> [a]
take Int
1 ([PackageCheck] -> [PackageCheck])
-> ([String] -> [PackageCheck]) -> [String] -> [PackageCheck]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Maybe PackageCheck) -> [String] -> [PackageCheck]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe String -> Maybe PackageCheck
checkTarPath     ([String] -> [PackageCheck]) -> [String] -> [PackageCheck]
forall a b. (a -> b) -> a -> b
$ [String]
files)
      -- If we get any of these checks triggering then we're likely to get
      -- many, and that's probably not helpful, so return at most one.

checkWindowsPath :: FilePath -> Maybe PackageCheck
checkWindowsPath :: String -> Maybe PackageCheck
checkWindowsPath String
path =
  Bool -> PackageCheck -> Maybe PackageCheck
check (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ String -> Bool
FilePath.Windows.isValid String
path') (PackageCheck -> Maybe PackageCheck)
-> PackageCheck -> Maybe PackageCheck
forall a b. (a -> b) -> a -> b
$
    String -> PackageCheck
PackageDistInexcusable (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
         String
"Unfortunately, the file " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
quote String
path String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is not a valid file "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"name on Windows which would cause portability problems for this "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"package. Windows file names cannot contain any of the characters "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\":*?<>|\" and there are a few reserved names including \"aux\", "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\"nul\", \"con\", \"prn\", \"com1-9\", \"lpt1-9\" and \"clock$\"."
  where
    path' :: String
path' = String
".\\" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
path
    -- 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.

-- | 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
  | String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
path Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
255   = PackageCheck -> Maybe PackageCheck
forall a. a -> Maybe a
Just PackageCheck
longPath
  | Bool
otherwise = case Int -> [String] -> Either PackageCheck [String]
forall (t :: * -> *) a.
Foldable t =>
Int -> [t a] -> Either PackageCheck [t a]
pack Int
nameMax ([String] -> [String]
forall a. [a] -> [a]
reverse (String -> [String]
splitPath String
path)) of
    Left PackageCheck
err           -> PackageCheck -> Maybe PackageCheck
forall a. a -> Maybe a
Just PackageCheck
err
    Right []           -> Maybe PackageCheck
forall a. Maybe a
Nothing
    Right (String
h:[String]
rest) -> case Int -> [String] -> Either PackageCheck [String]
forall (t :: * -> *) a.
Foldable t =>
Int -> [t a] -> Either PackageCheck [t a]
pack Int
prefixMax [String]
remainder of
      Left PackageCheck
err         -> PackageCheck -> Maybe PackageCheck
forall a. a -> Maybe a
Just PackageCheck
err
      Right []         -> Maybe PackageCheck
forall a. Maybe a
Nothing
      Right (String
_:[String]
_)      -> PackageCheck -> Maybe PackageCheck
forall a. a -> Maybe a
Just PackageCheck
noSplit
     where
        -- drop the '/' between the name and prefix:
        remainder :: [String]
remainder = ShowS
forall a. [a] -> [a]
safeInit String
h String -> [String] -> [String]
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
_   []     = PackageCheck -> Either PackageCheck [t a]
forall a b. a -> Either a b
Left PackageCheck
emptyName
    pack Int
maxLen (t a
c:[t a]
cs)
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxLen  = PackageCheck -> Either PackageCheck [t a]
forall a b. a -> Either a b
Left PackageCheck
longName
      | Bool
otherwise   = [t a] -> Either PackageCheck [t a]
forall a b. b -> Either a b
Right (Int -> Int -> [t a] -> [t a]
forall (t :: * -> *) a. Foldable t => Int -> Int -> [t a] -> [t a]
pack' Int
maxLen Int
n [t a]
cs)
      where n :: Int
n = t a -> Int
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' Int -> Int -> Bool
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
c
    pack' Int
_     Int
_ [t a]
cs = [t a]
cs

    longPath :: PackageCheck
longPath = String -> PackageCheck
PackageDistInexcusable (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
         String
"The following file name is too long to store in a portable POSIX "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"format tar archive. The maximum length is 255 ASCII characters.\n"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"The file in question is:\n  " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
path
    longName :: PackageCheck
longName = String -> PackageCheck
PackageDistInexcusable (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
         String
"The following file name is too long to store in a portable POSIX "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"format tar archive. The maximum length for the name part (including "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"extension) is 100 ASCII characters. The maximum length for any "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"individual directory component is 155.\n"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"The file in question is:\n  " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
path
    noSplit :: PackageCheck
noSplit = String -> PackageCheck
PackageDistInexcusable (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
         String
"The following file name is too long to store in a portable POSIX "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"format tar archive. While the total length is less than 255 ASCII "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"characters, there are unfortunately further restrictions. It has to "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"be possible to split the file path on a directory separator into "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"two parts such that the first part fits in 155 characters or less "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"and the second part fits in 100 characters or less. Basically you "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"have to make the file name or directory names shorter, or you could "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"split a long directory name into nested subdirectories with shorter "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"names.\nThe file in question is:\n  " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
path
    emptyName :: PackageCheck
emptyName = String -> PackageCheck
PackageDistInexcusable (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
         String
"Encountered a file with an empty name, something is very wrong! "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Files with an empty name cannot be stored in a tar archive or in "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"standard file systems."

-- --------------------------------------------------------------
-- * 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 =
  ([[PackageCheck]] -> [PackageCheck])
-> IO [[PackageCheck]] -> IO [PackageCheck]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[PackageCheck]] -> [PackageCheck]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (IO [[PackageCheck]] -> IO [PackageCheck])
-> IO [[PackageCheck]] -> IO [PackageCheck]
forall a b. (a -> b) -> a -> b
$ [(String, String, String)]
-> ((String, String, String) -> IO [PackageCheck])
-> IO [[PackageCheck]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [(String, String, String)]
allGlobs (((String, String, String) -> IO [PackageCheck])
 -> IO [[PackageCheck]])
-> ((String, String, String) -> IO [PackageCheck])
-> IO [[PackageCheck]]
forall a b. (a -> b) -> a -> b
$ \(String
field, String
dir, String
glob) ->
    -- 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
_ -> [PackageCheck] -> IO [PackageCheck]
forall (m :: * -> *) a. Monad m => a -> m a
return []
      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 individualWarnings :: [PackageCheck]
individualWarnings = [GlobResult String]
results [GlobResult String]
-> (GlobResult String -> [PackageCheck]) -> [PackageCheck]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> String -> GlobResult String -> [PackageCheck]
getWarning String
field String
glob
            noMatchesWarning :: [PackageCheck]
noMatchesWarning =
              [ String -> PackageCheck
PackageDistSuspiciousWarn (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
                     String
"In '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
field String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"': the pattern '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
glob String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' does not"
                  String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" match any files."
              | (GlobResult String -> Bool) -> [GlobResult String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool
not (Bool -> Bool)
-> (GlobResult String -> Bool) -> GlobResult String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobResult String -> Bool
forall a. GlobResult a -> Bool
suppressesNoMatchesWarning) [GlobResult String]
results
              ]
        [PackageCheck] -> IO [PackageCheck]
forall (m :: * -> *) a. Monad m => a -> m a
return ([PackageCheck]
noMatchesWarning [PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. [a] -> [a] -> [a]
++ [PackageCheck]
individualWarnings)
  where
    adjustedDataDir :: String
adjustedDataDir = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (PackageDescription -> String
dataDir PackageDescription
pkg) then String
"." else PackageDescription -> String
dataDir PackageDescription
pkg
    allGlobs :: [(String, String, String)]
allGlobs = [[(String, String, String)]] -> [(String, String, String)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [ (,,) String
"extra-source-files" String
"." (String -> (String, String, String))
-> [String] -> [(String, String, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackageDescription -> [String]
extraSrcFiles PackageDescription
pkg
      , (,,) String
"extra-doc-files" String
"." (String -> (String, String, String))
-> [String] -> [(String, String, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackageDescription -> [String]
extraDocFiles PackageDescription
pkg
      , (,,) String
"data-files" String
adjustedDataDir (String -> (String, String, String))
-> [String] -> [(String, String, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackageDescription -> [String]
dataFiles PackageDescription
pkg
      ]

    -- 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 -> [PackageCheck]
    getWarning :: String -> String -> GlobResult String -> [PackageCheck]
getWarning String
_ String
_ (GlobMatch String
_) =
      []
    -- 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) =
      [ String -> PackageCheck
PackageDistSuspiciousWarn (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
             String
"In '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
field String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"': the pattern '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
glob String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' does not"
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" match the file '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
file String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' because the extensions do not"
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" exactly match (e.g., foo.en.html does not exactly match *.html)."
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" To enable looser suffix-only matching, set 'cabal-version: 2.4' or higher."
      ]
    getWarning String
field String
glob (GlobMissingDirectory String
dir) =
      [ String -> PackageCheck
PackageDistSuspiciousWarn (String -> PackageCheck) -> String -> PackageCheck
forall a b. (a -> b) -> a -> b
$
             String
"In '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
field String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"': the pattern '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
glob String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' attempts to"
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" match files in the directory '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
dir String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"', but there is no"
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" directory by that name."
      ]

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

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

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

dups :: Ord a => [a] -> [a]
dups :: [a] -> [a]
dups [a]
xs = [ a
x | (a
x:a
_:[a]
_) <- [a] -> [[a]]
forall a. Eq a => [a] -> [[a]]
group ([a] -> [a]
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 String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
".hs", String
".lhs"]
    isC :: Bool
isC       = Maybe (CDialect, Bool) -> Bool
forall a. Maybe a -> Bool
isJust (String -> Maybe (CDialect, Bool)
filenameCDialect String
extension)

-- | Whether a path is a good relative path.
--
-- >>> let test fp = putStrLn $ show (isGoodRelativeDirectoryPath fp) ++ "; " ++ show (isGoodRelativeFilePath fp)
--
-- >>> test "foo/bar/quu"
-- 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", "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: .."
-- Just "reserved character '*'"; Just "reserved character '*'"
--
-- For the last case, 'isGoodRelativeGlob' doesn't warn:
--
-- >>> traverse_ (print . isGoodRelativeGlob) ["foo/../bar", "foo*bar"]
-- Just "parent directory segment: .."
-- Nothing
--
isGoodRelativeFilePath :: FilePath -> Maybe String
isGoodRelativeFilePath :: String -> Maybe String
isGoodRelativeFilePath = String -> Maybe String
state0
  where
    -- Reserved characters
    -- https://docs.microsoft.com/en-us/windows/win32/fileio/naming-a-file
    isReserved :: Char -> Bool
isReserved Char
c = Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"<>:\"\\/|?*"

    -- initial state
    state0 :: String -> Maybe String
state0 []                    = String -> Maybe String
forall a. a -> Maybe a
Just String
"empty path"
    state0 (Char
c:String
cs) | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.'     = String -> Maybe String
state1 String
cs
                  | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/'     = String -> Maybe String
forall a. a -> Maybe a
Just String
"posix absolute path"
                  | Char -> Bool
isReserved Char
c = String -> Maybe String
forall a. a -> Maybe a
Just (String
"reserved character " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show Char
c)
                  | Bool
otherwise    = String -> Maybe String
state3 String
cs

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

    -- after ./
    state2 :: String -> Maybe String
state2 []                    = String -> Maybe String
forall a. a -> Maybe a
Just String
"trailing slash"
    state2 (Char
c:String
cs) | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.'     = String -> Maybe String
state3 String
cs
                  | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/'     = String -> Maybe String
forall a. a -> Maybe a
Just String
"empty path segment"
                  | Char -> Bool
isReserved Char
c = String -> Maybe String
forall a. a -> Maybe a
Just (String
"reserved character " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show Char
c)
                  | Bool
otherwise    = String -> Maybe String
state5 String
cs

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

    -- after non-first segment's ..
    state4 :: String -> Maybe String
state4 []                    = String -> Maybe String
forall a. a -> Maybe a
Just String
"trailing parent directory segment: .."
    state4 (Char
c:String
cs) | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.'     = String -> Maybe String
state5 String
cs
                  | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/'     = String -> Maybe String
forall a. a -> Maybe a
Just String
"parent directory segment: .."
                  | Char -> Bool
isReserved Char
c = String -> Maybe String
forall a. a -> Maybe a
Just (String
"reserved character " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show Char
c)
                  | Bool
otherwise    = String -> Maybe String
state5 String
cs

    -- in a segment which is ok.
    state5 :: String -> Maybe String
state5 []                    = Maybe String
forall a. Maybe a
Nothing
    state5 (Char
c:String
cs) | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.'     = String -> Maybe String
state3 String
cs
                  | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/'     = String -> Maybe String
state2 String
cs
                  | Char -> Bool
isReserved Char
c = String -> Maybe String
forall a. a -> Maybe a
Just (String
"reserved character " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show Char
c)
                  | 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 (String -> Maybe String) -> ShowS -> String -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ShowS
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
    -- Reserved characters
    -- https://docs.microsoft.com/en-us/windows/win32/fileio/naming-a-file
    isReserved :: Char -> Bool
isReserved Char
c = Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"<>:\"\\/|?*"

    -- initial state
    state0 :: String -> Maybe String
state0 []                    = String -> Maybe String
forall a. a -> Maybe a
Just String
"empty path"
    state0 (Char
c:String
cs) | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.'     = String -> Maybe String
state5 String
cs
                  | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/'     = String -> Maybe String
forall a. a -> Maybe a
Just String
"posix absolute path"
                  | Char -> Bool
isReserved Char
c = String -> Maybe String
forall a. a -> Maybe a
Just (String
"reserved character " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show Char
c)
                  | Bool
otherwise    = String -> Maybe String
state4 String
cs

    -- after ./
    state1 :: String -> Maybe String
state1 []                    = Maybe String
forall a. Maybe a
Nothing -- "./"
    state1 (Char
c:String
cs) | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.'     = String -> Maybe String
state2 String
cs
                  | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/'     = String -> Maybe String
forall a. a -> Maybe a
Just String
"empty path segment"
                  | Char -> Bool
isReserved Char
c = String -> Maybe String
forall a. a -> Maybe a
Just (String
"reserved character " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show Char
c)
                  | Bool
otherwise    = String -> Maybe String
state4 String
cs

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

    -- after non-first segment's ..
    state3 :: String -> Maybe String
state3 []                    = String -> Maybe String
forall a. a -> Maybe a
Just String
"trailing parent directory segment: ."
    state3 (Char
c:String
cs) | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.'     = String -> Maybe String
state4 String
cs
                  | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/'     = String -> Maybe String
forall a. a -> Maybe a
Just String
"parent directory segment: .."
                  | Char -> Bool
isReserved Char
c = String -> Maybe String
forall a. a -> Maybe a
Just (String
"reserved character " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show Char
c)
                  | Bool
otherwise    = String -> Maybe String
state4 String
cs

    -- in a segment which is ok.
    state4 :: String -> Maybe String
state4 []                    = Maybe String
forall a. Maybe a
Nothing
    state4 (Char
c:String
cs) | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.'     = String -> Maybe String
state4 String
cs
                  | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/'     = String -> Maybe String
state1 String
cs
                  | Char -> Bool
isReserved Char
c = String -> Maybe String
forall a. a -> Maybe a
Just (String
"reserved character " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show Char
c)
                  | Bool
otherwise    = String -> Maybe String
state4 String
cs

    -- after .
    state5 :: String -> Maybe String
state5 []                    = Maybe String
forall a. Maybe a
Nothing -- "."
    state5 (Char
c:String
cs) | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.'     = String -> Maybe String
state3 String
cs
                  | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/'     = String -> Maybe String
state1 String
cs
                  | Char -> Bool
isReserved Char
c = String -> Maybe String
forall a. a -> Maybe a
Just (String
"reserved character " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show Char
c)
                  | 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 | COtherReserved | CChar
--   deriving (Eq, Ord, Enum, Bounded, Show)
--
-- reservedR :: ERE C
-- reservedR = notChar CSlash /\ notChar COtherReserved
--
-- 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
--     | x <= COtherReserved -> 6
--     | otherwise           -> 5
-- 1 -> \x -> if
--     | x <= CDot           -> 4
--     | x <= CSlash         -> 2
--     | x <= COtherReserved -> 6
--     | otherwise           -> 5
-- 2 -> \x -> if
--     | x <= CDot           -> 3
--     | x <= COtherReserved -> 6
--     | otherwise           -> 5
-- 3 -> \x -> if
--     | x <= CDot           -> 4
--     | x <= COtherReserved -> 6
--     | otherwise           -> 5
-- 4 -> \x -> if
--     | x <= CDot           -> 5
--     | x <= COtherReserved -> 6
--     | otherwise           -> 5
-- 5+ -> \x -> if
--     | x <= CDot           -> 5
--     | x <= CSlash         -> 2
--     | x <= COtherReserved -> 6
--     | otherwise           -> 5
-- 6 -> \_ -> 6 -- black hole
-- @
--
-- and @dirPathR@:
--
-- @
-- 0 -> \x -> if
--     | x <= CDot           -> 5
--     | x <= COtherReserved -> 6
--     | otherwise           -> 4
-- 1+ -> \x -> if
--     | x <= CDot           -> 2
--     | x <= COtherReserved -> 6
--     | otherwise           -> 4
-- 2 -> \x -> if
--     | x <= CDot           -> 3
--     | x <= COtherReserved -> 6
--     | otherwise           -> 4
-- 3 -> \x -> if
--     | x <= CDot           -> 4
--     | x <= COtherReserved -> 6
--     | otherwise           -> 4
-- 4+ -> \x -> if
--     | x <= CDot           -> 4
--     | x <= CSlash         -> 1
--     | x <= COtherReserved -> 6
--     | otherwise           -> 4
-- 5+ -> \x -> if
--     | x <= CDot           -> 3
--     | x <= CSlash         -> 1
--     | x <= COtherReserved -> 6
--     | otherwise           -> 4
-- 6 -> \_ -> 6 -- black hole
-- @